Cleanup code for your control

src/Dodge/Creature/State.hs

@@ -3,7 +3,6 @@ module Dodge.Creature.State (
     doDamage,
 ) where
 
-import Dodge.LightSource
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import Data.Monoid
@@ -24,6 +23,7 @@ import Dodge.Hammer
 import Dodge.ItEffect
 import Dodge.Item.Grammar
 import Dodge.Item.HeldOffset
+import Dodge.LightSource
 import Dodge.Prop.Gib
 import Dodge.SoundLogic
 --import Dodge.WorldEvent.Flash
@@ -73,9 +73,11 @@ stateUpdate f =
 
 checkDeath :: Creature -> World -> World
 checkDeath cr w
-    | _crHP cr > 0 = w
+    | _crHP cr > 0 =
+        w
             & cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage .~ []
-    | otherwise = w
+    | otherwise =
+        w
             & dropByState cr
             & removecr
             & stopSoundFrom (CrWeaponSound (_crID cr) 0)
@@ -192,26 +194,27 @@ chainLinkOrientation mo par (ILink lt f) child = (p + Q.rotate q p1, q * q1)
     (p, q) = mo
     (p1, q1) = f par lt child
 
-updateItemWithOrientation :: Creature -> (Point3, Q.Quaternion Float) 
-    -> LabelDoubleTree ItemLink Item
-    -> World -> World
+updateItemWithOrientation ::
+    Creature ->
+    (Point3, Q.Quaternion Float) ->
+    LabelDoubleTree ItemLink Item ->
+    World ->
+    World
 updateItemWithOrientation cr m itmtree = case _itType itm of
     HELD TORCH -> shineTorch cr itmtree m
     _ -> id
   where
     itm = itmtree ^. ldtValue
 
-
-
 shineTorch :: Creature -> LabelDoubleTree ItemLink Item -> (Point3, Q.Quaternion Float) -> World -> World
-shineTorch cr itmtree (p,q) = fromMaybe id $ do
-    (_,mag) <- find (isammolink . _iatType . fst) (itmtree ^. ldtLeft)
+shineTorch cr itmtree (p, q) = fromMaybe id $ do
+    (_, mag) <- find (isammolink . _iatType . fst) (itmtree ^. ldtLeft)
     i <- mag ^? ldtValue . itUse . amagLoadStatus . iaLoaded
     guard $ i >= x
     invid <- mag ^? ldtValue . itLocation . ilInvID
     return $
         (cWorld . lWorld . tempLightSources .:~ tlsTimeRadColPos 1 250 0.7 pos'')
-        . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . amagLoadStatus . iaLoaded -~ x)
+            . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . amagLoadStatus . iaLoaded -~ x)
   where
     x = 10
     isammolink AmmoInLink{} = True
@@ -219,39 +222,49 @@ shineTorch cr itmtree (p,q) = fromMaybe id $ do
     pos = (_crPos cr `v2z` 0 + rotate3 cdir p)
     pos'' = pos + rotate3 d (V3 8 0 1.5)
     cdir = _crDir cr
-    a = argV (Q.qToV2 q)
-    d = _crDir cr + a
+    d = _crDir cr + argV (Q.qToV2 q)
 
 itemInvSideEffect :: Creature -> Item -> World -> World
 itemInvSideEffect cr itm = case _itType itm of
     TARGETING tt -> updateItemTargeting tt cr itm
     _ -> id
 
+-- this probably needs to be set to null when dropped as well?
 updateItemTargeting :: TargetingType -> Creature -> Item -> World -> World
 updateItemTargeting tt cr itm w = case tt of
-        _ | not isattached ->  w 
-            & pointItUse . tgPos .~ Nothing
-            & pointItUse . tgActive .~ False
-        TARGETLASER | crIsAiming cr -> w 
-            & cWorld . lWorld . lasers .:~ LaserStart
+    _
+        | not isattached ->
+            w
+                & pointItUse . tgPos .~ Nothing
+                & pointItUse . tgActive .~ False
+    TARGETLASER
+        | crIsAiming cr ->
+            w
+                & cWorld . lWorld . lasers
+                    .:~ LaserStart
                         { _lpPhaseV = 1
                         , _lpDir = _crDir cr
                         , _lpPos = sp
                         , _lpColor = col
                         , _lpType = TargetingLaser (_itID itm)
                         }
-        TARGETLASER -> w & pointItUse . tgPos .~ Nothing
-        TargetRBPress | rbpressed -> w 
-            & pointItUse . tgPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. wCam)) Just
-            & pointItUse . tgActive .~ True
-        TargetRBPress -> w 
+    TARGETLASER -> w & pointItUse . tgPos .~ Nothing
+    TargetRBPress
+        | rbpressed ->
+            w
+                & pointItUse . tgPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. wCam)) Just
+                & pointItUse . tgActive .~ True
+    TargetRBPress ->
+        w
             & pointItUse . tgPos .~ Nothing
             & pointItUse . tgActive .~ False
