intricacy-0.3: Frame.hs

-- This file is part of Intricacy
-- Copyright (C) 2013 Martin Bays <mbays@sdf.org>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of version 3 of the GNU General Public License as
-- published by the Free Software Foundation.
--
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see http://www.gnu.org/licenses/.

module Frame where

import Data.List ((\\))
import qualified Data.Vector as Vector

import GameState
import GameStateTypes
import Hex

data Frame = BasicFrame Int
    deriving (Eq, Ord, Show, Read)

frameSize :: Frame -> Int
frameSize (BasicFrame size) = size
 
bolthole, entrance :: Frame -> HexVec
bolthole (BasicFrame size) = size<*>hu <+> (size`div`2)<*>hv
entrance f = neg $ bolthole f

boltWidth :: Frame -> Int
boltWidth (BasicFrame size) = size`div`4+1


baseState :: Frame -> GameState
baseState f =
    GameState 
	(Vector.fromList $ [ framePiece f, bolt ] ++ (initTools f))
	[]
    where
	bolt = PlacedPiece (bolthole f <+> origin) $ Block $
	    [ n<*>hu | n <- [-1..boltWidth f - 1] ] -- ++ [(-2)<*>hu<+>neg hv]

framePiece :: Frame -> PlacedPiece
framePiece f@(BasicFrame size) =
    PlacedPiece origin $ Block $
	map (bolthole f <+>) (
	    [ bw<*>hu <+> n<*>hv | n <- [0..bw] ]
	    ++ [ bw<*>hu <+> i<*>hw <+> n<*>hv | i <- [1..bw-1], n <- [0,bw+i] ])
	++ (map (entrance f <+>) [neg hu <+> hv, 2 <*> neg hu, neg hu <+> hw,
		2 <*> hw, neg hv <+> hw])
	++ (concat [
		map (rotate r) [ (n<*>hu) <+> (size<*>hw) | n <- [0..size-1] ] | r <- [0..5] ] \\ 
	    [bolthole f, entrance f])
    where bw = boltWidth f

initTools :: Frame -> [PlacedPiece]
initTools f =
    [ PlacedPiece (entrance f <+> neg hu <+> origin) $ Wrench zero,
    PlacedPiece (entrance f <+> hw <+> origin) $ Hook (neg hw) NullHF ]

clearToolArea :: Frame -> GameState -> GameState
clearToolArea f st = foldr delPieceIn st [entrance f <+> v <+> origin
	    | v <- [ neg hu, hw, zero ] ]

boltArea :: Frame -> [HexPos]
boltArea f = map PHS
	[ bolthole f <+> bw<*>hu <+> i<*>hw <+> n<*>hv | i <- [1..bw-1], n <- [1..bw+i-1] ]
    where bw = boltWidth f

inBounds :: Frame -> HexPos -> Bool
inBounds f pos = hexLen (pos <-> origin) < frameSize f
inEditable :: Frame -> HexPos -> Bool
inEditable f pos = inBounds f pos || pos `elem` boltArea f ++ [PHS $ bolthole f]
checkBounds :: Frame -> HexPos -> HexPos -> HexPos
checkBounds f def pos = if inBounds f pos then pos else def
checkEditable :: Frame -> HexPos -> HexPos -> HexPos
checkEditable f def pos = if inEditable f pos then pos else def
truncateToBounds,truncateToEditable :: Frame -> HexPos -> HexPos
truncateToBounds f pos@(PHS v) = PHS $ truncateToLength (frameSize f - 1) v
truncateToEditable f pos@(PHS v) = if inBounds f pos
    then pos
    else let pos' = PHS $ truncateToLength (frameSize f + boltWidth f - 1) v
	in if inEditable f pos'
	    then pos' else truncateToBounds f pos'