Flatten HUDElement

This commit is contained in:
2025-08-26 16:46:02 +01:00
parent 596880f76a
commit 9034c409e1
24 changed files with 255 additions and 270 deletions
+56 -56
View File
@@ -43,8 +43,8 @@ import NewInt
import SDL
updateUseInputInGame :: Universe -> Universe
updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud . hudElement of
DisplayInventory{_subInventory = si, _diSelection = disel} -> case si of
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, _, _))} ->
u
@@ -64,7 +64,7 @@ updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud . hudEleme
& uvWorld %~ setInvPosFromSS
_ -> M.foldlWithKey' updateKeyInGame u pkeys
where
tohud = uvWorld . hud . hudElement
tohud = uvWorld . hud
pkeys = u ^. uvWorld . input . pressedKeys
dodisplayregexinput filterprism filterlens x di = fromMaybe di $ do
sss <- di ^? diSections
@@ -98,7 +98,7 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
OverInvDragSelect{} | ButtonRight `M.member` (w ^. input . mouseButtons) ->
w & input . mouseContext .~ MouseGameRotate
OverInvDragSelect (Just sstart) _ ->
let sss = w ^. hud . hudElement . diSections
let sss = w ^. hud . diSections
msel = inverseSelNumPos cfig invDP sss (w ^. input . mousePos)
in case msel of
Nothing -> w & input . mouseContext . mcoSelEnd .~ Nothing
@@ -112,7 +112,7 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
(IM.lookupMax =<< sss ^? ix (fst sstart) . ssItems)
-- not sure how the above performs when filtering...
OverInvDragSelect Nothing _ -> fromMaybe w $ do
sss <- w ^? hud . hudElement . diSections
sss <- w ^? hud . diSections
ysel <-
inverseSelSecYint
(posSelSecYint cfig invDP (w ^. input . mousePos . _y))
@@ -126,9 +126,9 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
doDrag :: Configuration -> Int -> Int -> Maybe (Int, Int) -> World -> World
doDrag cfig n k mmouseover w = fromMaybe w $ do
guard (n /= 0)
ss <- w ^? hud . hudElement . diSections . ix k . ssItems
ss <- w ^? hud . diSections . ix k . ssItems
x <- mmouseover
is <- w ^? hud . hudElement . diSelection . _Just . _3
is <- w ^? hud . diSelection . _Just . _3
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 . hudElement . diSelection . _Just
(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 . hudElement . diSelection . _Just . _3
xs <- w ^? hud . diSelection . _Just . _3
let nfreeslots = crNumFreeSlots (w ^. cWorld . lWorld . items) cr
itmstopickup = mapMaybe g $ IS.toList xs
slotsneeded = alaf Sum foldMap itInvHeight itmstopickup
@@ -157,7 +157,7 @@ tryPickupSelected k mpos w = do
_ -> foldl' (flip $ pickUpItem 0) w ispickup & newdisel (length (cr ^. crInv)) xs
where
newdisel j xs =
hud . hudElement . diSelection
hud . diSelection
?~ (0, j, IS.fromDistinctAscList [j .. j + IS.size xs -1])
g i = do
NInt j <- w ^? hud . closeItems . ix i
@@ -171,25 +171,25 @@ updateMouseReleaseInGame w = case w ^. input . mouseContext of
OverInvDragSelect (Just ssel) mesel
| ScancodeLShift `M.member` (w ^. input . pressedKeys) ->
w & input . mouseContext .~ MouseInGame
& hud . hudElement . diSelection . _Just . _3
& hud . diSelection . _Just . _3
%~ getuniques
( maybe
mempty
(h ssel)
(guard (ssel ^? _1 == w ^? hud . hudElement . diSelection . _Just . _1) >> mesel ^? _Just)
(guard (ssel ^? _1 == w ^? hud . diSelection . _Just . _1) >> 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 . hudElement . diSelection . _Just . _3 %~ const mempty
& hud . diSelection . _Just . _3 %~ const mempty
_ -> w
where
getuniques x y = IS.union x y IS.\\ IS.intersection x y
f (x, y) z = (x, y, z)
h (k, i) j = fold $ do
sss <- w ^? hud . hudElement . diSections . ix k . ssItems
sss <- w ^? hud . diSections . ix k . ssItems
let (_, xss) = IM.split (min i j -1) sss
(yss, _) = IM.split (max i j + 1) xss
return . IM.keysSet $ yss
@@ -203,7 +203,7 @@ isGroupSelectableSection = \case
updateMouseClickInGame :: Configuration -> World -> World
updateMouseClickInGame cfig w = case w ^. input . mouseContext of
MouseInGame -> fromMaybe (w & input . mouseContext .~ OverInvDragSelect Nothing Nothing) $ do
let sss = w ^. hud . hudElement . diSections
let sss = w ^. hud . diSections
ysel <-
inverseSelSecYint
(posSelSecYint cfig invDP (w ^. input . mousePos . _y))
@@ -213,12 +213,12 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
return $ w & input . mouseContext .~ OverInvDragSelect (Just ysel) Nothing
OverInvSelect (-1, _)
| selsec == Just (-1) ->
w & hud . hudElement . diSelection %~ endRegex (-1) w
& hud . hudElement . diInvFilter .~ Nothing
w & hud . diSelection %~ endRegex (-1) w
& hud . diInvFilter .~ Nothing
OverInvSelect (2, _)
| selsec == Just 2 ->
w & hud . hudElement . diSelection %~ endRegex 2 w
& hud . hudElement . diCloseFilter .~ Nothing
w & hud . diSelection %~ endRegex 2 w
& hud . diCloseFilter .~ Nothing
OverInvSelect x
| ScancodeLShift `M.member` (w ^. input . pressedKeys)
&& isGroupSelectableSection (fst x) ->
@@ -226,14 +226,14 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
OverInvSelect x -> startDrag x w
OverTerminal tmid TerminalTextInput{} -> terminalReturnEffect tmid w
OverTerminal tmid TerminalPressTo{} -> continueTerminal tmid w
OutsideTerminal -> w & hud . hudElement . subInventory .~ NoSubInventory
OutsideTerminal -> w & hud . subInventory .~ NoSubInventory
OverCombSelect x ->
w & hud . hudElement . subInventory . ciSelection ?~ f x
w & hud . subInventory . ciSelection ?~ f x
& worldEventFlags . at CombineInventoryChange ?~ ()
OverCombFilter ->
w & hud . hudElement . subInventory . ciFilter .~ Nothing
w & hud . subInventory . ciFilter .~ Nothing
& worldEventFlags . at CombineInventoryChange ?~ ()
& hud . hudElement . subInventory . ciSelection %~ endCombineRegex w
& hud . subInventory . ciSelection %~ endCombineRegex w
OverCombCombine x ->
w
& tryCombine x
@@ -243,7 +243,7 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
OverCombEscape ->
w
& worldEventFlags . at InventoryChange ?~ ()
& hud . hudElement . subInventory .~ NoSubInventory
& hud . subInventory .~ NoSubInventory
OverCombFiltInv (0, j) -> fromMaybe w $ do
str <-
fmap (take 5) $
@@ -252,33 +252,33 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
w ^? cWorld . lWorld . items . ix k
>>= (listToMaybe . basicItemDisplay)
return . (worldEventFlags . at CombineInventoryChange ?~ ()) $
case w ^? hud . hudElement . subInventory . ciFilter . _Just of
case w ^? hud . subInventory . ciFilter . _Just of
Just ('#' : xs)
| str == xs ->
w & hud . hudElement . subInventory . ciFilter .~ Nothing
_ -> w & hud . hudElement . subInventory . ciFilter ?~ ("#" ++ str)
w & hud . subInventory . ciFilter .~ Nothing
_ -> w & hud . subInventory . ciFilter ?~ ("#" ++ str)
_ -> w
where
f (x, y) = (x, y, mempty)
selsec = w ^? hud . hudElement . diSelection . _Just . _1
selsec = w ^? hud . diSelection . _Just . _1
endRegex :: Int -> World -> Maybe (Int, Int, IS.IntSet) -> Maybe (Int, Int, IS.IntSet)
endRegex i w = ssSetCursor (ssLookupDown i j) sss
where
sss = w ^. hud . hudElement . diSections
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 w = ssSetCursor (ssLookupDown 0 j) sss
where
sss = w ^. hud . hudElement . subInventory . ciSections
sss = w ^. hud . subInventory . ciSections
j = fromMaybe 0 $ do
itms <- sss ^? ix 0 . ssItems
(k, _) <- IM.lookupMin itms
return (k -1)
startDrag :: (Int, Int) -> World -> World
startDrag (a, b) w = setcontext $ case w ^? hud . hudElement . diSelection . _Just of
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
where
@@ -316,10 +316,10 @@ shiftInvItems cfig n k x xs ss w = setSelWhileDragging . fromMaybe w $ do
let yint = posSelSecYint cfig invDP (w ^. input . mousePos . _y)
bn =
(\v -> inverseSelSecYint (yint + 1) v ^? nonInf)
=<< w ^? hud . hudElement . diSections
=<< w ^? hud . diSections
ab =
(\v -> inverseSelSecYint (yint - 1) v ^? nonInf)
=<< w ^? hud . hudElement . diSections
=<< w ^? hud . diSections
guard $ xk == k || xk + 1 == k || xk -1 == k
(maxi, _) <- IS.maxView xs
(mini, _) <- IS.minView xs
@@ -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 . hudElement . diSelection . _Just
(i, _, xs) <- w ^? hud . diSelection . _Just
(k, j) <- w ^? input . mouseContext . mcoMaybeSelect . _Just
guard $ i == k && j `IS.member` xs
return $ w & hud . hudElement . diSelection . _Just . _2 .~ j
return $ w & hud . diSelection . _Just . _2 .~ j
shiftInvItemsUp :: Int -> IS.IntSet -> World -> World
shiftInvItemsUp j is w = IS.foldl' f w is
@@ -350,7 +350,7 @@ shiftInvItemsUp j is w = IS.foldl' f w is
shiftInvItemsDown :: Int -> IS.IntSet -> World -> World
shiftInvItemsDown j is w = fromMaybe w $ do
let i = IS.findMax is
guard . isJust $ w ^? hud . hudElement . diSections . ix j . ssItems . ix i
guard . isJust $ w ^? hud . diSections . ix j . ssItems . ix i
return $ IS.foldr f w is
where
f i' w' = swapItemWith g (j, i') w'
@@ -386,8 +386,8 @@ updateKeysInTerminal tmid u = fromMaybe u $ do
return $ case tm ^. tmStatus of
_
| dist x y > 40 || not (hasButtonLOS x y (u ^. uvWorld)) ->
u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory
TerminalDeactivated -> u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory
u & uvWorld . hud . subInventory .~ NoSubInventory
TerminalDeactivated -> u & uvWorld . hud . subInventory .~ NoSubInventory
TerminalTextInput{} -> updateKeysTextInputTerminal tmid u
TerminalPressTo{} -> updateKeyContinueTerminal tmid u
_ -> u
@@ -477,14 +477,14 @@ updateBackspaceRegex :: World -> World
updateBackspaceRegex w = case di ^? subInventory of
Just NoSubInventory{}
| secfocus (-1) 0 ->
w & hud . hudElement %~ trybackspace (-1) diInvFilter diInvFilter diSelection
w & hud %~ trybackspace (-1) diInvFilter diInvFilter diSelection
& worldEventFlags . at InventoryChange ?~ ()
Just NoSubInventory{}
| secfocus 2 3 ->
w & hud . hudElement %~ trybackspace 2 diCloseFilter diCloseFilter diSelection
w & hud %~ trybackspace 2 diCloseFilter diCloseFilter diSelection
& worldEventFlags . at InventoryChange ?~ ()
Just CombineInventory{} ->
w & hud . hudElement . subInventory %~ trybackspace (-1) ciFilter ciFilter ciSelection
w & hud . subInventory %~ trybackspace (-1) ciFilter ciFilter ciSelection
& worldEventFlags . at InventoryChange ?~ ()
_ -> w
where
@@ -498,25 +498,25 @@ updateBackspaceRegex w = case di ^? subInventory of
he & filtset . _Just %~ init
& selset ?~ (x, 0, mempty)
[] -> he & filtset .~ Nothing
di = w ^. hud . hudElement
di = w ^. hud
updateEnterRegex :: World -> World
updateEnterRegex w = case w ^? hud . hudElement . subInventory of
updateEnterRegex w = case w ^? hud . subInventory of
Just NoSubInventory{}
| secfocus [-1, 0, 1] ->
w & hud . hudElement . diSelection ?~ (-1, 0, mempty)
& hud . hudElement . diInvFilter %~ enterregex
w & hud . diSelection ?~ (-1, 0, mempty)
& hud . diInvFilter %~ enterregex
Just NoSubInventory{}
| secfocus [2, 3] ->
w & hud . hudElement . diSelection ?~ (2, 0, mempty)
& hud . hudElement . diCloseFilter %~ enterregex
w & hud . diSelection ?~ (2, 0, mempty)
& hud . diCloseFilter %~ enterregex
Just CombineInventory{} ->
w & hud . hudElement . subInventory . ciFilter %~ enterregex
& hud . hudElement . subInventory . ciSelection ?~ (-1, 0, mempty)
w & hud . subInventory . ciFilter %~ enterregex
& hud . subInventory . ciSelection ?~ (-1, 0, mempty)
_ -> w
where
secfocus xs = fromMaybe False $ do
i <- w ^? hud . hudElement . diSelection . _Just . _1
i <- w ^? hud . diSelection . _Just . _1
return $ i `elem` xs
enterregex = (<|> Just "")
@@ -524,15 +524,15 @@ pauseGame :: Universe -> Universe
pauseGame u = u & uvScreenLayers .~ [pauseMenu u] & pauseSound
spaceAction :: World -> World
spaceAction w = case w ^. hud . hudElement . subInventory of
spaceAction w = case w ^. hud . subInventory of
NoSubInventory -> maybe id interactWithCloseObj (getCloseObj w) w
_ -> w & hud . hudElement . subInventory .~ NoSubInventory
_ -> w & hud . subInventory .~ NoSubInventory
getCloseObj :: World -> Maybe (Either (NewInt ItmInt) Button)
getCloseObj w = getSelectedCloseObj w <|> topcitem <|> topcbut
where
topcitem = do
k <- (w ^? hud . hudElement . diSections . ix 3 . ssItems)
k <- (w ^? hud . diSections . ix 3 . ssItems)
>>= (fmap fst . IM.lookupMin)
Left <$> w ^? hud . closeItems . ix k
topcbut = do
@@ -541,15 +541,15 @@ getCloseObj w = getSelectedCloseObj w <|> topcitem <|> topcbut
tryCombine :: (Int, Int) -> World -> World
tryCombine (i, j) w = fromMaybe w $ do
CombinableItem is it <- w ^? hud . hudElement . subInventory
CombinableItem is it <- w ^? hud . subInventory
. ciSections . ix i . ssItems . ix j . siPayload . _Just
p <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
return $
(createItemYou it (foldr (destroyInvItem 0 . NInt) w (sort is)))
& soundStart InventorySound p wrench1S Nothing
& hud . hudElement . diSelection . _Just . _3 .~ mempty
& hud . diSelection . _Just . _3 .~ mempty
maybeExitCombine :: World -> World
maybeExitCombine w
| ButtonRight `M.member` (w ^. input . mouseButtons) = w
| otherwise = w & hud . hudElement . subInventory .~ NoSubInventory
| otherwise = w & hud . subInventory .~ NoSubInventory
+2 -2
View File
@@ -23,7 +23,7 @@ import SDL
-- yi should be nonzero
updateWheelEvent :: Int -> World -> World
updateWheelEvent yi w = case w ^. hud . hudElement . subInventory of
updateWheelEvent yi w = case w ^. hud . subInventory of
NoSubInventory -> updateBaseWheelEvent yi w
ExamineInventory -> updateBaseWheelEvent yi w
MapperInventory{} -> updateBaseWheelEvent yi w
@@ -118,7 +118,7 @@ zoomOutLongGun sc = fromMaybe sc $ do
moveCombineSel :: Int -> World -> World
moveCombineSel yi =
( hud . hudElement . subInventory %~ doscroll
( hud . subInventory %~ doscroll
)
. (worldEventFlags . at CombineInventoryChange ?~ ())
where