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

Use NewIntMap InvInt for crInv

Browse Source
This commit is contained in:
justin
2025-08-25 10:21:59 +01:00
parent 25e64d5378
commit 3f6f1b4019
38 changed files with 437 additions and 406 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Inventory/Add.hs
+3 -3
View File
@@ -20,7 +20,7 @@ import NewInt
-- should check that the item is not already in your inventory
-- this assumes that this is a floor item
tryPutItemInInv :: Int -> Int -> World -> Maybe (Int,World)
tryPutItemInInv :: Int -> Int -> World -> Maybe (NewInt InvInt,World)
tryPutItemInInv cid itid w = do
itm <- w ^? cWorld . lWorld . items . ix itid
invid <- checkInvSlotsYou itm w
@@ -51,8 +51,8 @@ tryPutItemInInv cid itid w = do
tryPutItemInInvAt :: Int -> Int -> Int -> World -> Maybe World
tryPutItemInInvAt i cid itid w = do
(j, w') <- tryPutItemInInv cid itid w
guard (i <= j)
return $ foldr f w' [i + 1 .. j]
guard (i <= _unNInt j)
return $ foldr f w' [i + 1 .. _unNInt j]
where
f j = swapInvItems (\_ _ -> Just (j -1)) j
src/Dodge/Inventory/CheckSlots.hs
+4 -3
View File
@@ -4,6 +4,7 @@ module Dodge.Inventory.CheckSlots (
maxInvSlots,
) where
import NewInt
import Control.Monad
import Dodge.Item.InvSize
import Control.Lens
@@ -14,11 +15,11 @@ import qualified IntMapHelp as IM
{- | checks whether or not an item will fit in your inventory
if so return Just the next slot to be used
-}
checkInvSlotsYou :: Item -> World -> Maybe Int
checkInvSlotsYou :: Item -> World -> Maybe (NewInt InvInt)
checkInvSlotsYou it w = do
ycr <- w ^? cWorld . lWorld . creatures . ix 0
guard $ crNumFreeSlots (w ^. cWorld . lWorld . items) ycr >= itInvHeight it
Just . IM.newKey $ _crInv ycr
Just . NInt . IM.newKey . _unNIntMap $ _crInv ycr
crNumFreeSlots :: IM.IntMap Item -> Creature -> Int
--crNumFreeSlots cr = _crInvCapacity cr - invSize (_crInv cr)
@@ -29,5 +30,5 @@ crNumFreeSlots m cr = maxInvSlots - invSize (fmap f (_crInv cr))
maxInvSlots :: Int
maxInvSlots = 25
invSize :: IM.IntMap Item -> Int
invSize :: NewIntMap InvInt Item -> Int
invSize = alaf Sum foldMap itInvHeight
src/Dodge/Inventory/Location.hs
+17 -16
View File
@@ -20,12 +20,13 @@ import qualified IntMapHelp as IM
import NewInt
-- assumes all item locations inside the items are correct
tryGetRootAttachedFromInvID :: Int -> IM.IntMap Item -> Maybe (Int, IS.IntSet)
tryGetRootAttachedFromInvID invid im = do
tryGetRootAttachedFromInvID :: NewInt InvInt
-> NewIntMap InvInt Item -> Maybe (Int, IS.IntSet)
tryGetRootAttachedFromInvID (NInt invid) im = do
let imroots = invRootMap im
theroot = fromMaybe invid $ imroots ^? ix invid . _1 . _Just
t <- imroots ^? ix theroot . _2
return (theroot, foldMap (IS.singleton . (^?! itLocation . ilInvID)) t)
return (theroot, foldMap (IS.singleton . (^?! itLocation . ilInvID . unNInt)) t)
-- this assumes the creature inventory is well formed, specifically the
-- location ids
@@ -37,9 +38,9 @@ tryGetRootItemInvID m i cr = do
updateRootItemID :: IM.IntMap Item -> Creature -> Creature
updateRootItemID m cr = fromMaybe cr $ do
i <- cr ^? crManipulation . manObject . imSelectedItem
i <- cr ^? crManipulation . manObject . imSelectedItem . unNInt
j <- tryGetRootItemInvID m i cr
return $ cr & crManipulation . manObject . imRootSelectedItem .~ j
return $ cr & crManipulation . manObject . imRootSelectedItem .~ NInt j
-- the following assumes that the crManipulation is correct
crUpdateItemLocations :: Int -> LWorld -> LWorld
@@ -48,7 +49,7 @@ crUpdateItemLocations crid lw = fromMaybe lw $ do
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 crinv
return $ crSetRoots crid $ IM.foldlWithKey' (crUpdateInvidLocations mo crid) lw $ _unNIntMap crinv
crSetRoots :: Int -> LWorld -> LWorld
crSetRoots cid w = fromMaybe w $ do
@@ -61,19 +62,20 @@ crSetRoots cid w = fromMaybe w $ do
f w' x = w'
& items . ix (x ^. dtValue . _1 . itID . unNInt) . itLocation . ilIsRoot .~ True
crUpdateInvidLocations :: ManipulatedObject -> Int -> LWorld -> Int -> Item -> LWorld
crUpdateInvidLocations :: ManipulatedObject -> Int -> LWorld -> Int
-> Item -> LWorld
crUpdateInvidLocations mo crid lw invid itm =
lw
& creatures . ix crid . crInv . ix invid .~ itid -- . itLocation .~ newloc
& creatures . ix crid . crInv . ix (NInt invid) .~ itid -- . itLocation .~ newloc
& items . ix itid .~ (itm & itLocation .~ newloc)
where
itid = itm ^. itID . unNInt
newloc =
InInv
{ _ilCrID = crid
, _ilInvID = invid
, _ilIsRoot = Just invid == mo ^? imRootSelectedItem
, _ilIsSelected = Just invid == mo ^? imSelectedItem
, _ilInvID = NInt invid
, _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
@@ -83,8 +85,7 @@ crUpdateInvidLocations mo crid lw invid itm =
-- concern the player creature
-- this might not work if the selpos is in the inventory but too large
setInvPosFromSS :: World -> World
setInvPosFromSS w =
w
setInvPosFromSS w = w
& cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ thesel
where
thesel = fromMaybe SelNothing $ do
@@ -92,12 +93,12 @@ setInvPosFromSS w =
case i of
(-1) -> Just SortInventory
0 -> do
(rootid, aset) <- tryGetRootAttachedFromInvID j (fmap (\k -> w ^?! cWorld . lWorld . items . ix k )
(rootid, aset) <- tryGetRootAttachedFromInvID (NInt j) (fmap (\k -> w ^?! cWorld . lWorld . items . ix k )
$ you w ^. crInv)
return
SelectedItem
{ _imSelectedItem = j
, _imRootSelectedItem = rootid
{ _imSelectedItem = NInt j
, _imRootSelectedItem = NInt rootid
, _imAttachedItems = aset
}
1 -> Just SelNothing
src/Dodge/Inventory/Path.hs
+3 -2
View File
@@ -1,5 +1,6 @@
module Dodge.Inventory.Path (getInventoryPath) where
import NewInt
import Dodge.Data.Creature
import qualified Data.IntMap.Strict as IM
import Control.Lens
@@ -9,10 +10,10 @@ getInventoryPath :: Int -> InventoryPathing -> Int -> Creature -> Maybe Int
getInventoryPath x ip itid cr = case ip of
ABSOLUTE -> checkinvid x
RELCURS -> do
selid <- cr ^? crManipulation . manObject . imSelectedItem
selid <- cr ^? crManipulation . manObject . imSelectedItem . unNInt
checkinvid (x + selid)
RELITEM -> checkinvid (itid + x)
where
checkinvid y = do
guard $ y `IM.member` (cr ^. crInv)
guard $ y `IM.member` (cr ^. crInv . unNIntMap)
return y
src/Dodge/Inventory/RBList.hs
+2 -1
View File
@@ -4,6 +4,7 @@ module Dodge.Inventory.RBList (
eqSiteToPositions,
) where
import NewInt
import qualified Data.IntMap.Strict as IM
import Dodge.Data.Equipment.Misc
import Dodge.Data.EquipType
@@ -46,7 +47,7 @@ chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
where
hasnoequipment ep = isNothing $ cr ^? crEquipment . ix ep
getEquipmentAllocation :: Int -> World -> EquipmentAllocation
getEquipmentAllocation :: NewInt InvInt -> World -> EquipmentAllocation
getEquipmentAllocation invid w = fromMaybe DoNotMoveEquipment $ do
esite <- you w ^? crInv . ix invid >>= \k -> w ^? cWorld . lWorld . items . ix k >>= equipType-- . itUse . uequipEffect . eeType
i <-
src/Dodge/Inventory/Swap.hs
+5 -4
View File
@@ -3,6 +3,7 @@ module Dodge.Inventory.Swap (
swapAnyExtraSelection
) where
import NewInt
import Dodge.SoundLogic
import Dodge.Item.Grammar
import Dodge.Base.You
@@ -43,13 +44,13 @@ swapInvItems f i w = fromMaybe w $ do
& checkConnection InventoryConnectSound connectItemS i k
where
updatecreature k =
(crInv %~ IM.safeSwapKeys i k)
. (crManipulation . manObject . imSelectedItem .~ k)
(crInv . unNIntMap %~ IM.safeSwapKeys i k)
. (crManipulation . manObject . imSelectedItem .~ NInt k)
. swapSite i k
. swapSite k i
cr = you w
swapSite a b = case cr ^? crInv . ix a >>= \k -> w ^? cWorld . lWorld . items . ix k . itLocation . ilEquipSite . _Just of
Just epos -> crEquipment . ix epos .~ b
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
Nothing -> id
swapAnyExtraSelection :: Int -> Int -> World -> World