-        TargetRBCreature -> w & pointItUse %~ setRBCreatureTargeting cr w
-        TargetCursor -> w & pointItUse .~ TargetingUse
-                    (Just (mouseWorldPos (w ^. input) (w ^. wCam)))
-                    Nothing
-                    True
+    TargetRBCreature -> w & pointItUse %~ setRBCreatureTargeting cr w
+    TargetCursor ->
+        w & pointItUse
+            .~ TargetingUse
+                (Just (mouseWorldPos (w ^. input) (w ^. wCam)))
+                Nothing
+                True
   where
     pointItUse = cWorld . lWorld . creatures . ix cid . crInv . ix invid . itUse
     cid = _crID cr
@@ -264,7 +277,8 @@ updateItemTargeting tt cr itm w = case tt of
 setRBCreatureTargeting :: Creature -> World -> ItemUse -> ItemUse
 setRBCreatureTargeting cr w ituse
     | SDL.ButtonRight `M.member` _mouseButtons (_input w) && isJust (ituse ^? tgID . _Just)
-        && canSeeTarget = ituse & updatePos & tgActive .~ True
+        && canSeeTarget =
+        ituse & updatePos & tgActive .~ True
     | otherwise = ituse & tgID .~ fmap _crID newtarg & updatePos & tgActive .~ False
   where
     newtarg =
@@ -292,7 +306,6 @@ useUpdate =
         . (heldDelay . warmTime %~ decreaseToZero)
         . (heldDelay . rateTime %~ decreaseToZero)
 
-
 updateAutoRecharge :: Item -> Item
 updateAutoRecharge it = case it ^? itUse . leftConsumption of
     Just (AutoRecharging l m t p)

src/Dodge/Creature/YourControl.hs

@@ -20,15 +20,14 @@ import qualified SDL
 
 -- | The AI equivalent for your control.
 yourControl :: Creature -> World -> World
-yourControl cr w
+yourControl _ w
     | inInputFocus w = w
     | not intopinv =
-        w & cWorld . lWorld . creatures . ix (_crID cr)
-            %~ wasdWithAiming w (_mvSpeed $ _crMvType cr)
+        w & cWorld . lWorld . creatures . ix 0 %~ wasdWithAiming w
     | otherwise =
         w
-            & cWorld . lWorld . creatures . ix (_crID cr)
-                %~ (wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons (_input w)))
+            & cWorld . lWorld . creatures . ix 0
+                %~ (wasdWithAiming w . mouseActionsCr (w ^. input . mouseButtons))
             & pressedMBEffectsTopInventory pkeys
             & handleHotkeys
   where
@@ -91,88 +90,43 @@ tryAssignHotkey w sc = fromMaybe w $ do
     itid <- cr ^? crManipulation . manObject . imSelectedItem
     return $ w & cWorld . lWorld . creatures . ix 0 %~ assignHotkey itid (scancodeToHotkey sc)
 
-{- | Turn key presses into creature movement.
- | note the order of operation, setting the posture first--this prevents the twist fire bug
+{- | The order of these MAY be important, in particular the setting of crMvAim
+ within wasdMovement should probably be done first
 -}
---wasdWithAiming ::
---    World ->
---    -- | Base speed
---    Float ->
---    Creature ->
---    Creature
---wasdWithAiming w speed cr
---    | isAiming = addAnyTwist $ aimTurn mouseDir $ theMovement $ setMvAim cr
---    | crIsReloading cr && SDL.ButtonRight `M.member` _mouseButtons (_input w) =
---        aimTurn mouseDir $ removeTwist $ theMovement $ setMvAim cr
---    | otherwise = theMovement $ theTurn $ removeTwist $ setMvAim cr
---  where
---    setMvAim = maybe id (crMvAim .~) dir
---    twistamount = 1.6
---    removeTwist cr' =
---        cr'
---            & crDir +~ _crTwist cr'
---            & crTwist .~ 0
---    addAnyTwist = fromMaybe id $ do
---        itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
---        astance <- cr ^? crInv . ix itRef . itUse . heldAim . aimStance
---        case (astance, cr ^. crTwist) of
---            (TwoHandUnder, 0) ->
---                return $ (crTwist .~ twistamount * pi) . (crDir -~ twistamount * pi)
---            (TwoHandOver, 0) ->
---                return $ (crTwist .~ twistamount * pi) . (crDir -~ twistamount * pi)
---            _ -> Nothing
---    theMovement
---        | movDir == V2 0 0 = id
---        | otherwise = crMvAbsolute (speed *.* movAbs)
---    theTurn cr' = creatureTurnTowardDir (_crMvAim cr') 0.2 cr'
---    movDir = wasdDir (w ^. input)
---    dir = fmap ((w ^. wCam . camRot) +) (safeArgV movDir)
---    movAbs = rotateV (w ^. wCam . camRot) $ normalizeV movDir
---    isAiming = _posture (_crStance cr) == Aiming
---    mouseDir = argV $ mouseWorldPos (w ^. input) (w ^. wCam) - (cr ^. crPos)
-
--- | The order of these MAY be important, in particular the setting of crMvAim
--- within wasdMovement should probably be done first
 wasdWithAiming ::
     World ->
