justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Add AimStance to creature posture when Aiming

Browse Source
This commit is contained in:
justin
2025-08-27 11:46:41 +01:00
parent 5cb8be1363
commit 2e6b7a1b41
9 changed files with 44 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Action.hs
+1 -1
View File
@@ -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
+1 -1
View File
@@ -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
+1 -1
View File
@@ -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
+2 -1
View File
@@ -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
+18 -12
View File
@@ -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
src/Dodge/Data/AimStance.hs
+9
View File
@@ -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
+6 -2
View File
@@ -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
+3 -3
View File
@@ -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
src/Dodge/Item/HeldOffset.hs
+3 -2
View File
@@ -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