From 59d128f87a4840558f8c8a227994a6b32cdb673c Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 14 May 2026 13:42:33 +0100 Subject: [PATCH] Move towards unifying (your) creature manipulation with selection --- src/Dodge/Base/You.hs | 8 +- src/Dodge/Bullet.hs | 10 +- src/Dodge/Creature/Action.hs | 3 +- src/Dodge/Creature/HandPos.hs | 91 ++++++++++--------- src/Dodge/Creature/Impulse.hs | 14 +-- src/Dodge/Creature/Impulse/Movement.hs | 20 ++-- src/Dodge/Creature/Picture.hs | 48 +++++----- src/Dodge/Creature/State.hs | 18 ++-- src/Dodge/Creature/Statistics.hs | 14 +-- src/Dodge/Creature/Test.hs | 21 +++-- src/Dodge/Creature/Update.hs | 2 +- src/Dodge/Creature/YourControl.hs | 34 +++---- src/Dodge/Data/Creature.hs | 2 +- src/Dodge/Data/HUD.hs | 2 + .../Data/Item/Use/Consumption/LoadAction.hs | 12 +-- src/Dodge/Debug.hs | 5 +- src/Dodge/Default/Creature.hs | 1 - src/Dodge/Default/World.hs | 1 + src/Dodge/Euse.hs | 6 +- src/Dodge/HeldUse.hs | 31 ++++--- src/Dodge/Inventory.hs | 28 +++--- src/Dodge/Inventory/Add.hs | 3 +- src/Dodge/Inventory/Location.hs | 47 +++++----- src/Dodge/Inventory/Path.hs | 8 +- src/Dodge/Inventory/RBList.hs | 2 +- src/Dodge/Inventory/Swap.hs | 9 +- src/Dodge/Item/Draw.hs | 18 ++-- src/Dodge/Item/HeldOffset.hs | 27 +++--- src/Dodge/Item/Location.hs | 6 +- src/Dodge/Projectile/Update.hs | 3 +- src/Dodge/Render/HUD.hs | 5 +- src/Dodge/TestString.hs | 3 +- src/Dodge/Update.hs | 5 +- src/Dodge/Update/Camera.hs | 11 ++- src/Dodge/Update/Scroll.hs | 5 +- 35 files changed, 271 insertions(+), 252 deletions(-) diff --git a/src/Dodge/Base/You.hs b/src/Dodge/Base/You.hs index 4177a8b67..a80c446e3 100644 --- a/src/Dodge/Base/You.hs +++ b/src/Dodge/Base/You.hs @@ -19,19 +19,21 @@ you w = w ^?! cWorld . lWorld . creatures . ix 0 yourSelectedItem :: World -> Maybe Item yourSelectedItem w = do - i <- you w ^? crManipulation . manObject . imSelectedItem + i <- w ^? hud . manObject . imSelectedItem +--revise1 i <- you w ^? crManipulation . manObject . imSelectedItem j <- _crInv (you w) ^? ix i w ^? cWorld . lWorld . items . ix j yourRootItem :: World -> Maybe Item yourRootItem w = do - i <- you w ^? crManipulation . manObject . imRootSelectedItem + i <- w ^? hud . manObject . imRootSelectedItem +--revise1 i <- you w ^? crManipulation . manObject . imRootSelectedItem j <- _crInv (you w) ^? ix i w ^? cWorld . lWorld . items . ix j yourRootItemDT :: World -> Maybe (DTree OItem) yourRootItemDT w = do - i <- you w ^? crManipulation . manObject . imRootSelectedItem . unNInt + i <- w^?hud. manObject . imRootSelectedItem . unNInt invIMDT ((\k -> w ^?! cWorld . lWorld . items . ix k) <$> you w ^. crInv) ^? ix i yourInv :: World -> NewIntMap InvInt Item diff --git a/src/Dodge/Bullet.hs b/src/Dodge/Bullet.hs index 4388e5aa2..4cff08778 100644 --- a/src/Dodge/Bullet.hs +++ b/src/Dodge/Bullet.hs @@ -108,11 +108,11 @@ updateBulVel bt = bt & buVel .*.*~ _buDrag bt -- return $ BezierTrajectory sp tpos (mouseWorldPos (w ^. input) (w ^. wCam)) -- might want to restrict what/how bounces by material type -bounceDir :: IM.IntMap Item -> (Point2, Either Creature Wall) -> Maybe Point2 -bounceDir _ (_, Right wl) = Just $ uncurry (-) (_wlLine wl) -bounceDir m (p, Left cr) | crIsArmouredFrom m p cr +bounceDir :: World -> IM.IntMap Item -> (Point2, Either Creature Wall) -> Maybe Point2 +bounceDir _ _ (_, Right wl) = Just $ uncurry (-) (_wlLine wl) +bounceDir w m (p, Left cr) | crIsArmouredFrom m p w cr = Just $ vNormal $ p - (cr ^. crPos . _xy) -bounceDir _ _ = Nothing +bounceDir _ _ _ = Nothing useBulletPayload :: Bullet -> Point2 -> World -> World useBulletPayload bu = case _buPayload bu of @@ -160,7 +160,7 @@ hitEffFromBul w bu = case _buEffect bu of PenetrateBullet -> movePenBullet bu hitstream w BounceBullet -> fromMaybe (expireAndDamage bu hitstream w) $ do (hp, crwl) <- hitstream ^? _head - dir <- bounceDir (w ^. cWorld . lWorld . items) (hp, crwl) + dir <- bounceDir w (w ^. cWorld . lWorld . items) (hp, crwl) return ( w , bu diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index 9b6823935..93568fe79 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -208,7 +208,8 @@ dropItem cr invid w = youDropItem :: World -> World youDropItem w = fromMaybe w $ do curpos <- - cr ^? crManipulation . manObject . imSelectedItem . unNInt + w ^? hud . manObject . imSelectedItem . unNInt +--revise1 cr ^? crManipulation . manObject . imSelectedItem . unNInt <|> fmap fst (IM.lookupMax (cr ^. crInv . unNIntMap)) guard $ not $ w ^. cWorld . lWorld . lInvLock return $ case cr ^. crStance . posture of diff --git a/src/Dodge/Creature/HandPos.hs b/src/Dodge/Creature/HandPos.hs index 0ebca91f6..1342e29fa 100644 --- a/src/Dodge/Creature/HandPos.hs +++ b/src/Dodge/Creature/HandPos.hs @@ -16,6 +16,7 @@ module Dodge.Creature.HandPos ( strideLength, ) where +import Dodge.Data.World import Control.Monad import qualified Data.IntMap.Strict as IM import Linear @@ -27,21 +28,21 @@ import Geometry import qualified Quaternion as Q import ShapePicture -translateToES :: Creature -> EquipSite -> Point3 -> Point3 -translateToES cr es p = fst (equipSitePQ es cr `Q.comp` (p, Q.qid)) +translateToES :: World -> Creature -> EquipSite -> Point3 -> Point3 +translateToES w cr es p = fst (equipSitePQ es w cr `Q.comp` (p, Q.qid)) -equipSitePQ :: EquipSite -> Creature -> Point3Q +equipSitePQ :: EquipSite -> World -> Creature -> Point3Q equipSitePQ = \case OnLeftWrist -> leftWristPQ OnRightWrist -> rightWristPQ - OnHead -> headPQ - OnChest -> chestPQ - OnBack -> backPQ - OnLeftLeg -> legPQ LeftForward - OnRightLeg -> legPQ RightForward + OnHead -> headPQ + OnChest -> chestPQ + OnBack -> backPQ + OnLeftLeg -> const $ legPQ LeftForward + OnRightLeg -> const $ legPQ RightForward -translatePointToRightHand :: Creature -> Point3 -> Point3 -translatePointToRightHand cr p = fst (rightHandPQ cr `Q.comp` (p, Q.qid)) +translatePointToRightHand :: World -> Creature -> Point3 -> Point3 +translatePointToRightHand w cr p = fst (rightHandPQ w cr `Q.comp` (p, Q.qid)) strideLength :: Creature -> Float strideLength cr = case cr ^. crType of @@ -61,14 +62,15 @@ handWalkingPos b off cr = case (cr ^? crType . strideAmount,cr ^? crType . footF zeroOneSmooth :: Float -> Float zeroOneSmooth x = (1 - cos (pi * x)) / 2 -rightHandPQ :: Creature -> Point3Q -rightHandPQ cr - | oneH cr = (V3 11 (-3) 20, Q.qid) - | twists cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 4 (-10) 0, Q.qz 1) - | twoFlat cr = (V3 8 (-8) 12, Q.qid) - | Just TwoHandTwist <- cr ^? crManipulation . manObject . imAimStance +rightHandPQ :: World -> Creature -> Point3Q +rightHandPQ w cr + | oneH w cr = (V3 11 (-3) 20, Q.qid) + | twists w cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 4 (-10) 0, Q.qz 1) + | twoFlat w cr = (V3 8 (-8) 12, Q.qid) + | Just TwoHandTwist <- w ^? hud . manObject . imAimStance +--revise1 | Just TwoHandTwist <- cr ^? crManipulation . manObject . imAimStance = (V3 6 (-6) 10, Q.qid) - | Just TwoHandFlat <- cr ^? crManipulation . manObject . imAimStance + | Just TwoHandFlat <- w ^? hud . manObject . imAimStance = (V3 (8 - twoHandOffY cr) (-8) 12, Q.qid) | Just p <- crRightHandWall cr = (20 & _xy .~ p, Q.qid) | otherwise = (handWalkingPos LeftForward (-8) cr, Q.qid) @@ -109,22 +111,23 @@ crLeftHandWall cr = do cd = cr ^. crDir rot = rotateV (negate cd) -translateToRightHand :: Creature -> SPic -> SPic -translateToRightHand = overPosSP . translatePointToRightHand +translateToRightHand :: World -> Creature -> SPic -> SPic +translateToRightHand w = overPosSP . translatePointToRightHand w -rightWristPQ :: Creature -> Point3Q -rightWristPQ cr = rightHandPQ cr `Q.comp` (V3 0 (-4) (-4), Q.qid) +rightWristPQ :: World -> Creature -> Point3Q +rightWristPQ w cr = rightHandPQ w cr `Q.comp` (V3 0 (-4) (-4), Q.qid) -leftHandPQ :: Creature -> Point3Q -leftHandPQ cr - | twists cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 12 4 0, Q.qz 0.4) - | twoFlat cr = (V3 8 8 12, Q.qid) - | Just TwoHandTwist <- cr ^? crManipulation . manObject . imAimStance +leftHandPQ :: World -> Creature -> Point3Q +leftHandPQ w cr + | twists w cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 12 4 0, Q.qz 0.4) + | twoFlat w cr = (V3 8 8 12, Q.qid) + | Just TwoHandTwist <- w ^? hud . manObject . imAimStance +--revise1 | Just TwoHandTwist <- cr ^? crManipulation . manObject . imAimStance = (V3 (10 + twoHandOffY cr) 6 20, Q.qid) - | Just TwoHandFlat <- cr ^? crManipulation . manObject . imAimStance + | Just TwoHandFlat <- w ^? hud . manObject . imAimStance = (V3 (8 + twoHandOffY cr) 6 12, Q.qid) | Just p <- crLeftHandWall cr = (20 & _xy .~ p, Q.qid) - | oneH cr = (V3 0 8 10, Q.qz 0.4) + | oneH w cr = (V3 0 8 10, Q.qz 0.4) | otherwise = (handWalkingPos RightForward 8 cr, Q.qid) twoHandOffY :: Creature -> Float @@ -137,14 +140,14 @@ twoHandOffY cr = zeroOneSmooth $ case (cr ^? crType . strideAmount,cr ^? crType in f sa _ -> 0 -translatePointToLeftHand :: Creature -> Point3 -> Point3 -translatePointToLeftHand cr p = fst (leftHandPQ cr `Q.comp` (p, Q.qid)) +translatePointToLeftHand :: World -> Creature -> Point3 -> Point3 +translatePointToLeftHand w cr p = fst (leftHandPQ w cr `Q.comp` (p, Q.qid)) -translateToLeftHand :: Creature -> SPic -> SPic -translateToLeftHand = overPosSP . translatePointToLeftHand +translateToLeftHand :: World -> Creature -> SPic -> SPic +translateToLeftHand w = overPosSP . translatePointToLeftHand w -leftWristPQ :: Creature -> Point3Q -leftWristPQ cr = leftHandPQ cr `Q.comp` (V3 0 4 (-4), Q.qid) +leftWristPQ :: World -> Creature -> Point3Q +leftWristPQ w cr = leftHandPQ w cr `Q.comp` (V3 0 4 (-4), Q.qid) translateToLeftLeg :: Creature -> SPic -> SPic translateToLeftLeg cr = overPosSP (\p -> fst (legPQ LeftForward cr `Q.comp` (p, Q.qid))) @@ -171,17 +174,17 @@ legPQ' g cr = translateToRightLeg :: Creature -> SPic -> SPic translateToRightLeg cr = overPosSP (\p -> fst (legPQ RightForward cr `Q.comp` (p, Q.qid))) -headPQ :: Creature -> Point3Q -headPQ cr - | twists cr = (V3 0 2 20, Q.qz (-1)) `Q.comp` (V3 (negate 2.5) 0.25 0, Q.qz 1) - | oneH cr = (V3 0 0 20, Q.qz 0.5) `Q.comp` (V3 2.5 0 0, Q.qz (-0.5)) +headPQ :: World -> Creature -> Point3Q +headPQ w cr + | twists w cr = (V3 0 2 20, Q.qz (-1)) `Q.comp` (V3 (negate 2.5) 0.25 0, Q.qz 1) + | oneH w cr = (V3 0 0 20, Q.qz 0.5) `Q.comp` (V3 2.5 0 0, Q.qz (-0.5)) | otherwise = (V3 2.5 0 20, Q.qid) -chestPQ :: Creature -> Point3Q -chestPQ cr = backPQ cr `Q.comp` (0, Q.qz pi) +chestPQ :: World -> Creature -> Point3Q +chestPQ w cr = backPQ w cr `Q.comp` (0, Q.qz pi) -backPQ :: Creature -> Point3Q -backPQ cr - | oneH cr = (V3 0 0 10, Q.qz 0.5) - | twists cr = (V3 0 3 10, Q.qz (-1.5)) +backPQ :: World -> Creature -> Point3Q +backPQ w cr + | oneH w cr = (V3 0 0 10, Q.qz 0.5) + | twists w cr = (V3 0 3 10, Q.qz (-1.5)) | otherwise = (V3 0 0 10, Q.qz 0) diff --git a/src/Dodge/Creature/Impulse.hs b/src/Dodge/Creature/Impulse.hs index 0f20f2277..2f177b445 100644 --- a/src/Dodge/Creature/Impulse.hs +++ b/src/Dodge/Creature/Impulse.hs @@ -33,10 +33,10 @@ followImpulse cid w = \case Bark sid -> soundStart (CrMouth cid) cpos sid Nothing $ w & clens %~ resetCrVocCoolDown w - Move p -> crup $ crMvBy p (w ^. cWorld . lWorld) - Walk p -> crup $ crWalk p (w ^. cWorld . lWorld) - MoveForward x -> crup $ crMvForward x (w ^. cWorld . lWorld) - MoveNoStride p -> crup $ crMvByNoStride p (w ^. cWorld . lWorld) + Move p -> crup $ crMvBy p w + Walk p -> crup $ crWalk p w + MoveForward x -> crup $ crMvForward x w + MoveNoStride p -> crup $ crMvByNoStride p w Turn a -> crup $ crDir +~ a TurnToward p a -> crup $ creatureTurnToward p a TurnTo p -> crup $ creatureTurnTo p @@ -69,7 +69,7 @@ followImpulse cid w = \case i <- cr ^? crIntention . targetCr . _Just tcr <- w ^? cWorld . lWorld . creatures . ix i return $ followImpulse cid w (doCrImp f tcr) - MvForward -> crup $ crMvForward' (w ^. cWorld . lWorld) + MvForward -> crup $ crMvForward' w MvTurnToward p -> crup $ mvTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir)) @@ -101,10 +101,10 @@ meleeMovement :: World -> Int -> Creature -> Creature meleeMovement w tid cr = case cr ^. crType of HoverCrit {} -> fromMaybe cr $ do txy <- w ^? cWorld . lWorld . creatures . ix tid . crPos . _xy - return $ crMvAbsolute (w ^. cWorld . lWorld) (5 *^ normalizeV (cr ^. crPos . _xy - txy)) cr + return $ crMvAbsolute w (5 *^ normalizeV (cr ^. crPos . _xy - txy)) cr ChaseCrit {} -> fromMaybe cr $ do txy <- w ^? cWorld . lWorld . creatures . ix tid . crPos . _xy - return $ crMvAbsolute (w ^. cWorld . lWorld) (5 *^ normalizeV (txy - cr ^. crPos . _xy)) cr + return $ crMvAbsolute w (5 *^ normalizeV (txy - cr ^. crPos . _xy)) cr _ -> cr setBeeRandomMovement :: Int -> World -> World diff --git a/src/Dodge/Creature/Impulse/Movement.hs b/src/Dodge/Creature/Impulse/Movement.hs index 0a2e0b7a7..127d9d972 100644 --- a/src/Dodge/Creature/Impulse/Movement.hs +++ b/src/Dodge/Creature/Impulse/Movement.hs @@ -25,26 +25,26 @@ The idea is that this may or may not work, depending on the status of the creatu For now, though, this cannot fail. p is the movement translation vector, will be made relative to creature direction -} -crMvBy :: Point2 -> LWorld -> Creature -> Creature +crMvBy :: Point2 -> World -> Creature -> Creature crMvBy p lw cr = crMvAbsolute lw (rotateV (_crDir cr) p) cr -- | p is the movement translation vector, made relative to creature direction -crWalk :: Point2 -> LWorld -> Creature -> Creature +crWalk :: Point2 -> World -> Creature -> Creature crWalk p lw cr = crWalkAbsolute lw (rotateV (_crDir cr) p) cr -- | p is the movement translation vector, made relative to creature direction -crMvByNoStride :: Point2 -> LWorld -> Creature -> Creature +crMvByNoStride :: Point2 -> World -> Creature -> Creature crMvByNoStride p lw cr = crMvAbsoluteNoStride lw (rotateV (_crDir cr) p) cr -crMvAbsolute :: LWorld -> Point2 -> Creature -> Creature -crMvAbsolute lw p' cr = +crMvAbsolute :: World -> Point2 -> Creature -> Creature +crMvAbsolute w p' cr = cr & crPos . _xy +~ p & crMvDir .~ argV (p + cr ^. crOldPos . _xy - cr ^. crOldOldPos . _xy) where - p = strengthFactor (getCrMoveSpeed lw cr) *^ p' + p = strengthFactor (getCrMoveSpeed w cr) *^ p' -crWalkAbsolute :: LWorld -> Point2 -> Creature -> Creature +crWalkAbsolute :: World -> Point2 -> Creature -> Creature crWalkAbsolute lw p' cr | Walking <- cr ^. crStance . carriage = cr & crPos . _xy +~ p @@ -53,7 +53,7 @@ crWalkAbsolute lw p' cr where p = strengthFactor (getCrMoveSpeed lw cr) *.* p' -crMvAbsoluteNoStride :: LWorld -> Point2 -> Creature -> Creature +crMvAbsoluteNoStride :: World -> Point2 -> Creature -> Creature crMvAbsoluteNoStride lw p' cr = cr & crPos . _xy +~ p where p = strengthFactor (getCrMoveSpeed lw cr) *.* p' @@ -64,7 +64,7 @@ strengthFactor i | i < 1 = 0 | otherwise = 0.02 * fromIntegral i -crMvForward' :: LWorld -> Creature -> Creature +crMvForward' :: World -> Creature -> Creature crMvForward' lw cr = case crMvType cr of JitMvType s _ _ -> crMvBy (V2 s 0) lw cr StartStopMvType s _ n -> @@ -85,7 +85,7 @@ crMvForward' lw cr = case crMvType cr of MvWalking s -> crMvBy (V2 s 0) lw cr -crMvForward :: Float -> LWorld -> Creature -> Creature +crMvForward :: Float -> World -> Creature -> Creature crMvForward speed = crMvBy (V2 speed 0) creatureTurnTo :: Point2 -> Creature -> Creature diff --git a/src/Dodge/Creature/Picture.hs b/src/Dodge/Creature/Picture.hs index d70cc98a4..d4046f484 100644 --- a/src/Dodge/Creature/Picture.hs +++ b/src/Dodge/Creature/Picture.hs @@ -40,9 +40,9 @@ drawCreature w m cr = translateSP (_crPos cr) . fallrot . rotateSP (_crDir cr) $ BarrelCrit{} -> barrelShape LampCrit{_lampHeight = h} -> lampCrSPic h ChaseCrit{} -> noPic $ drawChaseCrit w cr - Avatar{} -> basicCrPict m cr - SwarmCrit -> basicCrPict m cr - AutoCrit -> basicCrPict m cr + Avatar{} -> basicCrPict w m cr + SwarmCrit -> basicCrPict w m cr + AutoCrit -> basicCrPict w m cr CrabCrit{} -> noPic $ drawCrabCrit w cr HoverCrit{} -> noPic $ drawHoverCrit cr SlinkCrit{} -> noPic $ drawSlinkCrit cr @@ -67,15 +67,15 @@ drawSlimeCrit cr = guard $ length qs == 12 return $ zipWith (+) (fmap (0.1 * (10 - x) *^) so) (fmap (0.1 * x *^) qs) -basicCrPict :: IM.IntMap Item -> Creature -> SPic -basicCrPict m cr = drawEquipment m cr <> noPic (basicCrShape cr) +basicCrPict :: World -> IM.IntMap Item -> Creature -> SPic +basicCrPict w m cr = drawEquipment w m cr <> noPic (basicCrShape w cr) -basicCrShape :: Creature -> Shape -basicCrShape cr = +basicCrShape :: World -> Creature -> Shape +basicCrShape w cr = scaleSH (V3 crsize crsize crsize) $ mconcat - [ colorSH (_skinHead cskin) . overPosSH (translateToES cr OnHead) $ scalp - , colorSH (_skinUpper cskin) $ upperBody cr + [ colorSH (_skinHead cskin) . overPosSH (translateToES w cr OnHead) $ scalp + , colorSH (_skinUpper cskin) $ upperBody w cr , rotmdir $ colorSH (_skinLower cskin) $ feet cr ] where @@ -294,8 +294,8 @@ spiderJoint p q = (f $ Q.axisAngle (V3 0 (-1) 0) (pi - (a + b)), f . Q.axisAngle -- c = argV $ (p-q) ^. _xy -- f x = Q.qz c * x -makeCorpse :: StdGen -> Creature -> SPic -makeCorpse g cr = case cr ^. crType of +makeCorpse :: World -> StdGen -> Creature -> SPic +makeCorpse w g cr = case cr ^. crType of HoverCrit{} -> noPic $ drawHoverCrit cr ChaseCrit{} -> noPic $ chaseCorpse g cr CrabCrit{} -> noPic $ crabCorpse g cr @@ -305,7 +305,7 @@ makeCorpse g cr = case cr ^. crType of . scaleSH (V3 crsize crsize crsize) $ mconcat [ colorSH (_skinHead cskin) $ deadScalp cr - , colorSH (_skinUpper cskin) $ deadUpperBody cr + , colorSH (_skinUpper cskin) $ deadUpperBody w cr , rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr ] where @@ -375,12 +375,12 @@ deadFeet :: Creature -> Shape {-# INLINE deadFeet #-} deadFeet = feet -arms :: Creature -> Shape +arms :: World -> Creature -> Shape {-# INLINE arms #-} -arms cr = +arms w cr = (^. _1) $ - translateToRightHand cr aHand - <> translateToLeftHand cr aHand + translateToRightHand w cr aHand + <> translateToLeftHand w cr aHand where aHand = noPic $ translateSHz (-2) . upperPrismPolyHalfST 2 $ polyCirc 3 4 @@ -404,28 +404,28 @@ scalp = (colorSH (greyN 0.9) . upperPrismPolyHalfST 5 $ polyCirc 3 5) & each . sfShadowImportance .~ Unimportant -torso :: Creature -> Shape +torso :: World -> Creature -> Shape {-# INLINE torso #-} -torso cr = overPosSH (translateToES cr OnBack) tsh +torso w cr = overPosSH (translateToES w cr OnBack) tsh where tsh = ashoulder 3 (-0.2) <> ashoulder (-3) 0.2 ashoulder y a = translateSHxy 0 y . rotateSH a $ scaleSH (V3 10 10 1) baseShoulder -deadUpperBody :: Creature -> Shape -deadUpperBody cr = deadRot cr . translateSHz (negate 10) . upperBody $ cr +deadUpperBody :: World -> Creature -> Shape +deadUpperBody w cr = deadRot cr . translateSHz (negate 10) . upperBody w $ cr baseShoulder :: Shape {-# INLINE baseShoulder #-} -- baseShoulder = translateSHz (-20) . scaleSH (V3 0.5 1 1) . upperPrismPolyHalfMI 10 $ polyCirc 3 1 baseShoulder = scaleSH (V3 0.5 1 1) . upperPrismPolyHalfMI 10 $ polyCirc 3 1 -upperBody :: Creature -> Shape +upperBody :: World -> Creature -> Shape {-# INLINE upperBody #-} -upperBody cr = arms cr <> torso cr +upperBody w cr = arms w cr <> torso w cr -drawEquipment :: IM.IntMap Item -> Creature -> SPic +drawEquipment :: World -> IM.IntMap Item -> Creature -> SPic {-# INLINE drawEquipment #-} -drawEquipment m cr = foldMap (itemEquipPict cr) (invDT . fmap (\i -> m ^?! ix i) $ _crInv cr) +drawEquipment w m cr = foldMap (itemEquipPict w cr) (invDT . fmap (\i -> m ^?! ix i) $ _crInv cr) barrelShape :: SPic barrelShape = noPic $ cylinderPoly Medium Important (map (addZ 20) ps) (map (addZ 0) ps) diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index cec06936e..f6570724b 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -83,7 +83,7 @@ jitterPain cr w where dojitter x y = let (p, g) = runState (randInCirc x) (_randGen w) - in w & cWorld . lWorld . creatures . ix (_crID cr) %~ crMvByNoStride p (w ^. cWorld . lWorld) + in w & cWorld . lWorld . creatures . ix (_crID cr) %~ crMvByNoStride p w & cWorld . lWorld . creatures . ix (_crID cr) . crPain -~ y & randGen .~ g @@ -161,7 +161,7 @@ copierItemUpdate itm cr w = fromMaybe w $ do x <- itm ^? itScroll . itsInt invid <- itm ^? itLocation . ilInvID ip <- itm ^? itType . ibtPathing - i <- getInventoryPath x ip (_unNInt invid) cr + i <- getInventoryPath w x ip (_unNInt invid) cr itm' <- cr ^? crInv . ix (NInt i) >>= \k -> w ^? cWorld . lWorld . items . ix k v <- getItemValue itm' w cr return $ w & pointerToItem itm . itUse . uValue .~ v @@ -251,7 +251,7 @@ shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ d , _lpOrigin = CrWeaponO $ cr ^. crID } where - o = locOrient loc cr + o = locOrient w loc cr itmtree = loc ^. locDT (p, q) = o `Q.comp` (V3 5 0 0, Q.qid) x = 1 @@ -264,19 +264,19 @@ shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ d itid = itm ^. itID . unNInt shineTorch :: Creature -> LocationDT OItem -> World -> World -shineTorch cr loc = fromMaybe id $ do +shineTorch cr loc w = fromMaybe w $ do mag <- find (isammolink . (^. dtValue . _2)) (itmtree ^. dtLeft) i <- mag ^. dtValue . _1 . itConsumables -- guard $ crIsAiming cr guard $ i >= x itid <- mag ^? dtValue . _1 . itID . unNInt - return $ - (cWorld . lWorld . lights .:~ LSParam pos 150 0.3) - . (cWorld . lWorld . lights .:~ LSParam (pos + V3 0 0 15) 50 0.3) - . (cWorld . lWorld . items . ix itid . itConsumables . _Just -~ x) + return $ w + & (cWorld . lWorld . lights .:~ LSParam pos 150 0.3) + & (cWorld . lWorld . lights .:~ LSParam (pos + V3 0 0 15) 50 0.3) + & (cWorld . lWorld . items . ix itid . itConsumables . _Just -~ x) where itmtree = loc ^. locDT - (p, q) = locOrient loc cr + (p, q) = locOrient w loc cr x = 10 isammolink AmmoMagSF{} = True isammolink _ = False diff --git a/src/Dodge/Creature/Statistics.hs b/src/Dodge/Creature/Statistics.hs index 9b3a5a9fa..583a678c1 100644 --- a/src/Dodge/Creature/Statistics.hs +++ b/src/Dodge/Creature/Statistics.hs @@ -6,6 +6,7 @@ module Dodge.Creature.Statistics ( -- crIntelligence, ) where +import Dodge.Data.World import Dodge.Data.Equipment.Misc import qualified Data.Map.Strict as M import NewInt @@ -53,8 +54,8 @@ crStrength cr = case cr ^. crType of -- BeeCrit{} -> 20 -getCrMoveSpeed :: LWorld -> Creature -> Int -getCrMoveSpeed lw cr = strFromHeldItem lw cr + strFromEquipment lw cr + crStrength cr +getCrMoveSpeed :: World -> Creature -> Int +getCrMoveSpeed w cr = strFromHeldItem w cr + strFromEquipment (w^.cWorld.lWorld) cr + crStrength cr strFromEquipment :: LWorld -> Creature -> Int strFromEquipment lw = sum . fmap equipmentStrValue . crCurrentEquipment lw @@ -70,12 +71,13 @@ crCurrentEquipment lw = fmap f . _crEquipment where f i = lw ^?! items . ix (_unNInt i) -strFromHeldItem :: LWorld -> Creature -> Int -strFromHeldItem lw cr = fromMaybe 0 $ do +strFromHeldItem :: World -> Creature -> Int +strFromHeldItem w cr = fromMaybe 0 $ do Aiming {} <- cr ^? crStance . posture - is <- cr ^? crManipulation . manObject . imAttachedItems + is <- w^?hud . manObject . imAttachedItems +--revise1 is <- cr ^? crManipulation . manObject . imAttachedItems let js = IM.elems $ IM.restrictKeys (cr ^. crInv . unNIntMap) is - return . negate . sum . fmap itemWeight $ IM.restrictKeys (lw ^. items) $ IS.fromList js + return . negate . sum . fmap itemWeight $ IM.restrictKeys (w ^.cWorld.lWorld. items) $ IS.fromList js itemWeight :: Item -> Int itemWeight it = case it ^. itType of diff --git a/src/Dodge/Creature/Test.hs b/src/Dodge/Creature/Test.hs index 466b193ea..f6d8a9226 100644 --- a/src/Dodge/Creature/Test.hs +++ b/src/Dodge/Creature/Test.hs @@ -84,24 +84,25 @@ crAwayFromPost cr = case _apGoal $ _crActionPlan cr of SentinelAt p _ -> dist p (cr ^. crPos . _xy) > 15 _ -> False -crInAimStance :: AimStance -> Creature -> Bool -crInAimStance as cr = cr ^? crStance . posture == Just Aiming - && cr ^? crManipulation . manObject . imAimStance == Just as +crInAimStance :: AimStance -> World -> Creature -> Bool +crInAimStance as w cr = cr ^? crStance . posture == Just Aiming + && w ^? hud . manObject . imAimStance == Just as +--revise1 && cr ^? crManipulation . manObject . imAimStance == Just as -oneH :: Creature -> Bool +oneH :: World -> Creature -> Bool oneH = crInAimStance OneHand -twoFlat :: Creature -> Bool +twoFlat :: World -> Creature -> Bool twoFlat = crInAimStance TwoHandFlat -twists :: Creature -> Bool +twists :: World -> Creature -> Bool twists = crInAimStance TwoHandTwist -- the use of crOldPos is because the damage position is calculated on the -- previous frame -- Not sure if it is a good idea -crIsArmouredFrom :: IM.IntMap Item -> Point2 -> Creature -> Bool -crIsArmouredFrom m p cr = fromMaybe False $ do +crIsArmouredFrom :: IM.IntMap Item -> Point2 -> World -> Creature -> Bool +crIsArmouredFrom m p w cr = fromMaybe False $ do NInt itid <- cr ^? crEquipment . ix OnChest ittype <- m ^? ix itid . itType return $ @@ -112,8 +113,8 @@ crIsArmouredFrom m p cr = fromMaybe False $ do where -- even though angleVV can generate NaN, the comparison seems to deal with it frontarmdirection - | crInAimStance OneHand cr = 0.5 - | crInAimStance TwoHandTwist cr = negate 1 + | crInAimStance OneHand w cr = 0.5 + | crInAimStance TwoHandTwist w cr = negate 1 | otherwise = 0 --crOnSeg :: Point2 -> Point2 -> Creature -> Bool diff --git a/src/Dodge/Creature/Update.hs b/src/Dodge/Creature/Update.hs index 5cdb8fd79..ad92cb3c1 100644 --- a/src/Dodge/Creature/Update.hs +++ b/src/Dodge/Creature/Update.hs @@ -534,7 +534,7 @@ corpseOrGib cr w = .~ g cid = cr ^. crID sethp x = cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ x - thecorpse = makeCorpse (w ^. randGen) cr + thecorpse = makeCorpse w (w ^. randGen) cr scorchSPic :: SPic -> SPic scorchSPic = _1 %~ overColSH (mixColors 0.9 0.1 black . normalizeColor) diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index 190e3570b..0ecd7cd57 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -38,7 +38,8 @@ 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 invid <- w ^? hud . manObject . imSelectedItem +--revise1 , 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 @@ -106,7 +107,7 @@ scancodeToHotkey = \case wasdWithAiming :: World -> Creature -> Creature wasdWithAiming w cr | Walking <- cr ^. crStance . carriage - = wasdAim inp w $ wasdMovement (w ^. cWorld . lWorld) inp cam speed cr + = wasdAim inp w $ wasdMovement w inp cam speed cr | otherwise = cr where speed = _mvSpeed $ crMvType cr @@ -118,7 +119,7 @@ wasdAim inp w cr | SDL.ButtonRight `M.member` _mouseButtons inp , AtEase <- cr ^. crStance . posture = setposture Aiming (-twoHandTwistAmount) - | SDL.ButtonRight `M.member` _mouseButtons inp = aimTurn (w ^. cWorld . lWorld) mousedir cr + | SDL.ButtonRight `M.member` _mouseButtons inp = aimTurn w mousedir cr | Aiming{} <- cr ^. crStance . posture = setposture AtEase twoHandTwistAmount -- | otherwise = creatureTurnTowardDir (_crMvAim cr) 0.2 cr | otherwise = creatureTurnTowardDir (_crMvDir cr) 0.2 cr @@ -126,7 +127,8 @@ wasdAim inp w cr setposture x r = cr & crStance . posture .~ x - & doAimTwist (cr ^? crManipulation . manObject . imAimStance) r + & doAimTwist (w ^? hud . manObject . imAimStance) r +--revise1 & doAimTwist (cr ^? crManipulation . manObject . imAimStance) r mousedir = argV $ w ^. cWorld . lWorld . lAimPos - (cr ^. crPos . _xy) doAimTwist :: Maybe AimStance -> Float -> Creature -> Creature @@ -137,8 +139,8 @@ doAimTwist as x twoHandTwistAmount :: Float twoHandTwistAmount = 1.6 * pi -wasdMovement :: LWorld -> Input -> Camera -> Float -> Creature -> Creature -wasdMovement lw inp cam speed = theMovement -- . setMvAim +wasdMovement :: World -> Input -> Camera -> Float -> Creature -> Creature +wasdMovement w inp cam speed = theMovement -- . setMvAim where -- setMvAim = fromMaybe id $ do -- dir <- safeArgV movDir @@ -147,14 +149,15 @@ wasdMovement lw inp cam speed = theMovement -- . setMvAim movAbs = rotateV (cam ^. camRot) $ normalizeV movDir theMovement | movDir == V2 0 0 = id - | otherwise = crMvAbsolute lw (speed *^ movAbs) + | otherwise = crMvAbsolute w (speed *^ movAbs) -aimTurn :: LWorld -> Float -> Creature -> Creature +aimTurn :: World -> 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 >>= \k -> lw ^? items . ix k . itType + itRef <- lw ^? hud . manObject . imRootSelectedItem +--revise1 itRef <- cr ^? crManipulation . manObject . imRootSelectedItem + fmap itemBulkiness $ cr ^? crInv . ix itRef >>= \k -> lw ^?cWorld.lWorld. items . ix k . itType itemBulkiness :: ItemType -> Float itemBulkiness = \case @@ -209,14 +212,7 @@ tryClickUse pkeys w = fromMaybe w $ do ltime <- pkeys ^? ix SDL.ButtonLeft rtime <- pkeys ^? ix SDL.ButtonRight guard $ ltime <= rtime - case w - ^? cWorld - . lWorld - . creatures - . ix 0 - . crManipulation - . manObject - . imSelectedItem - . unNInt of + case w ^?hud. manObject . imSelectedItem . unNInt of +--revise1 case w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imSelectedItem . unNInt of Just invid -> useItem invid ltime w Nothing -> interactWithCloseObj <$> getSelectedCloseObj w ?? w diff --git a/src/Dodge/Data/Creature.hs b/src/Dodge/Data/Creature.hs index b5b261944..913def322 100644 --- a/src/Dodge/Data/Creature.hs +++ b/src/Dodge/Data/Creature.hs @@ -42,7 +42,7 @@ data Creature = Creature , _crID :: Int , _crHP :: CrHP , _crInv :: NewIntMap InvInt Int - , _crManipulation :: Manipulation +-- , _crManipulation :: Manipulation , _crEquipment :: M.Map EquipSite (NewInt ItmInt) , _crDamage :: [Damage] , _crPain :: Int diff --git a/src/Dodge/Data/HUD.hs b/src/Dodge/Data/HUD.hs index d289332c8..cefc2fd5a 100644 --- a/src/Dodge/Data/HUD.hs +++ b/src/Dodge/Data/HUD.hs @@ -3,6 +3,7 @@ module Dodge.Data.HUD where +import Dodge.Data.Item.Use.Consumption.LoadAction import Control.Lens import Dodge.Data.Combine import Dodge.Data.Item.Location @@ -33,6 +34,7 @@ data HUD = HUD , _diCloseFilter :: Maybe String , _closeItems :: [NewInt ItmInt] , _closeButtons :: [Int] + , _manObject :: ManipulatedObject } data Selection = Sel {_slSec :: Int, _slInt :: Int} diff --git a/src/Dodge/Data/Item/Use/Consumption/LoadAction.hs b/src/Dodge/Data/Item/Use/Consumption/LoadAction.hs index 09563104a..acf163c42 100644 --- a/src/Dodge/Data/Item/Use/Consumption/LoadAction.hs +++ b/src/Dodge/Data/Item/Use/Consumption/LoadAction.hs @@ -12,10 +12,10 @@ import Data.Aeson import Data.Aeson.TH --import Sound.Data -data Manipulation -- should be ManipulatedObject? - = Manipulator {_manObject :: ManipulatedObject } - | Brute - deriving (Eq, Ord, Show, Read) --Generic, Flat) +--data Manipulation -- should be ManipulatedObject? +-- = Manipulator {_manObject :: ManipulatedObject } +-- | Brute +-- deriving (Eq, Ord, Show, Read) --Generic, Flat) data ManipulatedObject = SortInventory @@ -33,6 +33,6 @@ data ManipulatedObject deriving (Eq, Ord, Show, Read) --Generic, Flat) makeLenses ''ManipulatedObject -makeLenses ''Manipulation +--makeLenses ''Manipulation deriveJSON defaultOptions ''ManipulatedObject -deriveJSON defaultOptions ''Manipulation +--deriveJSON defaultOptions ''Manipulation diff --git a/src/Dodge/Debug.hs b/src/Dodge/Debug.hs index 3739c681c..0e3bb4e5b 100644 --- a/src/Dodge/Debug.hs +++ b/src/Dodge/Debug.hs @@ -320,12 +320,13 @@ drawCreatureRad cr = setLayer DebugLayer showMuzzlePositions :: Universe -> Picture showMuzzlePositions u = fold $ do cr <- u ^? uvWorld . cWorld . lWorld . creatures . ix 0 - invid <- cr ^? crManipulation . manObject . imRootSelectedItem . unNInt + invid <- u ^?uvWorld.hud . manObject . imRootSelectedItem . unNInt +--revise1 invid <- cr ^? crManipulation . manObject . imRootSelectedItem . unNInt loc <- invIndents ((\k -> u ^?! uvWorld . cWorld . lWorld . items . ix k) <$> _crInv cr) ^? ix invid . _2 return . color red $ setLayer DebugLayer $ reduceLocDT (f cr) loc where - f cr loc = foldMap (g . muzzlePos loc cr) (itemMuzzles loc) + f cr loc = foldMap (g . muzzlePos (u^.uvWorld) loc cr) (itemMuzzles loc) where g :: Point3Q -> Picture g pq = translate3 (pq ^. _1) $ crossPic 5 diff --git a/src/Dodge/Default/Creature.hs b/src/Dodge/Default/Creature.hs index bfacb2b30..f93b08c5a 100644 --- a/src/Dodge/Default/Creature.hs +++ b/src/Dodge/Default/Creature.hs @@ -27,7 +27,6 @@ defaultCreature = , _crHP = HP 100 -- , _crMaxHP = 150 , _crInv = mempty - , _crManipulation = Manipulator SelNothing -- , _crInvCapacity = 25 , _crDamage = [] -- , _crCorpse = MakeDefaultCorpse diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 2ca5e1d97..f0d53faf8 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -182,4 +182,5 @@ defaultHUD = , _diCloseFilter = mempty , _closeItems = mempty , _closeButtons = mempty + , _manObject = SelNothing } diff --git a/src/Dodge/Euse.hs b/src/Dodge/Euse.hs index ddc6ab2ce..473e7ec83 100644 --- a/src/Dodge/Euse.hs +++ b/src/Dodge/Euse.hs @@ -62,12 +62,12 @@ useMagShield mt _ cr w = -- _ -> w createHeadLamp :: Item -> Creature -> World -> World -createHeadLamp _ cr = +createHeadLamp _ cr w = w & cWorld . lWorld . lights .:~ LSParam - (_crPos cr + rotate3z (_crDir cr) (translateToES cr OnHead (V3 5 0 3))) + (_crPos cr + rotate3z (_crDir cr) (translateToES w cr OnHead (V3 5 0 3))) 200 0.7 @@ -122,7 +122,7 @@ setWristShieldPos itm cr esite w = w & moveWallIDUnsafe i wlline . itLocation . ilEquipSite . _Just of - Just x -> translateToES cr x -- . g + Just x -> translateToES w cr x -- . g _ -> undefined -- g -- | twists cr = (+.+.+ V3 (-5) 10 0) diff --git a/src/Dodge/HeldUse.hs b/src/Dodge/HeldUse.hs index 758878778..27698f5ba 100644 --- a/src/Dodge/HeldUse.hs +++ b/src/Dodge/HeldUse.hs @@ -484,12 +484,12 @@ applySoundCME itm cr = fromMaybe id $ do cid = _crID cr applyRecoil :: LocationDT OItem -> Creature -> World -> World -applyRecoil loc cr = +applyRecoil loc cr w = w & cWorld . lWorld . creatures . ix (_crID cr) . crPos . _xy +~ rotateV (_crDir cr + Q.qToAng q) (V2 ((- recoilAmount itm) / crMass (_crType cr)) 0) where itm = loc ^. locDT . dtValue . _1 - (_, q) = locOrient loc cr + (_, q) = locOrient w loc cr recoilAmount :: Item -> Float recoilAmount itm @@ -777,29 +777,29 @@ useLoadedAmmo loc cr mz m w = MuzzleScroller -> useTimeScrollGun itm cr w where o = CrWeaponO $ cr ^. crID - pq = muzzlePos loc cr mz - (pq', g) = muzzleRandPos loc cr mz `runState` (w ^. randGen) + pq = muzzlePos w loc cr mz + (pq', g) = muzzleRandPos w loc cr mz `runState` (w ^. randGen) itmtree = loc ^. locDT mitid = magtree ^. dtValue . _1 . itID itm = itmtree ^. dtValue . _1 (x, magtree) = fromJust m -muzzlePos :: LocationDT OItem -> Creature -> Muzzle -> Point3Q -muzzlePos m cr muz = (p1, q1) `Q.comp` pq `Q.comp` (p3, q3) +muzzlePos :: World -> LocationDT OItem -> Creature -> Muzzle -> Point3Q +muzzlePos w m cr muz = (p1, q1) `Q.comp` pq `Q.comp` (p3, q3) where - pq = locOrient m cr + pq = locOrient w m cr p1 = cr ^. crPos q1 = Q.qz $ cr ^. crDir p3 = addZ 0 $ muz ^. mzPos q3 = Q.qz $ muz ^. mzRot -muzzleRandPos :: LocationDT OItem -> Creature -> Muzzle -> State StdGen Point3Q -muzzleRandPos m cr muz = do +muzzleRandPos :: World -> LocationDT OItem -> Creature -> Muzzle -> State StdGen Point3Q +muzzleRandPos w m cr muz = do a <- state $ randomR (- inacc, inacc) y <- case muz ^. mzRandomOffset of 0 -> return 0 i -> state $ randomR (- i, i) - return $ muzzlePos m cr muz `Q.comp` (V3 0 y 0, Q.qz a) + return $ muzzlePos w m cr muz `Q.comp` (V3 0 y 0, Q.qz a) where inacc = _mzInaccuracy muz @@ -1004,7 +1004,7 @@ shootBullets loc cr (mz, x, magtree) w = fromMaybe w $ do shootBullet :: Bullet -> LocationDT OItem -> Creature -> Muzzle -> World -> World shootBullet bu loc cr mz w = makeBullet bu itm pq . (randGen .~ g) $ w where - (pq, g) = muzzleRandPos loc cr mz `runState` (w ^. randGen) + (pq, g) = muzzleRandPos w loc cr mz `runState` (w ^. randGen) itm = loc ^. locDT . dtValue . _1 makeBullet :: Bullet -> Item -> Point3Q -> World -> World @@ -1384,10 +1384,10 @@ dropInventoryPath :: Creature -> World -> World -dropInventoryPath i ip loc cr = fromMaybe id $ do +dropInventoryPath i ip loc cr w = fromMaybe w $ do invid <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID . unNInt - j <- getInventoryPath i ip invid cr - return $ dropItem cr j + j <- getInventoryPath w i ip invid cr + return $ dropItem cr j w --dropInventoryPath i ip loc cr w = case ip of -- ABSOLUTE -> fromMaybe w $ do @@ -1421,7 +1421,8 @@ useInventoryPath pt i ip loc cr w = case ip of guard $ i `IM.member` (cr ^. crInv . unNIntMap) return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem i pt) RELCURS -> fromMaybe w $ do - j <- cr ^? crManipulation . manObject . imSelectedItem . unNInt + j <- w ^? hud . manObject . imSelectedItem . unNInt +--revise1 j <- cr ^? crManipulation . manObject . imSelectedItem . unNInt guard $ (i + j) `IM.member` (cr ^. crInv . unNIntMap) return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem (i + j) pt) RELITEM -> fromMaybe w $ do diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 88ec8169d..a415e28da 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -90,9 +90,11 @@ rmInvItem cid invid w = & cWorld . lWorld . items . ix itid . itLocation . ilEquipSite .~ Nothing & updateselection & updateselectionextra - & pointcid %~ updateRootItemID (w ^. cWorld . lWorld . items) + & uprootitem +--revise1 & pointcid %~ updateRootItemID (w ^. cWorld . lWorld . items) & worldEventFlags . at InventoryChange ?~ () where + uprootitem w' = updateRootItemID (w ^. cWorld . lWorld . items) (w'^?!cWorld.lWorld.creatures.ix 0) w' pointcid = cWorld . lWorld . creatures . ix cid updateselectionextra -- | cid == 0 = hud . diSelection . _Just . slSet %~ IS.foldl' h mempty @@ -101,10 +103,9 @@ rmInvItem cid invid w = -- | i < _unNInt invid = IS.insert i x -- | otherwise = x updateselection - | cid == 0 && cr ^? crManipulation . manObject . imSelectedItem == Just invid = + | cid == 0 && w ^? hud . manObject . imSelectedItem == Just invid = scrollAugInvSel (-1) . scrollAugInvSel 1 - | otherwise = - pointcid . crManipulation . manObject . imSelectedItem %~ g + | otherwise = hud . manObject . imSelectedItem %~ g cr = w ^?! cWorld . lWorld . creatures . ix cid itid = _crInv cr ^?! ix invid itm = w ^?! cWorld . lWorld . items . ix itid @@ -265,14 +266,8 @@ changeSwapOther manlens n f i w = fromMaybe w $ do return $ w & swapAnyExtraSelection 3 i k - & cWorld - . lWorld - . creatures - . ix 0 - . crManipulation - . manObject - . manlens - %~ doswap + &hud. manObject . manlens %~ doswap +--revise1 & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . manlens %~ doswap & hud . closeItems %~ swapIndices i k & hud . diSelection . _Just . slInt %~ doswap & worldEventFlags . at InventoryChange ?~ () @@ -299,7 +294,8 @@ invSetSelection sel w = & hud . diSelection ?~ sel & worldEventFlags . at InventoryChange ?~ () & setInvPosFromSS - & cWorld . lWorld %~ crUpdateItemLocations 0 + & crUpdateItemLocations 0 +--revise1 & cWorld . lWorld %~ crUpdateItemLocations 0 invSetSelectionPos :: Int -> Int -> World -> World invSetSelectionPos i j = invSetSelection (Sel i j) @@ -312,7 +308,8 @@ scrollAugInvSel yi w & hud %~ doscroll & worldEventFlags . at InventoryChange ?~ () & setInvPosFromSS - & cWorld . lWorld %~ crUpdateItemLocations 0 + & crUpdateItemLocations 0 +--revise1 & cWorld . lWorld %~ crUpdateItemLocations 0 where doscroll he = fromMaybe he $ do sss <- he ^? diSections @@ -324,7 +321,8 @@ scrollAugNextInSection w = & hud %~ doscroll & worldEventFlags . at InventoryChange ?~ () & setInvPosFromSS - & cWorld . lWorld %~ crUpdateItemLocations 0 + & crUpdateItemLocations 0 +--revise1 & cWorld . lWorld %~ crUpdateItemLocations 0 where doscroll he = fromMaybe he $ do sss <- he ^? diSections diff --git a/src/Dodge/Inventory/Add.hs b/src/Dodge/Inventory/Add.hs index 28ce6bad0..850a9f83b 100644 --- a/src/Dodge/Inventory/Add.hs +++ b/src/Dodge/Inventory/Add.hs @@ -36,7 +36,8 @@ tryPutItemInInv mcipos cid itid w = do } return $ (invid,) $ w - & cWorld . lWorld %~ crUpdateItemLocations cid + & crUpdateItemLocations cid +--revise1 & cWorld . lWorld %~ crUpdateItemLocations cid -- not sure about the order of these... & cWorld . lWorld . creatures . ix cid . crInv . at invid ?~ itid & cWorld . lWorld . items . ix itid . itLocation .~ itloc diff --git a/src/Dodge/Inventory/Location.hs b/src/Dodge/Inventory/Location.hs index 1f479885d..ed8762a80 100644 --- a/src/Dodge/Inventory/Location.hs +++ b/src/Dodge/Inventory/Location.hs @@ -39,42 +39,36 @@ getRootItemInvID m i cr = fromMaybe i $ do theroot <- adj ^? ix i theroot ^? _1 . _Just . _1 -updateRootItemID :: IM.IntMap Item -> Creature -> Creature -updateRootItemID m cr = fromMaybe cr $ do - i <- cr ^? crManipulation . manObject . imSelectedItem . unNInt +updateRootItemID :: IM.IntMap Item -> Creature -> World -> World +updateRootItemID m cr w = fromMaybe w $ do + i <- w^?hud . manObject . imSelectedItem . unNInt let j = getRootItemInvID m i cr - return $ cr & crManipulation . manObject . imRootSelectedItem .~ NInt j + return $ w & hud . manObject . imRootSelectedItem .~ NInt j -- the following assumes that the crManipulation is correct -crUpdateItemLocations :: Int -> LWorld -> LWorld +crUpdateItemLocations :: Int -> World -> World crUpdateItemLocations crid lw = fromMaybe lw $ do - mo <- lw ^? creatures . ix crid . crManipulation . manObject - cinv <- lw ^? creatures . ix crid . crInv - let crinv = fmap (\k -> lw ^?! items . ix k) cinv + mo <- lw ^? hud . manObject + cinv <- lw ^? cWorld.lWorld.creatures . ix crid . crInv + let crinv = fmap (\k -> lw ^?! cWorld.lWorld.items . ix k) cinv return $ crSetRoots crid $ IM.foldlWithKey' (crUpdateInvidLocations mo crid) lw $ _unNIntMap crinv -crSetRoots :: Int -> LWorld -> LWorld +crSetRoots :: Int -> World -> World crSetRoots cid w = fromMaybe w $ do - inv <- w ^? creatures . ix cid . crInv - let cinv = invIMDT $ fmap (\i -> w ^?! items . ix i) inv + inv <- w ^? cWorld .lWorld. creatures . ix cid . crInv + let cinv = invIMDT $ fmap (\i -> w ^?! cWorld.lWorld.items . ix i) inv return $ foldl' f (foldl' g w inv) cinv where - g w' i = w' & items . ix i . itLocation . ilIsRoot .~ False - f :: LWorld -> DTree OItem -> LWorld + g w' i = w' &cWorld.lWorld.items . ix i . itLocation . ilIsRoot .~ False + f :: World -> DTree OItem -> World f w' x = - w' & items . ix (x ^. dtValue . _1 . itID . unNInt) . itLocation . ilIsRoot .~ True + w' &cWorld.lWorld.items . ix (x ^. dtValue . _1 . itID . unNInt) . itLocation . ilIsRoot .~ True -crUpdateInvidLocations :: - ManipulatedObject -> - Int -> - LWorld -> - Int -> - Item -> - LWorld +crUpdateInvidLocations :: ManipulatedObject -> Int -> World -> Int -> Item -> World crUpdateInvidLocations mo crid lw invid itm = lw - & creatures . ix crid . crInv . ix (NInt invid) .~ itid - & items . ix itid .~ (itm & itLocation .~ newloc) + &cWorld.lWorld.creatures . ix crid . crInv . ix (NInt invid) .~ itid + &cWorld.lWorld.items . ix itid .~ (itm & itLocation .~ newloc) where itid = itm ^. itID . unNInt newloc = @@ -84,15 +78,16 @@ crUpdateInvidLocations mo crid lw invid itm = , _ilIsRoot = Just (NInt invid) == mo ^? imRootSelectedItem , _ilIsSelected = Just (NInt invid) == mo ^? imSelectedItem , _ilIsAttached = invid `IS.member` (mo ^. imAttachedItems) - , _ilEquipSite = lw ^? items . ix itid . itLocation . ilEquipSite . _Just + , _ilEquipSite = lw ^? cWorld .lWorld. items . ix itid . itLocation . ilEquipSite . _Just +--revise1 , _ilEquipSite = lw ^? items . ix itid . itLocation . ilEquipSite . _Just } -- this should be looked at, as it is sometimes used in functions that need not -- concern the player creature -- this might not work if the selpos is in the inventory but too large setInvPosFromSS :: World -> World -setInvPosFromSS w = w - & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ thesel +setInvPosFromSS w = w &hud . manObject .~ thesel +--revise1 & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ thesel where thesel = fromMaybe SelNothing $ do --Sel i j _ <- w ^? hud . diSelection . _Just diff --git a/src/Dodge/Inventory/Path.hs b/src/Dodge/Inventory/Path.hs index 014a7f1f0..b919867a5 100644 --- a/src/Dodge/Inventory/Path.hs +++ b/src/Dodge/Inventory/Path.hs @@ -1,16 +1,18 @@ module Dodge.Inventory.Path (getInventoryPath) where +import Dodge.Data.World import NewInt import Dodge.Data.Creature import qualified Data.IntMap.Strict as IM import Control.Lens import Control.Monad -getInventoryPath :: Int -> InventoryPathing -> Int -> Creature -> Maybe Int -getInventoryPath x ip itid cr = case ip of +getInventoryPath :: World -> Int -> InventoryPathing -> Int -> Creature -> Maybe Int +getInventoryPath w x ip itid cr = case ip of ABSOLUTE -> checkinvid x RELCURS -> do - selid <- cr ^? crManipulation . manObject . imSelectedItem . unNInt + selid <- w ^? hud . manObject . imSelectedItem . unNInt +--revise1 selid <- cr ^? crManipulation . manObject . imSelectedItem . unNInt checkinvid (x + selid) RELITEM -> checkinvid (itid + x) where diff --git a/src/Dodge/Inventory/RBList.hs b/src/Dodge/Inventory/RBList.hs index ec24b64e7..8e3cc2a3c 100644 --- a/src/Dodge/Inventory/RBList.hs +++ b/src/Dodge/Inventory/RBList.hs @@ -24,7 +24,7 @@ updateRBList w = case w ^. rbState of _ | norightclick -> w & rbState .~ NoRightButtonState EquipOptions{} -> w _ -> fromMaybe (w & rbState .~ NoRightButtonState) $ do - i <- cr ^? crManipulation . manObject . imSelectedItem + i <- w^?hud . manObject . imSelectedItem itid <- cr ^? crInv . ix i itm <- w ^? cWorld . lWorld . items . ix itid etype <- equipType itm diff --git a/src/Dodge/Inventory/Swap.hs b/src/Dodge/Inventory/Swap.hs index 6953ecbae..9edbe5614 100644 --- a/src/Dodge/Inventory/Swap.hs +++ b/src/Dodge/Inventory/Swap.hs @@ -37,19 +37,22 @@ swapInvItems f i w = fromMaybe w $ do & swapAnyExtraSelection 0 i k & checkConnection InventorySound disconnectItemS i k & cWorld . lWorld . creatures . ix 0 %~ updatecreature k + & updatecreature' k & updateselection & worldEventFlags . at InventoryChange ?~ () - & cWorld . lWorld %~ crUpdateItemLocations 0 + & crUpdateItemLocations 0 +--revise1 & cWorld . lWorld %~ crUpdateItemLocations 0 & setInvPosFromSS - & cWorld . lWorld %~ crUpdateItemLocations 0 -- the double application is inefficient, but necessary without further changes + & crUpdateItemLocations 0 -- the double application is inefficient, but necessary without further changes -- a rethink is maybe in order & checkConnection InventoryConnectSound connectItemS i k where updatecreature k = (crInv . unNIntMap %~ IM.safeSwapKeys i k) - . (crManipulation . manObject . imSelectedItem .~ NInt k) . swapSite i k . swapSite k i + updatecreature' k = + (hud . manObject . imSelectedItem .~ NInt k) cr = you w swapSite a b = case cr ^? crInv . ix (NInt a) >>= \k -> w ^? cWorld . lWorld . items . ix k . itLocation . ilEquipSite . _Just of Just epos -> crEquipment . ix epos .~ NInt b diff --git a/src/Dodge/Item/Draw.hs b/src/Dodge/Item/Draw.hs index 85c5e6b9e..553a1072a 100644 --- a/src/Dodge/Item/Draw.hs +++ b/src/Dodge/Item/Draw.hs @@ -2,6 +2,7 @@ module Dodge.Item.Draw (itemEquipPict) where +import Dodge.Data.World import Dodge.Item.Draw.SPicTree import Control.Lens import Dodge.Creature.HandPos @@ -15,13 +16,14 @@ import Geometry.Data import qualified Quaternion as Q import ShapePicture -itemEquipPict :: Creature -> DTree CItem -> SPic -itemEquipPict cr itmtree +itemEquipPict :: World -> Creature -> DTree CItem -> SPic +itemEquipPict w cr itmtree | Just esite <- itm ^? itLocation . ilEquipSite . _Just , Just attachpos <- equipAttachPos <$> itm ^? itType . ibtEquip = - equipPosition esite cr attachpos (itemSPic itm) - | itm ^? itLocation . ilInvID == cr ^? crManipulation . manObject . imRootSelectedItem = - overPosSP (Q.apply $ handHandleOrient loc cr) (itemTreeSPic itmtree) + equipPosition esite w cr attachpos (itemSPic itm) + | itm ^? itLocation . ilInvID == w ^? hud . manObject . imRootSelectedItem = +--revise1 | itm ^? itLocation . ilInvID == cr ^? crManipulation . manObject . imRootSelectedItem = + overPosSP (Q.apply $ handHandleOrient w loc cr) (itemTreeSPic itmtree) | otherwise = mempty where itm = itmtree ^. dtValue . _1 @@ -35,7 +37,7 @@ equipAttachPos = \case BULLETBELTBRACER -> (V3 (-9) 0 10, Q.qid) _ -> (0, Q.qid) -equipPosition :: EquipSite -> Creature -> Point3Q -> SPic -> SPic -equipPosition es cr q = +equipPosition :: EquipSite -> World -> Creature -> Point3Q -> SPic -> SPic +equipPosition es w cr q = overPosSP - (\x -> fst $ equipSitePQ es cr `Q.comp` q `Q.comp` (x, Q.qid)) + (\x -> fst $ equipSitePQ es w cr `Q.comp` q `Q.comp` (x, Q.qid)) diff --git a/src/Dodge/Item/HeldOffset.hs b/src/Dodge/Item/HeldOffset.hs index 64d148eaa..5b071bb67 100644 --- a/src/Dodge/Item/HeldOffset.hs +++ b/src/Dodge/Item/HeldOffset.hs @@ -7,6 +7,7 @@ module Dodge.Item.HeldOffset ( handHandleOrient, ) where +import Dodge.Data.World import Dodge.Creature.HandPos import Linear import Dodge.Data.AimStance @@ -49,28 +50,28 @@ handleOrient loc = case loc ^. locDT . dtValue . _1 . itType of -- TwoHandUnder -> (V3 7 (-8) 15, Q.axisAngle (V3 0 0 1) (strideRot cr + 1.2)) -- TwoHandOver -> (V3 10 0 15, Q.axisAngle (V3 0 0 1) (strideRot cr + 1.2)) -handOrient :: Creature -> AimStance -> Point3Q -handOrient cr = \case +handOrient :: World -> Creature -> AimStance -> Point3Q +handOrient w cr = \case TwoHandTwist -> - let (rp,_) = rightHandPQ cr - (lp,_) = leftHandPQ cr + let (rp,_) = rightHandPQ w cr + (lp,_) = leftHandPQ w cr -- in (rp,Q.qz (argV $ (lp - rp) ^. _xy)) in (rp,Q.qNoRoll (lp - rp)) - OneHand -> rightHandPQ cr + OneHand -> rightHandPQ w cr TwoHandFlat -> - let (rp,_) = rightHandPQ cr - (lp,_) = leftHandPQ cr + let (rp,_) = rightHandPQ w cr + (lp,_) = leftHandPQ w cr in (0.5 *^ (rp + lp),Q.qz (argV (vNormal ((lp - rp) ^. _xy)))) -locOrient :: LocationDT OItem -> Creature -> Point3Q -locOrient loc cr = - handHandleOrient ((\(x, y, _) -> (x, y)) <$> locToTop loc) cr +locOrient :: World -> LocationDT OItem -> Creature -> Point3Q +locOrient w loc cr = + handHandleOrient w ((\(x, y, _) -> (x, y)) <$> locToTop loc) cr `Q.comp` (loc ^. locDT . dtValue . _3) -handHandleOrient :: LocationDT CItem -> Creature -> Point3Q -handHandleOrient loc cr = - handOrient cr (itemAimStance (l ^. locDT)) `Q.comp` handleOrient l +handHandleOrient :: World -> LocationDT CItem -> Creature -> Point3Q +handHandleOrient w loc cr = + handOrient w cr (itemAimStance (l ^. locDT)) `Q.comp` handleOrient l where l = locToTop loc diff --git a/src/Dodge/Item/Location.hs b/src/Dodge/Item/Location.hs index 37f2b9cbc..104397048 100644 --- a/src/Dodge/Item/Location.hs +++ b/src/Dodge/Item/Location.hs @@ -25,14 +25,16 @@ import Dodge.Data.World pointerYourSelectedItem :: Applicative a => (Item -> a Item) -> World -> a World pointerYourSelectedItem f w = fromMaybe (pure w) $ do - itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imSelectedItem + itinvid <- w ^? hud. manObject . imSelectedItem +--revise1 itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imSelectedItem itid <- w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix itinvid Just $ (cWorld . lWorld . items . ix itid) f w -- note the ilIsRoot/Selected/Attached booleans are irrelevant pointerYourRootItem :: Applicative a => (Item -> a Item) -> World -> a World pointerYourRootItem f w = fromMaybe (pure w) $ do - itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imRootSelectedItem + itinvid <- w ^? hud. manObject . imRootSelectedItem +--revise1 itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imRootSelectedItem itid <- w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix itinvid Just $ (cWorld . lWorld . items . ix itid) f w diff --git a/src/Dodge/Projectile/Update.hs b/src/Dodge/Projectile/Update.hs index 9850c41e4..851b6f9c2 100644 --- a/src/Dodge/Projectile/Update.hs +++ b/src/Dodge/Projectile/Update.hs @@ -197,7 +197,8 @@ doBarrelSpin cid i pj w = pjRemoteSetDirection :: RocketHoming -> Projectile -> World -> World pjRemoteSetDirection ph pj w = case ph of HomeUsingRemoteScreen screenid - | lw ^? creatures . ix 0 . crManipulation . manObject . imSelectedItem + | w ^? hud . manObject . imSelectedItem +--revise1 | w ^? hud . manObject . imSelectedItem == lw ^? items . ix (_unNInt screenid) . itLocation . ilInvID -> w & pjlens diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index bf0543f44..889fec23f 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -231,7 +231,7 @@ floorItemPickupInfo n itm -- note the use of ^?! -- 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 +yourAugmentedItem f x g w = case w ^? hud . manObject of Just (SelectedItem i _ _ _) -> f $ yourInv w ^?! ix i Just (SelCloseItem i) -> fromMaybe x $ do j <- w ^? hud . closeItems . ix i . unNInt @@ -246,7 +246,8 @@ yourAugmentedItem f x g w = case you w ^? crManipulation . manObject of drawRBOptions :: Config -> World -> Picture drawRBOptions cfig w = fold $ do guard $ ButtonRight `M.member` _mouseButtons (_input w) - invid <- you w ^? crManipulation . manObject . imSelectedItem + invid <- w ^? hud . manObject . imSelectedItem +--revise1 invid <- you w ^? crManipulation . manObject . imSelectedItem itid <- you w ^? crInv . ix invid eslist <- fmap eqTypeToSites $ diff --git a/src/Dodge/TestString.hs b/src/Dodge/TestString.hs index 02a3ae2c8..7c846ee87 100644 --- a/src/Dodge/TestString.hs +++ b/src/Dodge/TestString.hs @@ -122,7 +122,8 @@ testStringInit u = u ^.. uvWorld . hud . diSections . each . ssSet . to show topTestPart :: Universe -> [String] topTestPart u = - [ maybe "" showManObj $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . manObject + [ maybe "" showManObj $ u ^? uvWorld . hud . manObject +--revise1 [ maybe "" showManObj $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . manObject ] showManObj :: ManipulatedObject -> String diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index a83427071..9b2df9164 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -350,7 +350,8 @@ pushYouOutFromWalls u -- rotate creature as well? behaviour on ledges? muzzleWallCheck :: World -> Creature -> Creature muzzleWallCheck w cr = fromMaybe cr $ do - invid <- cr ^? crManipulation . manObject . imRootSelectedItem . unNInt + invid <- w ^? hud . manObject . imRootSelectedItem . unNInt +--revise1 invid <- cr ^? crManipulation . manObject . imRootSelectedItem . unNInt loc <- invIndents ((\k -> w ^?! cWorld . lWorld . items . ix k) <$> _crInv cr) ^? ix invid . _2 @@ -368,7 +369,7 @@ muzzleWallCheck w cr = fromMaybe cr $ do x = dotV v' v in cr & crPos . _xy +~ min 1 x *^ v' where - f loc = map (muzzlePos loc cr) (itemMuzzles loc) + f loc = map (muzzlePos w loc cr) (itemMuzzles loc) g cp wls p = case collidePoint cp p wls of (ep, Just wl) -> Just (ep - p, wl) _ -> Nothing diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index c00bb5173..e5878d780 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -101,7 +101,8 @@ moveZoomCamera cfig theinput cr w campos = & camItemZoom .~ newItemZoom where mremotepos = do - i <- cr ^? crManipulation . manObject . imSelectedItem + i <- w^?hud . manObject . imSelectedItem +--revise1 i <- cr ^? crManipulation . manObject . imSelectedItem itid <- cr ^? crInv . ix i j <- w ^? cWorld . lWorld . items . ix itid . itUse . uaParams . apProjectiles . ix 0 guard $ Just REMOTESCREEN == w ^? cWorld . lWorld . items . ix itid . itType . ibtAttach @@ -109,24 +110,24 @@ moveZoomCamera cfig theinput cr w campos = docamrot = rotateV (campos ^. camRot) offset = fromMaybe noscopeoffset $ do guard (SDL.ButtonRight `M.member` _mouseButtons theinput) - i <- cr ^? crManipulation . manObject . imSelectedItem + i <- w^?hud . manObject . imSelectedItem itid <- cr ^? crInv . ix i fmap docamrot (w ^? cWorld . lWorld . items . ix itid . itUse . uScope . opticPos) noscopeoffset = docamrot $ ((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos theinput newzoom = fromMaybe (newDefaultZoom * newItemZoom) $ do - i <- cr ^? crManipulation . manObject . imSelectedItem + i <- w^?hud . manObject . imSelectedItem itid <- cr ^? crInv . ix i w ^? cWorld . lWorld . items . ix itid . itUse . uScope . opticZoom idealDefaultZoom = clipZoom wallZoom newDefaultZoom = fromMaybe (changeZoom (campos ^. camDefaultZoom) idealDefaultZoom) $ do - i <- cr ^? crManipulation . manObject . imSelectedItem + i <- w^?hud . manObject . imSelectedItem itid <- cr ^? crInv . ix i w ^? cWorld . lWorld . items . ix itid . itUse . uScope . opticZoom idealItemZoom = fromMaybe 1 $ do guard $ crIsAiming cr - i <- cr ^? crManipulation . manObject . imSelectedItem + i <- w^?hud . manObject . imSelectedItem itid <- cr ^? crInv . ix i getAimZoom <$> (w ^? cWorld . lWorld . items . ix itid) newItemZoom = changeZoom (campos ^. camItemZoom) idealItemZoom diff --git a/src/Dodge/Update/Scroll.hs b/src/Dodge/Update/Scroll.hs index 195c3be71..c3da8fee0 100644 --- a/src/Dodge/Update/Scroll.hs +++ b/src/Dodge/Update/Scroll.hs @@ -42,13 +42,14 @@ updateBaseWheelEvent yi w where bdown b = w & has (input . mouseButtons . ix b) rbscrollmax = fromMaybe 1 $ do - invid <- you w ^? crManipulation . manObject . imSelectedItem + invid <- w ^? hud . manObject . imSelectedItem +--revise1 invid <- you w ^? crManipulation . manObject . imSelectedItem etype <- you w ^? crInv . ix invid >>= \k -> w ^? cWorld . lWorld . items . ix k >>= equipType return . length $ eqTypeToSites etype selectedItemScroll :: Int -> World -> Maybe World selectedItemScroll yi w = do - i <- you w ^? crManipulation . manObject . imSelectedItem + i <- w ^? hud . manObject . imSelectedItem itm <- you w ^? crInv . ix i >>= \k -> w ^? cWorld . lWorld . items . ix k return $ itemScroll yi itm w