packages feed

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