Set lasGun muzzle position correctly

src/Dodge/Creature/Action.hs

@@ -2,8 +2,7 @@
 {- | Actions performed by creatures within the world
  -}
 module Dodge.Creature.Action 
-    ( performActionsR
-    , performActions
+    ( performActions
     , stripNoItems
     , setMinInvSize
     , dropUnselected
@@ -42,7 +41,6 @@ import Control.Lens
 --import Control.Applicative
 import Data.Maybe
 import Data.List (findIndex)
-import Control.Monad.Reader
 --import qualified Data.Map as M
 performActions :: World -> Creature -> Creature
 performActions w cr = cr
@@ -51,9 +49,6 @@ performActions w cr = cr
   where
     (iss, mayas) = unzip $ map (performAction cr w) $ cr ^. crActionPlan . crAction
 
-performActionsR :: Creature -> Reader World Creature
-performActionsR cr = reader $ \w -> performActions w cr
-
 type OutAction = ( [Impulse] , Maybe Action )
 
 performAimAt :: Creature -> World -> Int -> Point2 -> OutAction

src/Dodge/Creature/Impulse.hs

@@ -1,6 +1,8 @@
+{-# LANGUAGE TupleSections #-}
 module Dodge.Creature.Impulse
     ( impulsiveAI
     , followImpulses
+    , followThenClearImpulses
     ) where
 import Dodge.Data
 import Dodge.Creature.Vocalization
@@ -19,51 +21,50 @@ impulsiveAI :: (World -> Creature -> Creature)
     -> Creature
     -> World
     -> (World -> World , Creature)
-impulsiveAI impf cr w = followImpulses w $ impf w cr
+impulsiveAI f cr w = followImpulses w $ f w cr
+
+followThenClearImpulses :: World -> Creature -> (World -> World, Creature)
+followThenClearImpulses w = second f . followImpulses w
+  where
+    f = crActionPlan . crImpulse .~ []
 
 followImpulses :: World -> Creature -> (World -> World, Creature)
-followImpulses w cr = foldr 
-    foldf
-    (id, cr) 
-    (_crImpulse $ _crActionPlan cr)
+followImpulses w cr = foldr f (id, cr) (_crImpulse $ _crActionPlan cr)
   where
-    foldf imp (f,cr') = first ( . f) $ followImpulse cr' w imp
+    f imp (theupdate,cr') = first (. theupdate) $ followImpulse cr' w imp
 
 followImpulse :: Creature -> World -> Impulse -> (World -> World , Creature)
 followImpulse cr w imp = case imp of
-    Bark sid -> (soundStart (CrMouth cid) cpos sid Nothing, resetCrVocCoolDown cr)
-    Move p  -> (id, crMvBy p cr)
-    MoveForward x  -> (id, crMvForward x cr)
-    Turn a  -> (id, creatureTurn a cr)
-    TurnToward p a -> (id, creatureTurnToward p a cr)
-    TurnTo p -> (id, creatureTurnTo p cr)
-    ChangePosture post -> (id, cr & crStance . posture .~ post)
-    UseItem -> (tryUseItem cr, cr)
-    SwitchToItem i -> (id, cr & crInvSel .~ i)
-    Melee cid' -> (hitCr cid'
+    Bark sid        -> (soundStart (CrMouth cid) cpos sid Nothing, resetCrVocCoolDown cr)
+    Move p          -> crup $ crMvBy p cr
+    MoveForward x   -> crup $ crMvForward x cr
+    Turn a          -> crup $ creatureTurn a cr
+    TurnToward p a  -> crup $ creatureTurnToward p a cr
+    TurnTo p        -> crup $ creatureTurnTo p cr
+    ChangePosture post  -> crup $ cr & crStance . posture .~ post
+    UseItem         -> (tryUseItem cr, cr)
+    SwitchToItem i  -> crup $ cr & crInvSel .~ i
+    Melee cid'      -> (hitCr cid'
         , crMvBy (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crMeleeCooldown .~ 20)
-    RandomTurn a -> (id, creatureTurn (rr a) cr)
-    MakeSound sid -> ( soundStart (CrSound (_crID cr)) (_crPos cr) sid Nothing , cr )
-    DropItem -> undefined
-    ChangeStrategy strat -> (id, cr & crActionPlan . crStrategy .~ strat)
-    AddGoal gl -> (id, cr & crActionPlan . crGoal .:~ gl )
-    ArbitraryImpulseFunction f -> (id, f w cr)
-    ArbitraryImpulse f -> followImpulse cr w (f cr w) 
-    ImpulseUseTargetCID f -> case cr ^? crIntention . targetCr . _Just of
+    RandomTurn a    -> crup $ creatureTurn (rr a) cr
+    MakeSound sid   -> ( soundStart (CrSound (_crID cr)) (_crPos cr) sid Nothing , cr )
+    DropItem        -> undefined
+    ChangeStrategy strat    -> crup $ cr & crActionPlan . crStrategy .~ strat
+    AddGoal gl      -> crup $ cr & crActionPlan . crGoal .:~ gl 
+    ArbitraryImpulseFunction f  -> crup $ f w cr
+    ArbitraryImpulse f  -> followImpulse cr w (f cr w) 
+    ImpulseUseTargetCID f   -> case cr ^? crIntention . targetCr . _Just of
         Just tcr -> followImpulse cr w (f $ _crID tcr)
-        _ -> (id,cr)
+        _        -> crup cr
     ImpulseUseTarget f -> case cr ^? crIntention . targetCr . _Just of
         Just tcr -> followImpulse cr w (f tcr)
-        _ -> (id,cr)
---    ImpulseUseTarget f -> fromMaybe (id,cr) $ do
---        cid <- cr ^? crIntention . targetCr . _Just
---        tcr <- w ^? creatures . ix cid
---        return $ followImpulse cr w (f tcr)
+        _        -> crup cr
     ImpulseUseAheadPos f -> followImpulse cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
-    MvForward -> (id, crMvForward speed cr)
-    MvTurnToward p -> (id, creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir)) cr)
---    _ -> (id , cr)
+    MvForward       -> crup $ crMvForward speed cr
+    MvTurnToward p  -> crup 
+        $ creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir)) cr
   where
+    crup = (id,)
     mvType = _crMvType cr
     speed = _mvSpeed mvType
     turnRad = _mvTurnRad mvType
@@ -72,6 +73,6 @@ followImpulse cr w imp = case imp of
     cid  = _crID cr
     posFromID cid' = _crPos $ _creatures w IM.! cid'
     rr a = fst $ randomR (-a,a) $ _randGen w
-    hitCr i = over (creatures . ix i . crState . crDamage) (addDam i)
+    hitCr i = (creatures . ix i . crState . crDamage %~ addDam i)
         . soundStart (CrSound cid) cpos hitS Nothing
-    addDam i dams = Blunt 100 cpos (posFromID i) (posFromID i) : dams 
+    addDam i = ( Blunt 100 cpos (posFromID i) (posFromID i) : )