layers-game-0.3: src/States/CreatingPlatform.hs
{-# LANGUAGE TupleSections #-}
module States.CreatingPlatform where
#include "Utils.cpp"
import Control.Applicative ((<$>))
import Data.Composition ((.:))
import Gamgine.Control ((?))
import qualified Gamgine.Math.Vect as V
import qualified Gamgine.Math.Box as B
import qualified GameData.Level as LV
import qualified GameData.Data as GD
import qualified GameData.Entity as E
import qualified GameData.Platform as PF
import qualified Entity.Id as EI
import qualified Gamgine.State.State as ST
import qualified States.GameRunning as GR
IMPORT_LENS_AS_LE
data CreatingPlatform = CreatingPlatform {
entityId :: Maybe Int,
startPos :: V.Vect
}
-- | the state for creating a platform during edit mode
mkCreatingPlatformState :: ST.State GD.Data
mkCreatingPlatformState =
mkState $ CreatingPlatform Nothing V.nullVec
where
mkState cp = ST.State {
ST.enter = \mp gd ->
let id = LV.freeEntityId . LE.getL GD.currentLevelL $ gd
bound = B.Box V.nullVec V.nullVec
gd' = LE.modL GD.currentLevelL (LV.addEntity (PF.newPlatform id (Left mp) bound) LV.ToActiveLayer) gd
in Just (gd', mkState cp {entityId = Just id, startPos = mp}),
ST.leave = (, mkState cp {entityId = Nothing, startPos = V.nullVec}),
ST.update = (, mkState cp) . GR.update,
ST.render = ((, mkState cp) <$>) .: GR.render,
ST.keyEvent = (, mkState cp) .: flip const,
ST.mouseEvent = (, mkState cp) .: flip const,
ST.mouseMoved = \mp gd ->
case cp of
CreatingPlatform {entityId = Just id, startPos = sp} ->
(E.eMap (\e -> id == EI.entityId e ? updatePosAndBound mp sp e $ e) gd,
mkState cp)
}
updatePosAndBound :: V.Vect -> V.Vect -> E.Entity -> E.Entity
updatePosAndBound v1 v2 pf@(E.Platform {}) =
let minPt = V.minVec v1 v2
maxPt = V.maxVec v1 v2
diffVec = V.map abs $ maxPt - minPt
in pf {E.platformPosition = Left minPt,
E.platformBound = B.Box V.nullVec diffVec}
updatePosAndBound _ _ e = e