Cleanup

2025-08-26 19:35:19 +01:00
parent 1ebdbdd8ae
commit e5473d1028
4 changed files with 53 additions and 77 deletions
@@ -37,9 +37,7 @@ import NewInt
 -- should consider never fully destroying items, but assigning a flag saying how
 -- they were moved from play
 destroyInvItem :: Int -> NewInt InvInt -> World -> World
-destroyInvItem cid invid w =
-    rmInvItem cid invid w & removeitloc
-        & removeithotkey
+destroyInvItem cid invid w = rmInvItem cid invid w & removeitloc & removeithotkey
  where
    removeitloc = fromMaybe id $ do
        itid <- w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid
@@ -97,13 +95,9 @@ rmInvItem cid invid w =
    itid = _crInv cr ^?! ix invid
    itm = w ^?! cWorld . lWorld . items . ix itid
    dounequipfunction = effectOnRemove itm cr
-    --  fromMaybe id $ do
-    --    rmf <- itm ^? itUse . uequipEffect . eeOnRemove
-    --    return $ doItmCrWdWd rmf itm cr
    removeAnySlotEquipment = fromMaybe id $ do
        epos <-
-            w
-                ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid
+            w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid
                >>= \k -> w ^? cWorld . lWorld . items . ix k
                    . itLocation
                    . ilEquipSite
@@ -120,23 +114,22 @@ rmInvItem cid invid w =

 updateCloseObjects :: World -> World
 updateCloseObjects w =
-    w & hud . closeItems %~ f
-        & hud . closeButtons %~ g
+    w & hud . closeItems %~ h citems
+        & hud . closeButtons %~ h cbts
  where
-    g oldbts = intersect oldbts cbts `union` cbts
-    f olditems = intersect olditems citems `union` citems
+    h a b = intersect b a `union` a
    lw = w ^. cWorld . lWorld
-    citems = let is = IM.filter (isclose . _flItPos) (lw^.floorItems)
-        in map NInt $ IM.keys $ IM.intersection (lw ^. items) is
-    isclose x = dist y x < 40 && hasButtonLOS y x w
-    y = _crPos $ you w
+    citems = map NInt $ IM.keys $ IM.intersection (lw ^. items) 
+        $ IM.filter (isclose . _flItPos) (lw^.floorItems)
    cbts = lw^..buttons . each . filtered canpress . filtered (isclose . _btPos) . to _btID
    canpress bt = case bt ^. btEvent of
        ButtonPress{_btOn = t} -> not t
        ButtonAccessTerminal tid -> fromMaybe False $ do
-            x <- w ^? cWorld . lWorld . terminals . ix tid . tmStatus
+            x <- lw ^? terminals . ix tid . tmStatus
            return (x /= TerminalDeactivated)
        _ -> True
+    isclose x = dist y x < 40 && hasButtonLOS y x w
+    y = _crPos $ you w

 changeSwapSel :: Int -> World -> World
 changeSwapSel yi w
@@ -184,13 +177,6 @@ changeSwapWith f w
    | Just (Sel j i _) <- w ^. hud . diSelection = swapItemWith f (j,i) w
    | otherwise = w

--changeSwapWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
--changeSwapWith f w = case w ^? hud . hudElement . diSelection . _Just of
--    Just (0, i, _) -> w & swapInvItems f i
--    Just (3, i, _) -> w & changeSwapOther ispCloseItem 3 f i
--    Just (5, i, _) -> w & changeSwapOther ispCloseButton 5 f i
--    _ -> w
-
 invSetSelection :: Selection -> World -> World
 invSetSelection sel w =
    w
@@ -200,15 +186,7 @@ invSetSelection sel w =
        & cWorld . lWorld %~ crUpdateItemLocations 0

 invSetSelectionPos :: Int -> Int -> World -> World
