Cleanup

src/Dodge/Creature/Damage.hs

@@ -8,31 +8,31 @@ import Geometry
 import LensHelp
 
 import Control.Monad.State
-import System.Random
+--import System.Random
 import Data.List
 
-defaultApplyDamage :: [Damage] -> Creature -> (World -> World, Creature)
+defaultApplyDamage :: [Damage] -> Creature -> World -> World
-defaultApplyDamage ds cr = over _2 doPoisonDam $ foldl' applyIndividualDamage (id,cr) ds'
+defaultApplyDamage ds cr w = foldl' (applyIndividualDamage cr) w ds'
   where 
-    (ps,ds') = partition isPoison ds
+    (_,ds') = partition isPoison ds
     isPoison Damage{_dmType=PoisonDam} = True
     isPoison _ = False
-    poisonDam = quot (max 0 (sum (map _dmAmount ps))) 10
+--    poisonDam = quot (max 0 (sum (map _dmAmount ps))) 10
-    doPoisonDam = crHP -~ poisonDam
+--    doPoisonDam = crHP -~ poisonDam
 
-applyDamageEffect :: Damage -> DamageEffect -> (World->World,Creature) -> (World -> World, Creature)
+applyDamageEffect :: Damage -> DamageEffect -> Creature -> World -> World
-applyDamageEffect dm de (f,cr) = case de of
+applyDamageEffect dm de cr w = case de of
-    PushDamage push pushexp pushRad -> (f, cr 
+    PushDamage push pushexp pushRad -> w
-        & crPos %~ (+.+ (pushAmount *.* squashNormalizeV (_crPos cr -.- fromDir))) )
+        & creatures . ix (_crID cr) . crPos .+.+~ pushAmount *.* squashNormalizeV (_crPos cr -.- fromDir) 
       where
         pushAmount
             | dist (_crPos cr) fromDir == 0 = 0
             | otherwise = min 5 $ (push*5*pushRad / (dist (_crPos cr) fromDir * _crMass cr))**pushexp
-    PushBackDamage pback -> (f, cr
+    PushBackDamage pback -> w
-        & crPos %~ (+.+ ((1/_crMass cr) *.* pback ))
+        & creatures . ix (_crID cr) . crPos .+.+~ (1/_crMass cr) *.* pback
-        )
+    TorqueDamage rot -> w
-    TorqueDamage rot -> (f, cr & crDir +~ rot)
+        & creatures . ix (_crID cr) . crDir +~ rot
-    BounceBullet bt | crIsArmouredFrom p cr -> (f . (instantParticles .:~ bouncer), cr) -- TODO
+    BounceBullet bt | crIsArmouredFrom p cr -> w & instantParticles .:~ bouncer
       where
         bouncer = (aBulAt Nothing id (Just (_ptColor bt)) Nothing pOut reflectVel (_btDrag bt)
                                           (_ptHitEff bt) (_ptWidth bt)
@@ -41,32 +41,30 @@ applyDamageEffect dm de (f,cr) = case de of
         reflectVel = magV bulVel *.* newDir
         newDir = squashNormalizeV (p -.- _crPos cr)
         bulVel = _ptVel bt
-    DamageSpawn f -> (instantParticles .:~ thepart, cr)
+    BounceBullet _ -> w
+    DamageSpawn f -> w & instantParticles .:~ thepart
+        & randGen .~ g
       where
-        thepart = evalState (f (Left cr) dm) $ mkStdGen 0
+        (thepart,g) = runState (f (Left cr) dm) $ _randGen w
+    NoDamageEffect -> w
   where
     fromDir = _dmFrom dm
     p = _dmAt dm
 
-applyIndividualDamage :: (World -> World, Creature) -> Damage -> (World -> World, Creature)
+applyIndividualDamage :: Creature -> World -> Damage -> World
-applyIndividualDamage (f,cr) dm = applyDamageEffect dm (_dmEffect dm) (f . f', cr')
+applyIndividualDamage cr w dm = applyDamageEffect dm (_dmEffect dm) cr $ applyIndividualDamage' cr w dm
-  where
-    (f',cr') = applyIndividualDamage' (f,cr) dm
 
 --      & applyDamageEffect dm (_dmEffect dm)
 
-applyIndividualDamage' :: (World -> World, Creature) -> Damage -> (World -> World, Creature)
+applyIndividualDamage' :: Creature -> World -> Damage -> World
-applyIndividualDamage' (f,cr) dm = case _dmType dm of
+applyIndividualDamage' cr w dm = case _dmType dm of
-    Piercing -> applyPiercingDamage cr dm & _1 %~ (. f)
+    Piercing -> applyPiercingDamage cr dm w
-    _ -> (f , newcr )
+    _ -> w & creatures . ix (_crID cr) . crHP -~ _dmAmount dm
-  where
-    newcr = cr
-      & crHP -~ _dmAmount dm
 
-applyPiercingDamage :: Creature -> Damage -> (World -> World, Creature)
+applyPiercingDamage :: Creature -> Damage -> World -> World
 applyPiercingDamage cr dm
-    | crIsArmouredFrom p cr = (colSpark 8 (brightX 10 1.5 orange) p1 (argV (p1 -.- p)) , cr) 
+    | crIsArmouredFrom p cr = colSpark 8 (brightX 10 1.5 orange) p1 (argV (p1 -.- p))
-    | otherwise = (id, cr & crHP -~ _dmAmount dm)
+    | otherwise = creatures . ix (_crID cr) . crHP -~ _dmAmount dm
   where
     p = _dmAt dm
     p1 = p +.+ 2 *.* squashNormalizeV (p -.- _crPos cr)

src/Dodge/Creature/Inanimate.hs

@@ -55,11 +55,11 @@ explosiveBarrel = defaultInanimate
         {_crSpState = Barrel []
         }
     , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
-    ,_crApplyDamage = \_ c -> (id, c)
+    ,_crApplyDamage = \_ _ -> id
     }
 updateBarrel :: Creature -> World -> World
 updateBarrel cr
-    | _crHP cr > 0 = creatures . ix (_crID cr) %~ (snd . doDamage)
+    | _crHP cr > 0 = doDamage cr
     | otherwise    = creatures . at (_crID cr) .~ Nothing
 
 -- should generate the sparks externally using new random generators

src/Dodge/Creature/Lamp.hs

@@ -62,7 +62,7 @@ updateLamp h i cr w
         & creatures . at cid .~ Nothing
     | otherwise = w 
         & lightSources . ix i . lsParam . lsPos .~ addZ h cpos
-        & creatures . ix cid %~ (snd . doDamage)
+        & doDamage cr
   where
     cpos = _crPos cr
     cid  = _crID cr

src/Dodge/Creature/State.hs

@@ -47,16 +47,15 @@ stateUpdate :: (Creature -> World -> (World -> World, Creature))
     -> Creature -> World -> World
 stateUpdate = stateUpdateDamage doDamage
 
-stateUpdateDamage :: (Creature -> (World -> World,Creature)) 
+stateUpdateDamage :: (Creature -> World -> World)
     -> (Creature -> World -> (World -> World, Creature)) 
 --    -> CRUpdate
     -> Creature -> World -> World
-stateUpdateDamage damageupdate u cr w =  
+stateUpdateDamage damageupdate u cr w = damageupdate cr $
-    mvcrhammerup . invSideEff upcr . movementSideEff cr . deathEff . f . g $ w
+    mvcrhammerup . invSideEff upcr . movementSideEff cr . deathEff . f $ w
-        & creatures . at (_crID cr) .~  (stepReloading <$> crOrCorpse upcr')
+        & creatures . at (_crID cr) .~  (stepReloading <$> crOrCorpse upcr)
   where
     (f,upcr) = u (updateMovement cr) w
-    (g,upcr') = damageupdate upcr
     mvcrhammerup = creatures . ix (_crID cr) . crHammerPosition %~ moveHammerUp
     crOrCorpse cr' 
         | cr' ^. crHP > 0 = Just cr'
@@ -82,13 +81,14 @@ setOldPos cr = cr
     & crOldPos .~ _crPos cr
     & crOldDir .~ _crDir cr
 
-clearDamage :: Creature -> (World-> World,Creature)
+clearDamage :: Creature -> World -> World
-clearDamage cr = (id,cr&crState . crDamage .~ [])
+clearDamage cr = creatures . ix (_crID cr) . crState . crDamage .~ []
 
-doDamage :: Creature -> (World -> World, Creature)
+doDamage :: Creature -> World -> World
-doDamage cr = set (_2 . crState . crDamage) [] 
+doDamage cr w = w
-    . over (_2 . crState . crPastDamage) (advancePastDamages dams)
+    & creatures . ix (_crID cr) . crState . crDamage .~ [] 
-    $ _crApplyDamage cr dams cr
+    & creatures . ix (_crID cr) . crState . crPastDamage %~ advancePastDamages dams
+    & _crApplyDamage cr dams cr
   where 
     dams = _crDamage $ _crState cr
 

src/Dodge/Data.hs

@@ -277,7 +277,7 @@ data Creature = Creature
     , _crLeftInvSel     :: Maybe Int
     , _crState          :: CreatureState
     , _crCorpse         :: Picture
-    , _crApplyDamage    :: [Damage] -> Creature -> (World -> World,Creature)
+    , _crApplyDamage    :: [Damage] -> Creature -> World -> World
     , _crStance         :: Stance
     , _crActionPlan     :: ActionPlan
     , _crMeleeCooldown  :: Int