Major item refactor, still broken

This commit is contained in:
2025-08-24 19:34:09 +01:00
parent 22b4be440a
commit 94f6d5c630
62 changed files with 820 additions and 805 deletions
+25 -21
View File
@@ -4,6 +4,7 @@ module Dodge.Creature.YourControl (
yourControl,
) where
import qualified Data.IntMap.Strict as IM
import Dodge.Creature.MoveType
import Dodge.Data.Equipment.Misc
import Control.Monad
@@ -48,14 +49,14 @@ handleHotkeys w
, Just hk <-
listToMaybe . mapMaybe scancodeToHotkey . M.keys $ w ^. input . pressedKeys
, Just invid <- lw ^? creatures . ix 0 . crManipulation . manObject . imSelectedItem
, Just itid <- lw ^? creatures . ix 0 . crInv . ix invid . itID =
w & cWorld . lWorld %~ assignHotkey itid hk
, Just itid <- lw ^? creatures . ix 0 . crInv . ix invid =
w & cWorld . lWorld %~ assignHotkey (NInt itid) hk
| ispressed SDL.ScancodeLCtrl || ispressed SDL.ScancodeRCtrl
, Just hk <-
listToMaybe . mapMaybe scancodeToHotkey . M.keys $
w ^. input . pressedKeys
, Just itid <- lw ^? hotkeys . ix hk . unNInt
, Just invid <- lw ^? itemLocations . ix itid . ilInvID =
, Just invid <- lw ^? items . ix itid . itLocation . ilInvID =
w & invSetSelectionPos 0 invid
| otherwise =
M.foldl'
@@ -69,7 +70,7 @@ handleHotkeys w
useHotkey :: World -> (NewInt ItmInt, Int) -> World
useHotkey w (NInt itid, pt) = fromMaybe w $ do
invid <- w ^? cWorld . lWorld . itemLocations . ix itid . ilInvID
invid <- w ^? cWorld . lWorld . items . ix itid . itLocation . ilInvID
useItem invid pt w
hotkeyToScancode :: Hotkey -> SDL.Scancode
@@ -117,7 +118,7 @@ scancodeToHotkey x = case x of
within wasdMovement should probably be done first
-}
wasdWithAiming :: World -> Creature -> Creature
wasdWithAiming w cr = wasdAim inp w $ wasdMovement inp cam speed cr
wasdWithAiming w cr = wasdAim inp w $ wasdMovement (w ^. cWorld . lWorld) inp cam speed cr
where
speed = _mvSpeed $ crMvType cr
inp = w ^. input
@@ -127,31 +128,34 @@ wasdAim :: Input -> World -> Creature -> Creature
wasdAim inp w cr
| Just 0 <- inp ^? mouseButtons . ix SDL.ButtonRight
, Nothing <- inp ^? mouseButtons . ix SDL.ButtonLeft =
setAimPosture cr
| SDL.ButtonRight `M.member` _mouseButtons inp = aimTurn mousedir cr
| Aiming <- cr ^. crStance . posture = removeAimPosture 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
| otherwise = creatureTurnTowardDir (_crMvAim cr) 0.2 cr
where
m = w ^. cWorld . lWorld . items
mousedir = argV $ w ^. cWorld . lWorld . lAimPos - (cr ^. crPos)
setAimPosture :: Creature -> Creature
setAimPosture = (crStance . posture .~ Aiming) . doAimTwist (- twoHandTwistAmount)
setAimPosture :: IM.IntMap Item -> Creature -> Creature
setAimPosture m = (crStance . posture .~ Aiming) . doAimTwist m (- twoHandTwistAmount)
doAimTwist :: Float -> Creature -> Creature
doAimTwist x cr = fromMaybe cr $ do
doAimTwist :: IM.IntMap Item -> Float -> Creature -> Creature
doAimTwist m x cr = fromMaybe cr $ do
itRef <- cr ^? crManipulation . manObject . imRootSelectedItem
astance <- fmap itemBaseStance $ cr ^? crInv . ix itRef
itid <- cr ^? crInv . ix itRef
astance <- fmap itemBaseStance $ m ^? ix itid
guard $ astance == TwoHandOver || astance == TwoHandUnder
return $ cr & crDir +~ x
removeAimPosture :: Creature -> Creature
removeAimPosture = (crStance . posture .~ AtEase) . doAimTwist twoHandTwistAmount
removeAimPosture :: IM.IntMap Item -> Creature -> Creature
removeAimPosture m = (crStance . posture .~ AtEase) . doAimTwist m twoHandTwistAmount
twoHandTwistAmount :: Float
twoHandTwistAmount = 1.6 * pi
wasdMovement :: Input -> Camera -> Float -> Creature -> Creature
wasdMovement inp cam speed = theMovement . setMvAim
wasdMovement :: LWorld -> Input -> Camera -> Float -> Creature -> Creature
wasdMovement lw inp cam speed = theMovement . setMvAim
where
setMvAim = fromMaybe id $ do
dir <- safeArgV movDir
@@ -160,14 +164,14 @@ wasdMovement inp cam speed = theMovement . setMvAim
movAbs = rotateV (cam ^. camRot) $ normalizeV movDir
theMovement
| movDir == V2 0 0 = id
| otherwise = crMvAbsolute (speed *.* movAbs)
| otherwise = crMvAbsolute lw (speed *.* movAbs)
aimTurn :: Float -> Creature -> Creature
aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr
aimTurn :: LWorld -> Float -> Creature -> Creature
aimTurn lw a cr = creatureTurnTowardDir a (x * 0.2) cr
where
x = fromMaybe 1 $ do
itRef <- cr ^? crManipulation . manObject . imRootSelectedItem
fmap itemBulkiness $ cr ^? crInv . ix itRef . itType
fmap itemBulkiness $ cr ^? crInv . ix itRef >>= \k -> lw ^? items . ix k . itType
itemBulkiness :: ItemType -> Float
itemBulkiness = \case