Tweak inventory management

This commit is contained in:
2021-12-01 01:55:20 +00:00
parent 0ed260c9b7
commit b9e4a80a46
12 changed files with 138 additions and 109 deletions
+37 -56
View File
@@ -8,16 +8,17 @@ module Dodge.Inventory
, rmInvItem
, updateCloseObjects
, closeObjScrollDir
, swapInvDir
, changeInvPos
, changeSwapInvPos
, changeInvCloseObjectsPos
-- , swapInvDir
, changeInvSel
, changeSwapInvSel
, changeAugInvSel
, crNumFreeSlots
, crInvSize
, selectedCloseObject
)
where
import Dodge.Data
import Dodge.Inventory.CloseObject
import Dodge.Base
import Dodge.Base.Collide
import Geometry
@@ -41,7 +42,6 @@ checkInvSlotsYou it w
where
ycr = you w
inv = _crInv ycr
-- curinvsize = invSize inv
crNumFreeSlots :: Creature -> Int
crNumFreeSlots cr = _crInvCapacity cr - invSize (_crInv cr)
@@ -52,6 +52,7 @@ crInvSize = invSize . _crInv
invSize :: IM.IntMap Item -> Int
invSize = sum . fmap _itInvSize
-- | after this the item at the inventory position will no longer exist
rmInvItem :: Int -- ^ Creature id
-> Int -- ^ Inventory position
-> World -> World
@@ -66,16 +67,17 @@ rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itAmou
in xs `IM.union` IM.mapKeys (subtract 1) ys
g x | x > invid || Just x == maxk = max 0 $ x - 1
| otherwise = x
{- Delete a creature's selected item, the item will no longer exist. -}
rmSelectedInvItem
:: Int -- ^ Creature id
-> World
-> World
rmSelectedInvItem :: Int -> World -> World
rmSelectedInvItem cid w = rmInvItem cid (_crInvSel (_creatures w IM.! cid)) w
augmentedInvSizes :: World -> IM.IntMap Int
augmentedInvSizes w = IM.union (fmap _itInvSize $ yourInv w)
(IM.fromAscList $ zip [length (yourInv w) ..] $ map closeObjectSize $ _closeObjects w)
augmentedInvSizes = bimapAugmentInv _itInvSize closeObjectSize
bimapAugmentInv :: (Item -> a) -> (Either FloorItem Button -> a) -> World -> IM.IntMap a
bimapAugmentInv f g w = IM.union
(fmap f $ yourInv w)
(IM.fromAscList $ zip [length (yourInv w) ..] $ map g $ _closeObjects w)
invSelSize :: Int -> World -> Int
invSelSize i w = fromMaybe 1 $ augmentedInvSizes w IM.!? i
@@ -89,7 +91,7 @@ selNumPos :: Int -> World -> Int
selNumPos i w = splitgap + (foldl' (+) 0 . fst $ IM.split i (augmentedInvSizes w))
where
splitgap
| yourInvSel w < length (yourInv w) = 0
| i < length (yourInv w) = 0
| otherwise = 1
invSelPos :: World -> Int
@@ -100,28 +102,23 @@ invSelPos w = splitgap + (foldl' (+) 0 . fst $ IM.split invsel (augmentedInvSize
| yourInvSel w < length (yourInv w) = 0
| otherwise = 1
-- this looks ugly...
updateCloseObjects :: World -> World
updateCloseObjects w = w & closeObjects .~ unionBy eTest oldCloseFiltered currentClose
& creatures . ix 0 . crInvSel %~ updateinvsel
updateCloseObjects w = w & closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose
& creatures . ix (_yourID w) . crInvSel %~ updateinvsel
where
updateinvsel curinvsel
| length (augmentedInvSizes w) <= curinvsel = length (augmentedInvSizes w) - 1
| otherwise = curinvsel
filt = filter $ \obj -> dist ypos (pos obj) < 40 && hasLOS ypos (pos obj) w
filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasLOS ypos (closeObjPos obj) w
ypos = _crPos $ you w
objs = map Left (IM.elems $ _floorItems w) ++ activeButtons
activeButtons = map Right
. filter ( (/=) BtNoLabel . _btState)
. IM.elems
$ _buttons w
pos (Right x) = _btPos x
pos (Left x) = _flItPos x
eTest (Right x) (Right y) = _btID x == _btID y
eTest (Left x) (Left y) = _flItID x == _flItID y
eTest _ _ = False
currentClose = filt objs
currentClose = filt $ map Left (IM.elems $ _floorItems w) ++ activeButtons
oldClose = filt $ _closeObjects w
oldCloseFiltered = intersectBy eTest oldClose currentClose
oldCloseFiltered = intersectBy closeObjEq oldClose currentClose
closeObjScrollDir :: Float -> World -> World
closeObjScrollDir x
@@ -129,43 +126,27 @@ closeObjScrollDir x
| x < 0 = over closeObjects rotD
| otherwise = id
swapInvDir :: Int -> World -> World
swapInvDir k w
| n == 0 = w
| i < n = w & creatures . ix (_yourID w) %~ updatecreature
| otherwise = w
where
updatecreature = ( crInv %~ IM.swapKeys (i `mod` n) swapi )
. (crLeftInvSel . _Just %~ updateLeftInvSel)
swapi = (i + k) `mod` n
updateLeftInvSel li | i == li = swapi
| swapi == li = i
| otherwise = li
i = _crInvSel $ you w
n = length $ _crInv $ _creatures w IM.! _yourID w
--numCO = length $ _closeObjects w
changeInvPos :: Int -> World -> World
changeInvPos i w
changeInvSel :: Int -> World -> World
changeInvSel i w
| n == 0 = w
| yourInvSel w < n = w & creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract i
| otherwise = w & creatures . ix (_yourID w) . crInvSel %~ ((+n) . (`mod` numCO) . subtract (i+n))
-- arguably this should jump the invpos into the inventory proper
where
n = length $ _crInv $ _creatures w IM.! _yourID w
numCO = length $ _closeObjects w
changeSwapInvPos :: Int -> World -> World
changeSwapInvPos k w
changeSwapInvSel :: Int -> World -> World
changeSwapInvSel k w
| n == 0 = w
| yourInvSel w < n = w
& creatures . ix (_yourID w) %~ updatecreature
& creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract k
-- | otherwise = w & creatures . ix (_yourID w) . crInvSel %~ ((+n) . (`mod` numCO) . subtract (k+n))
| otherwise = w & creatures . ix (_yourID w) . crInvSel .~ ico'
& closeObjects %~ listSwapIndices (i - n) (ico' - n)
& closeObjects %~ swapIndices (i - n) (ico' - n)
where
updatecreature = ( crInv %~ IM.swapKeys (i `mod` n) swapi )
. (crLeftInvSel . _Just %~ updateLeftInvSel)
. (crInvSel %~ (`mod` n) . subtract k)
swapi = (i - k) `mod` n
updateLeftInvSel li | i == li = swapi
| swapi == li = i
@@ -175,18 +156,19 @@ changeSwapInvPos k w
n = length $ _crInv $ _creatures w IM.! _yourID w
numCO = length $ _closeObjects w
listSwapIndices :: Int -> Int -> [a] -> [a]
listSwapIndices i j xs = insertOver i (xs !! j) . insertOver j (xs !! i) $ xs
changeInvCloseObjectsPos :: Int -> World -> World
changeInvCloseObjectsPos i w
changeAugInvSel :: Int -> World -> World
changeAugInvSel i w
| n == 0 = w
| otherwise = w & creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract i
| otherwise = w & creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract i
where
n = (length $ IM.keys $ _crInv $ _creatures w IM.! _yourID w) + length (_closeObjects w)
n = length (yourInv w) + length (_closeObjects w)
bestCloseObjectIndex :: World -> Maybe Int
bestCloseObjectIndex w = Nothing
bestCloseObjectIndex w = findIndex f $ _closeObjects w
where
f (Right _) = True
f (Left flit) = _itInvSize (_flIt flit) <= _crInvCapacity ycr - crInvSize ycr
ycr = you w
selectedCloseObject :: World -> Maybe (Int,Either FloorItem Button)
selectedCloseObject w
@@ -196,7 +178,6 @@ selectedCloseObject w
invsel = _crInvSel cr
cr = you w
inv = _crInv cr
invsize = crInvSize (you w)
selectNthCloseObject :: World -> Int -> (Int,Either FloorItem Button)
selectNthCloseObject w n = (length (yourInv w) + n, _closeObjects w !! n)