diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index 56ba7a724..1573d8638 100644 --- a/src/Dodge/Creature/Action.hs +++ b/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 diff --git a/src/Dodge/Creature/Statistics.hs b/src/Dodge/Creature/Statistics.hs index 2bcd48c47..3b7fc6b67 100644 --- a/src/Dodge/Creature/Statistics.hs +++ b/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 diff --git a/src/Dodge/Creature/Test.hs b/src/Dodge/Creature/Test.hs index 5927f63cb..d81edf136 100644 --- a/src/Dodge/Creature/Test.hs +++ b/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 diff --git a/src/Dodge/Creature/Volition.hs b/src/Dodge/Creature/Volition.hs index 302b6df9a..9b0883526 100644 --- a/src/Dodge/Creature/Volition.hs +++ b/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]) diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index fd6c11f8a..0dfc6304e 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/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 m x cr = fromMaybe cr $ do - itRef <- cr ^? crManipulation . manObject . imRootSelectedItem - itid <- cr ^? crInv . ix itRef - astance <- fmap itemBaseStance $ m ^? ix itid - guard $ astance == TwoHandOver || astance == TwoHandUnder - return $ cr & crDir +~ x +doAimTwist :: AimStance -> Float -> Creature -> Creature +doAimTwist as x + | as == TwoHandOver || as == TwoHandUnder = crDir +~ x + | otherwise = id -removeAimPosture :: IM.IntMap Item -> Creature -> Creature -removeAimPosture m = (crStance . posture .~ AtEase) . doAimTwist m twoHandTwistAmount +removeAimPosture :: Creature -> Creature +removeAimPosture cr = fromMaybe cr $ do + as <- cr ^? crStance . posture . aimStance + return $ cr + & crStance . posture .~ AtEase + & doAimTwist as twoHandTwistAmount twoHandTwistAmount :: Float twoHandTwistAmount = 1.6 * pi diff --git a/src/Dodge/Data/AimStance.hs b/src/Dodge/Data/AimStance.hs index d4fe25b82..11f440227 100644 --- a/src/Dodge/Data/AimStance.hs +++ b/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 diff --git a/src/Dodge/Data/Creature/Stance.hs b/src/Dodge/Data/Creature/Stance.hs index ea5d56fc9..46d74025a 100644 --- a/src/Dodge/Data/Creature/Stance.hs +++ b/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) diff --git a/src/Dodge/Item/AimStance.hs b/src/Dodge/Item/AimStance.hs index add7bebcb..307f746f7 100644 --- a/src/Dodge/Item/AimStance.hs +++ b/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 -aimStance dt +itemAimStance :: DTree CItem -> AimStance +itemAimStance dt | islasweapon = TwoHandFlat | otherwise = itemBaseStance $ dt ^. dtValue . _1 where diff --git a/src/Dodge/Item/HeldOffset.hs b/src/Dodge/Item/HeldOffset.hs index 93e57667a..4953ab41e 100644 --- a/src/Dodge/Item/HeldOffset.hs +++ b/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