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

Refactor triplet to Selection datatype

Browse Source
This commit is contained in:
justin
2025-08-26 18:13:27 +01:00
parent 9034c409e1
commit b87c3380b8
16 changed files with 127 additions and 135 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Update/Input/InGame.hs
+28 -28
View File
@@ -46,18 +46,18 @@ updateUseInputInGame :: Universe -> Universe
updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud of
HUD{_subInventory = si, _diSelection = disel} -> case si of
DisplayTerminal tmid -> updateKeysInTerminal tmid u
CombineInventory{_ciSections = sss, _ciSelection = msel@(Just (-1, _, _))} ->
CombineInventory{_ciSections = sss, _ciSelection = msel@(Just (Sel (-1) _ _))} ->
u
& tohud . subInventory %~ docombineregexinput sss msel
& uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
_
| disel ^? _Just . _1 == Just (-1) ->
| disel ^? _Just . slSec == Just (-1) ->
u
& tohud %~ dodisplayregexinput diInvFilter diInvFilter (-1)
& uvWorld . worldEventFlags . at InventoryChange ?~ ()
& uvWorld %~ setInvPosFromSS
_
| disel ^? _Just . _1 == Just 2 ->
| disel ^? _Just . slSec == Just 2 ->
u
& tohud %~ dodisplayregexinput diCloseFilter diCloseFilter 2
& uvWorld . worldEventFlags . at InventoryChange ?~ ()
@@ -128,7 +128,7 @@ doDrag cfig n k mmouseover w = fromMaybe w $ do
guard (n /= 0)
ss <- w ^? hud . diSections . ix k . ssItems
x <- mmouseover
is <- w ^? hud . diSelection . _Just . _3
is <- w ^? hud . diSelection . _Just . slSet
return $
if concurrentIS is
then shiftInvItems cfig n k x is ss w
@@ -138,7 +138,7 @@ tryDropSelected :: Maybe (Int, Int) -> World -> Maybe World
tryDropSelected mpos w = do
guard $ maybe True (\(i, _) -> i == 3) mpos
cr <- w ^? cWorld . lWorld . creatures . ix 0
(0, _, xs) <- w ^? hud . diSelection . _Just
Sel 0 _ xs <- w ^? hud . diSelection . _Just
return . foldl' (flip $ dropItem cr) w . IS.toDescList $ xs
tryPickupSelected :: Int -> Maybe (Int, Int) -> World -> Maybe World
@@ -146,7 +146,7 @@ tryPickupSelected k mpos w = do
guard $ k == 3
guard $ maybe True (\(i, _) -> i == 0 || i == 1) mpos
cr <- w ^? cWorld . lWorld . creatures . ix 0
xs <- w ^? hud . diSelection . _Just . _3
xs <- w ^? hud . diSelection . _Just . slSet
let nfreeslots = crNumFreeSlots (w ^. cWorld . lWorld . items) cr
itmstopickup = mapMaybe g $ IS.toList xs
slotsneeded = alaf Sum foldMap itInvHeight itmstopickup
@@ -158,7 +158,7 @@ tryPickupSelected k mpos w = do
where
newdisel j xs =
hud . diSelection
?~ (0, j, IS.fromDistinctAscList [j .. j + IS.size xs -1])
?~ Sel 0 j (IS.fromDistinctAscList [j .. j + IS.size xs -1])
g i = do
NInt j <- w ^? hud . closeItems . ix i
w ^? cWorld . lWorld . items . ix j
@@ -171,23 +171,23 @@ updateMouseReleaseInGame w = case w ^. input . mouseContext of
OverInvDragSelect (Just ssel) mesel
| ScancodeLShift `M.member` (w ^. input . pressedKeys) ->
w & input . mouseContext .~ MouseInGame
& hud . diSelection . _Just . _3
& hud . diSelection . _Just . slSet
%~ getuniques
( maybe
mempty
(h ssel)
(guard (ssel ^? _1 == w ^? hud . diSelection . _Just . _1) >> mesel ^? _Just)
(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))
OverInvDragSelect{} ->
w & input . mouseContext .~ MouseInGame
& hud . diSelection . _Just . _3 %~ const mempty
& hud . diSelection . _Just . slSet %~ const mempty
_ -> w
where
getuniques x y = IS.union x y IS.\\ IS.intersection x y
f (x, y) z = (x, y, z)
f (x, y) z = Sel x y z
h (k, i) j = fold $ do
sss <- w ^? hud . diSections . ix k . ssItems
let (_, xss) = IM.split (min i j -1) sss
@@ -259,16 +259,16 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
_ -> w & hud . subInventory . ciFilter ?~ ("#" ++ str)
_ -> w
where
f (x, y) = (x, y, mempty)
selsec = w ^? hud . diSelection . _Just . _1
f (x, y) = Sel x y mempty
selsec = w ^? hud . diSelection . _Just . slSec
endRegex :: Int -> World -> Maybe (Int, Int, IS.IntSet) -> Maybe (Int, Int, IS.IntSet)
endRegex :: Int -> World -> Maybe Selection -> Maybe Selection
endRegex i w = ssSetCursor (ssLookupDown i j) sss
where
sss = w ^. hud . diSections
j = maybe 0 fst $ IM.lookupMin =<< sss ^? ix i . ssItems
endCombineRegex :: World -> Maybe (Int, Int, IS.IntSet) -> Maybe (Int, Int, IS.IntSet)
endCombineRegex :: World -> Maybe Selection -> Maybe Selection
endCombineRegex w = ssSetCursor (ssLookupDown 0 j) sss
where
sss = w ^. hud . subInventory . ciSections
@@ -279,8 +279,8 @@ endCombineRegex w = ssSetCursor (ssLookupDown 0 j) sss
startDrag :: (Int, Int) -> World -> World
startDrag (a, b) w = setcontext $ case w ^? hud . diSelection . _Just of
Just (i, _, xs) | i == a && b `IS.member` xs -> w
_ -> invSetSelection (a, b, IS.singleton b) w
Just (Sel i _ xs) | i == a && b `IS.member` xs -> w
_ -> invSetSelection (Sel a b (IS.singleton b)) w
where
setcontext = input . mouseContext .~ OverInvDrag a (Just (a, b))
@@ -336,10 +336,10 @@ shiftInvItems cfig n k x xs ss w = setSelWhileDragging . fromMaybe w $ do
setSelWhileDragging :: World -> World
setSelWhileDragging w = fromMaybe w $ do
(i, _, xs) <- w ^? hud . diSelection . _Just
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 . _2 .~ j
return $ w & hud . diSelection . _Just . slInt .~ j
shiftInvItemsUp :: Int -> IS.IntSet -> World -> World
shiftInvItemsUp j is w = IS.foldl' f w is
@@ -446,9 +446,9 @@ doRegexInput ::
Input ->
Int ->
IMSS a ->
Maybe (Int, Int, IS.IntSet) ->
Maybe Selection ->
Maybe String ->
(IMSS a, Maybe (Int, Int, IS.IntSet), Maybe String)
(IMSS a, Maybe Selection, Maybe String)
doRegexInput inp i sss msel filts
| backspacetonothing || escapekey = endregex i 0
| endkeys = endregex (i + 1) (j -1)
@@ -489,14 +489,14 @@ updateBackspaceRegex w = case di ^? subInventory of
_ -> w
where
secfocus a b = fromMaybe False $ do
i <- di ^? diSelection . _Just . _1
i <- di ^? diSelection . _Just . slSec
return $ i == a || i == b
trybackspace x filtget filtset selset he = fromMaybe he $ do
str <- he ^? filtget . _Just
return $ case str of
(_ : _) ->
he & filtset . _Just %~ init
& selset ?~ (x, 0, mempty)
& selset ?~ Sel x 0 mempty
[] -> he & filtset .~ Nothing
di = w ^. hud
@@ -504,19 +504,19 @@ updateEnterRegex :: World -> World
updateEnterRegex w = case w ^? hud . subInventory of
Just NoSubInventory{}
| secfocus [-1, 0, 1] ->
w & hud . diSelection ?~ (-1, 0, mempty)
w & hud . diSelection ?~ Sel (-1) 0 mempty
& hud . diInvFilter %~ enterregex
Just NoSubInventory{}
| secfocus [2, 3] ->
w & hud . diSelection ?~ (2, 0, mempty)
w & hud . diSelection ?~ Sel 2 0 mempty
& hud . diCloseFilter %~ enterregex
Just CombineInventory{} ->
w & hud . subInventory . ciFilter %~ enterregex
& hud . subInventory . ciSelection ?~ (-1, 0, mempty)
& hud . subInventory . ciSelection ?~ Sel (-1) 0 mempty
_ -> w
where
secfocus xs = fromMaybe False $ do
i <- w ^? hud . diSelection . _Just . _1
i <- w ^? hud . diSelection . _Just . slSec
return $ i `elem` xs
enterregex = (<|> Just "")
@@ -547,7 +547,7 @@ 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 . _3 .~ mempty
& hud . diSelection . _Just . slSet .~ mempty
maybeExitCombine :: World -> World
maybeExitCombine w