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

Highlight dropped items, work towards fixing pickup selection change

Browse Source
This commit is contained in:
justin
2026-05-16 10:04:28 +01:00
parent 569ea1e1ab
commit db2ce72076
11 changed files with 39 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/HUD.hs
+1 -1
View File
@@ -38,7 +38,7 @@ data HUD = HUD
}
data Selection = Sel {_slSec :: Int, _slInt :: Int}
deriving (Eq)
deriving (Eq,Show)
makeLenses ''HUD
makeLenses ''Selection
src/Dodge/Data/Item/Location.hs
+1 -1
View File
@@ -35,7 +35,7 @@ data ItemLocation
, _ilEquipSite :: Maybe EquipSite
}
| OnTurret {_ilTuID :: Int}
| OnFloor -- {_ilFlID :: NewInt FloorInt}
| OnFloor {_ilCloseSel :: Bool} -- {_ilFlID :: NewInt FloorInt}
| InVoid
deriving (Eq, Show, Ord, Read) --Generic, Flat)
src/Dodge/FloorItem.hs
+2 -1
View File
@@ -15,8 +15,9 @@ copyItemToFloor :: Point2 -> Item -> World -> World
copyItemToFloor p it w =
w'
& cWorld . lWorld . floorItems . at (it ^. itID . unNInt) ?~ FlIt q r
& cWorld . lWorld . items . at (it ^. itID . unNInt) ?~ (it & itLocation .~ OnFloor)
& cWorld . lWorld . items . at (it ^. itID . unNInt) ?~ (it & itLocation .~ OnFloor False)
& hud . closeItems .:~ _itID it -- puts item at top of close items
& cWorld . highlightItems . at (it ^. itID . unNInt) ?~ 20
where
(q, w') = findWallFreeDropPoint (_dimRad $ itDim it) p w
r = fst . randomR (- pi, pi) $ _randGen w
src/Dodge/Inventory.hs
+1 -1
View File
@@ -73,7 +73,7 @@ destroyItem itid w = case w ^? cWorld . lWorld . items . ix itid . itLocation of
Nothing -> error $ "Tried to destroy item that does not exist; item id: " ++ show itid
Just InInv{_ilCrID = cid, _ilInvID = invid} -> destroyInvItem cid invid w
Just OnTurret{} -> error "need to write code for destroying items on turrets"
Just OnFloor ->
Just OnFloor{} ->
w
& cWorld . lWorld . items . at itid .~ Nothing
& cWorld . lWorld . floorItems . at itid .~ Nothing
src/Dodge/Inventory/Add.hs
+18 -20
View File
@@ -22,12 +22,12 @@ import qualified IntMapHelp as IM
import NewInt
-- this assumes that this item is currently on the floor
tryPutItemInInv :: Maybe Int -> Int -> Int -> World -> Maybe (NewInt InvInt, World)
tryPutItemInInv mcipos cid itid w = do
tryPutItemInInv :: Maybe Int -> Int -> World -> Maybe (NewInt InvInt, World)
tryPutItemInInv mcipos itid w = do
itm <- w ^? cWorld . lWorld . items . ix itid
invid <- checkInvSlotsYou itm w
let itloc = InInv
{ _ilCrID = cid
{ _ilCrID = 0
, _ilInvID = invid
, _ilIsRoot = False
, _ilIsSelected = False
@@ -36,17 +36,18 @@ tryPutItemInInv mcipos cid itid w = do
}
return $ (invid,) $
w
& crUpdateItemLocations
& setInvPosFromSS
& crUpdateItemLocations
-- not sure about the order of these...
& cWorld . lWorld . creatures . ix cid . crInv . at invid ?~ itid
& cWorld . lWorld . creatures . ix 0 . crInv . at invid ?~ itid
& cWorld . lWorld . items . ix itid . itLocation .~ itloc
& cWorld . lWorld . floorItems . at itid .~ Nothing
& updateselectionextra invid
& updatecloseitemset
& maybeselect invid
& cWorld . highlightItems . at itid ?~ 20
& setInvPosFromSS
& crUpdateItemLocations
& setInvPosFromSS
where
maybeselect invid = fromMaybe id $ do
i <- mcipos
@@ -56,39 +57,36 @@ tryPutItemInInv mcipos cid itid w = do
updatecloseitemset = fromMaybe id $ do
i <- mcipos
return $ hud . diSections . ix 3 . ssSet %~ IS.deleteShift i
updateselectionextra i
| cid == 0 = (hud . diSections . ix 0 . ssSet %~ IS.map (f i))
updateselectionextra i = (hud . diSections . ix 0 . ssSet %~ IS.map (f i))
. (hud . diSelection . _Just . slInt %~ f i)
| otherwise = id
f j i | i >= _unNInt j = i + 1
| otherwise = i
-- not sure why we have the cid here, this will probably only work for cid == 0
tryPutItemInInvAt :: Maybe Int -> Int -> Int -> Int -> World -> Maybe World
tryPutItemInInvAt mcipos i cid itid w = do
(j, w') <- tryPutItemInInv mcipos cid itid w
tryPutItemInInvAt :: Maybe Int -> Int -> Int -> World -> Maybe World
tryPutItemInInvAt mcipos i itid w = do
(j, w') <- tryPutItemInInv mcipos itid w
guard (i <= _unNInt j)
return $ foldr f w' [i + 1 .. _unNInt j]
where
f j = swapInvItems (\_ _ -> Just (j -1)) j
createItemYou :: Item -> World -> World
createItemYou itm w = maybe w' snd $ tryPutItemInInv Nothing 0 itid w'
createItemYou itm w = maybe w' snd $ tryPutItemInInv Nothing itid w'
where
itid = IM.newKey $ w ^. cWorld . lWorld . items
pos = w ^?! cWorld . lWorld . creatures . ix 0 . crPos . _xy
w' = copyItemToFloor pos (itm & itID .~ NInt itid) w
-- the duplication is annoying...
pickUpItem :: Int -> (Int,Int) -> World -> World
pickUpItem cid (i,itid) w = fromMaybe w $ do
pickUpItem :: (Int,Int) -> World -> World
pickUpItem (i,itid) w = fromMaybe w $ do
p <- w ^? cWorld . lWorld . floorItems . ix itid . flItPos
soundStart (CrSound cid) p pickUpS Nothing . snd <$> tryPutItemInInv (Just i) cid itid w
soundStart (CrSound 0) p pickUpS Nothing . snd <$> tryPutItemInInv (Just i) itid w
pickUpItemAt :: Int -> Int -> (Int,Int) -> World -> World
pickUpItemAt invid cid (i,itid) w = fromMaybe w $ do
pickUpItemAt :: Int -> (Int,Int) -> World -> World
pickUpItemAt invid (i,itid) w = fromMaybe w $ do
p <- w ^? cWorld . lWorld . floorItems . ix itid . flItPos
soundStart (CrSound cid) p pickUpS Nothing <$> tryPutItemInInvAt (Just i) invid cid itid w
soundStart (CrSound 0) p pickUpS Nothing <$> tryPutItemInInvAt (Just i) invid itid w
& _Just . hud . diSections . ix 0 . ssSet %~ IS.map f
where
f j | j >= invid = j +1
src/Dodge/Inventory/SelectionList.hs
+5 -1
View File
@@ -231,8 +231,12 @@ closeItemToSelectionItem w i = do
, _siColor = col
, _siOffX = 0
, _siPayload = Nothing
, _siDisplayMod = DropShadowSI
, _siDisplayMod = dmod
}
where
dmod = maybe DropShadowSI (const HighlightSI)
$ w ^? cWorld . highlightItems . ix i
closeButtonToSelectionItem :: World -> Int -> Maybe (SelectionItem ())
closeButtonToSelectionItem w i = do
src/Dodge/Placement/PlaceSpot.hs
+1 -1
View File
@@ -111,7 +111,7 @@ placeSpotID rid ps pt w = case pt of
in ( i
, w
& gwWorld . cWorld . lWorld . floorItems . at i ?~ FlIt p rot
& gwWorld . cWorld . lWorld . items . at i ?~ (itm & itID .~ NInt i & itLocation .~ OnFloor)
& gwWorld . cWorld . lWorld . items . at i ?~ (itm & itID .~ NInt i & itLocation .~ OnFloor False)
)
PutCrit cr -> plNewUpID (gwWorld . cWorld . lWorld . creatures) crID (mvCr p rot cr) w
PutForeground fs ->
src/Dodge/SelectedClose.hs
+1 -1
View File
@@ -12,7 +12,7 @@ interactWithCloseObj :: Either (NewInt ItmInt) Button -> World -> World
interactWithCloseObj e w = worldEventFlags . at InventoryChange ?~ () $ case e of
(Left flit) -> fromMaybe w $ do
i <- w ^? hud . diSelection . _Just . slInt
return $ pickUpItem 0 (i,_unNInt flit) w
return $ pickUpItem (i,_unNInt flit) w
(Right but) -> doButtonEvent (but ^. btEvent) but w
getSelectedCloseObj :: World -> Maybe (Either (NewInt ItmInt) Button)
src/Dodge/TestString.hs
+3 -3
View File
@@ -58,10 +58,10 @@ crs :: Universe -> [Creature]
crs u = u ^.. uvWorld . cWorld . lWorld . creatures . each
testStringInit :: Universe -> [String]
testStringInit u = [u ^. uvWorld . input . mouseContext . to show]
testStringInit u = [u ^. uvWorld . input . mouseContext . to show
, u ^. uvWorld . hud . diSelection . to show
] <> u ^.. uvWorld . hud . diSections . each . ssSet . to show
-- u ^. uvWorld . hud . manObject . to prettyShort
-- <>
-- u ^.. uvWorld . hud . diSections . each . ssSet . to show
--testStringInit u = u ^. uvWorld . cWorld . lWorld . creatures . ix 5 . crActionPlan . to prettyShort
--[show . getSum $ foldMap (Sum . crslime) (crs u)]
-- u ^.. tocrs . each . crType . slimeSplitTimer . to show
src/Dodge/Update.hs
+2 -1
View File
@@ -426,7 +426,8 @@ updateMouseContext cfig u = case u ^? uvScreenLayers . ix 0 of
updateMouseContextGame :: Config -> Universe -> MouseContext -> MouseContext
updateMouseContextGame cfig u = \case
OverInvDrag i -> OverInvDrag i -- (inverseSelNumPos cfig invDP mpos disss ^? _Just . nonInf)
--OverInvDrag i -> OverInvDrag i -- (inverseSelNumPos cfig invDP mpos disss ^? _Just . nonInf)
x@OverInvDrag{} -> x
x@OverInvDragSelect{} -> x
MouseGameRotate x
| ButtonRight `M.member` (w ^. input . mouseButtons) -> MouseGameRotate x
src/Dodge/Update/Input/InGame.hs
+4 -4
View File
@@ -194,11 +194,11 @@ tryPickupSelected k mpos w = do
ispickup = map (_unNInt . _itID) itmstopickup
guard $ nfreeslots >= slotsneeded
return $ case mpos of
Just (0, j) -> foldr (pickUpItemAt j 0) w (zip is ispickup) & newdisel j joff
_ -> foldl' (flip $ pickUpItem 0) w (zip is ispickup) & newdisel (length (cr ^. crInv)) joff
Just (0, j) -> foldr (pickUpItemAt j) w (zip is ispickup) & newdisel j joff
_ -> foldl' (flip $ pickUpItem) w (zip is ispickup) & newdisel (length (cr ^. crInv)) joff
-- _ -> foldr (pickUpItem 0) w (zip is ispickup) & newdisel (length (cr ^. crInv)) joff
where
newdisel j joff =
(hud . diSelection ?~ Sel 0 (j + joff))
newdisel j joff = hud . diSelection ?~ Sel 0 (j + joff)
g i = do
NInt j <- w ^? hud . closeItems . ix i
w ^? cWorld . lWorld . items . ix j