Change selection set to work for multiple sections

This commit is contained in:
2026-05-13 11:18:52 +01:00
parent e4bd971017
commit 91480c957d
14 changed files with 372 additions and 299 deletions
+68 -22
View File
@@ -49,7 +49,7 @@ import SDL
updateUseInputInGame :: Universe -> Universe
updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud . subInventory of
DisplayTerminal tmid -> updateKeysInTerminal tmid u
CombineInventory{_ciSections = sss, _ciSelection = msel@(Just (Sel (-1) _ _))} ->
CombineInventory{_ciSections = sss, _ciSelection = msel@(Just (Sel (-1) _))} ->
u
& tohud . subInventory %~ docombineregexinput sss msel
& uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
@@ -165,13 +165,20 @@ tryDropSelected mpos w = do
xs <- selectionSet w
let xmin = IS.findMin xs
return
. (hud . diSelection ?~ Sel 3 (j-xmin) (IS.fromDistinctAscList [0..IS.size xs - 1]))
. (hud . diSelection ?~ Sel 3 (j-xmin) )
. (hud . diSections . ix 3 . ssSet .~ IS.fromDistinctAscList [0..IS.size xs - 1])
. foldl' (flip $ dropItem cr) w . IS.toDescList $ xs
selectionSet :: World -> Maybe IS.IntSet
selectionSet w = case w ^? hud . diSelection . _Just . slSet of
Just is' | not $ IS.null is' -> Just is'
selectionSet w = do
j <- w ^? hud . diSelection . _Just . slSec
case w ^? hud . diSections . ix j . ssSet of
Just is | not $ IS.null is -> Just is
_ -> IS.singleton <$> w ^? hud . diSelection . _Just . slInt
--selectionSet :: World -> Maybe IS.IntSet
--selectionSet w = case w ^? hud . diSelection . _Just . slSet of
-- Just is' | not $ IS.null is' -> Just is'
-- _ -> IS.singleton <$> w ^? hud . diSelection . _Just . slInt
tryPickupSelected :: Int -> Maybe (Int, Int) -> World -> Maybe World
@@ -193,7 +200,9 @@ tryPickupSelected k mpos w = do
_ -> foldl' (flip $ pickUpItem 0) w ispickup & newdisel (length (cr ^. crInv)) joff xs
where
newdisel j joff xs =
hud . diSelection ?~ Sel 0 (j+joff) (IS.fromDistinctAscList [j .. j + IS.size xs -1])
-- hud . diSelection ?~ Sel 0 (j+joff) (IS.fromDistinctAscList [j .. j + IS.size xs -1])
(hud . diSelection ?~ Sel 0 (j+joff))
. (hud . diSections . ix 0 . ssSet .~ IS.fromDistinctAscList [j .. j + IS.size xs -1])
g i = do
NInt j <- w ^? hud . closeItems . ix i
w ^? cWorld . lWorld . items . ix j
@@ -206,23 +215,44 @@ updateMouseReleaseInGame w = case w ^. input . mouseContext of
OverInvDragSelect (Just ssel) mesel
| ScancodeLShift `M.member` (w ^. input . pressedKeys) ->
w & input . mouseContext .~ MouseInGame
& hud . diSelection . _Just . slSet
%~ getuniques
( maybe
& (fromMaybe id $ do
j <- w ^? hud . diSelection . _Just . slSec
return $ hud . diSections . ix j . ssSet
%~ getuniques
( maybe
mempty
(h ssel)
mempty
--(h ssel)
(guard (ssel ^? _1 == w ^? hud . diSelection . _Just . slSec) >> mesel ^? _Just)
))
& hud . diSections . ix (fst ssel) . ssSet
%~ getuniques
( maybe
mempty
(h ssel)
(guard (ssel ^? _1 == w ^? hud . diSelection . _Just . slSec) >> mesel ^? _Just)
)
-- & hud . diSelection . _Just . slSet
-- %~ getuniques
-- ( maybe
-- mempty
-- (h ssel)
-- (guard (ssel ^? _1 == w ^? hud . diSelection . _Just . slSec) >> mesel ^? _Just)
-- )
OverInvDragSelect (Just ssel) (Just esel) ->
w & input . mouseContext .~ MouseInGame
& invSetSelection (f (fst ssel, esel) (h ssel esel))
-- & invSetSelection (f (fst ssel, esel) (h ssel esel))
& hud . diSections . ix (fst ssel) . ssSet .~ h ssel esel
& invSetSelection (f (fst ssel, esel))
OverInvDragSelect{} ->
w & input . mouseContext .~ MouseInGame
& hud . diSelection . _Just . slSet %~ const mempty
-- & hud . diSelection . _Just . slSet %~ const mempty
& hud . diSections . each . ssSet %~ const mempty
_ -> w
where
getuniques x y = IS.union x y IS.\\ IS.intersection x y
f (x, y) = Sel x y
-- need to set this in OverInvDragSelect (twice)?
h (k, i) j = fold $ do
sss <- w ^? hud . diSections . ix k . ssItems
let (_, xss) = IM.split (min i j -1) sss
@@ -298,7 +328,7 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
_ -> w & hud . subInventory . ciFilter ?~ ("#" ++ str)
_ -> w
where
f (x, y) = Sel x y mempty
f (x, y) = Sel x y
selsec = w ^? hud . diSelection . _Just . slSec
endRegex :: Int -> World -> Maybe Selection -> Maybe Selection
@@ -317,12 +347,18 @@ endCombineRegex w = ssSetCursor (ssLookupDown 0 j) sss
return (k -1)
startDrag :: (Int, Int) -> World -> World
startDrag (a, b) w = setcontext $ case w ^? hud . diSelection . _Just of
Just (Sel i _ xs) | i == a && b `IS.member` xs -> w
-- _ -> invSetSelection (Sel a b (IS.singleton b)) w
_ -> invSetSelection (Sel a b mempty) w
startDrag (a, b) w = setcontext $ fromMaybe (invSetSelection (Sel a b) w) $ do
i <- w ^? hud . diSelection . _Just . slSec
xs <- w ^? hud . diSections . ix i . ssSet
guard $ i == a && b `IS.member` xs
return w
where
setcontext = input . mouseContext .~ OverInvDrag a (Just (a, b))
--startDrag (a, b) w = setcontext $ case w ^? hud . diSelection . _Just of
-- Just (Sel i _ xs) | i == a && b `IS.member` xs -> w
-- _ -> invSetSelection (Sel a b mempty) w
-- where
-- setcontext = input . mouseContext .~ OverInvDrag a (Just (a, b))
shiftInvItems ::
@@ -359,10 +395,15 @@ shiftInvItems cfig n k x xs ss w = setSelWhileDragging . fromMaybe w $ do
setSelWhileDragging :: World -> World
setSelWhileDragging w = fromMaybe w $ do
Sel i _ xs <- w ^? hud . diSelection . _Just
Sel i _ <- w ^? hud . diSelection . _Just
xs <- w ^? hud . diSections . ix i . ssSet
(k, j) <- w ^? input . mouseContext . mcoMaybeSelect . _Just
guard $ i == k && j `IS.member` xs
return $ w & hud . diSelection . _Just . slInt .~ j
-- Sel i _ xs <- w ^? hud . diSelection . _Just
-- (k, j) <- w ^? input . mouseContext . mcoMaybeSelect . _Just
-- guard $ i == k && j `IS.member` xs
-- return $ w & hud . diSelection . _Just . slInt .~ j
updateFunctionKeys :: Universe -> Universe
@@ -508,7 +549,8 @@ updateBackspaceRegex w = case di ^? subInventory of
return $ case str of
(_ : _) ->
he & filtset . _Just %~ init
& selset ?~ Sel x 0 mempty
& selset ?~ Sel x 0
-- & selset ?~ Sel x 0 mempty
[] -> he & filtset .~ Nothing
di = w ^. hud
@@ -516,15 +558,18 @@ updateEnterRegex :: World -> World
updateEnterRegex w = case w ^? hud . subInventory of
Just NoSubInventory{}
| secfocus [-1, 0, 1] ->
w & hud . diSelection ?~ Sel (-1) 0 mempty
-- w & hud . diSelection ?~ Sel (-1) 0 mempty
w & hud . diSelection ?~ Sel (-1) 0
& hud . diInvFilter %~ enterregex
Just NoSubInventory{}
| secfocus [2, 3] ->
w & hud . diSelection ?~ Sel 2 0 mempty
-- w & hud . diSelection ?~ Sel 2 0 mempty
w & hud . diSelection ?~ Sel 2 0
& hud . diCloseFilter %~ enterregex
Just CombineInventory{} ->
w & hud . subInventory . ciFilter %~ enterregex
& hud . subInventory . ciSelection ?~ Sel (-1) 0 mempty
-- & hud . subInventory . ciSelection ?~ Sel (-1) 0 mempty
& hud . subInventory . ciSelection ?~ Sel (-1) 0
_ -> w
where
secfocus xs = fromMaybe False $ do
@@ -567,7 +612,8 @@ tryCombine (i, j) w = fromMaybe w $ do
return $
createItemYou it (foldr (destroyInvItem 0 . NInt) w (sort is))
& soundStart InventorySound p wrench1S Nothing
& hud . diSelection . _Just . slSet .~ mempty
& hud . diSections . ix 1 . ssSet.~ mempty
-- & hud . diSelection . _Just . slSet .~ mempty
maybeExitCombine :: World -> World
maybeExitCombine w