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

Refactor floor items to use centralised items intmap

Browse Source
This commit is contained in:
justin
2025-08-24 13:14:49 +01:00
parent c38d03165f
commit 22b4be440a
14 changed files with 170 additions and 152 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/FloorItem.hs
+2 -2
View File
@@ -8,11 +8,11 @@ module Dodge.Data.FloorItem where
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Dodge.Data.Item
--import Dodge.Data.Item
import Geometry.Data
data FloorItem = FlIt {_flIt :: Item, _flItPos :: Point2, _flItRot :: Float}--, _flItID :: NewInt FloorInt}
data FloorItem = FlIt {_flItPos :: Point2, _flItRot :: Float}--, _flItID :: NewInt FloorInt}
--deriving (Eq, Show, Read) --Generic, Flat)
makeLenses ''FloorItem
src/Dodge/Default.hs
+1 -1
View File
@@ -25,7 +25,7 @@ defaultEquipment :: Item
defaultEquipment = defaultHeldItem & itUse .~ UseNothing
defaultFlIt :: FloorItem
defaultFlIt = FlIt{_flItRot = 0, _flIt = defaultHeldItem, _flItPos = V2 0 0}
defaultFlIt = FlIt{_flItRot = 0, _flItPos = V2 0 0}
defaultMachine :: Machine
defaultMachine =
src/Dodge/FloorItem.hs
+2 -6
View File
@@ -24,18 +24,14 @@ copyItemToFloorID pos it w =
w'
& cWorld . lWorld . floorItems %~ IM.insert (_unNInt $ _itID it) theflit
& cWorld . lWorld . itemLocations %~ IM.insert (_unNInt $ _itID it) OnFloor
& cWorld . lWorld . items . ix (_unNInt $ _itID it) . itLocation .~ OnFloor
& hud . closeItems %~ (_itID it:)
-- & hud . hudElement . diSections . ix 3 . ssOffset .~ 0
-- ensures dropped item is at the top of the close item selection list
where
(p', w') = findWallFreeDropPoint (_dimRad $ itDim it) pos w
rot = fst . randomR (- pi, pi) $ _randGen w
theflit =
FlIt
{ _flIt = it & itLocation .~ OnFloor
, _flItPos = p'
, _flItRot = rot
}
theflit = FlIt { _flItPos = p' , _flItRot = rot }
cardinalVectors :: [Point2]
cardinalVectors =
src/Dodge/Inventory.hs
+2 -1
View File
@@ -125,7 +125,8 @@ updateCloseObjects w =
g oldbts = intersect oldbts cbts `union` cbts
f olditems = intersect olditems citems `union` citems
lw = w ^. cWorld . lWorld
citems = lw^..floorItems . each . filtered (isclose . _flItPos) . to (_itID . _flIt)
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
cbts = lw^..buttons . each . filtered canpress . filtered (isclose . _btPos) . to _btID
src/Dodge/Inventory/Add.hs
+79 -52
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE TupleSections #-}
module Dodge.Inventory.Add (
tryPutItemInInv,
createItemYou,
@@ -17,49 +18,13 @@ import Dodge.SoundLogic
import qualified IntMapHelp as IM
import NewInt
tryPutFloorItemIDInInv :: Int -> Int -> World -> Maybe (Int, World)
tryPutFloorItemIDInInv cid i w = do
flit <- w ^? cWorld . lWorld . floorItems . ix i
tryPutItemInInv cid flit w
-- not sure why we have the cid here, this will probably only work for cid == 0
tryPutItemInInvAt :: Int -> Int -> FloorItem -> World -> Maybe World
tryPutItemInInvAt i cid flit w = do
(j, w') <- tryPutItemInInv cid flit w
guard (i <= j)
return $ foldr f w' [i + 1 .. j]
where
f j = swapInvItems (\_ _ -> Just (j -1)) j
-- | Pick up a specific item.
tryPutItemInInv :: Int -> FloorItem -> World -> Maybe (Int, World)
tryPutItemInInv cid flit w = do
i <- checkInvSlotsYou it w
Just
( i
, w
& cWorld . lWorld . floorItems %~ IM.delete (flit ^. flIt . itID . unNInt)
& cWorld . lWorld . creatures . ix cid . crInv . at i ?~ it
& updateItLocation i
-- I forget whether using "at" rather than "IM.insert" here caused problems
-- & cWorld . lWorld . creatures . ix cid . crInv . at i ?~ it
-- note item locations are updated twice: first for the ilInvID,
-- second for the root/selected item bools
& cWorld . lWorld %~ crUpdateItemLocations cid
& setInvPosFromSS
& updateselectionextra
& cWorld . lWorld %~ crUpdateItemLocations cid
)
where
updateselectionextra
| cid == 0 =
hud . hudElement . diSelection . _Just . _3 %~ const mempty
| otherwise = id
it = _flIt flit
-- not sure if the following is necessary
updateItLocation invid w' =
w' & cWorld . lWorld . itemLocations . ix (_unNInt $ _itID it)
.~ InInv
-- 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 cid itid w = do
itm <- w ^? cWorld . lWorld . items . ix itid
invid <- checkInvSlotsYou itm w
let itloc = InInv
{ _ilCrID = cid
, _ilInvID = invid
, _ilIsRoot = False
@@ -67,6 +32,66 @@ tryPutItemInInv cid flit w = do
, _ilIsAttached = False
, _ilEquipSite = Nothing
}
newitm = itm & itLocation .~ itloc
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 . items . at itid ?~ newitm
& cWorld . lWorld . itemLocations . at itid ?~ itloc
& cWorld . lWorld . floorItems . at itid .~ Nothing
& updateselectionextra
where
updateselectionextra
| cid == 0 =
hud . hudElement . diSelection . _Just . _3 %~ const mempty
| otherwise = id
-- not sure why we have the cid here, this will probably only work for cid == 0
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]
where
f j = swapInvItems (\_ _ -> Just (j -1)) j
---- | Pick up a specific item.
--tryPutItemInInv :: Int -> Item -> Int -> World -> Maybe (Int, World)
--tryPutItemInInv cid flit itid w = do
-- i <- checkInvSlotsYou it w
-- Just
-- ( i
-- , w
-- & cWorld . lWorld . floorItems %~ IM.delete itid
-- & cWorld . lWorld . creatures . ix cid . crInv . at i ?~ it
-- & updateItLocation i
-- -- I forget whether using "at" rather than "IM.insert" here caused problems
-- -- & cWorld . lWorld . creatures . ix cid . crInv . at i ?~ it
-- -- note item locations are updated twice: first for the ilInvID,
-- -- second for the root/selected item bools
-- & cWorld . lWorld %~ crUpdateItemLocations cid
-- & setInvPosFromSS
-- & updateselectionextra
-- & cWorld . lWorld %~ crUpdateItemLocations cid
-- )
-- where
-- updateselectionextra
-- | cid == 0 =
-- hud . hudElement . diSelection . _Just . _3 %~ const mempty
-- | otherwise = id
-- it = _flIt flit
-- -- not sure if the following is necessary
-- updateItLocation invid w' =
-- w' & cWorld . lWorld . itemLocations . ix (_unNInt $ _itID it)
-- .~ InInv
-- { _ilCrID = cid
-- , _ilInvID = invid
-- , _ilIsRoot = False
-- , _ilIsSelected = False
-- , _ilIsAttached = False
-- , _ilEquipSite = Nothing
-- }
---- should select the item on the floor if no inventory space?
--createAndSelectItem :: Item -> World -> World
@@ -87,7 +112,7 @@ tryPutItemInInv cid flit w = do
createItemYou :: Item -> World -> (ItemLocation, World)
createItemYou itm w = fromMaybe (OnFloor, w') $ do
(invid, w'') <- tryPutFloorItemIDInInv 0 itid w'
(invid, w'') <- tryPutItemInInv 0 itid w'
itloc <- w'' ^? cWorld . lWorld . creatures . ix 0 . crInv . ix invid . itLocation
return (itloc, w'')
where
@@ -96,13 +121,15 @@ createItemYou itm w = fromMaybe (OnFloor, w') $ do
w' = copyItemToFloorID pos (itm & itID .~ NInt itid) w
-- | Pick up a specific item.
pickUpItem :: Int -> FloorItem -> World -> World
pickUpItem cid flit w =
maybe w (soundStart (CrSound cid) (_flItPos flit) pickUpS Nothing . snd) $
tryPutItemInInv cid flit w
pickUpItem :: Int -> Int -> World -> World
pickUpItem cid itid w = fromMaybe w $ do
(_,w') <- tryPutItemInInv cid itid w
p <- w ^? cWorld . lWorld . floorItems . ix itid . flItPos
return $ soundStart (CrSound cid) p pickUpS Nothing w'
-- | Pick up a specific item.
pickUpItemAt :: Int -> Int -> FloorItem -> World -> World
pickUpItemAt invid cid flit w =
maybe w (soundStart (CrSound cid) (_flItPos flit) pickUpS Nothing) $
tryPutItemInInvAt invid cid flit w
pickUpItemAt :: Int -> Int -> Int -> World -> World
pickUpItemAt invid cid itid w = fromMaybe w $ do
w' <- tryPutItemInInvAt invid cid itid w
p <- w ^? cWorld . lWorld . floorItems . ix itid . flItPos
return $ soundStart (CrSound cid) p pickUpS Nothing w'
src/Dodge/Inventory/SelectionList.hs
+3 -5
View File
@@ -204,7 +204,7 @@ hotkeyToChar = \case
closeItemToSelectionItem :: World -> Int -> Maybe (SelectionItem ())
closeItemToSelectionItem w i = do
e <- w ^? cWorld . lWorld . floorItems . ix i
e <- w ^? cWorld . lWorld . items . ix i
let (pics, col) = closeItemToTextPictures e
return
SelItem
@@ -237,7 +237,5 @@ btText bt = case _btEvent bt of
ButtonSwitch {_btOn = t} -> if t then "SWITCH\\" else "SWITCH/"
ButtonAccessTerminal {} -> "TERMINAL"
closeItemToTextPictures :: FloorItem -> ([String], Color)
closeItemToTextPictures flit = (basicItemDisplay it, itemInvColor $ baseCI it)
where
it = _flIt flit
closeItemToTextPictures :: Item -> ([String], Color)
closeItemToTextPictures it = (basicItemDisplay it, itemInvColor $ baseCI it)
src/Dodge/Item/Location.hs
+2 -2
View File
@@ -36,7 +36,7 @@ pointerYourRootItem f w = fromMaybe (pure w) $ do
pointerToItem :: Applicative f => Item -> (Item -> f Item) -> World -> f World
pointerToItem x = case x ^. itLocation of
OnFloor -> cWorld . lWorld . floorItems . ix (x ^. itID . unNInt) . flIt
OnFloor -> cWorld . lWorld . items . ix (x ^. itID . unNInt)
OnTurret _ -> cWorld . lWorld . items . ix (x ^. itID . unNInt)
InInv cid invid _ _ _ _ -> cWorld . lWorld . creatures . ix cid . crInv . ix invid
InVoid -> const pure
@@ -45,7 +45,7 @@ pointerToItemID :: Applicative f => NewInt ItmInt -> (Item -> f Item) -> World -
pointerToItemID itid f w = fromMaybe (pure w) $ do
itloc <- w ^? cWorld . lWorld . itemLocations . ix (_unNInt itid)
return $ (\x -> x f w) $ case itloc of
OnFloor -> cWorld . lWorld . floorItems . ix (_unNInt itid) . flIt
OnFloor -> cWorld . lWorld . items . ix (itid ^. unNInt)
OnTurret _ -> cWorld . lWorld . items . ix (itid ^. unNInt)
InInv cid invid _ _ _ _ -> cWorld . lWorld . creatures . ix cid . crInv . ix invid
InVoid -> const pure
src/Dodge/Placement/PlaceSpot.hs
+4 -3
View File
@@ -112,7 +112,8 @@ placeSpotID' ps pt w = case pt of
PutFlIt itm -> let i = IM.newKey (w ^. cWorld . lWorld . itemLocations)
in (i, w & cWorld . lWorld . itemLocations . at i ?~ OnFloor
& cWorld . lWorld . floorItems . at i ?~ createFlIt p rot
(itm & itID .~ NInt i)
& cWorld . lWorld . items . at i ?~ (itm & itID .~ NInt i
& itLocation .~ OnFloor)
)
-- plNewUpID
-- (cWorld . lWorld . floorItems . unNIntMap)
@@ -181,8 +182,8 @@ mvButton :: Point2 -> Float -> Button -> Button
mvButton p a = (btRot +~ a) . (btPos %~ ((p +.+) . rotateV a))
{- Creates a floor item at a given point.-}
createFlIt :: Point2 -> Float -> Item -> FloorItem
createFlIt p rot itm = FlIt{_flItPos = p, _flItRot = rot, _flIt = itm}
createFlIt :: Point2 -> Float -> FloorItem
createFlIt p rot = FlIt{_flItPos = p, _flItRot = rot}
mvPP :: Point2 -> Float -> PressPlate -> PressPlate
mvPP p rot pp = pp{_ppPos = p, _ppRot = rot}
src/Dodge/Render/HUD.hs
+4 -4
View File
@@ -217,9 +217,9 @@ drawExamineInventory cfig w =
, _siPayload = Nothing
}
closeObjectInfo :: Int -> Either FloorItem Button -> String
closeObjectInfo :: Int -> Either Item Button -> String
closeObjectInfo n x = case x of
Left FlIt{_flIt = itm} -> itemInfo itm ++ " It is on the floor" ++ floorItemPickupInfo n itm
Left itm -> itemInfo itm ++ " It is on the floor" ++ floorItemPickupInfo n itm
Right _ -> "Some sort of switch or button."
floorItemPickupInfo :: Int -> Item -> String
@@ -229,12 +229,12 @@ floorItemPickupInfo n itm
-- note the use of ^?!
-- it is probably desirable for this to crash hard for now
yourAugmentedItem :: (Item -> a) -> a -> (Either FloorItem Button -> a) -> World -> a
yourAugmentedItem :: (Item -> a) -> a -> (Either Item Button -> a) -> World -> a
yourAugmentedItem f x g w = case you w ^? crManipulation . manObject of
Just (SelectedItem i _ _) -> f $ yourInv w ^?! ix i
Just (SelCloseItem i) -> fromMaybe x $ do
j <- w ^? hud . closeItems . ix i . unNInt
flit <- w ^? cWorld . lWorld . floorItems . ix j
flit <- w ^? cWorld . lWorld . items . ix j
return . g $ Left flit
Just (SelCloseButton i) -> fromMaybe x $ do
j <- w ^? hud . closeButtons . ix i
src/Dodge/Render/ShapePicture.hs
+4 -4
View File
@@ -29,7 +29,7 @@ worldSPic cfig u =
<> foldup (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn _fsPos _foregroundShapes)
<> foldup (shiftDraw' _cpPos _cpDir _cpSPic) (filtOn _cpPos _corpses)
<> foldup drawCreature (filtOn _crPos _creatures)
<> foldup floorItemSPic (filtOn _flItPos (_floorItems))
<> foldup (Prelude.uncurry floorItemSPic) (IM.intersectionWith (,) (u^.uvWorld.cWorld.lWorld.items) (filtOn _flItPos (_floorItems)))
<> foldup btSPic (filtOn _btPos _buttons)
<> foldup (mcSPic (u ^. uvWorld . cWorld . lWorld)) (filtOn _mcPos _machines)
<> foldMap' drawChasm (u ^. uvWorld . cWorld . chasms)
@@ -117,12 +117,12 @@ extraPics cfig u =
ppDraw :: PressPlate -> Picture
ppDraw c = uncurryV translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c)
floorItemSPic :: FloorItem -> SPic
floorItemSPic flit =
floorItemSPic :: Item -> FloorItem -> SPic
floorItemSPic itm flit =
uncurryV translateSPxy (_flItPos flit) $
rotateSP
(_flItRot flit)
(itemSPic $ _flIt flit)
(itemSPic $ itm)
btSPic :: Button -> SPic
btSPic bt =
src/Dodge/SelectedClose.hs
+4 -6
View File
@@ -6,18 +6,16 @@ import Dodge.Data.World
import Dodge.Inventory.Add
import NewInt
interactWithCloseObj :: Either FloorItem Button -> World -> World
interactWithCloseObj :: Either (NewInt ItmInt) Button -> World -> World
interactWithCloseObj e w = worldEventFlags . at InventoryChange ?~ () $ case e of
(Left flit) -> pickUpItem 0 flit w
(Left flit) -> pickUpItem 0 (_unNInt flit) w
(Right but) -> doButtonEvent (but ^. btEvent) but w
getSelectedCloseObj :: World -> Maybe (Either FloorItem Button)
getSelectedCloseObj :: World -> Maybe (Either (NewInt ItmInt) Button)
getSelectedCloseObj w = do
(i, j, _) <- w ^? hud . hudElement . diSelection . _Just
case i of
3 -> do
NInt k <- w ^? hud . closeItems . ix j
fmap Left $ w ^? cWorld . lWorld . floorItems . ix k
3 -> Left <$> w ^? hud . closeItems . ix j
5 -> do
k <- w ^? hud . closeButtons . ix j
fmap Right $ w ^? cWorld . lWorld . buttons . ix k
src/Dodge/Update/Input/InGame.hs
+6 -7
View File
@@ -134,23 +134,23 @@ tryPickupSelected k mpos w = do
let nfreeslots = crNumFreeSlots cr
xs <- w ^? hud . hudElement . diSelection . _Just . _3
let itmstopickup = mapMaybe g $ IS.toList xs
let slotsneeded = alaf Sum foldMap (itInvHeight . _flIt) itmstopickup
let slotsneeded = alaf Sum foldMap itInvHeight itmstopickup
guard $ nfreeslots >= slotsneeded
return $ case mpos of
Just (0, j) ->
foldr (pickUpItemAt j 0) w itmstopickup
foldr (pickUpItemAt j 0) w (IS.toList xs)
& hud . hudElement . diSelection
?~ ( 0
, j
, IS.fromDistinctAscList [j .. j + IS.size xs -1]
)
_ ->
foldl' (flip $ pickUpItem 0) w itmstopickup
foldl' (flip $ pickUpItem 0) w (IS.toList xs)
& hud . hudElement . diSelection . _Just . _3 %~ const mempty
where
g i = do
NInt j <- w ^? hud . closeItems . ix i
w ^? cWorld . lWorld . floorItems . ix j
w ^? cWorld . lWorld . items . ix j
updateMouseReleaseInGame :: World -> World
updateMouseReleaseInGame w = case w ^. input . mouseContext of
@@ -524,14 +524,13 @@ spaceAction w = case w ^. hud . hudElement of
& worldEventFlags . at InventoryChange ?~ ()
_ -> w & hud . hudElement . subInventory .~ NoSubInventory
getCloseObj :: World -> Maybe (Either FloorItem Button)
getCloseObj :: World -> Maybe (Either (NewInt ItmInt) Button)
getCloseObj w = getSelectedCloseObj w <|> topcitem <|> topcbut
where
topcitem = do
k' <- (w ^? hud . hudElement . diSections . ix 3 . ssItems)
>>= (fmap fst . IM.lookupMin)
NInt k <- w ^? hud . closeItems . ix k'
Left <$> w ^? cWorld . lWorld . floorItems . ix k
Left <$> w ^? hud . closeItems . ix k'
topcbut = do
k <- w ^? hud . closeButtons . ix 0
Right <$> w ^? cWorld . lWorld . buttons . ix k