Tweak posture

src/Dodge/Creature/YourControl.hs

@@ -2,9 +2,7 @@
 
 module Dodge.Creature.YourControl (yourControl) where
 
-import Linear
 import Control.Monad
-import qualified Data.IntMap.Strict as IM
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import Dodge.AssignHotkey
@@ -16,11 +14,11 @@ import Dodge.Data.Equipment.Misc
 import Dodge.Data.World
 import Dodge.InputFocus
 import Dodge.Inventory
-import Dodge.Item.AimStance
 import Dodge.SelectedClose
 import Dodge.WASD
 import Geometry
 import LensHelp
+import Linear
 import NewInt
 import qualified SDL
 
@@ -28,51 +26,37 @@ import qualified SDL
 yourControl :: Creature -> World -> World
 yourControl _ w
     | inTextInputFocus w = w
-    | Just x <- w ^? hud . subInventory
-      , f x =
+    | NoSubInventory <- w ^. hud . subInventory =
         w
-            & cWorld . lWorld . creatures . ix 0 %~ wasdWithAiming w
-            & tryClickUse pkeys
+            & cWorld
+            . lWorld
+            . creatures
+            . ix 0
+            %~ wasdWithAiming w
+            & tryClickUse (w ^. input . mouseButtons)
             & handleHotkeys
     | otherwise = w & cWorld . lWorld . creatures . ix 0 %~ wasdWithAiming w
-  where
-    f = \case
-        NoSubInventory -> True
-        ExamineInventory -> True
-        _ -> False
-    pkeys = w ^. input . mouseButtons
 
 -- the following only works because modifier keys are ordered after scancode "hotkeys"
 handleHotkeys :: World -> World
 handleHotkeys w
     | ispressed SDL.ScancodeLShift || ispressed SDL.ScancodeRShift
-      , (hk:_) <- mapMaybe scancodeToHotkey . M.keys $ pkeys
-      , Just invid <- lw ^? creatures . ix 0 . crManipulation . manObject . imSelectedItem
-      , Just itid <- lw ^? creatures . ix 0 . crInv . ix invid =
+    , (hk : _) <- mapMaybe scancodeToHotkey . M.keys $ pkeys
+    , Just invid <- lw ^? creatures . ix 0 . crManipulation . manObject . imSelectedItem
+    , Just itid <- lw ^? creatures . ix 0 . crInv . ix invid =
         w & cWorld . lWorld %~ assignHotkey (NInt itid) hk
     | ispressed SDL.ScancodeLCtrl || ispressed SDL.ScancodeRCtrl
-      , (hk:_) <- mapMaybe scancodeToHotkey . M.keys $ pkeys
-      , Just itid <- lw ^? hotkeys . ix hk . unNInt
-      , Just invid <- lw ^? items . ix itid . itLocation . ilInvID =
+    , (hk : _) <- mapMaybe scancodeToHotkey . M.keys $ pkeys
+    , Just itid <- lw ^? hotkeys . ix hk . unNInt
+    , Just invid <- lw ^? items . ix itid . itLocation . ilInvID =
         w & invSetSelectionPos 0 (_unNInt invid)
-    | otherwise =
-        M.foldl'
-            useHotkey
-            w
-            (M.intersectionWith (,) thehotkeys (w ^. input . pressedKeys))
+    | otherwise = M.foldl' useHotkey w pressedhotkeys
   where
     pkeys = w ^. input . pressedKeys
     ispressed k = k `M.member` _pressedKeys (_input w)
     thehotkeys = M.mapKeys hotkeyToScancode $ w ^. cWorld . lWorld . hotkeys
     lw = w ^. cWorld . lWorld
-
---modifierKeys :: S.Set SDL.Scancode
---modifierKeys = S.fromList 
---    [ SDL.ScancodeLShift
---    , SDL.ScancodeRShift
---    , SDL.ScancodeRCtrl
---    , SDL.ScancodeLCtrl
---    ]
+    pressedhotkeys = M.intersectionWith (,) thehotkeys (w ^. input . pressedKeys)
 
 useHotkey :: World -> (NewInt ItmInt, Int) -> World
 useHotkey w (NInt itid, pt) = fromMaybe w $ do
