From cfb27d4a7633c79b72e9119e195207a3a2ad963d Mon Sep 17 00:00:00 2001
From: jgk <justin.g.kruger@gmail.com>
Date: Wed, 18 Aug 2021 00:59:35 +0200
Subject: [PATCH] Implementation of creature update using endofunctor monoid

---
 src/Dodge/Creature/Inanimate.hs |  2 +-
 src/Dodge/Creature/State.hs     |  4 +++-
 src/Dodge/LightSources.hs       |  2 --
 src/Dodge/Update.hs             | 17 ++++++++++++++---
 4 files changed, 18 insertions(+), 7 deletions(-)

diff --git a/src/Dodge/Creature/Inanimate.hs b/src/Dodge/Creature/Inanimate.hs
index a3978b356..ec54902f0 100644
--- a/src/Dodge/Creature/Inanimate.hs
+++ b/src/Dodge/Creature/Inanimate.hs
@@ -63,7 +63,7 @@ polyToTriFold _ = []
 initialiseLamp :: Float -> CRUpdate
 initialiseLamp h w (f,g) cr = ( (addLS . f , g), Just $ cr & crUpdate .~ updateLamp h i)
   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))
     (V2 x y) = _crPos cr
 
diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs
index 355a3af34..02c228b29 100644
--- a/src/Dodge/Creature/State.hs
+++ b/src/Dodge/Creature/State.hs
@@ -30,9 +30,11 @@ import Control.Monad.State
 import System.Random
 --import qualified Data.Set as S
 --import qualified Data.Map as M
-  
+import Data.Monoid
+
 type CRUpdate = World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
 
+
 meleeCooldown :: CRUpdate -> CRUpdate
 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.
diff --git a/src/Dodge/LightSources.hs b/src/Dodge/LightSources.hs
index ad217effe..ac19c31ed 100644
--- a/src/Dodge/LightSources.hs
+++ b/src/Dodge/LightSources.hs
@@ -7,8 +7,6 @@ import Dodge.LevelGen.Data
 import Picture
 import Geometry.Data
 
---import qualified Data.IntMap.Strict as IM
-
 lightAt :: Point3 -> Int -> LightSource
 lightAt (V3 x y z) i = 
     LS {_lsID = i
diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs
index 4de71152a..c21e660d2 100644
--- a/src/Dodge/Update.hs
+++ b/src/Dodge/Update.hs
@@ -26,9 +26,11 @@ import Data.List
 import Data.Maybe
 import Data.Function
 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 Control.Lens
+import Data.Monoid
+import System.Random
 
 update :: World -> World
 update = update' . pushSideEffects
@@ -129,12 +131,21 @@ updateParticles w = set particles (catMaybes ps) w'
   where 
     (w',ps) = mapAccumR (\a b -> _ptUpdate' b a b) w $ _particles w
 
-updateCreatures :: World -> World
-updateCreatures w = f $ set randGen newG $ set creatures (IM.mapMaybe id crs) w
+updateCreatures' :: World -> World
+updateCreatures' w = f $ set randGen newG $ set creatures (IM.mapMaybe id crs) w
   where 
     ((f,newG),crs) = 
         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.  -}
 updateWalls :: World -> World