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

Improve scroll selection/inventory modification

Browse Source
This commit is contained in:
justin
2026-03-24 19:21:04 +00:00
parent 5b297643db
commit 8ff2f37af5
16 changed files with 532 additions and 432 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Inventory.hs
+119 -19
View File
@@ -1,4 +1,4 @@
--{-# LANGUAGE TupleSections #-}
-- {-# LANGUAGE TupleSections #-}
module Dodge.Inventory (
rmInvItem,
destroyInvItem,
@@ -14,15 +14,22 @@ module Dodge.Inventory (
swapItemWith,
destroyItem,
destroyAllInvItems,
multiSelScroll,
changeSwapSelSet,
concurrentIS,
collectInvItems,
shiftInvItemsUp,
shiftInvItemsDown,
) where
import Dodge.Euse
import Linear
import Control.Monad
import Data.Function
import qualified Data.IntSet as IS
import Data.Maybe
import Dodge.Base
import Dodge.Data.SelectionList
import Dodge.Data.World
import Dodge.Euse
import Dodge.Inventory.Location
import Dodge.Inventory.RBList
import Dodge.Inventory.Swap
@@ -30,6 +37,7 @@ import Dodge.SelectionSections
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import Linear
import ListHelp
import NewInt
@@ -65,7 +73,8 @@ destroyItem itid w = case w ^? cWorld . lWorld . items . ix itid . itLocation of
Just InInv{_ilCrID = cid, _ilInvID = invid} -> destroyInvItem cid invid w
Just OnTurret{} -> error "need to write code for destroying items on turrets"
Just OnFloor ->
w & cWorld . lWorld . items . at itid .~ Nothing
w
& cWorld . lWorld . items . at itid .~ Nothing
& cWorld . lWorld . floorItems . at itid .~ Nothing
Just InVoid -> w & cWorld . lWorld . items . at itid .~ Nothing
@@ -74,7 +83,7 @@ destroyItem itid w = case w ^? cWorld . lWorld . items . ix itid . itLocation of
rmInvItem :: Int -> NewInt InvInt -> World -> World
rmInvItem cid invid w =
w
& dounequipfunction --the ordering of these is
& dounequipfunction -- the ordering of these is
& pointcid . crInv %~ f -- important
& removeAnySlotEquipment
& cWorld . lWorld . items . ix itid . itLocation . ilEquipSite .~ Nothing
@@ -97,12 +106,13 @@ rmInvItem cid invid w =
itm = w ^?! cWorld . lWorld . items . ix itid
dounequipfunction = effectOnRemove itm cr
removeAnySlotEquipment = fromMaybe id $ do
epos <- itm ^?
itLocation
. ilEquipSite
. _Just
epos <-
itm
^? itLocation
. ilEquipSite
. _Just
return $ pointcid . crEquipment . at epos .~ Nothing
-- return $ pointcid . crEquipment .~ mempty
-- return $ pointcid . crEquipment .~ mempty
maxk = fmap fst $ IM.lookupMax $ _unNIntMap $ cr ^. crInv
f inv =
let (xs, ys) = IM.split (_unNInt invid) $ _unNIntMap inv
@@ -114,14 +124,18 @@ rmInvItem cid invid w =
updateCloseObjects :: World -> World
updateCloseObjects w =
w & hud . closeItems %~ h citems
w
& hud . closeItems %~ h citems
& hud . closeButtons %~ h cbts
where
h a b = intersect b a `union` a
lw = w ^. cWorld . lWorld
citems = map NInt $ IM.keys $ IM.intersection (lw ^. items)
$ IM.filter (isclose . _flItPos) (lw^.floorItems)
cbts = lw^..buttons . each . filtered canpress . filtered (isclose . _btPos) . to _btID
citems =
map NInt $
IM.keys $
IM.intersection (lw ^. items) $
IM.filter (isclose . _flItPos) (lw ^. floorItems)
cbts = lw ^.. buttons . each . filtered canpress . filtered (isclose . _btPos) . to _btID
canpress bt = case bt ^. btEvent of
ButtonPress{_btOn = t} -> not t
ButtonAccessTerminal tid -> fromMaybe False $ do
@@ -131,6 +145,66 @@ updateCloseObjects w =
isclose x = dist y x < 40 && hasButtonLOS y x w
y = you w ^. crPos . _xy
changeSwapSelSet :: Int -> World -> World
changeSwapSelSet yi w
| yi >= 0 = foldl' (&) w $ replicate yi (swapSelSet shiftSetUp)
| otherwise = foldl' (&) w $ replicate (negate yi) (swapSelSet shiftSetDown)
swapSelSet :: (Int -> IS.IntSet -> World -> World) -> World -> World
swapSelSet f w = fromMaybe w $ do
Sel j _ is <- w ^. hud . diSelection
return $
if concurrentIS is
then f j is w
else collectInvItems j is w
shiftSetUp :: Int -> IS.IntSet -> World -> World
shiftSetUp j is w = fromMaybe w $ do
(mini, _) <- IS.minView is
guard (mini > 0)
return $ shiftInvItemsUp j is w
shiftSetDown :: Int -> IS.IntSet -> World -> World
shiftSetDown j is w = fromMaybe w $ do
(maxi, _) <- IS.maxView is
(maxinv, _) <- IM.lookupMax =<< (w ^? hud . diSections . ix j . ssItems)
guard (maxi < maxinv)
return $ shiftInvItemsDown j is w
shiftInvItemsDown :: Int -> IS.IntSet -> World -> World
shiftInvItemsDown j is w = fromMaybe w $ do
let i = IS.findMax is
guard . isJust $ w ^? hud . diSections . ix j . ssItems . ix i
return $ IS.foldr f w is
where
f i' = swapItemWith g (j, i')
g i' m = fst <$> IM.lookupGT i' m
shiftInvItemsUp :: Int -> IS.IntSet -> World -> World
shiftInvItemsUp j is w = IS.foldl' f w is
where
f w' i' = swapItemWith g (j, i') w'
g i' m = fst <$> IM.lookupLT i' m
concurrentIS :: IS.IntSet -> Bool
concurrentIS = go . IS.minView
where
go x = fromMaybe True $ do
(i, is) <- x
(j, js) <- IS.minView is
return $ i + 1 == j && go (Just (j, js))
collectInvItems :: Int -> IS.IntSet -> World -> World
collectInvItems secid is w = fromMaybe w $ do
guard $ secid == 0
(j, js) <- IS.minView is
return $ h j js w
where
h j js w' = fromMaybe w' $ do
(k, ks) <- IS.minView js
return . h (j + 1) ks $ swapInvItems (\_ _ -> Just (j + 1)) k w'
changeSwapSel :: Int -> World -> World
changeSwapSel yi w
| yi >= 0 = foldl' (&) w $ replicate yi (changeSwapWith $ f IM.cycleLT)
@@ -138,6 +212,24 @@ changeSwapSel yi w
where
f g i m = fst <$> g i m
multiSelScroll :: Int -> World -> World
multiSelScroll yi w
| yi >= 0 = foldl' (&) w $ replicate yi (multiSelScroll' $ f IM.lookupLT)
| otherwise = foldl' (&) w $ replicate (negate yi) (multiSelScroll' $ f IM.lookupGT)
where
f g i m = fst <$> g i m
multiSelScroll' :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
multiSelScroll' f w = fromMaybe w $ do
Sel j i is <- w ^. hud . diSelection
ss <- w ^? hud . diSections . ix j . ssItems
k <- f i ss
let insertordelete = if k `IS.member` is then IS.delete i else IS.insert i . IS.insert k
return $
w
& hud . diSelection . _Just . slSet %~ insertordelete
& hud . diSelection . _Just . slInt .~ k
changeSwapOther ::
((Int -> Identity Int) -> ManipulatedObject -> Identity ManipulatedObject) ->
Int ->
@@ -155,7 +247,13 @@ changeSwapOther manlens n f i w = fromMaybe w $ do
return $
w
& swapAnyExtraSelection i k
& cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . manlens
& cWorld
. lWorld
. creatures
. ix 0
. crManipulation
. manObject
. manlens
%~ doswap
& hud . closeItems %~ swapIndices i k
& hud . diSelection . _Just . slInt %~ doswap
@@ -173,8 +271,8 @@ swapItemWith f (j, i) = case j of
_ -> id
changeSwapWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
changeSwapWith f w
| Just (Sel j i _) <- w ^. hud . diSelection = swapItemWith f (j,i) w
changeSwapWith f w
| Just (Sel j i _) <- w ^. hud . diSelection = swapItemWith f (j, i) w
| otherwise = w
invSetSelection :: Selection -> World -> World
@@ -192,7 +290,8 @@ scrollAugInvSel :: Int -> World -> World
scrollAugInvSel yi w
| yi == 0 = w
| otherwise =
w & hud %~ doscroll
w
& hud %~ doscroll
& worldEventFlags . at InventoryChange ?~ ()
& setInvPosFromSS
& cWorld . lWorld %~ crUpdateItemLocations 0
@@ -203,7 +302,8 @@ scrollAugInvSel yi w
scrollAugNextInSection :: World -> World
scrollAugNextInSection w =
w & hud %~ doscroll
w
& hud %~ doscroll
& worldEventFlags . at InventoryChange ?~ ()
& setInvPosFromSS
& cWorld . lWorld %~ crUpdateItemLocations 0