@@ -132,36 +116,35 @@ wasdWithAiming w cr = wasdAim inp w $ wasdMovement (w ^. cWorld . lWorld) inp ca
 
 wasdAim :: Input -> World -> Creature -> Creature
 wasdAim inp w cr
-    | Just 0 <- inp ^? mouseButtons . ix SDL.ButtonRight
-      , Nothing <- inp ^? mouseButtons . ix SDL.ButtonLeft =
-        setAimPosture (w ^. cWorld . lWorld . items) cr
+    --    | Just 0 <- inp ^? mouseButtons . ix SDL.ButtonRight
+    --    , Nothing <- inp ^? mouseButtons . ix SDL.ButtonLeft =
+    --        setAimPosture cr
+    | SDL.ButtonRight `M.member` _mouseButtons inp
+    , AtEase <- cr ^. crStance . posture =
+        setAimPosture cr
     | SDL.ButtonRight `M.member` _mouseButtons inp =
         aimTurn (w ^. cWorld . lWorld) mousedir cr
-    | Aiming {} <- cr ^. crStance . posture = removeAimPosture cr
+    | Aiming{} <- cr ^. crStance . posture = removeAimPosture cr
     | otherwise = creatureTurnTowardDir (_crMvAim cr) 0.2 cr
   where
     mousedir = argV $ w ^. cWorld . lWorld . lAimPos - (cr ^. crPos . _xy)
 
-setAimPosture :: IM.IntMap Item -> Creature -> Creature
-setAimPosture m cr = fromMaybe cr $ do
-    invid <- cr ^? crManipulation . manObject . imRootSelectedItem
-    itid <- cr ^? crInv . ix invid
-    as <- fmap itemBaseStance $ m ^? ix itid
-    return $ cr
-        & crStance . posture .~ Aiming as
-        & doAimTwist as (- twoHandTwistAmount)
+setAimPosture :: Creature -> Creature
+setAimPosture cr =
+    cr
+        & crStance . posture .~ Aiming
+        & doAimTwist (cr ^? crManipulation . manObject . imAimStance) (-twoHandTwistAmount)
 
-doAimTwist :: AimStance -> Float -> Creature -> Creature
+doAimTwist :: Maybe AimStance -> Float -> Creature -> Creature
 doAimTwist as x
-    | as == TwoHandOver || as == TwoHandUnder = crDir +~ x
+    | as == Just TwoHandOver || as == Just TwoHandUnder = crDir +~ x
     | otherwise = id
 
 removeAimPosture :: Creature -> Creature
-removeAimPosture cr = fromMaybe cr $ do
-    as <- cr ^? crStance . posture . aimStance
-    return $ cr
-        & crStance . posture .~ AtEase
-        & doAimTwist as twoHandTwistAmount
+removeAimPosture cr =
+        cr
+            & crStance . posture .~ AtEase
+            & doAimTwist (cr ^? crManipulation . manObject . imAimStance) twoHandTwistAmount
 
 twoHandTwistAmount :: Float
 twoHandTwistAmount = 1.6 * pi
@@ -239,10 +222,13 @@ tryClickUse pkeys w = fromMaybe w $ do
     rtime <- pkeys ^? ix SDL.ButtonRight
     guard $ ltime <= rtime
     case w
-        ^? cWorld . lWorld . creatures . ix 0
-            . crManipulation
-            . manObject
-            . imSelectedItem
-            . unNInt of
+        ^? cWorld
+        . lWorld
+        . creatures
+        . ix 0
+        . crManipulation
+        . manObject
+        . imSelectedItem
+        . unNInt of
         Just invid -> useItem invid ltime w
         Nothing -> interactWithCloseObj <$> getSelectedCloseObj w ?? w