From e56a953c9b00af485a59090467e5691f5bcec2f4 Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 15 May 2026 10:35:17 +0100 Subject: [PATCH] Cleanup inventory management, tweak dragging start --- src/Dodge/Base/You.hs | 7 +-- src/Dodge/Creature/Action.hs | 22 +------- src/Dodge/Creature/HandPos.hs | 2 - src/Dodge/Creature/Statistics.hs | 1 - src/Dodge/Creature/Test.hs | 1 - src/Dodge/Creature/YourControl.hs | 16 ++---- src/Dodge/Data/LWorld.hs | 2 +- src/Dodge/Debug.hs | 1 - src/Dodge/HeldUse.hs | 17 +++--- src/Dodge/Inventory.hs | 28 ++++------ src/Dodge/Inventory/Add.hs | 6 +-- src/Dodge/Inventory/Location.hs | 87 ++++++++++--------------------- src/Dodge/Inventory/Path.hs | 2 - src/Dodge/Inventory/Swap.hs | 8 +-- src/Dodge/Item/Draw.hs | 1 - src/Dodge/Item/Location.hs | 4 -- src/Dodge/Projectile/Update.hs | 11 +--- src/Dodge/Render/HUD.hs | 2 - src/Dodge/TestString.hs | 9 ++-- src/Dodge/Update.hs | 1 - src/Dodge/Update/Camera.hs | 6 --- src/Dodge/Update/Input/InGame.hs | 4 +- src/Dodge/Update/Scroll.hs | 12 ++--- 23 files changed, 70 insertions(+), 180 deletions(-) diff --git a/src/Dodge/Base/You.hs b/src/Dodge/Base/You.hs index e9313eb85..72a71019c 100644 --- a/src/Dodge/Base/You.hs +++ b/src/Dodge/Base/You.hs @@ -20,16 +20,13 @@ you w = w ^?! cWorld . lWorld . creatures . ix 0 yourSelectedItem :: World -> Maybe Item yourSelectedItem w = do Sel 0 i <- w ^? hud . diSelection . _Just ---revise2 i <- you w ^? crManipulation . manObject . imSelectedItem ---revise1 i <- you w ^? crManipulation . manObject . imSelectedItem - j <- _crInv (you w) ^? ix (NInt i) + j <- w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix (NInt i) w ^? cWorld . lWorld . items . ix j yourRootItem :: World -> Maybe Item yourRootItem w = do i <- w ^? hud . manObject . hiRootSelectedItem ---revise1 i <- you w ^? crManipulation . manObject . imRootSelectedItem - j <- _crInv (you w) ^? ix i + j <- w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix i w ^? cWorld . lWorld . items . ix j yourRootItemDT :: World -> Maybe (DTree OItem) diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index 9114b89e3..b51a80d38 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -159,22 +159,6 @@ performTurnToA cr p dirv = p -.- cpos jit = _mvTurnJit $ crMvType cr ---setMinInvSize :: Int -> Creature -> World -> World ---setMinInvSize n cr = cWorld . lWorld . creatures . ix (_crID cr) . crInvCapacity .~ n - ---organiseInvKeys :: Int -> World -> World ---organiseInvKeys cid w = --- w & cWorld . lWorld . creatures . ix cid --- %~ ( (crInvSel . iselPos .~ newSelKey) --- . (crInv .~ newInv) --- . (crInvSel . iselAction .~ NoInvSelAction) --- ) --- where --- cr = w ^?! cWorld . lWorld . creatures . ix cid -- _creatures (_cWorld w) IM.! cid --- pairs = IM.toList (_crInv cr) --- newSelKey = fromMaybe 0 $ findIndex ((== crSel cr) . fst) pairs --- newInv = IM.fromAscList $ zip [0 ..] $ map snd pairs - -- why not a cid (Int)? dropItem :: Creature -> Int -> World -> World dropItem cr invid w = @@ -207,11 +191,7 @@ dropItem cr invid w = -- | Get your creature to drop the item under the cursor. youDropItem :: World -> World youDropItem w = fromMaybe w $ do - curpos <- - mi ---revise2 w ^? hud . manObject . imSelectedItem . unNInt ---revise1 cr ^? crManipulation . manObject . imSelectedItem . unNInt - <|> fmap fst (IM.lookupMax (cr ^. crInv . unNIntMap)) + curpos <- mi <|> fmap fst (IM.lookupMax (cr ^. crInv . unNIntMap)) guard $ not $ w ^. cWorld . lWorld . lInvLock return $ case cr ^. crStance . posture of Aiming{} -> throwItem w diff --git a/src/Dodge/Creature/HandPos.hs b/src/Dodge/Creature/HandPos.hs index faeadf9b3..6fde01189 100644 --- a/src/Dodge/Creature/HandPos.hs +++ b/src/Dodge/Creature/HandPos.hs @@ -67,7 +67,6 @@ rightHandPQ w cr | 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 . hiAimStance ---revise1 | Just TwoHandTwist <- cr ^? crManipulation . manObject . imAimStance = (V3 6 (-6) 10, Q.qid) | Just TwoHandFlat <- w ^? hud . manObject . hiAimStance = (V3 (8 - twoHandOffY cr) (-8) 12, Q.qid) @@ -121,7 +120,6 @@ 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 . hiAimStance ---revise1 | Just TwoHandTwist <- cr ^? crManipulation . manObject . imAimStance = (V3 (10 + twoHandOffY cr) 6 20, Q.qid) | Just TwoHandFlat <- w ^? hud . manObject . hiAimStance = (V3 (8 + twoHandOffY cr) 6 12, Q.qid) diff --git a/src/Dodge/Creature/Statistics.hs b/src/Dodge/Creature/Statistics.hs index b0ab42fb2..a8c3bbbdf 100644 --- a/src/Dodge/Creature/Statistics.hs +++ b/src/Dodge/Creature/Statistics.hs @@ -74,7 +74,6 @@ strFromHeldItem :: World -> Creature -> Int strFromHeldItem w cr = fromMaybe 0 $ do Aiming {} <- cr ^? crStance . posture is <- w^?hud . manObject . hiAttachedItems ---revise1 is <- cr ^? crManipulation . manObject . imAttachedItems let js = IM.elems $ IM.restrictKeys (cr ^. crInv . unNIntMap) is return . negate . sum . fmap itemWeight $ IM.restrictKeys (w ^.cWorld.lWorld. items) $ IS.fromList js diff --git a/src/Dodge/Creature/Test.hs b/src/Dodge/Creature/Test.hs index 2c5efdff8..49a47db70 100644 --- a/src/Dodge/Creature/Test.hs +++ b/src/Dodge/Creature/Test.hs @@ -87,7 +87,6 @@ crAwayFromPost cr = case _apGoal $ _crActionPlan cr of crInAimStance :: AimStance -> World -> Creature -> Bool crInAimStance as w cr = cr ^? crStance . posture == Just Aiming && w ^? hud . manObject . hiAimStance == Just as ---revise1 && cr ^? crManipulation . manObject . imAimStance == Just as oneH :: World -> Creature -> Bool oneH = crInAimStance OneHand diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index aa5e1d194..4beeabbf4 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -39,8 +39,6 @@ handleHotkeys w | ispressed SDL.ScancodeLShift || ispressed SDL.ScancodeRShift , (hk : _) <- mapMaybe scancodeToHotkey . M.keys $ pkeys , Just (Sel 0 invid) <- w ^. hud .diSelection ---revise2 , Just invid <- w ^? hud . manObject . imSelectedItem ---revise1 , Just invid <- lw ^? creatures . ix 0 . crManipulation . manObject . imSelectedItem , Just itid <- lw ^? creatures . ix 0 . crInv . ix (NInt invid) = w & cWorld . lWorld %~ assignHotkey (NInt itid) hk | ispressed SDL.ScancodeLCtrl || ispressed SDL.ScancodeRCtrl @@ -118,18 +116,15 @@ wasdWithAiming w cr wasdAim :: Input -> World -> Creature -> Creature wasdAim inp w cr | SDL.ButtonRight `M.member` _mouseButtons inp - , AtEase <- cr ^. crStance . posture = - setposture Aiming (-twoHandTwistAmount) + , AtEase <- cr ^. crStance . posture = setposture Aiming (-twistAmount) | SDL.ButtonRight `M.member` _mouseButtons inp = aimTurn w mousedir cr - | Aiming{} <- cr ^. crStance . posture = setposture AtEase twoHandTwistAmount --- | otherwise = creatureTurnTowardDir (_crMvAim cr) 0.2 cr + | Aiming{} <- cr ^. crStance . posture = setposture AtEase twistAmount | otherwise = creatureTurnTowardDir (_crMvDir cr) 0.2 cr where setposture x r = cr & crStance . posture .~ x & doAimTwist (w ^? hud . manObject . hiAimStance) 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 +132,8 @@ doAimTwist as x | as == Just TwoHandTwist = crDir +~ x | otherwise = id -twoHandTwistAmount :: Float -twoHandTwistAmount = 1.6 * pi +twistAmount :: Float +twistAmount = 1.6 * pi wasdMovement :: World -> Input -> Camera -> Float -> Creature -> Creature wasdMovement w inp cam speed = theMovement -- . setMvAim @@ -157,7 +152,6 @@ aimTurn lw a cr = creatureTurnTowardDir a (x * 0.2) cr where x = fromMaybe 1 $ do itRef <- lw ^? hud . manObject . hiRootSelectedItem ---revise1 itRef <- cr ^? crManipulation . manObject . imRootSelectedItem fmap itemBulkiness $ cr ^? crInv . ix itRef >>= \k -> lw ^?cWorld.lWorld. items . ix k . itType itemBulkiness :: ItemType -> Float @@ -214,7 +208,5 @@ tryClickUse pkeys w = fromMaybe w $ do rtime <- pkeys ^? ix SDL.ButtonRight guard $ ltime <= rtime case w ^.hud.diSelection of ---revise2 case w ^?hud. manObject . imSelectedItem . unNInt of ---revise1 case w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imSelectedItem . unNInt of Just (Sel 0 invid) -> useItem invid ltime w _ -> interactWithCloseObj <$> getSelectedCloseObj w ?? w diff --git a/src/Dodge/Data/LWorld.hs b/src/Dodge/Data/LWorld.hs index 0b274b1a9..a31866d4b 100644 --- a/src/Dodge/Data/LWorld.hs +++ b/src/Dodge/Data/LWorld.hs @@ -146,7 +146,7 @@ data LWorld = LWorld , _hotkeys :: M.Map Hotkey (NewInt ItmInt) , _imHotkeys :: NewIntMap ItmInt Hotkey , _lAimPos :: Point2 - , _lInvLock :: Bool + , _lInvLock :: Bool -- used eg burstRifle fire , _respawnPos :: (Point2, Float) } diff --git a/src/Dodge/Debug.hs b/src/Dodge/Debug.hs index 1590270b5..702d312dd 100644 --- a/src/Dodge/Debug.hs +++ b/src/Dodge/Debug.hs @@ -321,7 +321,6 @@ showMuzzlePositions :: Universe -> Picture showMuzzlePositions u = fold $ do cr <- u ^? uvWorld . cWorld . lWorld . creatures . ix 0 invid <- u ^?uvWorld.hud . manObject . hiRootSelectedItem . 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 diff --git a/src/Dodge/HeldUse.hs b/src/Dodge/HeldUse.hs index c8a58d8aa..da6cd56de 100644 --- a/src/Dodge/HeldUse.hs +++ b/src/Dodge/HeldUse.hs @@ -1417,19 +1417,18 @@ useInventoryPath :: World -> World useInventoryPath pt i ip loc cr w = case ip of - ABSOLUTE -> fromMaybe w $ do - guard $ i `IM.member` (cr ^. crInv . unNIntMap) - return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem i pt) + ABSOLUTE -> fromMaybe w $ useat i RELCURS -> fromMaybe w $ do Sel 0 j <- w ^? hud .diSelection._Just ---revise2 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) + useat $ i + j RELITEM -> fromMaybe w $ do j <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID . unNInt - guard $ (i + j) `IM.member` (cr ^. crInv . unNIntMap) - return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem (i + j) pt) + useat $ i + j + where + useat k = do + guard $ k `IM.member` (cr ^. crInv . unNIntMap) + return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem k pt) + --useRewindGun _ _ w = case w ^. cwTime . rewindWorlds of -- [w'] -> w & cwTime . maybeWorld .~ Just' w' diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 76d7983bf..88835bbd7 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -81,6 +81,7 @@ destroyItem itid w = case w ^? cWorld . lWorld . items . ix itid . itLocation of -- note rmInvItem does not fully destroy the item, other updates to the item -- location are required +-- note if this gets called ssInvPosFromSS might be necessary elsewhere rmInvItem :: Int -> NewInt InvInt -> World -> World rmInvItem cid invid w = w @@ -89,20 +90,15 @@ rmInvItem cid invid w = & removeAnySlotEquipment & cWorld . lWorld . items . ix itid . itLocation . ilEquipSite .~ Nothing & updateselection --- & 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 updateselection | cid == 0 && (w ^? hud .diSelection._Just) == Just (Sel 0 (invid^.unNInt)) = ---revise2 | cid == 0 && w ^? hud . manObject . imSelectedItem == Just invid = scrollAugInvSel (-1) . scrollAugInvSel 1 - | otherwise = id -- hud . manObject . imSelectedItem %~ g ---revise2 | otherwise = hud . manObject . imSelectedItem %~ g + | otherwise = id cr = w ^?! cWorld . lWorld . creatures . ix cid - itid = _crInv cr ^?! ix invid + itid = cr ^?! crInv . ix invid itm = w ^?! cWorld . lWorld . items . ix itid dounequipfunction = effectOnRemove itm cr removeAnySlotEquipment = fromMaybe id $ do @@ -235,13 +231,11 @@ multiSelScroll' f w = fromMaybe w $ do & hud . diSelection . _Just . slInt .~ k changeSwapOther :: ---revise3 ((Int -> Identity Int) -> ManipulatedObject -> Identity ManipulatedObject) -> Int -> (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> Int -> World -> World ---revise3 changeSwapOther manlens n f i w = fromMaybe w $ do changeSwapOther n f i w = fromMaybe w $ do ss <- w ^? hud . diSections . ix n . ssItems k <- f i ss @@ -252,8 +246,6 @@ changeSwapOther n f i w = fromMaybe w $ do return $ w & swapAnyExtraSelection 3 i k --- &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 ?~ () @@ -267,8 +259,6 @@ swapItemWith f (j, i) = case j of 0 -> swapInvItems f i 3 -> changeSwapOther 3 f i 5 -> changeSwapOther 5 f i ---revise3 3 -> changeSwapOther ispCloseItem 3 f i ---revise3 5 -> changeSwapOther ispCloseButton 5 f i _ -> id changeSwapWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World @@ -281,9 +271,9 @@ invSetSelection sel w = w & hud . diSelection ?~ sel & worldEventFlags . at InventoryChange ?~ () + & crUpdateItemLocations & setInvPosFromSS -- is this necessary here? - & crUpdateItemLocations 0 ---revise1 & cWorld . lWorld %~ crUpdateItemLocations 0 + & crUpdateItemLocations invSetSelectionPos :: Int -> Int -> World -> World invSetSelectionPos i j = invSetSelection (Sel i j) @@ -295,9 +285,9 @@ scrollAugInvSel yi w w & hud %~ doscroll & worldEventFlags . at InventoryChange ?~ () + & crUpdateItemLocations & setInvPosFromSS - & crUpdateItemLocations 0 ---revise1 & cWorld . lWorld %~ crUpdateItemLocations 0 + & crUpdateItemLocations where doscroll he = fromMaybe he $ do sss <- he ^? diSections @@ -308,9 +298,9 @@ scrollAugNextInSection w = w & hud %~ doscroll & worldEventFlags . at InventoryChange ?~ () + & crUpdateItemLocations & setInvPosFromSS - & crUpdateItemLocations 0 ---revise1 & cWorld . lWorld %~ crUpdateItemLocations 0 + & crUpdateItemLocations where doscroll he = fromMaybe he $ do sss <- he ^? diSections diff --git a/src/Dodge/Inventory/Add.hs b/src/Dodge/Inventory/Add.hs index 850a9f83b..2f4a5ae47 100644 --- a/src/Dodge/Inventory/Add.hs +++ b/src/Dodge/Inventory/Add.hs @@ -36,8 +36,9 @@ tryPutItemInInv mcipos cid itid w = do } return $ (invid,) $ w - & crUpdateItemLocations cid ---revise1 & cWorld . lWorld %~ crUpdateItemLocations cid + & crUpdateItemLocations + & setInvPosFromSS + & crUpdateItemLocations -- not sure about the order of these... & cWorld . lWorld . creatures . ix cid . crInv . at invid ?~ itid & cWorld . lWorld . items . ix itid . itLocation .~ itloc @@ -56,7 +57,6 @@ tryPutItemInInv mcipos cid itid w = do i <- mcipos return $ hud . diSections . ix 3 . ssSet %~ IS.deleteShift i updateselectionextra i --- | cid == 0 = (hud . diSelection . _Just . slSet %~ IS.map (f i)) | cid == 0 = (hud . diSections . ix 0 . ssSet %~ IS.map (f i)) . (hud . diSelection . _Just . slInt %~ f i) | otherwise = id diff --git a/src/Dodge/Inventory/Location.hs b/src/Dodge/Inventory/Location.hs index ab2c7e7db..f785bf4f0 100644 --- a/src/Dodge/Inventory/Location.hs +++ b/src/Dodge/Inventory/Location.hs @@ -1,10 +1,8 @@ module Dodge.Inventory.Location ( --- updateRootItemID, crUpdateItemLocations, setInvPosFromSS, ) where -import Dodge.Item.AimStance import Control.Lens import Data.Foldable import qualified Data.IntSet as IS @@ -14,6 +12,7 @@ import Dodge.Data.ComposedItem import Dodge.Data.DoubleTree import Dodge.Data.Item.Use.Consumption.LoadAction import Dodge.Data.World +import Dodge.Item.AimStance import Dodge.Item.Grammar import qualified IntMapHelp as IM import NewInt @@ -29,87 +28,55 @@ tryGetRootAttachedFromInvID (NInt invid) im = do t <- imroots ^? ix theroot . _2 return (theroot, foldMap (IS.singleton . (^?! itLocation . ilInvID . unNInt)) t) ----- this assumes the creature inventory is well formed, specifically the ----- location ids ----- note the item intmap is all items ---getRootItemInvID :: IM.IntMap Item -> Int -> Creature -> Int ---getRootItemInvID m i cr = fromMaybe i $ do --- let adj = invAdj $ fmap (\k -> m ^?! ix k) (_crInv cr) --- theroot <- adj ^? ix i --- theroot ^? _1 . _Just . _1 - ---updateRootItemID :: IM.IntMap Item -> Creature -> World -> World ---updateRootItemID m cr w = fromMaybe w $ do --- Sel 0 i <- w^?hud.diSelection._Just -----revise2 i <- w^?hud . manObject . imSelectedItem . unNInt --- let j = getRootItemInvID m i cr --- return $ w & hud . manObject . hiRootSelectedItem .~ NInt j - -- the following assumes that the crManipulation is correct -crUpdateItemLocations :: Int -> World -> World -crUpdateItemLocations crid lw = fromMaybe lw $ do +crUpdateItemLocations :: World -> World +crUpdateItemLocations lw = fromMaybe lw $ do 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 + cinv <- lw ^? cWorld . lWorld . creatures . ix 0 . crInv + let crinv = fmap (\k -> lw ^?! cWorld . lWorld . items . ix k) cinv + return $ crSetRoots $ IM.foldlWithKey' (crUpdateInvidLocations mo) lw $ _unNIntMap crinv -crSetRoots :: Int -> World -> World -crSetRoots cid w = fromMaybe w $ do - inv <- w ^? cWorld .lWorld. creatures . ix cid . crInv - let cinv = invIMDT $ fmap (\i -> w ^?! cWorld.lWorld.items . ix i) inv +crSetRoots :: World -> World +crSetRoots w = fromMaybe w $ do + inv <- w ^? cWorld . lWorld . creatures . ix 0 . 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' &cWorld.lWorld.items . ix i . itLocation . ilIsRoot .~ False + g w' i = w' & cWorld . lWorld . items . ix i . itLocation . ilIsRoot .~ False f :: World -> DTree OItem -> World f w' x = - w' &cWorld.lWorld.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 -> World -> Int -> Item -> World -crUpdateInvidLocations mo crid lw invid itm = - lw - &cWorld.lWorld.creatures . ix crid . crInv . ix (NInt invid) .~ itid - &cWorld.lWorld.items . ix itid .~ (itm & itLocation .~ newloc) +crUpdateInvidLocations :: ManipulatedObject -> World -> Int -> Item -> World +crUpdateInvidLocations mo w invid itm = + w + & cWorld . lWorld . creatures . ix 0 . crInv . ix (NInt invid) .~ itid + & cWorld . lWorld . items . ix itid .~ (itm & itLocation .~ newloc) where itid = itm ^. itID . unNInt newloc = InInv - { _ilCrID = crid + { _ilCrID = 0 , _ilInvID = NInt invid , _ilIsRoot = Just (NInt invid) == mo ^? hiRootSelectedItem - , _ilIsSelected = Just (NInt invid) == lw ^? hud.diSelection._Just.slInt.to NInt -- this may match with the wrong sections, not sure if this is possible ---revise1 , _ilIsSelected = Just (NInt i2vid) == mo ^? imSelectedItem + , _ilIsSelected = Just (Sel 0 invid) == w ^? hud . diSelection . _Just , _ilIsAttached = invid `IS.member` (mo ^. hiAttachedItems) - , _ilEquipSite = lw ^? cWorld .lWorld. items . ix itid . itLocation . ilEquipSite . _Just ---revise1 , _ilEquipSite = lw ^? items . ix itid . itLocation . ilEquipSite . _Just + , _ilEquipSite = w ^? cWorld . lWorld . 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 &hud . manObject .~ thesel ---revise1 & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ thesel +setInvPosFromSS w = w & hud . manObject .~ thesel where + invitemmap = + (\k -> w ^?! cWorld . lWorld . items . ix k) + <$> you w ^. crInv thesel = fromMaybe HandsFree $ do - --Sel i j _ <- w ^? hud . diSelection . _Just Sel 0 j <- w ^? hud . diSelection . _Just - (rootid, aset) <- - tryGetRootAttachedFromInvID - (NInt j) - ( 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 + (rootid, aset) <- tryGetRootAttachedFromInvID (NInt j) invitemmap + dt <- invIMDT invitemmap ^? ix rootid return HeldItem { _hiRootSelectedItem = NInt rootid - , _hiAimStance = itemAimStance ((\(x,y,_) -> (x,y)) <$> dt) + , _hiAimStance = itemAimStance ((\(x, y, _) -> (x, y)) <$> dt) , _hiAttachedItems = aset } --- 1 -> Just SelNothing --- 2 -> Just SortCloseItem --- 3 -> Just $ SelCloseItem j --- 4 -> Just SortCloseButton --- 5 -> Just $ SelCloseButton j --- _ -> error "selection out of bounds" diff --git a/src/Dodge/Inventory/Path.hs b/src/Dodge/Inventory/Path.hs index 27ea3cb5b..2fe393534 100644 --- a/src/Dodge/Inventory/Path.hs +++ b/src/Dodge/Inventory/Path.hs @@ -11,8 +11,6 @@ getInventoryPath w x ip itid cr = case ip of ABSOLUTE -> checkinvid x RELCURS -> do Sel 0 selid <- w ^? hud .diSelection._Just ---revise2 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/Swap.hs b/src/Dodge/Inventory/Swap.hs index 4adc396df..ab6a3cb3c 100644 --- a/src/Dodge/Inventory/Swap.hs +++ b/src/Dodge/Inventory/Swap.hs @@ -37,13 +37,11 @@ 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 ?~ () - & crUpdateItemLocations 0 ---revise1 & cWorld . lWorld %~ crUpdateItemLocations 0 + & crUpdateItemLocations & setInvPosFromSS - & crUpdateItemLocations 0 -- the double application is inefficient, but necessary without further changes + & crUpdateItemLocations -- a rethink is maybe in order & checkConnection InventoryConnectSound connectItemS i k where @@ -51,8 +49,6 @@ swapInvItems f i w = fromMaybe w $ do (crInv . unNIntMap %~ IM.safeSwapKeys i k) . swapSite i k . swapSite k i --- updatecreature' k = (hud . manObject . imSelectedItem .~ NInt k) ---revise2 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 d64931556..41d251a35 100644 --- a/src/Dodge/Item/Draw.hs +++ b/src/Dodge/Item/Draw.hs @@ -21,7 +21,6 @@ itemEquipPict w cr itmtree , Just attachpos <- equipAttachPos <$> itm ^? itType . ibtEquip = equipPosition esite w cr attachpos (itemSPic itm) | itm ^? itLocation . ilInvID == w ^? hud . manObject . hiRootSelectedItem = ---revise1 | itm ^? itLocation . ilInvID == cr ^? crManipulation . manObject . imRootSelectedItem = overPosSP (Q.apply $ handHandleOrient w loc cr) (itemTreeSPic itmtree) | otherwise = mempty where diff --git a/src/Dodge/Item/Location.hs b/src/Dodge/Item/Location.hs index d40ebc8ed..ea58419ac 100644 --- a/src/Dodge/Item/Location.hs +++ b/src/Dodge/Item/Location.hs @@ -26,16 +26,12 @@ import Dodge.Data.World pointerYourSelectedItem :: Applicative a => (Item -> a Item) -> World -> a World pointerYourSelectedItem f w = fromMaybe (pure w) $ do Sel 0 itinvid <- w ^? hud.diSelection._Just ---revise2 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 (NInt 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 ^? hud. manObject . hiRootSelectedItem ---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 31d4331fb..e06573eac 100644 --- a/src/Dodge/Projectile/Update.hs +++ b/src/Dodge/Projectile/Update.hs @@ -197,8 +197,6 @@ doBarrelSpin cid i pj w = pjRemoteSetDirection :: RocketHoming -> Projectile -> World -> World pjRemoteSetDirection ph pj w = case ph of HomeUsingRemoteScreen screenid ---revise2 | w ^? hud . manObject . imSelectedItem ---revise1 | w ^? hud . manObject . imSelectedItem | w ^. hud .diSelection == fmap (\i -> Sel 0 (i^.unNInt)) (lw ^? items . ix (_unNInt screenid) . itLocation . ilInvID) -> w @@ -207,13 +205,8 @@ pjRemoteSetDirection ph pj w = case ph of HomeUsingTargeting itid | Just tp <- w ^? pointerToItemID itid . itTargeting . itTgPos . _Just -> w - & pjlens - . pjDir - %~ turnTo 0.2 (pj ^. pjPos . _xy) tp - & pjlens - . pjSpin - .~ 0.5 - * diffAngles + & pjlens . pjDir %~ turnTo 0.2 (pj ^. pjPos . _xy) tp + & pjlens . pjSpin .~ 0.5 * diffAngles (turnTo 0.2 (pj ^. pjPos . _xy) tp pjdir) pjdir _ -> w diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index b20092578..63d05cb44 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -259,8 +259,6 @@ drawRBOptions cfig w = fold $ do guard $ ButtonRight `M.member` _mouseButtons (_input w) Sel 0 invid' <- w^.hud.diSelection let invid = NInt invid' ---revise2 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 4240e3ea8..9b155ef7a 100644 --- a/src/Dodge/TestString.hs +++ b/src/Dodge/TestString.hs @@ -58,10 +58,10 @@ crs :: Universe -> [Creature] crs u = u ^.. uvWorld . cWorld . lWorld . creatures . each testStringInit :: Universe -> [String] -testStringInit u = - u ^. uvWorld . hud . manObject . to prettyShort - <> - u ^.. uvWorld . hud . diSections . each . ssSet . to show +testStringInit u = [u ^. uvWorld . input . mouseContext . to show] +-- u ^. uvWorld . hud . manObject . to prettyShort +-- <> +-- u ^.. uvWorld . hud . diSections . each . ssSet . to show --testStringInit u = u ^. uvWorld . cWorld . lWorld . creatures . ix 5 . crActionPlan . to prettyShort --[show . getSum $ foldMap (Sum . crslime) (crs u)] -- u ^.. tocrs . each . crType . slimeSplitTimer . to show @@ -126,7 +126,6 @@ testStringInit u = topTestPart :: Universe -> [String] topTestPart u = [ 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 1602eceb1..29154a7a0 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -352,7 +352,6 @@ pushYouOutFromWalls u muzzleWallCheck :: World -> Creature -> Creature muzzleWallCheck w cr = fromMaybe cr $ do invid <- w ^? hud . manObject . hiRootSelectedItem . unNInt ---revise1 invid <- cr ^? crManipulation . manObject . imRootSelectedItem . unNInt loc <- invIndents ((\k -> w ^?! cWorld . lWorld . items . ix k) <$> _crInv cr) ^? ix invid . _2 diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 8c05df8d3..abe52da4a 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -103,8 +103,6 @@ moveZoomCamera cfig theinput cr w campos = where mremotepos = do Sel 0 i <- w^?hud .diSelection._Just ---revise1 i <- cr ^? crManipulation . manObject . imSelectedItem ---revise2 i <- w^?hud . manObject . imSelectedItem itid <- cr ^? crInv . ix (NInt i) j <- w ^? cWorld . lWorld . items . ix itid . itUse . uaParams . apProjectiles . ix 0 guard $ Just REMOTESCREEN == w ^? cWorld . lWorld . items . ix itid . itType . ibtAttach @@ -113,7 +111,6 @@ moveZoomCamera cfig theinput cr w campos = offset = fromMaybe noscopeoffset $ do guard (SDL.ButtonRight `M.member` _mouseButtons theinput) Sel 0 i <- w^?hud.diSelection._Just ---revise2 i <- w^?hud . manObject . imSelectedItem itid <- cr ^? crInv . ix (NInt i) fmap docamrot (w ^? cWorld . lWorld . items . ix itid . itUse . uScope . opticPos) noscopeoffset = @@ -121,19 +118,16 @@ moveZoomCamera cfig theinput cr w campos = ((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos theinput newzoom = fromMaybe (newDefaultZoom * newItemZoom) $ do Sel 0 i <- w^?hud .diSelection._Just ---revise2 i <- w^?hud . manObject . imSelectedItem itid <- cr ^? crInv . ix (NInt i) w ^? cWorld . lWorld . items . ix itid . itUse . uScope . opticZoom idealDefaultZoom = clipZoom wallZoom newDefaultZoom = fromMaybe (changeZoom (campos ^. camDefaultZoom) idealDefaultZoom) $ do Sel 0 i <- w^?hud .diSelection._Just ---revise2 i <- w^?hud . manObject . imSelectedItem itid <- cr ^? crInv . ix (NInt i) w ^? cWorld . lWorld . items . ix itid . itUse . uScope . opticZoom idealItemZoom = fromMaybe 1 $ do guard $ crIsAiming cr Sel 0 i <- w^?hud .diSelection._Just ---revise2 i <- w^?hud . manObject . imSelectedItem itid <- cr ^? crInv . ix (NInt i) getAimZoom <$> (w ^? cWorld . lWorld . items . ix itid) newItemZoom = changeZoom (campos ^. camItemZoom) idealItemZoom diff --git a/src/Dodge/Update/Input/InGame.hs b/src/Dodge/Update/Input/InGame.hs index 3e2b5227e..37c5c4064 100644 --- a/src/Dodge/Update/Input/InGame.hs +++ b/src/Dodge/Update/Input/InGame.hs @@ -301,9 +301,9 @@ endCombineRegex w = ssSetCursor (ssLookupDown 0 j) sss return (k - 1) startDrag :: (Int, Int) -> World -> World -startDrag (a, b) w = setcontext $ fromMaybe (invSetSelection (Sel a b) w) $ do +startDrag (a, b) w = setcontext $ fromMaybe (invSetSelection (Sel a b) w & hud.diSections.ix a.ssSet.~ mempty) $ do i <- w ^? hud . diSelection . _Just . slSec - xs <- w ^? hud . diSections . ix i . ssSet + xs <- w ^? hud . diSections . ix a . ssSet guard $ i == a && b `IS.member` xs return w where diff --git a/src/Dodge/Update/Scroll.hs b/src/Dodge/Update/Scroll.hs index fbbdedc3b..13dadc298 100644 --- a/src/Dodge/Update/Scroll.hs +++ b/src/Dodge/Update/Scroll.hs @@ -34,24 +34,22 @@ updateBaseWheelEvent yi w EquipOptions{} -> w & rbState . opSel %~ scrollRBOption yi rbscrollmax NoRightButtonState -> fromMaybe w (selectedItemScroll yi w) | bdown ButtonLeft = w & wCam . camZoom +~ fromIntegral yi - | ScancodeCapsLock `M.member` _pressedKeys (_input w) - , ScancodeLShift `M.member` (w ^. input . pressedKeys) = changeSwapSel yi w - | ScancodeCapsLock `M.member` _pressedKeys (_input w) = changeSwapSelSet yi w - | ScancodeLShift `M.member` (w ^. input . pressedKeys) = multiSelScroll yi w + | kdown ScancodeCapsLock + , kdown ScancodeLShift = changeSwapSel yi w + | kdown ScancodeCapsLock = changeSwapSelSet yi w + | kdown ScancodeLShift = multiSelScroll yi w | otherwise = scrollAugInvSel yi w where + kdown k = k `M.member` (w ^. input . pressedKeys) bdown b = w & has (input . mouseButtons . ix b) rbscrollmax = fromMaybe 1 $ do Sel 0 invid <- w ^. hud.diSelection ---revise2 invid <- w ^? hud . manObject . imSelectedItem ---revise1 invid <- you w ^? crManipulation . manObject . imSelectedItem etype <- you w ^? crInv . ix (NInt invid) >>= \k -> w ^? cWorld . lWorld . items . ix k >>= equipType return . length $ eqTypeToSites etype selectedItemScroll :: Int -> World -> Maybe World selectedItemScroll yi w = do Sel 0 i <- w ^.hud.diSelection ---revise2 i <- w ^? hud . manObject . imSelectedItem itm <- you w ^? crInv . ix (NInt i) >>= \k -> w ^? cWorld . lWorld . items . ix k return $ itemScroll yi itm w