-invSetSelectionPos i j w =
-    w
-        & hud . diSelection %~ f
-        & worldEventFlags . at InventoryChange ?~ ()
-        & setInvPosFromSS
-        & cWorld . lWorld %~ crUpdateItemLocations 0
-  where
-    f Nothing = Just (Sel i j mempty)
-    f (Just (Sel _ _ s)) = Just (Sel i j s)
+invSetSelectionPos i j = invSetSelection (Sel i j mempty)

 scrollAugInvSel :: Int -> World -> World
 scrollAugInvSel yi w
@@ -43,7 +43,8 @@ tryPutItemInInv cid itid w = do
                & updateselectionextra invid
  where
    updateselectionextra i
-        | cid == 0 = hud . diSelection . _Just . slSet %~ IS.map (f i)
+        | cid == 0 = (hud . diSelection . _Just . slSet %~ IS.map (f i))
+            . (hud . diSelection . _Just . slInt %~ (f i))
        | otherwise = id
    f j i | i >= _unNInt j = i + 1
          | otherwise = i
@@ -4,7 +4,6 @@ module Dodge.Inventory.Location (
    setInvPosFromSS,
 ) where

-import Control.Applicative
 import Control.Lens
 import Data.Foldable
 --import Data.IntMap.Merge.Strict
@@ -32,16 +31,17 @@ tryGetRootAttachedFromInvID (NInt invid) im = do

 -- this assumes the creature inventory is well formed, specifically the
 -- location ids
-tryGetRootItemInvID :: IM.IntMap Item -> Int -> Creature -> Maybe Int
-tryGetRootItemInvID m i cr = do
+-- 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 <|> Just i
+    theroot ^? _1 . _Just . _1

 updateRootItemID :: IM.IntMap Item -> Creature -> Creature
 updateRootItemID m cr = fromMaybe cr $ do
    i <- cr ^? crManipulation . manObject . imSelectedItem . unNInt
-    j <- tryGetRootItemInvID m i cr
+    let j = getRootItemInvID m i cr
    return $ cr & crManipulation . manObject . imRootSelectedItem .~ NInt j

 -- the following assumes that the crManipulation is correct
@@ -49,7 +49,6 @@ crUpdateItemLocations :: Int -> LWorld -> LWorld
 crUpdateItemLocations crid lw = fromMaybe lw $ do
    mo <- lw ^? creatures . ix crid . crManipulation . manObject
    cinv <- lw ^? creatures . ix crid . crInv
-    --let crinv = IM.restrictKeys  (lw ^. items) (IS.fromList $ IM.elems itids)
    let crinv = fmap (\k -> lw ^?! items . ix k) cinv
    return $ crSetRoots crid $ IM.foldlWithKey' (crUpdateInvidLocations mo crid) lw $ _unNIntMap crinv

@@ -62,8 +61,7 @@ crSetRoots cid w = fromMaybe w $ do
    g w' i = w' & items . ix i . itLocation . ilIsRoot .~ False
    f :: LWorld -> DTree OItem -> LWorld
    f w' x =
-        w'
-            & items . ix (x ^. dtValue . _1 . itID . unNInt) . itLocation . ilIsRoot .~ True
+        w' & items . ix (x ^. dtValue . _1 . itID . unNInt) . itLocation . ilIsRoot .~ True

 crUpdateInvidLocations ::
    ManipulatedObject ->
@@ -74,7 +72,7 @@ crUpdateInvidLocations ::
    LWorld
 crUpdateInvidLocations mo crid lw invid itm =
    lw
-        & creatures . ix crid . crInv . ix (NInt invid) .~ itid -- . itLocation .~ newloc
+        & creatures . ix crid . crInv . ix (NInt invid) .~ itid
        & items . ix itid .~ (itm & itLocation .~ newloc)
  where
    itid = itm ^. itID . unNInt
@@ -85,8 +83,7 @@ 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 = do
-                lw ^? items . ix itid . itLocation . ilEquipSite . _Just
+            , _ilEquipSite = lw ^? items . ix itid . itLocation . ilEquipSite . _Just
            }

 -- this should be looked at, as it is sometimes used in functions that need not