Add AimStance to creature posture when Aiming

src/Dodge/Creature/Action.hs

@@ -201,7 +201,7 @@ youDropItem w = fromMaybe w $ do
     --guard $ not $ _crInvLock cr
     guard $ not $ w ^. cWorld . lWorld . lInvLock
     return $ case cr ^. crStance . posture of
-        Aiming -> throwItem w
+        Aiming {} -> throwItem w
         AtEase -> dropItem cr curpos w
   where
     cr = you w

src/Dodge/Creature/Statistics.hs

@@ -64,7 +64,7 @@ crCurrentEquipment lw = fmap f . _crEquipment
 
 strFromHeldItem :: LWorld -> Creature -> Int
 strFromHeldItem lw cr = fromMaybe 0 $ do
-    Aiming <- cr ^? crStance . posture
+    Aiming {} <- cr ^? crStance . posture
     i <- cr ^? crManipulation . manObject . imRootSelectedItem
     j <- cr ^? crInv . ix i
     fmap (negate . itemWeight) $ lw ^? items . ix j

src/Dodge/Creature/Test.hs

@@ -99,7 +99,7 @@ crInAimStance as m cr = crIsAiming cr && mitstance == Just as
         i <- cr ^? crManipulation . manObject . imRootSelectedItem
         --itm <- invRootTrees' (cr ^. crInv) ^? ix i
         itm <- fmap (fmap (\(a,b,_) -> (a,b))) $ invIMDT (fmap (\k -> m ^?! ix k) (cr ^. crInv)) ^? ix (_unNInt i)
-        return $ aimStance itm
+        return $ itemAimStance itm
         --cr ^? crInv . ix i . itUse . heldAim . aimStance
 
 oneH :: IM.IntMap Item -> Creature -> Bool

src/Dodge/Creature/Volition.hs

@@ -6,6 +6,7 @@ module Dodge.Creature.Volition (
     shootFirstMiss,
 ) where
 
+import Dodge.Data.AimStance
 import Dodge.Data.Creature
 import Dodge.Data.CreatureEffect
 import Dodge.SoundLogic.LoadSound
@@ -13,7 +14,7 @@ import Geometry
 
 holsterWeapon, drawWeapon :: Action
 holsterWeapon = DoImpulses [ChangePosture AtEase, MakeSound whiteNoiseFadeOutS]
-drawWeapon = DoImpulses [ChangePosture Aiming, MakeSound whiteNoiseFadeInS]
+drawWeapon = DoImpulses [ChangePosture $ Aiming OneHand, MakeSound whiteNoiseFadeInS]
 
 shootTillEmpty :: Action
 --shootTillEmpty = (crCanShoot `DoActionWhile` DoImpulses [UseItem])

src/Dodge/Creature/YourControl.hs

@@ -136,25 +136,31 @@ wasdAim inp w cr
         setAimPosture (w ^. cWorld . lWorld . items) cr
     | SDL.ButtonRight `M.member` _mouseButtons inp =
         aimTurn (w ^. cWorld . lWorld) mousedir cr
-    | Aiming <- cr ^. crStance . posture = removeAimPosture m cr
+    | Aiming {} <- cr ^. crStance . posture = removeAimPosture cr
     | otherwise = creatureTurnTowardDir (_crMvAim cr) 0.2 cr
   where
-    m = w ^. cWorld . lWorld . items
     mousedir = argV $ w ^. cWorld . lWorld . lAimPos - (cr ^. crPos)
 
 setAimPosture :: IM.IntMap Item -> Creature -> Creature
-setAimPosture m = (crStance . posture .~ Aiming) . doAimTwist m (- twoHandTwistAmount)
+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)
 
