Frame.hs

   1 -- This file is part of Intricacy
   2 -- Copyright (C) 2013 Martin Bays <mbays@sdf.org>
   3 --
   4 -- This program is free software: you can redistribute it and/or modify
   5 -- it under the terms of version 3 of the GNU General Public License as
   6 -- published by the Free Software Foundation, or any later version.
   7 --
   8 -- You should have received a copy of the GNU General Public License
   9 -- along with this program.  If not, see http://www.gnu.org/licenses/.
  10
  11 module Frame where
  12
  13 import           Data.List      ((\\))
  14 import qualified Data.Vector    as Vector
  15
  16 import           GameState
  17 import           GameStateTypes
  18 import           Hex
  19
  20 newtype Frame = BasicFrame Int
  21     deriving (Eq, Ord, Show, Read)
  22
  23 frameSize :: Frame -> Int
  24 frameSize (BasicFrame size) = size
  25
  26 bolthole, entrance :: Frame -> HexVec
  27 bolthole (BasicFrame size) = size*^hu +^ (size`div`2)*^hv
  28 entrance f = neg $ bolthole f
  29
  30 boltWidth :: Frame -> Int
  31 boltWidth (BasicFrame size) = size`div`4+1
  32
  33 baseState :: Frame -> GameState
  34 baseState f =
  35     GameState
  36         (Vector.fromList $ [ framePiece f, bolt ] ++ initTools f)
  37         []
  38     where
  39         bolt = PlacedPiece (bolthole f +^ origin) $ Block $
  40             [ n*^hu | n <- [-1..boltWidth f - 1] ] -- ++ [(-2)*^hu+^neg hv]
  41
  42 framePiece :: Frame -> PlacedPiece
  43 framePiece f@(BasicFrame size) =
  44     PlacedPiece origin . Block $
  45         map (bolthole f +^) (
  46             [ bw*^hu +^ n*^hv | n <- [0..bw] ]
  47             ++ [ bw*^hu +^ i*^hw +^ n*^hv | i <- [1..bw-1], n <- [0,bw+i] ])
  48         ++ map (entrance f +^) [neg hu +^ hv, 2 *^ neg hu, neg hu +^ hw,
  49                 2 *^ hw, neg hv +^ hw]
  50         ++ (concat [
  51                 [rotate r ((n *^ hu) +^ (size *^ hw)) | n <- [0 .. size - 1]] | r <- [0..5] ] \\
  52             [bolthole f, entrance f])
  53     where bw = boltWidth f
  54
  55 initTools :: Frame -> [PlacedPiece]
  56 initTools f =
  57     [ PlacedPiece (entrance f +^ neg hu +^ origin) $ Wrench zero,
  58     PlacedPiece (entrance f +^ hw +^ origin) $ Hook (neg hw) NullHF ]
  59
  60 clearToolArea :: Frame -> GameState -> GameState
  61 clearToolArea f st = foldr delPieceIn st $ toolsArea f
  62
  63
  64 boltArea,toolsArea :: Frame -> [HexPos]
  65 boltArea f = [PHS (bolthole f +^ bw *^ hu +^ i *^ hw +^ n *^ hv) |
  66    i <- [1 .. bw - 1], n <- [1 .. bw + i - 1]]
  67     where bw = boltWidth f
  68 toolsArea f = [entrance f +^ v +^ origin | v <- [ neg hu, hw, zero ] ]
  69
  70 inBounds :: Frame -> HexPos -> Bool
  71 inBounds f pos = hexLen (pos -^ origin) < frameSize f
  72 inEditable :: Frame -> HexPos -> Bool
  73 inEditable f pos = inBounds f pos || pos `elem` boltArea f ++ [PHS $ bolthole f] ++ toolsArea f
  74 checkBounds :: Frame -> HexPos -> HexPos -> HexPos
  75 checkBounds f def pos = if inBounds f pos then pos else def
  76 checkEditable :: Frame -> HexPos -> HexPos -> HexPos
  77 checkEditable f def pos = if inEditable f pos then pos else def
  78 truncateToBounds,truncateToEditable :: Frame -> HexPos -> HexPos
  79 truncateToBounds f pos@(PHS v) = PHS $ truncateToLength (frameSize f - 1) v
  80 truncateToEditable f pos@(PHS v) = if inBounds f pos
  81     then pos
  82     else head
  83         $ [ pos'
  84             | n <- reverse [0..boltWidth f]
  85             , let pos' = PHS $ truncateToLength (frameSize f - 1 + n) v
  86             , inEditable f pos' ]