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

Tweak posture

Browse Source
This commit is contained in:
justin
2026-03-31 22:50:53 +01:00
parent 074d354970
commit ecdc19fb5e
13 changed files with 134 additions and 143 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Block/Debris.hs
-1
View File
@@ -83,7 +83,6 @@ makeDebrisDirectedZ arcrad dir z dt bm p w =
f = do
v <- rotateV (dir - arcrad / 2) <$> randInArcStrip 1 2 arcrad
spinspeed <- randomR (-0.2, -0.1) & state
-- basedebris <- baseDebris bm
return $
DebrisChunk
{ _dbPos = p `v2z` z
src/Dodge/Creature/Impulse.hs
+1 -2
View File
@@ -18,7 +18,6 @@ import Dodge.SoundLogic
import Geometry
import LensHelp
import Linear
import NewInt
import System.Random
-- note SwitchToItem doesn't necessarily update the root item correctly
@@ -39,7 +38,7 @@ followImpulse cid w = \case
TurnTo p -> crup $ creatureTurnTo p
ChangePosture post -> crup $ crStance . posture .~ post
UseItem -> undefined
SwitchToItem i -> crup $ crManipulation . manObject .~ SelectedItem (NInt i) (NInt i) mempty
-- SwitchToItem i -> crup $ crManipulation . manObject .~ SelectedItem (NInt i) (NInt i) mempty
Melee cid' ->
hitCr cid' $
crup
src/Dodge/Creature/Test.hs
+2 -1
View File
@@ -92,7 +92,8 @@ crAwayFromPost cr = case find sentinelGoal . _apGoal $ _crActionPlan cr of
sentinelGoal _ = False
crInAimStance :: AimStance -> Creature -> Bool
crInAimStance as cr = cr ^? crStance . posture . aimStance == Just as
crInAimStance as cr = cr ^? crStance . posture == Just Aiming
&& cr ^? crManipulation . manObject . imAimStance == Just as
oneH :: Creature -> Bool
oneH = crInAimStance OneHand
src/Dodge/Creature/Volition.hs
+1 -2
View File
@@ -6,7 +6,6 @@ module Dodge.Creature.Volition (
shootFirstMiss,
) where
import Dodge.Data.AimStance
import Dodge.Data.Creature
import Dodge.Data.CreatureEffect
import Dodge.SoundLogic.LoadSound
@@ -14,7 +13,7 @@ import Geometry
holsterWeapon, drawWeapon :: Action
holsterWeapon = DoImpulses [ChangePosture AtEase, MakeSound whiteNoiseFadeOutS]
drawWeapon = DoImpulses [ChangePosture $ Aiming OneHand, MakeSound whiteNoiseFadeInS]
drawWeapon = DoImpulses [ChangePosture $ Aiming, MakeSound whiteNoiseFadeInS]
shootTillEmpty :: Action
--shootTillEmpty = (crCanShoot `DoActionWhile` DoImpulses [UseItem])
src/Dodge/Creature/YourControl.hs
+42 -56
View File
@@ -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
src/Dodge/Data/ActionPlan.hs
+1 -1
View File
@@ -34,7 +34,7 @@ data Impulse
| MvForward
| TurnTo Point2
| UseItem
| SwitchToItem Int
-- | SwitchToItem Int
| DropItem
| Bark SoundID -- placeholder for various communication types
| Melee Int
src/Dodge/Data/Creature/Stance.hs
+1 -3
View File
@@ -30,9 +30,7 @@ data Carriage
data FootForward = LeftForward | RightForward
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data Posture
= Aiming {_aimStance :: AimStance}
| AtEase
data Posture = Aiming | AtEase
deriving (Eq, Ord, Show, Read) --Generic, Flat)
makeLenses ''Stance
src/Dodge/Data/Item/Use/Consumption/LoadAction.hs
+2
View File
@@ -3,6 +3,7 @@
module Dodge.Data.Item.Use.Consumption.LoadAction where
import Dodge.Data.AimStance
import Dodge.Data.Item.Location
import NewInt
import qualified Data.IntSet as IS
@@ -21,6 +22,7 @@ data ManipulatedObject
| SelectedItem
{ _imSelectedItem :: NewInt InvInt
, _imRootSelectedItem :: NewInt InvInt
, _imAimStance :: AimStance
, _imAttachedItems :: IS.IntSet -- this should probably be NewIntSet InvInt also
}
| SelNothing
src/Dodge/Inventory/Location.hs
+4
View File
@@ -4,6 +4,7 @@ module Dodge.Inventory.Location (
setInvPosFromSS,
) where
import Dodge.Item.AimStance
import Control.Lens
import Data.Foldable
--import Data.IntMap.Merge.Strict
@@ -104,10 +105,13 @@ setInvPosFromSS w = w
( fmap (\k -> w ^?! cWorld . lWorld . items . ix k) $
you w ^. crInv
)
dt <- invIMDT ((\k -> w ^?! cWorld . lWorld . items . ix k) <$> you w ^. crInv) ^? ix rootid
-- there is redundancy above
return
SelectedItem
{ _imSelectedItem = NInt j
, _imRootSelectedItem = NInt rootid
, _imAimStance = itemAimStance ((\(x,y,_) -> (x,y)) <$> dt)
, _imAttachedItems = aset
}
1 -> Just SelNothing
src/Dodge/Item/AimStance.hs
+1
View File
@@ -1,5 +1,6 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Item.AimStance (itemAimStance,itemBaseStance) where
--module Dodge.Item.AimStance (itemAimStance) where
import Dodge.Data.Item
import Dodge.Data.ComposedItem
src/Dodge/Render/HUD.hs
+1 -1
View File
@@ -239,7 +239,7 @@ floorItemPickupInfo n itm
-- it is probably desirable for this to crash hard for now
yourAugmentedItem :: (Item -> a) -> a -> (Either Item Button -> a) -> World -> a
yourAugmentedItem f x g w = case you w ^? crManipulation . manObject of
Just (SelectedItem i _ _) -> f $ yourInv w ^?! ix i
Just (SelectedItem i _ _ _) -> f $ yourInv w ^?! ix i
Just (SelCloseItem i) -> fromMaybe x $ do
j <- w ^? hud . closeItems . ix i . unNInt
flit <- w ^? cWorld . lWorld . items . ix j
src/Dodge/TestString.hs
+2 -1
View File
@@ -74,7 +74,8 @@ topTestPart u = [maybe "" showManObj $ u ^? uvWorld . cWorld . lWorld . creature
showManObj :: ManipulatedObject -> String
showManObj SortInventory = "SortInventory"
showManObj (SelectedItem x y z) = "SelItem: "++ show x++ " Root: "++show y++" Attached: "++show z
showManObj (SelectedItem x y as z) = "SelItem: "++ show x++ " Root: "++show y++" Attached: "++show z
++ " AimStance: " ++ show as
showManObj SelNothing = "SelNothing"
showManObj SortCloseItem = "SortCloseItem"
showManObj (SelCloseItem x) = "CloseItem " ++ show x