-doAimTwist :: IM.IntMap Item -> Float -> Creature -> Creature
+doAimTwist :: AimStance -> Float -> Creature -> Creature
-doAimTwist m x cr = fromMaybe cr $ do
+doAimTwist as x
-    itRef <- cr ^? crManipulation . manObject . imRootSelectedItem
+    | as == TwoHandOver || as == TwoHandUnder = crDir +~ x
-    itid <- cr ^? crInv . ix itRef
+    | otherwise = id
-    astance <- fmap itemBaseStance $ m ^? ix itid
-    guard $ astance == TwoHandOver || astance == TwoHandUnder
-    return $ cr & crDir +~ x
 
-removeAimPosture :: IM.IntMap Item -> Creature -> Creature
+removeAimPosture :: Creature -> Creature
-removeAimPosture m = (crStance . posture .~ AtEase) . doAimTwist m twoHandTwistAmount
+removeAimPosture cr = fromMaybe cr $ do
+    as <- cr ^? crStance . posture . aimStance
+    return $ cr
+        & crStance . posture .~ AtEase
+        & doAimTwist as twoHandTwistAmount
 
 twoHandTwistAmount :: Float
 twoHandTwistAmount = 1.6 * pi

src/Dodge/Data/AimStance.hs

@@ -1,6 +1,12 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
 
 module Dodge.Data.AimStance where
+import Control.Lens
+import Data.Aeson
+import Data.Aeson.TH
 
 data AimStance
     = TwoHandUnder
@@ -8,3 +14,6 @@ data AimStance
     | TwoHandFlat
     | OneHand
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
+
+makeLenses ''AimStance
+deriveJSON defaultOptions ''AimStance

src/Dodge/Data/Creature/Stance.hs

@@ -3,8 +3,12 @@
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 
-module Dodge.Data.Creature.Stance where
+module Dodge.Data.Creature.Stance 
+    ( module Dodge.Data.Creature.Stance
+    , module Dodge.Data.AimStance
+    )where
 
+import Dodge.Data.AimStance
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
@@ -32,7 +36,7 @@ data FootForward = LeftForward | RightForward
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data Posture
-    = Aiming
+    = Aiming {_aimStance :: AimStance}
     | AtEase
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 

src/Dodge/Item/AimStance.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE LambdaCase #-}
-module Dodge.Item.AimStance (aimStance,itemBaseStance) where
+module Dodge.Item.AimStance (itemAimStance,itemBaseStance) where
 
 import Dodge.Data.Item
 import Dodge.Data.ComposedItem
@@ -7,8 +7,8 @@ import Dodge.Data.DoubleTree
 import Control.Lens
 import Dodge.Data.AimStance
 
-aimStance :: DTree CItem -> AimStance
+itemAimStance :: DTree CItem -> AimStance
-aimStance dt 
+itemAimStance dt 
     | islasweapon = TwoHandFlat
     | otherwise = itemBaseStance $ dt ^. dtValue . _1
   where

src/Dodge/Item/HeldOffset.hs

@@ -34,9 +34,10 @@ handleOrient loc = case loc ^. locDT . dtValue . _1 . itType of
     _ -> (V3 (-3) 0 0, Q.qID)
 
 -- note this is relative to the creature
+-- the aimstance here should match any aimstance in Aiming
 handOrient :: Creature -> AimStance -> Point3Q
 handOrient cr = case cr ^. crStance . posture of
-    Aiming -> \case
+    Aiming {} -> \case
         TwoHandUnder -> (V3 (-3) 0 shoulderHeight, Q.qID)
         TwoHandOver -> (V3 0 0 shoulderHeight, Q.qID)
         OneHand -> (V3 13 (-2) shoulderHeight, Q.qID)
@@ -60,7 +61,7 @@ locOrient loc cr =
 
 handHandleOrient :: LocationDT CItem -> Creature -> Point3Q
 handHandleOrient loc cr =
-    handOrient cr (aimStance (loc' ^. locDT))
+    handOrient cr (itemAimStance (loc' ^. locDT))
         `Q.comp` handleOrient loc'
   where
     loc' = locToTop loc