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

Major item refactor, still broken

Browse Source
This commit is contained in:
justin
2025-08-24 19:34:09 +01:00
parent 22b4be440a
commit 94f6d5c630
62 changed files with 820 additions and 805 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Inventory/Add.hs
+5 -8
View File
@@ -36,9 +36,9 @@ tryPutItemInInv cid itid w = do
return $ (invid,) $ w
& cWorld . lWorld %~ crUpdateItemLocations cid
-- not sure about the order of these...
& cWorld . lWorld . creatures . ix cid . crInv . at invid ?~ newitm
& cWorld . lWorld . creatures . ix cid . crInv . at invid ?~ itid
& cWorld . lWorld . items . at itid ?~ newitm
& cWorld . lWorld . itemLocations . at itid ?~ itloc
-- & cWorld . lWorld . itemLocations . at itid ?~ itloc
& cWorld . lWorld . floorItems . at itid .~ Nothing
& updateselectionextra
where
@@ -110,13 +110,10 @@ tryPutItemInInvAt i cid itid w = do
-- copyItemToFloorID (_crPos $ you w) (applyModules it) w
-- return (Just i, w')
createItemYou :: Item -> World -> (ItemLocation, World)
createItemYou itm w = fromMaybe (OnFloor, w') $ do
(invid, w'') <- tryPutItemInInv 0 itid w'
itloc <- w'' ^? cWorld . lWorld . creatures . ix 0 . crInv . ix invid . itLocation
return (itloc, w'')
createItemYou :: Item -> World -> World
createItemYou itm w = fromMaybe w' $ fmap snd $ tryPutItemInInv 0 itid w'
where
itid = IM.newKey $ w ^. cWorld . lWorld . itemLocations
itid = IM.newKey $ w ^. cWorld . lWorld . items
pos = w ^?! cWorld . lWorld . creatures . ix 0 . crPos
w' = copyItemToFloorID pos (itm & itID .~ NInt itid) w
src/Dodge/Inventory/CheckSlots.hs
+5 -3
View File
@@ -17,12 +17,14 @@ import qualified IntMapHelp as IM
checkInvSlotsYou :: Item -> World -> Maybe Int
checkInvSlotsYou it w = do
ycr <- w ^? cWorld . lWorld . creatures . ix 0
guard $ crNumFreeSlots ycr >= itInvHeight it
guard $ crNumFreeSlots (w ^. cWorld . lWorld . items) ycr >= itInvHeight it
Just . IM.newKey $ _crInv ycr
crNumFreeSlots :: Creature -> Int
crNumFreeSlots :: IM.IntMap Item -> Creature -> Int
--crNumFreeSlots cr = _crInvCapacity cr - invSize (_crInv cr)
crNumFreeSlots cr = maxInvSlots - invSize (_crInv cr)
crNumFreeSlots m cr = maxInvSlots - invSize (fmap f (_crInv cr))
where
f i = m ^?! ix i
maxInvSlots :: Int
maxInvSlots = 25
src/Dodge/Inventory/Location.hs
+25 -21
View File
@@ -4,9 +4,12 @@ module Dodge.Inventory.Location (
setInvPosFromSS,
) where
import Dodge.Data.ComposedItem
import Dodge.Data.DoubleTree
import Data.Foldable
import Control.Applicative
import Control.Lens
import Data.IntMap.Merge.Strict
--import Data.IntMap.Merge.Strict
import qualified Data.IntSet as IS
import Data.Maybe
import Dodge.Base.You
@@ -26,43 +29,43 @@ tryGetRootAttachedFromInvID invid im = do
-- this assumes the creature inventory is well formed, specifically the
-- location ids
tryGetRootItemInvID :: Int -> Creature -> Maybe Int
tryGetRootItemInvID i cr = do
let adj = invAdj (_crInv cr)
tryGetRootItemInvID :: IM.IntMap Item -> Int -> Creature -> Maybe Int
tryGetRootItemInvID m i cr = do
let adj = invAdj $ fmap (\k -> m ^?! ix k) (_crInv cr)
theroot <- adj ^? ix i
theroot ^? _1 . _Just . _1 <|> Just i
updateRootItemID :: Creature -> Creature
updateRootItemID cr = fromMaybe cr $ do
updateRootItemID :: IM.IntMap Item -> Creature -> Creature
updateRootItemID m cr = fromMaybe cr $ do
i <- cr ^? crManipulation . manObject . imSelectedItem
j <- tryGetRootItemInvID i cr
j <- tryGetRootItemInvID m i cr
return $ cr & crManipulation . manObject . imRootSelectedItem .~ j
-- the following assumes that the crManipulation is correct
crUpdateItemLocations :: Int -> LWorld -> LWorld
crUpdateItemLocations crid lw = fromMaybe lw $ do
mo <- lw ^? creatures . ix crid . crManipulation . manObject
crinv <- lw ^? creatures . ix crid . crInv
itids <- lw ^? creatures . ix crid . crInv
let crinv = IM.restrictKeys (lw ^. items) (IS.fromList $ IM.elems itids)
return $ crSetRoots crid $ IM.foldlWithKey' (crUpdateInvidLocations mo crid) lw crinv
crSetRoots :: Int -> LWorld -> LWorld
crSetRoots cid w = fromMaybe w $ do
inv <- w ^? creatures . ix cid . crInv
return $
w & creatures . ix cid . crInv
%~ merge
dropMissing
preserveMissing
(zipWithMatched f)
(invIMDT inv)
let cinv = invIMDT $ fmap (\i -> w ^?! items . ix i) inv
return $ foldl' f (foldl' g w inv) cinv
where
f _ _ = itLocation . ilIsRoot .~ True
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
crUpdateInvidLocations :: ManipulatedObject -> Int -> LWorld -> Int -> Item -> LWorld
crUpdateInvidLocations mo crid lw invid itm =
lw
& creatures . ix crid . crInv . ix invid . itLocation .~ newloc
& itemLocations %~ IM.insert itid newloc
& creatures . ix crid . crInv . ix invid .~ itid -- . itLocation .~ newloc
& items . ix invid .~ (itm & itLocation .~ newloc)
-- & itemLocations %~ IM.insert itid newloc
where
itid = itm ^. itID . unNInt
newloc =
@@ -72,8 +75,8 @@ crUpdateInvidLocations mo crid lw invid itm =
, _ilIsRoot = Just invid == mo ^? imRootSelectedItem
, _ilIsSelected = Just invid == mo ^? imSelectedItem
, _ilIsAttached = invid `IS.member` (mo ^. imAttachedItems)
, _ilEquipSite = lw ^? creatures . ix crid . crInv . ix invid
. itLocation . ilEquipSite . _Just
, _ilEquipSite = do
lw ^? items . ix itid . itLocation . ilEquipSite . _Just
}
-- this should be looked at, as it is sometimes used in functions that need not
@@ -89,7 +92,8 @@ setInvPosFromSS w =
case i of
(-1) -> Just SortInventory
0 -> do
(rootid, aset) <- tryGetRootAttachedFromInvID j (you w ^. crInv)
(rootid, aset) <- tryGetRootAttachedFromInvID j (fmap (\k -> w ^?! cWorld . lWorld . items . ix k )
$ you w ^. crInv)
return
SelectedItem
{ _imSelectedItem = j
src/Dodge/Inventory/RBList.hs
+10 -8
View File
@@ -4,6 +4,7 @@ module Dodge.Inventory.RBList (
eqSiteToPositions,
) where
import qualified Data.IntMap.Strict as IM
import Dodge.Data.Equipment.Misc
import Dodge.Data.EquipType
import Control.Applicative
@@ -21,11 +22,11 @@ updateRBList w = case w ^. rbOptions of
EquipOptions{} -> w
_ -> fromMaybe (w & rbOptions .~ NoRightButtonOptions) $ do
i <- cr ^? crManipulation . manObject . imSelectedItem
esite <- cr ^? crInv . ix i >>= equipType -- . itUse . uequipEffect . eeType
esite <- cr ^? crInv . ix i >>= \k -> w ^? cWorld . lWorld . items . ix k >>= equipType -- . itUse . uequipEffect . eeType
return $
w & rbOptions
.~ EquipOptions
{ _opSel = chooseEquipPosition cr (eqSiteToPositions esite)
{ _opSel = chooseEquipPosition (w ^. cWorld . lWorld . items) cr (eqSiteToPositions esite)
}
where
norightclick = not $ SDL.ButtonRight `M.member` (w ^. input . mouseButtons)
@@ -33,10 +34,11 @@ updateRBList w = case w ^. rbOptions of
-- want to choose the current position if the item is equipped, otherwise try to
-- find a free equipment slot
chooseEquipPosition :: Creature -> [EquipSite] -> Int
chooseEquipPosition cr eps = fromMaybe (chooseFreeSite cr eps) $ do
chooseEquipPosition :: IM.IntMap Item -> Creature -> [EquipSite] -> Int
chooseEquipPosition m cr eps = fromMaybe (chooseFreeSite cr eps) $ do
i <- cr ^? crManipulation . manObject . imSelectedItem
ep <- cr ^? crInv . ix i . itLocation . ilEquipSite . _Just
itid <- cr ^? crInv . ix i
ep <- m ^? ix itid . itLocation . ilEquipSite . _Just
elemIndex ep eps
chooseFreeSite :: Creature -> [EquipSite] -> Int
@@ -46,12 +48,12 @@ chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
getEquipmentAllocation :: Int -> World -> EquipmentAllocation
getEquipmentAllocation invid w = fromMaybe DoNotMoveEquipment $ do
esite <- you w ^? crInv . ix invid >>= equipType-- . itUse . uequipEffect . eeType
esite <- you w ^? crInv . ix invid >>= \k -> w ^? cWorld . lWorld . items . ix k >>= equipType-- . itUse . uequipEffect . eeType
i <-
w ^? rbOptions . opSel
<|> Just (chooseEquipPosition (you w) (eqSiteToPositions esite))
<|> Just (chooseEquipPosition (w ^. cWorld . lWorld . items) (you w) (eqSiteToPositions esite))
es <- eqSiteToPositions esite ^? ix i
return $ case you w ^? crInv . ix invid . itLocation . ilEquipSite . _Just of
return $ case you w ^? crInv . ix invid >>= \k -> w ^? cWorld . lWorld . items . ix k . itLocation . ilEquipSite . _Just of
Just epos
| es == epos -> RemoveEquipment{_allocOldPos = epos}
Just epos
src/Dodge/Inventory/SelectionList.hs
+6 -3
View File
@@ -92,15 +92,18 @@ itemExternalValue itm w cr
= Just (Right "ON")
| BINGATE <- itm ^. itType = do
invid <- itm ^? itLocation . ilInvID
litm <- cr ^? crInv . ix (invid -2)
ritm <- cr ^? crInv . ix (invid -1)
litid <- cr ^? crInv . ix (invid -2)
ritid <- cr ^? crInv . ix (invid -1)
litm <- w ^? cWorld . lWorld . items . ix litid
ritm <- w ^? cWorld . lWorld . items . ix ritid
x <- itm ^? itScroll . itsRangeInt
l <- getItemValue litm w cr ^? _Just . _Left
r <- getItemValue ritm w cr ^? _Just . _Left
Just . Left $ bgateCalc x l r
| UNIGATE <- itm ^. itType = do
invid <- itm ^? itLocation . ilInvID
itm' <- cr ^? crInv . ix (invid -1)
itid' <- cr ^? crInv . ix (invid -1)
itm' <- w ^? cWorld . lWorld . items . ix itid'
x <- itm ^? itScroll . itsRangeInt
y <- getItemValue itm' w cr ^? _Just . _Left
Just . Left $ ugateCalc x y
src/Dodge/Inventory/Swap.hs
+3 -2
View File
@@ -48,7 +48,7 @@ swapInvItems f i w = fromMaybe w $ do
. swapSite i k
. swapSite k i
cr = you w
swapSite a b = case cr ^? crInv . ix a . itLocation . ilEquipSite . _Just of
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
Nothing -> id
@@ -63,8 +63,9 @@ swapAnyExtraSelection i k w = fromMaybe w $ do
checkConnection :: SoundOrigin -> SoundID -> Int -> Int -> World -> World
checkConnection so s i j w = fromMaybe w $ do
inv <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
inv' <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
cpos <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
let inv = fmap (\k -> w ^?! cWorld . lWorld . items . ix k) inv'
let locs = invIndents inv -- why indents?
iit <- locs ^? ix i . _2
jit <- locs ^? ix j . _2