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 
+followImpulses w cr = foldr f (id, cr) (_crImpulse $ _crActionPlan cr)
-    foldf
-    (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)
+    Bark sid        -> (soundStart (CrMouth cid) cpos sid Nothing, resetCrVocCoolDown cr)
-    Move p  -> (id, crMvBy p cr)
+    Move p          -> crup $ crMvBy p cr
-    MoveForward x  -> (id, crMvForward x cr)
+    MoveForward x   -> crup $ crMvForward x cr
-    Turn a  -> (id, creatureTurn a cr)
+    Turn a          -> crup $ creatureTurn a cr
-    TurnToward p a -> (id, creatureTurnToward p a cr)
+    TurnToward p a  -> crup $ creatureTurnToward p a cr
-    TurnTo p -> (id, creatureTurnTo p cr)
+    TurnTo p        -> crup $ creatureTurnTo p cr
-    ChangePosture post -> (id, cr & crStance . posture .~ post)
+    ChangePosture post  -> crup $ cr & crStance . posture .~ post
-    UseItem -> (tryUseItem cr, cr)
+    UseItem         -> (tryUseItem cr, cr)
-    SwitchToItem i -> (id, cr & crInvSel .~ i)
+    SwitchToItem i  -> crup $ cr & crInvSel .~ i
-    Melee cid' -> (hitCr cid'
+    Melee cid'      -> (hitCr cid'
         , crMvBy (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crMeleeCooldown .~ 20)
-    RandomTurn a -> (id, creatureTurn (rr a) cr)
+    RandomTurn a    -> crup $ creatureTurn (rr a) cr
-    MakeSound sid -> ( soundStart (CrSound (_crID cr)) (_crPos cr) sid Nothing , cr )
+    MakeSound sid   -> ( soundStart (CrSound (_crID cr)) (_crPos cr) sid Nothing , cr )
-    DropItem -> undefined
+    DropItem        -> undefined
-    ChangeStrategy strat -> (id, cr & crActionPlan . crStrategy .~ strat)
+    ChangeStrategy strat    -> crup $ cr & crActionPlan . crStrategy .~ strat
-    AddGoal gl -> (id, cr & crActionPlan . crGoal .:~ gl )
+    AddGoal gl      -> crup $ cr & crActionPlan . crGoal .:~ gl 
-    ArbitraryImpulseFunction f -> (id, f w cr)
+    ArbitraryImpulseFunction f  -> crup $ f w cr
-    ArbitraryImpulse f -> followImpulse cr w (f cr w) 
+    ArbitraryImpulse f  -> followImpulse cr w (f cr w) 
-    ImpulseUseTargetCID f -> case cr ^? crIntention . targetCr . _Just of
+    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)
+        _        -> crup cr
---    ImpulseUseTarget f -> fromMaybe (id,cr) $ do
---        cid <- cr ^? crIntention . targetCr . _Just
---        tcr <- w ^? creatures . ix cid
---        return $ followImpulse cr w (f tcr)
     ImpulseUseAheadPos f -> followImpulse cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
-    MvForward -> (id, crMvForward speed cr)
+    MvForward       -> crup $ crMvForward speed cr
-    MvTurnToward p -> (id, creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir)) cr)
+    MvTurnToward p  -> crup 
---    _ -> (id , cr)
+        $ 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) : )

src/Dodge/Item/Weapon/BatteryGuns.hs

@@ -6,6 +6,7 @@ module Dodge.Item.Weapon.BatteryGuns
     )
     where
 import Dodge.Data
+import Dodge.Creature.HandPos
 import Dodge.Particle.TeslaArc
 import Dodge.SoundLogic.LoadSound
 import Dodge.WorldEvent
@@ -24,11 +25,11 @@ import Picture
 import Shape
 import ShapePicture
 import Dodge.Picture
+import LensHelp
 
-import Data.Function
+--import Data.Function
 --import qualified Data.Sequence as Seq
 import Data.List
-import Control.Lens
 import System.Random
 --import Data.Maybe
 import Data.Tuple
@@ -76,7 +77,7 @@ lasGun = defaultAutoGun
         , _ammoLoaded = 200
         , _reloadTime = 80
         }
-    , _itUse = ruseInstant (const aLaser) NoHammer
+    , _itUse = ruseInstant aLaser NoHammer
         [ ammoCheckI
         , withTempLight 1 100 (V3 1 1 0)
         , withSoundForI tone440sawtoothquietS 2
@@ -146,7 +147,7 @@ tractorGun = lasGun
 
 aTeslaArc :: Creature -> World -> World
 aTeslaArc cr w = set randGen g w
-    & particles %~ (makeTeslaArcAt col pos dir :)
+    & particles .:~ makeTeslaArcAt col pos dir
   where 
     pos = _crPos cr +.+ (_crRad cr +1) *.* unitVectorAtAngle dir
     dir = _crDir cr
@@ -157,20 +158,14 @@ aTeslaArc cr w = set randGen g w
     chooseColor 2 = blue
     chooseColor _ = cyan
 
-aLaser :: Creature -> World -> World
+aLaser :: Item -> Creature -> World -> World
-aLaser cr = particles %~ (makeLaserAt phasev pos dir : )
+aLaser it cr = particles .:~ makeLaserAt phasev pos dir
   where 
-    pos = _crPos cr +.+ ((_crRad cr +3) *.* unitVectorAtAngle dir) 
+    pos = _crPos cr +.+ (aimingMuzzlePos cr it) *.* unitVectorAtAngle dir
     dir = _crDir cr
     phasev = _phaseV . _itParams $ _crInv cr IM.! j
     j = _crInvSel cr
 
---charToPhaseV :: Fractional p => Char -> p
---charToPhaseV 'V'    = 0.2
---charToPhaseV '/'   = 1
---charToPhaseV 'Z'    = 5
---charToPhaseV _ = error "Trying to set an undefined phaseV"
-
 makeLaserAt :: Float -> Point2 -> Float -> Particle
 makeLaserAt phasev pos dir = Particle
     { _ptDraw = const blank
@@ -232,7 +227,7 @@ moveLaser phasev pos dir w pt
         ]
 
 aTractorBeam :: Item -> Creature -> World -> World
-aTractorBeam _ cr w = over props (IM.insert i (tractorBeamAt i spos outpos dir)) w
+aTractorBeam _ cr w = w & props . at i ?~ tractorBeamAt i spos outpos dir
   where 
     i = newProjectileKey w
     cpos = _crPos cr
@@ -254,7 +249,6 @@ tractorBeamAt i pos outpos dir = ProjectileTimed
     }
   where 
     d  = unitVectorAtAngle dir
-
 {- |
 The interaction of this with objects, walls etc needs more thought.  -}
 updateTractor :: Prop -> World -> World

src/Dodge/Placement/Instance/Turret.hs

@@ -75,9 +75,7 @@ updateTurret rotSpeed mc w
                 & crRad    .~ 1
                 & crDir .~ mcdir
                 & crPict .~ (\cr _ _ -> drawCrEquipment cr)
-                -- & crPict .~ basicCrPict red
+                & crUpdate .~ stateUpdateDamage clearDamage (flip followThenClearImpulses)
-                -- & crUpdate .~ (\cr -> crUpCrUp stepReloading cr . invSideEff cr)
-                & crUpdate .~ stateUpdateDamage clearDamage (flip followImpulses)
                 & crStance . posture .~ Aiming
         Just cid -> w'
             & creatures . ix cid . crPos .~ mcpos