-    -- | Base speed
-    Float ->
     Creature ->
     Creature
-wasdWithAiming w speed = wasdAim inp cam . wasdTwist . wasdMovement inp cam speed
+wasdWithAiming w cr = wasdAim inp cam . wasdTwist $ wasdMovement inp cam speed cr
   where
+    speed = _mvSpeed $ _crMvType cr
     inp = w ^. input
     cam = w ^. wCam
 
 wasdAim :: Input -> Camera -> Creature -> Creature
 wasdAim inp cam cr
     | SDL.ButtonRight `M.member` _mouseButtons inp = aimTurn mouseDir cr
-    | otherwise = theTurn cr
+    | otherwise = creatureTurnTowardDir (_crMvAim cr) 0.2 cr
   where
-    theTurn cr' = creatureTurnTowardDir (_crMvAim cr') 0.2 cr'
     mouseDir = argV $ mouseWorldPos inp cam - (cr ^. crPos)
 
 -- aim with the root item
 wasdTwist :: Creature -> Creature
 wasdTwist cr
-    | _posture (_crStance cr) == Aiming = addAnyTwist cr
-    | otherwise = removeTwist cr
-  where
-    twistamount = 1.6
-    removeTwist cr' =
-        cr'
-            & crDir +~ _crTwist cr'
-            & crTwist .~ 0
-    addAnyTwist = fromMaybe id $ do
+    | _posture (_crStance cr) == Aiming = fromMaybe cr $ do
         itRef <- cr ^? crManipulation . manObject . imRootItem
         astance <- cr ^? crInv . ix itRef . itUse . heldAim . aimStance
         case (astance, cr ^. crTwist) of
             (TwoHandUnder, 0) ->
-                return $ (crTwist .~ twistamount * pi) . (crDir -~ twistamount * pi)
+                return $ cr & crTwist .~ twistamount * pi & crDir -~ twistamount * pi
             (TwoHandOver, 0) ->
-                return $ (crTwist .~ twistamount * pi) . (crDir -~ twistamount * pi)
+                return $ cr & crTwist .~ twistamount * pi & crDir -~ twistamount * pi
             _ -> Nothing
-  
+    | otherwise = cr
+            & crDir +~ _crTwist cr
+            & crTwist .~ 0 --remove twistk
+  where
+    twistamount = 1.6
 
 wasdMovement :: Input -> Camera -> Float -> Creature -> Creature
 wasdMovement inp cam speed = theMovement . setMvAim
@@ -193,11 +147,14 @@ aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr
         itRef <- cr ^? crManipulation . manObject . imRootItem
         cr ^? crInv . ix itRef . itUse . heldAim . aimTurnSpeed
 
--- | Set posture according to mouse presses.
+{- | Set posture according to mouse presses.
+ (should you be aiming without a selected item?)
+-}
 mouseActionsCr :: M.Map SDL.MouseButton Int -> Creature -> Creature
-mouseActionsCr pkeys cr
-    | SDL.ButtonRight `M.member` pkeys = cr & crStance . posture .~ Aiming
-    | otherwise = cr & crStance . posture .~ AtEase
+mouseActionsCr pkeys
+    | SDL.ButtonRight `M.member` pkeys = crStance . posture .~ Aiming
+    | otherwise = crStance . posture .~ AtEase
+
 --  where
 --    noaction = fromMaybe True $ do
 --        theaction <- cr ^? crManipulation . manObject . inInventory . iselAction
@@ -210,7 +167,7 @@ pressedMBEffectsTopInventory pkeys w
     | isDown SDL.ButtonMiddle = w & wCam . camRot -~ rotation
     | otherwise = w
   where
-    youhammerdown = set (cWorld . lWorld . creatures . ix 0 . crHammerPosition) HammerDown 
+    youhammerdown = set (cWorld . lWorld . creatures . ix 0 . crHammerPosition) HammerDown
     inTopInv = case w ^. hud . hudElement of
         DisplayInventory{_subInventory = NoSubInventory} -> True
         _ -> False