layers-game-0.3: src/States/MovingEntity.hs
{-# LANGUAGE TupleSections #-}
module States.MovingEntity where
#include "Utils.cpp"
import Control.Applicative ((<$>))
import Data.Composition ((.:))
import qualified Gamgine.Math.Vect as V
import Gamgine.Control ((?))
import qualified Gamgine.State.State as ST
import qualified States.GameRunning as GR
import qualified GameData.Level as LV
import qualified GameData.Entity as E
import qualified GameData.Data as GD
import qualified Entity.Id as EI
import qualified Entity.Position as EP
IMPORT_LENS_AS_LE
data MovingEntity = MovingEntity {
entityId :: Maybe Int,
startPos :: V.Vect,
basePos :: V.Vect
}
-- | the state for moving an entity during edit mode
mkMovingEntityState :: ST.State GD.Data
mkMovingEntityState =
mkState $ MovingEntity Nothing V.nullVec V.nullVec
where
mkState me = ST.State {
ST.enter = \mp gd ->
case LV.findEntityAt mp $ LE.getL GD.currentLevelL gd of
Just e -> Just (gd, mkState (me {entityId = Just $ EI.entityId e,
startPos = mp,
basePos = EP.position e}))
_ -> Nothing,
ST.leave = (, mkState (me {entityId = Nothing, startPos = V.nullVec, basePos = V.nullVec})),
ST.update = (, mkState me) . GR.update,
ST.render = ((, mkState me) <$>) .: GR.render,
ST.keyEvent = (, mkState me) .: flip const,
ST.mouseEvent = (, mkState me) .: flip const,
ST.mouseMoved = \mp gd ->
case me of
MovingEntity {entityId = Just id, startPos = sp, basePos = bp} ->
(E.eMap (\e -> id == EI.entityId e ? EP.setPosition e (bp + (mp - sp)) $ e) gd,
mkState me)
_ -> (gd, mkState me)
}