Cleanup

src/Dodge/Creature.hs

@@ -149,7 +149,7 @@ startCr = defaultCreature
     , _crMvDir  = pi/2
     , _crID = 0
     , _crPict = basicCrPict black
-    , _crUpdate = stateUpdate' yourControl
+    , _crUpdate = stateUpdate yourControl
     , _crRad = 10
     , _crMass = 10
     , _crHP = 1000

src/Dodge/Creature/ChaseCrit.hs

@@ -5,12 +5,10 @@ module Dodge.Creature.ChaseCrit
 import Dodge.Data
 import Dodge.Default
 import Dodge.Creature.Picture
-import Dodge.Creature.ChainUpdates
+import Dodge.Creature.Update
 import Dodge.Creature.ReaderUpdate
-import Dodge.Creature.Impulse
 import Dodge.Creature.Action
 import Dodge.Creature.Perception
-import Dodge.Creature.State
 import Dodge.Item.Consumable
 import Dodge.Picture.Layer
 import Dodge.SoundLogic
@@ -33,7 +31,7 @@ smallChaseCrit = chaseCrit
     }
 chaseCrit :: Creature
 chaseCrit = defaultCreature
-    { _crUpdate = stateUpdate' $ impulsiveAI' $ chainCreatureUpdates
+    { _crUpdate = defaultImpulsive
         [ const doStrategyActions
         , performActions
         , const overrideMeleeCloseTarget

src/Dodge/Creature/Impulse.hs

@@ -1,10 +1,7 @@
 {-# LANGUAGE TupleSections #-}
 module Dodge.Creature.Impulse
-    ( impulsiveAI
-    , impulsiveAI'
-    , followImpulses
+    ( impulsiveAI'
     , followThenClearImpulses
-    , followThenClearImpulses'
     ) where
 import Dodge.Data
 import Dodge.Creature.Vocalization
@@ -18,6 +15,15 @@ import qualified Data.IntMap.Strict as IM
 import System.Random
 import Data.Bifunctor
 --import Data.Maybe
+--
+impulsiveAIBeforeAfter 
+    :: (World -> Creature -> Creature)
+    -> (World -> Creature -> Creature)
+    -> Creature -> World -> World
+impulsiveAIBeforeAfter startup endup cr w = w' & creatures . ix (_crID cr) .~ endup w' cr'
+  where
+    w' = g w
+    (g,cr') = impulsiveAI startup cr w
 
 impulsiveAI' :: (World -> Creature -> Creature)
     -> Creature -> World -> World
@@ -32,15 +38,9 @@ impulsiveAI
     -> (World -> World , Creature)
 impulsiveAI f cr w = followImpulses w $ f w cr
 
-followThenClearImpulses' :: Creature -> World -> World
-followThenClearImpulses' cr w = f w & creatures . ix (_crID cr) .~ cr'
-  where
-    (f,cr') = followThenClearImpulses w cr
 
-followThenClearImpulses :: World -> Creature -> (World -> World, Creature)
-followThenClearImpulses w = second f . followImpulses w
-  where
-    f = crActionPlan . crImpulse .~ []
+followThenClearImpulses :: Creature -> World -> World
+followThenClearImpulses = impulsiveAIBeforeAfter (const id) (const $ crActionPlan . crImpulse .~ [])
 
 followImpulses :: World -> Creature -> (World -> World, Creature)
 followImpulses w cr = foldr f (id, cr) (_crImpulse $ _crActionPlan cr)

src/Dodge/Creature/LtAutoCrit.hs

@@ -4,8 +4,7 @@ module Dodge.Creature.LtAutoCrit
 import Dodge.Data
 import Dodge.Default
 import Dodge.Creature.Picture
-import Dodge.Creature.ChainUpdates
-import Dodge.Creature.Impulse
+import Dodge.Creature.Update
 import Dodge.Creature.Action
 import Dodge.Creature.Test
 import Dodge.Creature.Volition
@@ -13,8 +12,6 @@ import Dodge.Creature.Strategy
 --import Dodge.Creature.ChooseTarget
 import Dodge.Creature.ReaderUpdate
 import Dodge.Creature.Perception
-import Dodge.Creature.State
---import Dodge.Creature.State.Data
 import Dodge.Item.Weapon.BulletGuns
 import Dodge.Item.Consumable
 import Geometry
@@ -26,7 +23,7 @@ import Control.Lens
 ltAutoCrit :: Creature
 ltAutoCrit = defaultCreature
     { _crPict = basicCrPict red
-    , _crUpdate = stateUpdate' $ impulsiveAI' $ chainCreatureUpdates
+    , _crUpdate = defaultImpulsive
         [ performActions
         , watchUpdateStrat
             [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) 

src/Dodge/Creature/PistolCrit.hs

@@ -4,15 +4,13 @@ module Dodge.Creature.PistolCrit
 import Dodge.Data
 import Dodge.Default
 import Dodge.Creature.Picture
+import Dodge.Creature.Update
 import Dodge.Creature.Test
-import Dodge.Creature.Impulse
 import Dodge.Creature.Action
 import Dodge.Creature.Volition
 import Dodge.Creature.Strategy
 import Dodge.Creature.ReaderUpdate
-import Dodge.Creature.ChainUpdates
 import Dodge.Creature.Perception
-import Dodge.Creature.State
 --import Dodge.Creature.State.Data
 import Dodge.Item.Weapon.BulletGuns
 import Dodge.Item.Consumable
@@ -29,7 +27,7 @@ import Control.Monad.State
 pistolCrit :: Creature
 pistolCrit = defaultCreature
     { _crPict = basicCrPict red
-    , _crUpdate =  stateUpdate' $ impulsiveAI' $ chainCreatureUpdates
+    , _crUpdate =  defaultImpulsive
         [ performActions
         , watchUpdateStrat
               [ (crHasTargetLOS, \w cr -> StrategyActions (ShootAt 0) 

src/Dodge/Creature/SpreadGunCrit.hs

@@ -4,15 +4,13 @@ module Dodge.Creature.SpreadGunCrit
 import Dodge.Data
 import Dodge.Default
 import Dodge.Creature.Picture
+import Dodge.Creature.Update
 import Dodge.Creature.Test
-import Dodge.Creature.Impulse
 import Dodge.Creature.Action
 import Dodge.Creature.Volition
 import Dodge.Creature.Strategy
 import Dodge.Creature.ReaderUpdate
-import Dodge.Creature.ChainUpdates
 import Dodge.Creature.Perception
-import Dodge.Creature.State
 --import Dodge.Creature.State.Data
 import Dodge.Item.Weapon.BulletGuns
 import Dodge.Item.Consumable
@@ -27,7 +25,7 @@ import Control.Lens
 spreadGunCrit :: Creature
 spreadGunCrit = defaultCreature
     { _crPict = basicCrPict red
-    , _crUpdate = stateUpdate' $ impulsiveAI' $ chainCreatureUpdates
+    , _crUpdate = defaultImpulsive
         [performActions
         ,watchUpdateStrat
           [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) 

src/Dodge/Creature/State.hs

@@ -1,9 +1,6 @@
 module Dodge.Creature.State 
-    ( stateUpdate'
-    , stateUpdateDamage
+    ( stateUpdate
     , doDamage
-    , clearDamage
-    , invSideEff
     ) where
 import Dodge.Data
 import Dodge.Hammer
@@ -49,54 +46,39 @@ foldCr xs cr w = foldr ($ cr) w xs
 -- the creature before or after it has moved?
 -- at what point invSideEffects is applied wrt to when the creature moves
 -- may effect whether the shield moves correctly
-stateUpdate' :: (Creature -> World -> World) -> Creature -> World -> World
-stateUpdate' f = foldCr
+stateUpdate :: (Creature -> World -> World) -> Creature -> World -> World
+stateUpdate f = foldCr
     [ checkDeath
     , doDamage
     , invSideEff
     , movementSideEff
-    , moveCrHammerUp
-    , stepReloading'
-    , updateMovement'
+    , internalUpdate
     , f
     ]
 
 checkDeath :: Creature -> World -> World
-checkDeath cr 
-    | _crHP cr < 1 = creatures . at (_crID cr) .~ Nothing -- TODO add corpse
-    | otherwise    = id
-moveCrHammerUp :: Creature -> World -> World
-moveCrHammerUp cr = creatures . ix (_crID cr) . crHammerPosition %~ moveHammerUp
-
-stepReloading' :: Creature -> World -> World
-stepReloading' cr = creatures . ix (_crID cr) %~ stepReloading
-
-updateMovement' :: Creature -> World -> World
-updateMovement' cr = creatures . ix (_crID cr) %~ updateMovement
-
-stateUpdateDamage :: (Creature -> World -> World)
-    -> (Creature -> World -> (World -> World, Creature)) 
-    -> Creature -> World -> World
-stateUpdateDamage damageupdate u cr w = damageupdate cr 
-    $ invSideEff upcr . movementSideEff cr . deathEff . f 
-    $ w
-        & creatures . at (_crID cr) .~ (mvcrhammerup . stepReloading <$> crOrCorpse upcr)
+checkDeath cr w
+    | _crHP cr > 0 = w
+    | otherwise = w 
+        & creatures . at (_crID cr) .~ Nothing
+        & stopSoundFrom (CrWeaponSound (_crID cr) 0) 
+        & over decorations addCorpse 
+        & dropByState cr
   where
-    (f,upcr) = u (updateMovement cr) w
-    mvcrhammerup = crHammerPosition %~ moveHammerUp
-    crOrCorpse cr'
-        | cr' ^. crHP > 0 = Just cr'
-        | otherwise      = Nothing
-    deathEff
-        | cr ^.crHP > 0 = id
-        | otherwise = stopSoundFrom (CrWeaponSound (_crID cr) 0) 
-            . over decorations addCorpse 
-            . dropByState cr
     addCorpse = IM.insertNewKey 
         $ uncurryV translate (_crOldPos cr) 
         $ rotate (_crDir cr)
         (_crCorpse cr)
+
+internalUpdate :: Creature -> World -> World
+internalUpdate cr = creatures . ix (_crID cr) %~ 
+    ( (crHammerPosition %~ moveHammerUp)
+    . stepReloading
+    . updateMovement
+    )
+
 -- | Drop items according to the creature state.
+-- TODO make sure this doesn't mess up any ItemPosition
 dropByState :: Creature -> World -> World
 dropByState cr w = foldr (copyInvItemToFloor cr) w $ case cr ^. crState . crDropsOnDeath of
     DropAll -> IM.keys $ _crInv cr
@@ -108,25 +90,13 @@ setOldPos cr = cr
     & crOldPos .~ _crPos cr
     & crOldDir .~ _crDir cr
 
-clearDamage :: Creature -> World -> World
-clearDamage cr = creatures . ix (_crID cr) . crState . crDamage .~ []
-
 doDamage :: Creature -> World -> World
 doDamage cr w = w
     & creatures . ix (_crID cr) . crState . crDamage .~ [] 
---    & creatures . ix (_crID cr) . crState . crPastDamage %~ advancePastDamages dams
     & _crApplyDamage cr dams cr
   where 
     dams = _crDamage $ _crState cr
 
---advancePastDamages :: [Damage] -> V.Vector [Damage] -> V.Vector [Damage]
---advancePastDamages newDs v = f $ V.backpermute v bpVector
---  where
---    f = V.modify $ \v' -> MV.write v' 0 newDs
-
---bpVector :: V.Vector Int
---bpVector = V.fromList $ 0 : [0 .. 18]
-
 movementSideEff :: Creature -> World -> World
 movementSideEff cr w
     | hasJetPack = case cr ^? crStance . carriage of
@@ -206,17 +176,6 @@ weaponReloadSounds cr w = case cr ^? crInv . ix (_crInvSel cr) . itConsumption o
   where 
     cid = _crID cr
 
---weaponReloadSounds cr w = case _crInv cr IM.!? _crInvSel cr of
---    Just Weapon{_wpAmmo=LoadableAmmo{_wpReloadType = PassiveReload stype,_wpReloadTime=rt,_wpReloadState=rs} }
---        | rt == rs -> soundContinue (CrReloadSound 0) (_crPos cr) stype Nothing w
---        | otherwise -> w
---    Just Weapon{_wpAmmo=LoadableAmmo{_wpReloadState = 0}} -> w
---    Just Weapon{_wpAmmo=LoadableAmmo{_wpReloadState = 1}} -> stopSoundFrom (CrReloadSound cid) w
---    Just Weapon{} -> soundContinue (CrReloadSound cid) (_crPos cr) reloadS (Just 1) w
---    _ -> w
---  where 
---    cid = _crID cr
-
 updateMovement :: Creature -> Creature
 updateMovement cr 
     | isFrictionless cr = over crPos (+.+ momentum) $ setOldPos cr

src/Dodge/Creature/State/WalkCycle.hs

@@ -30,7 +30,6 @@ footstepSideEffect cr w = case cr ^? crStance . carriage of
   where
     maxStride = _strideLength (_crStance cr)
 
-
 makeFootstepSound :: Int -> Int -> FootForward -> Point2 -> World -> World
 makeFootstepSound currentStride maxStride ff p
     | currentStride > maxStride = soundMultiFrom footor p (chooseFootSound ff) Nothing

src/Dodge/Creature/Update.hs

@@ -6,4 +6,4 @@ import Dodge.Creature.ChainUpdates
 
 defaultImpulsive :: [World -> Creature -> Creature]
     -> Creature -> World -> World
-defaultImpulsive = stateUpdate' . impulsiveAI' . chainCreatureUpdates
+defaultImpulsive = stateUpdate . impulsiveAI' . chainCreatureUpdates

src/Dodge/Creature/YourControl.hs

@@ -16,9 +16,8 @@ import Data.Maybe
 yourControl :: Creature -> World -> World
 yourControl cr w = w
     & updateUsingInput 
-    & creatures . ix (_crID cr) %~ (mouseActionsCr (_mouseButtons w) . wasdWithAiming w speed)
-  where
-    speed = _mvSpeed $ _crMvType cr
+    & creatures . ix (_crID cr) %~ 
+        (mouseActionsCr (_mouseButtons w) . wasdWithAiming w (_mvSpeed $ _crMvType cr))
 
 {- | Turn key presses into creature movement.  -}
 wasdWithAiming 
@@ -51,8 +50,7 @@ wasdWithAiming w speed cr
     isReloading = _posture (_crStance cr) == Reloading
     mouseDir = case cr ^? crInv . ix (_crInvSel cr) . itScope . scopePos of
         Just p -> normalizeAngle $ argV
-                                $ p +.+ 2 / _cameraZoom w 
-                                    *.* rotateV (_cameraRot w) (_mousePos w)
+             $ p +.+ 2 / _cameraZoom w *.* rotateV (_cameraRot w) (_mousePos w)
         _ -> normalizeAngle $ argV (_mousePos w) + _cameraRot w
 
 wasdM :: SDL.Scancode -> Point2

src/Dodge/Placement/Instance/Turret.hs

@@ -77,7 +77,7 @@ updateTurret rotSpeed mc w
                 & crRad    .~ 1
                 & crDir .~ mcdir
                 & crPict .~ (\cr _ _ -> drawCrEquipment cr)
-                & crUpdate .~ stateUpdate' followThenClearImpulses'
+                & crUpdate .~ stateUpdate followThenClearImpulses
                 & crStance . posture .~ Aiming
                 & crApplyDamage .~ applyNoDamage
         Just cid -> w'