Implementation of creature update using endofunctor monoid
This commit is contained in:
@@ -63,7 +63,7 @@ polyToTriFold _ = []
|
|||||||
initialiseLamp :: Float -> CRUpdate
|
initialiseLamp :: Float -> CRUpdate
|
||||||
initialiseLamp h w (f,g) cr = ( (addLS . f , g), Just $ cr & crUpdate .~ updateLamp h i)
|
initialiseLamp h w (f,g) cr = ( (addLS . f , g), Just $ cr & crUpdate .~ updateLamp h i)
|
||||||
where
|
where
|
||||||
i = IM.newKey $ _lightSources $ f w -- to give different lights different keys
|
i = _crID cr
|
||||||
addLS = over lightSources (IM.insert i (lightAt (V3 x y h) i))
|
addLS = over lightSources (IM.insert i (lightAt (V3 x y h) i))
|
||||||
(V2 x y) = _crPos cr
|
(V2 x y) = _crPos cr
|
||||||
|
|
||||||
|
|||||||
@@ -30,9 +30,11 @@ import Control.Monad.State
|
|||||||
import System.Random
|
import System.Random
|
||||||
--import qualified Data.Set as S
|
--import qualified Data.Set as S
|
||||||
--import qualified Data.Map as M
|
--import qualified Data.Map as M
|
||||||
|
import Data.Monoid
|
||||||
|
|
||||||
type CRUpdate = World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
|
type CRUpdate = World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
|
||||||
|
|
||||||
|
|
||||||
meleeCooldown :: CRUpdate -> CRUpdate
|
meleeCooldown :: CRUpdate -> CRUpdate
|
||||||
meleeCooldown u w (f,g) cr = u w (f,g) $ cr & crMeleeCooldown . _Just %~ (max 0 . (\x -> x - 1))
|
meleeCooldown u w (f,g) cr = u w (f,g) $ cr & crMeleeCooldown . _Just %~ (max 0 . (\x -> x - 1))
|
||||||
-- | The movement is updated before the ai in order to correctly set the oldpos.
|
-- | The movement is updated before the ai in order to correctly set the oldpos.
|
||||||
|
|||||||
@@ -7,8 +7,6 @@ import Dodge.LevelGen.Data
|
|||||||
import Picture
|
import Picture
|
||||||
import Geometry.Data
|
import Geometry.Data
|
||||||
|
|
||||||
--import qualified Data.IntMap.Strict as IM
|
|
||||||
|
|
||||||
lightAt :: Point3 -> Int -> LightSource
|
lightAt :: Point3 -> Int -> LightSource
|
||||||
lightAt (V3 x y z) i =
|
lightAt (V3 x y z) i =
|
||||||
LS {_lsID = i
|
LS {_lsID = i
|
||||||
|
|||||||
+14
-3
@@ -26,9 +26,11 @@ import Data.List
|
|||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Function
|
import Data.Function
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
import qualified Data.IntMap.Strict as IM
|
import qualified Data.IntMap.Lazy as IM
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
|
import Data.Monoid
|
||||||
|
import System.Random
|
||||||
|
|
||||||
update :: World -> World
|
update :: World -> World
|
||||||
update = update' . pushSideEffects
|
update = update' . pushSideEffects
|
||||||
@@ -129,12 +131,21 @@ updateParticles w = set particles (catMaybes ps) w'
|
|||||||
where
|
where
|
||||||
(w',ps) = mapAccumR (\a b -> _ptUpdate' b a b) w $ _particles w
|
(w',ps) = mapAccumR (\a b -> _ptUpdate' b a b) w $ _particles w
|
||||||
|
|
||||||
updateCreatures :: World -> World
|
updateCreatures' :: World -> World
|
||||||
updateCreatures w = f $ set randGen newG $ set creatures (IM.mapMaybe id crs) w
|
updateCreatures' w = f $ set randGen newG $ set creatures (IM.mapMaybe id crs) w
|
||||||
where
|
where
|
||||||
((f,newG),crs) =
|
((f,newG),crs) =
|
||||||
IM.mapAccum (\g' cr -> _crUpdate cr w g' cr) (id,_randGen w) $ _creatures w
|
IM.mapAccum (\g' cr -> _crUpdate cr w g' cr) (id,_randGen w) $ _creatures w
|
||||||
|
|
||||||
|
updateToTM :: (World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)) -> World -> Creature -> (Endo World, Maybe Creature)
|
||||||
|
updateToTM u w cr = case u w (id,_randGen w) cr of
|
||||||
|
((f,_),mcr) -> (Endo f,mcr)
|
||||||
|
|
||||||
|
updateCreatures :: World -> World
|
||||||
|
updateCreatures w = appEndo f $ creatures .~ IM.mapMaybe id m $ w
|
||||||
|
where
|
||||||
|
(f,m) = traverse (\cr -> updateToTM (_crUpdate cr) w cr) (_creatures w)
|
||||||
|
|
||||||
{- |
|
{- |
|
||||||
Apply door mechanisms. -}
|
Apply door mechanisms. -}
|
||||||
updateWalls :: World -> World
|
updateWalls :: World -> World
|
||||||
|
|||||||
Reference in New Issue
Block a user