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

Cleanup

Browse Source
This commit is contained in:
justin
2025-08-26 16:19:49 +01:00
parent f7fd747a7c
commit 596880f76a
1 changed files with 91 additions and 103 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Update/Input/InGame.hs
+85 -97
View File
@@ -5,11 +5,6 @@ module Dodge.Update.Input.InGame (
updateMouseInGame, updateMouseInGame,
) where ) where
import Dodge.Data.CardinalPoint
import Dodge.Inventory.CheckSlots
import Dodge.Base.Collide
import Geometry.Vector
import Dodge.Data.Terminal.Status
import Control.Applicative import Control.Applicative
import Control.Monad import Control.Monad
import Data.Foldable import Data.Foldable
@@ -19,14 +14,18 @@ import Data.List (sort)
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import Data.Maybe import Data.Maybe
import Data.Monoid import Data.Monoid
import Dodge.Base.Collide
import Dodge.Camera import Dodge.Camera
import Dodge.Creature.Action import Dodge.Creature.Action
import Dodge.Data.CardinalPoint
import Dodge.Data.Combine import Dodge.Data.Combine
import Dodge.Data.Terminal.Status
import Dodge.Data.Universe import Dodge.Data.Universe
import Dodge.DisplayInventory import Dodge.DisplayInventory
import Dodge.Event.Test import Dodge.Event.Test
import Dodge.Inventory import Dodge.Inventory
import Dodge.Inventory.Add import Dodge.Inventory.Add
import Dodge.Inventory.CheckSlots
import Dodge.Item.Display import Dodge.Item.Display
import Dodge.Item.InvSize import Dodge.Item.InvSize
import Dodge.ListDisplayParams import Dodge.ListDisplayParams
@@ -38,8 +37,7 @@ import Dodge.SoundLogic
import Dodge.Terminal import Dodge.Terminal
import Dodge.Update.Input.DebugTest import Dodge.Update.Input.DebugTest
import Dodge.Update.Input.Text import Dodge.Update.Input.Text
--import Dodge.WorldPos import Geometry.Vector
--import Geometry
import LensHelp import LensHelp
import NewInt import NewInt
import SDL import SDL
@@ -50,25 +48,23 @@ updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud . hudEleme
DisplayTerminal tmid -> updateKeysInTerminal tmid u DisplayTerminal tmid -> updateKeysInTerminal tmid u
CombineInventory{_ciSections = sss, _ciSelection = msel@(Just (-1, _, _))} -> CombineInventory{_ciSections = sss, _ciSelection = msel@(Just (-1, _, _))} ->
u u
& uvWorld . hud . hudElement . subInventory & tohud . subInventory %~ docombineregexinput sss msel
%~ docombineregexinput sss msel
& uvWorld . worldEventFlags . at CombineInventoryChange ?~ () & uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
_ _
| disel ^? _Just . _1 == Just (-1) -> | disel ^? _Just . _1 == Just (-1) ->
u u
& uvWorld . hud . hudElement & tohud %~ dodisplayregexinput diInvFilter diInvFilter (-1)
%~ dodisplayregexinput diInvFilter diInvFilter (-1)
& uvWorld . worldEventFlags . at InventoryChange ?~ () & uvWorld . worldEventFlags . at InventoryChange ?~ ()
& uvWorld %~ setInvPosFromSS & uvWorld %~ setInvPosFromSS
_ _
| disel ^? _Just . _1 == Just 2 -> | disel ^? _Just . _1 == Just 2 ->
u u
& uvWorld . hud . hudElement & tohud %~ dodisplayregexinput diCloseFilter diCloseFilter 2
%~ dodisplayregexinput diCloseFilter diCloseFilter 2
& uvWorld . worldEventFlags . at InventoryChange ?~ () & uvWorld . worldEventFlags . at InventoryChange ?~ ()
& uvWorld %~ setInvPosFromSS & uvWorld %~ setInvPosFromSS
_ -> M.foldlWithKey' updateKeyInGame u pkeys _ -> M.foldlWithKey' updateKeyInGame u pkeys
where where
tohud = uvWorld . hud . hudElement
pkeys = u ^. uvWorld . input . pressedKeys pkeys = u ^. uvWorld . input . pressedKeys
dodisplayregexinput filterprism filterlens x di = fromMaybe di $ do dodisplayregexinput filterprism filterlens x di = fromMaybe di $ do
sss <- di ^? diSections sss <- di ^? diSections
@@ -99,21 +95,28 @@ updateMouseInGame cfig w
updateMouseHeldInGame :: Configuration -> World -> World updateMouseHeldInGame :: Configuration -> World -> World
updateMouseHeldInGame cfig w = case w ^. input . mouseContext of updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
OverInvDragSelect {} | ButtonRight `M.member` (w ^. input . mouseButtons) OverInvDragSelect{} | ButtonRight `M.member` (w ^. input . mouseButtons) ->
-> w & input . mouseContext .~ MouseGameRotate w & input . mouseContext .~ MouseGameRotate
OverInvDragSelect (Just sstart) _ -> fromMaybe w $ do OverInvDragSelect (Just sstart) _ ->
sss <- w ^? hud . hudElement . diSections let sss = w ^. hud . hudElement . diSections
let msel = inverseSelNumPos cfig invDP sss (w ^. input . mousePos) msel = inverseSelNumPos cfig invDP sss (w ^. input . mousePos)
return $ case msel of in case msel of
Nothing -> w & input . mouseContext . mcoSelEnd .~ Nothing Nothing -> w & input . mouseContext . mcoSelEnd .~ Nothing
Just (i,j) | i == fst sstart -> w & input . mouseContext . mcoSelEnd ?~ j Just (i, j)
| i == fst sstart -> w & input . mouseContext . mcoSelEnd ?~ j
| i < fst sstart -> w & input . mouseContext . mcoSelEnd ?~ 0 | i < fst sstart -> w & input . mouseContext . mcoSelEnd ?~ 0
| otherwise -> w & input . mouseContext . mcoSelEnd .~ fmap fst | otherwise ->
w & input . mouseContext . mcoSelEnd
.~ fmap
fst
(IM.lookupMax =<< sss ^? ix (fst sstart) . ssItems) (IM.lookupMax =<< sss ^? ix (fst sstart) . ssItems)
-- not sure how the above performs when filtering...
OverInvDragSelect Nothing _ -> fromMaybe w $ do OverInvDragSelect Nothing _ -> fromMaybe w $ do
sss <- w ^? hud . hudElement . diSections sss <- w ^? hud . hudElement . diSections
ysel <- inverseSelSecYint ysel <-
(posSelSecYint cfig invDP (w ^. input . mousePos . _y)) sss inverseSelSecYint
(posSelSecYint cfig invDP (w ^. input . mousePos . _y))
sss
^? nonInf ^? nonInf
guard (isGroupSelectableSection $ fst ysel) guard (isGroupSelectableSection $ fst ysel)
return $ w & input . mouseContext .~ OverInvDragSelect (Just ysel) Nothing return $ w & input . mouseContext .~ OverInvDragSelect (Just ysel) Nothing
@@ -122,7 +125,7 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
doDrag :: Configuration -> Int -> Int -> Maybe (Int, Int) -> World -> World doDrag :: Configuration -> Int -> Int -> Maybe (Int, Int) -> World -> World
doDrag cfig n k mmouseover w = fromMaybe w $ do doDrag cfig n k mmouseover w = fromMaybe w $ do
guard (n /= 0) -- > 0 ? guard (n /= 0)
ss <- w ^? hud . hudElement . diSections . ix k . ssItems ss <- w ^? hud . hudElement . diSections . ix k . ssItems
x <- mmouseover x <- mmouseover
is <- w ^? hud . hudElement . diSelection . _Just . _3 is <- w ^? hud . hudElement . diSelection . _Just . _3
@@ -150,15 +153,12 @@ tryPickupSelected k mpos w = do
ispickup = map (_unNInt . _itID) itmstopickup ispickup = map (_unNInt . _itID) itmstopickup
guard $ nfreeslots >= slotsneeded guard $ nfreeslots >= slotsneeded
return $ case mpos of return $ case mpos of
Just (0, j) -> Just (0, j) -> foldr (pickUpItemAt j 0) w ispickup & newdisel j xs
foldr (pickUpItemAt j 0) w ispickup _ -> foldl' (flip $ pickUpItem 0) w ispickup & newdisel (length (cr ^. crInv)) xs
& newdisel j xs
_ ->
foldl' (flip $ pickUpItem 0) w ispickup
& newdisel (length (cr ^. crInv)) xs
where where
newdisel j xs = hud . hudElement . diSelection ?~ newdisel j xs =
(0 , j , IS.fromDistinctAscList [j .. j + IS.size xs -1]) hud . hudElement . diSelection
?~ (0, j, IS.fromDistinctAscList [j .. j + IS.size xs -1])
g i = do g i = do
NInt j <- w ^? hud . closeItems . ix i NInt j <- w ^? hud . closeItems . ix i
w ^? cWorld . lWorld . items . ix j w ^? cWorld . lWorld . items . ix j
@@ -176,17 +176,12 @@ updateMouseReleaseInGame w = case w ^. input . mouseContext of
( maybe ( maybe
mempty mempty
(h ssel) (h ssel)
( guard (ssel ^? _1 == w ^? hud . hudElement . diSelection . _Just . _1) (guard (ssel ^? _1 == w ^? hud . hudElement . diSelection . _Just . _1) >> mesel ^? _Just)
>> mesel ^? _Just
) )
)
OverInvDragSelect _ Nothing ->
w & input . mouseContext .~ MouseInGame
& hud . hudElement . diSelection . _Just . _3 %~ const mempty
OverInvDragSelect (Just ssel) (Just esel) -> OverInvDragSelect (Just ssel) (Just esel) ->
w & input . mouseContext .~ MouseInGame w & input . mouseContext .~ MouseInGame
& invSetSelection (f (fst ssel, esel) (h ssel esel)) & invSetSelection (f (fst ssel, esel) (h ssel esel))
OverInvDragSelect Nothing _ -> OverInvDragSelect{} ->
w & input . mouseContext .~ MouseInGame w & input . mouseContext .~ MouseInGame
& hud . hudElement . diSelection . _Just . _3 %~ const mempty & hud . hudElement . diSelection . _Just . _3 %~ const mempty
_ -> w _ -> w
@@ -208,20 +203,21 @@ isGroupSelectableSection = \case
updateMouseClickInGame :: Configuration -> World -> World updateMouseClickInGame :: Configuration -> World -> World
updateMouseClickInGame cfig w = case w ^. input . mouseContext of updateMouseClickInGame cfig w = case w ^. input . mouseContext of
MouseInGame -> fromMaybe (w & input . mouseContext .~ OverInvDragSelect Nothing Nothing) $ do MouseInGame -> fromMaybe (w & input . mouseContext .~ OverInvDragSelect Nothing Nothing) $ do
sss <- w ^? hud . hudElement . diSections let sss = w ^. hud . hudElement . diSections
ysel <- inverseSelSecYint ysel <-
(posSelSecYint cfig invDP (w ^. input . mousePos . _y)) sss ^? nonInf inverseSelSecYint
(posSelSecYint cfig invDP (w ^. input . mousePos . _y))
sss
^? nonInf
guard (isGroupSelectableSection $ fst ysel) guard (isGroupSelectableSection $ fst ysel)
return $ w & input . mouseContext .~ OverInvDragSelect (Just ysel) Nothing return $ w & input . mouseContext .~ OverInvDragSelect (Just ysel) Nothing
OverInvSelect (-1, _) OverInvSelect (-1, _)
| selsec == Just (-1) -> | selsec == Just (-1) ->
w w & hud . hudElement . diSelection %~ endRegex (-1) w
& hud . hudElement . diSelection %~ endRegex (-1) w
& hud . hudElement . diInvFilter .~ Nothing & hud . hudElement . diInvFilter .~ Nothing
OverInvSelect (2, _) OverInvSelect (2, _)
| selsec == Just 2 -> | selsec == Just 2 ->
w w & hud . hudElement . diSelection %~ endRegex 2 w
& hud . hudElement . diSelection %~ endRegex 2 w
& hud . hudElement . diCloseFilter .~ Nothing & hud . hudElement . diCloseFilter .~ Nothing
OverInvSelect x OverInvSelect x
| ScancodeLShift `M.member` (w ^. input . pressedKeys) | ScancodeLShift `M.member` (w ^. input . pressedKeys)
@@ -252,11 +248,13 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
str <- str <-
fmap (take 5) $ fmap (take 5) $
w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix (NInt j) w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix (NInt j)
>>= \k -> w ^? cWorld . lWorld . items . ix k >>= \k ->
w ^? cWorld . lWorld . items . ix k
>>= (listToMaybe . basicItemDisplay) >>= (listToMaybe . basicItemDisplay)
return . (worldEventFlags . at CombineInventoryChange ?~ ()) $ return . (worldEventFlags . at CombineInventoryChange ?~ ()) $
case w ^? hud . hudElement . subInventory . ciFilter . _Just of case w ^? hud . hudElement . subInventory . ciFilter . _Just of
Just ('#' : xs) | str == xs -> Just ('#' : xs)
| str == xs ->
w & hud . hudElement . subInventory . ciFilter .~ Nothing w & hud . hudElement . subInventory . ciFilter .~ Nothing
_ -> w & hud . hudElement . subInventory . ciFilter ?~ ("#" ++ str) _ -> w & hud . hudElement . subInventory . ciFilter ?~ ("#" ++ str)
_ -> w _ -> w
@@ -265,26 +263,22 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
selsec = w ^? hud . hudElement . diSelection . _Just . _1 selsec = w ^? hud . hudElement . diSelection . _Just . _1
endRegex :: Int -> World -> Maybe (Int, Int, IS.IntSet) -> Maybe (Int, Int, IS.IntSet) endRegex :: Int -> World -> Maybe (Int, Int, IS.IntSet) -> Maybe (Int, Int, IS.IntSet)
endRegex i w = fromMaybe id $ do endRegex i w = ssSetCursor (ssLookupDown i j) sss
sss <- w ^? hud . hudElement . diSections where
let j = fromMaybe 0 $ do sss = w ^. hud . hudElement . diSections
itms <- sss ^? ix i . ssItems j = maybe 0 fst $ IM.lookupMin =<< sss ^? ix i . ssItems
(k, _) <- IM.lookupMin itms
return k
return $ ssSetCursor (ssLookupDown i j) sss
endCombineRegex :: World -> Maybe (Int, Int, IS.IntSet) -> Maybe (Int, Int, IS.IntSet) endCombineRegex :: World -> Maybe (Int, Int, IS.IntSet) -> Maybe (Int, Int, IS.IntSet)
endCombineRegex w = fromMaybe id $ do endCombineRegex w = ssSetCursor (ssLookupDown 0 j) sss
sss <- w ^? hud . hudElement . subInventory . ciSections where
let j = fromMaybe 0 $ do sss = w ^. hud . hudElement . subInventory . ciSections
j = fromMaybe 0 $ do
itms <- sss ^? ix 0 . ssItems itms <- sss ^? ix 0 . ssItems
(k, _) <- IM.lookupMin itms (k, _) <- IM.lookupMin itms
return (k -1) return (k -1)
return $ ssSetCursor (ssLookupDown 0 j) sss
startDrag :: (Int, Int) -> World -> World startDrag :: (Int, Int) -> World -> World
startDrag (a, b) w = setcontext startDrag (a, b) w = setcontext $ case w ^? hud . hudElement . diSelection . _Just of
$ case w ^? hud . hudElement . diSelection . _Just of
Just (i, _, xs) | i == a && b `IS.member` xs -> w Just (i, _, xs) | i == a && b `IS.member` xs -> w
_ -> invSetSelection (a, b, IS.singleton b) w _ -> invSetSelection (a, b, IS.singleton b) w
where where
@@ -320,9 +314,11 @@ shiftInvItems ::
shiftInvItems cfig n k x xs ss w = setSelWhileDragging . fromMaybe w $ do shiftInvItems cfig n k x xs ss w = setSelWhileDragging . fromMaybe w $ do
let xk = fst x let xk = fst x
let yint = posSelSecYint cfig invDP (w ^. input . mousePos . _y) let yint = posSelSecYint cfig invDP (w ^. input . mousePos . _y)
bn = (\v -> inverseSelSecYint (yint + 1) v ^? nonInf) bn =
(\v -> inverseSelSecYint (yint + 1) v ^? nonInf)
=<< w ^? hud . hudElement . diSections =<< w ^? hud . hudElement . diSections
ab = (\v -> inverseSelSecYint (yint - 1) v ^? nonInf) ab =
(\v -> inverseSelSecYint (yint - 1) v ^? nonInf)
=<< w ^? hud . hudElement . diSections =<< w ^? hud . hudElement . diSections
guard $ xk == k || xk + 1 == k || xk -1 == k guard $ xk == k || xk + 1 == k || xk -1 == k
(maxi, _) <- IS.maxView xs (maxi, _) <- IS.maxView xs
@@ -354,8 +350,7 @@ shiftInvItemsUp j is w = IS.foldl' f w is
shiftInvItemsDown :: Int -> IS.IntSet -> World -> World shiftInvItemsDown :: Int -> IS.IntSet -> World -> World
shiftInvItemsDown j is w = fromMaybe w $ do shiftInvItemsDown j is w = fromMaybe w $ do
let i = IS.findMax is let i = IS.findMax is
guard . isJust $ guard . isJust $ w ^? hud . hudElement . diSections . ix j . ssItems . ix i
w ^? hud . hudElement . diSections . ix j . ssItems . ix i
return $ IS.foldr f w is return $ IS.foldr f w is
where where
f i' w' = swapItemWith g (j, i') w' f i' w' = swapItemWith g (j, i') w'
@@ -363,10 +358,7 @@ shiftInvItemsDown j is w = fromMaybe w $ do
updateFunctionKeys :: Universe -> Universe updateFunctionKeys :: Universe -> Universe
updateFunctionKeys u = updateFunctionKeys u =
M.foldlWithKey' M.foldlWithKey' updateFunctionKey u (u ^. uvWorld . input . pressedKeys)
updateFunctionKey
u
(u ^. uvWorld . input . pressedKeys)
updateFunctionKey :: Universe -> Scancode -> Int -> Universe updateFunctionKey :: Universe -> Scancode -> Int -> Universe
updateFunctionKey uv sc 0 = case sc of updateFunctionKey uv sc 0 = case sc of
@@ -392,8 +384,9 @@ updateKeysInTerminal tmid u = fromMaybe u $ do
x <- u ^? uvWorld . cWorld . lWorld . buttons . ix (tm ^. tmButtonID) . btPos x <- u ^? uvWorld . cWorld . lWorld . buttons . ix (tm ^. tmButtonID) . btPos
y <- u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crPos y <- u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crPos
return $ case tm ^. tmStatus of return $ case tm ^. tmStatus of
_ | dist x y > 40 || not (hasButtonLOS x y (u ^. uvWorld)) _
-> u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory | dist x y > 40 || not (hasButtonLOS x y (u ^. uvWorld)) ->
u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory
TerminalDeactivated -> u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory TerminalDeactivated -> u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory
TerminalTextInput{} -> updateKeysTextInputTerminal tmid u TerminalTextInput{} -> updateKeysTextInputTerminal tmid u
TerminalPressTo{} -> updateKeyContinueTerminal tmid u TerminalPressTo{} -> updateKeyContinueTerminal tmid u
@@ -401,8 +394,7 @@ updateKeysInTerminal tmid u = fromMaybe u $ do
updateKeyContinueTerminal :: Int -> Universe -> Universe updateKeyContinueTerminal :: Int -> Universe -> Universe
updateKeyContinueTerminal tmid u updateKeyContinueTerminal tmid u
| elem 0 $ u ^. uvWorld . input . pressedKeys = | elem 0 $ u ^. uvWorld . input . pressedKeys = u & uvWorld %~ continueTerminal tmid
u & uvWorld %~ continueTerminal tmid
| otherwise = u | otherwise = u
continueTerminal :: Int -> World -> World continueTerminal :: Int -> World -> World
@@ -421,7 +413,8 @@ updateKeysTextInputTerminal tmid u =
uvWorld %~ terminalReturnEffect tmid uvWorld %~ terminalReturnEffect tmid
| otherwise = id | otherwise = id
tryTabComplete tryTabComplete
| u ^. uvWorld . input . pressedKeys . at ScancodeTab == Just 0 = uvWorld . cWorld . lWorld . terminals . ix tmid %~ tabComplete (u ^. uvWorld) | u ^. uvWorld . input . pressedKeys . at ScancodeTab == Just 0 =
uvWorld . cWorld . lWorld . terminals . ix tmid %~ tabComplete (u ^. uvWorld)
| otherwise = id | otherwise = id
updateKeyInGame :: Universe -> Scancode -> Int -> Universe updateKeyInGame :: Universe -> Scancode -> Int -> Universe
@@ -452,10 +445,10 @@ updateLongPressInGame uv = \case
doRegexInput :: doRegexInput ::
Input -> Input ->
Int -> Int ->
IM.IntMap (SelectionSection a) -> IMSS a ->
Maybe (Int, Int, IS.IntSet) -> Maybe (Int, Int, IS.IntSet) ->
Maybe String -> Maybe String ->
(IM.IntMap (SelectionSection a), Maybe (Int, Int, IS.IntSet), Maybe String) (IMSS a, Maybe (Int, Int, IS.IntSet), Maybe String)
doRegexInput inp i sss msel filts doRegexInput inp i sss msel filts
| backspacetonothing || escapekey = endregex i 0 | backspacetonothing || escapekey = endregex i 0
| endkeys = endregex (i + 1) (j -1) | endkeys = endregex (i + 1) (j -1)
@@ -474,10 +467,7 @@ doRegexInput inp i sss msel filts
itms <- sss ^? ix (i + 1) . ssItems itms <- sss ^? ix (i + 1) . ssItems
fst <$> IM.lookupMin itms fst <$> IM.lookupMin itms
escapekey = ScancodeEscape `M.lookup` pkeys == Just 0 escapekey = ScancodeEscape `M.lookup` pkeys == Just 0
endkeys = endkeys = any ((== Just 0) . (`M.lookup` pkeys)) [ScancodeReturn, ScancodeSlash]
any
((== Just 0) . (`M.lookup` pkeys))
[ScancodeReturn, ScancodeSlash]
backspacetonothing = backspacetonothing =
filts == Just "" filts == Just ""
&& ScancodeBackspace `M.lookup` pkeys == Just 0 && ScancodeBackspace `M.lookup` pkeys == Just 0
@@ -485,10 +475,12 @@ doRegexInput inp i sss msel filts
updateBackspaceRegex :: World -> World updateBackspaceRegex :: World -> World
updateBackspaceRegex w = case di ^? subInventory of updateBackspaceRegex w = case di ^? subInventory of
Just NoSubInventory{} | secfocus (-1) 0 -> Just NoSubInventory{}
| secfocus (-1) 0 ->
w & hud . hudElement %~ trybackspace (-1) diInvFilter diInvFilter diSelection w & hud . hudElement %~ trybackspace (-1) diInvFilter diInvFilter diSelection
& worldEventFlags . at InventoryChange ?~ () & worldEventFlags . at InventoryChange ?~ ()
Just NoSubInventory{} | secfocus 2 3 -> Just NoSubInventory{}
| secfocus 2 3 ->
w & hud . hudElement %~ trybackspace 2 diCloseFilter diCloseFilter diSelection w & hud . hudElement %~ trybackspace 2 diCloseFilter diCloseFilter diSelection
& worldEventFlags . at InventoryChange ?~ () & worldEventFlags . at InventoryChange ?~ ()
Just CombineInventory{} -> Just CombineInventory{} ->
@@ -510,10 +502,12 @@ updateBackspaceRegex w = case di ^? subInventory of
updateEnterRegex :: World -> World updateEnterRegex :: World -> World
updateEnterRegex w = case w ^? hud . hudElement . subInventory of updateEnterRegex w = case w ^? hud . hudElement . subInventory of
Just NoSubInventory{} | secfocus [-1, 0, 1] -> Just NoSubInventory{}
| secfocus [-1, 0, 1] ->
w & hud . hudElement . diSelection ?~ (-1, 0, mempty) w & hud . hudElement . diSelection ?~ (-1, 0, mempty)
& hud . hudElement . diInvFilter %~ enterregex & hud . hudElement . diInvFilter %~ enterregex
Just NoSubInventory{} | secfocus [2, 3] -> Just NoSubInventory{}
| secfocus [2, 3] ->
w & hud . hudElement . diSelection ?~ (2, 0, mempty) w & hud . hudElement . diSelection ?~ (2, 0, mempty)
& hud . hudElement . diCloseFilter %~ enterregex & hud . hudElement . diCloseFilter %~ enterregex
Just CombineInventory{} -> Just CombineInventory{} ->
@@ -527,34 +521,28 @@ updateEnterRegex w = case w ^? hud . hudElement . subInventory of
enterregex = (<|> Just "") enterregex = (<|> Just "")
pauseGame :: Universe -> Universe pauseGame :: Universe -> Universe
pauseGame u = u & uvScreenLayers .~ [pauseMenu u] pauseGame u = u & uvScreenLayers .~ [pauseMenu u] & pauseSound
& pauseSound
spaceAction :: World -> World spaceAction :: World -> World
spaceAction w = case w ^. hud . hudElement of spaceAction w = case w ^. hud . hudElement . subInventory of
DisplayInventory{_subInventory = NoSubInventory{}} -> NoSubInventory -> maybe id interactWithCloseObj (getCloseObj w) w
maybe id interactWithCloseObj (getCloseObj w) w
DisplayInventory{_subInventory = DisplayTerminal{}} ->
w
& hud . hudElement . subInventory .~ NoSubInventory
& worldEventFlags . at InventoryChange ?~ ()
_ -> w & hud . hudElement . subInventory .~ NoSubInventory _ -> w & hud . hudElement . subInventory .~ NoSubInventory
getCloseObj :: World -> Maybe (Either (NewInt ItmInt) Button) getCloseObj :: World -> Maybe (Either (NewInt ItmInt) Button)
getCloseObj w = getSelectedCloseObj w <|> topcitem <|> topcbut getCloseObj w = getSelectedCloseObj w <|> topcitem <|> topcbut
where where
topcitem = do topcitem = do
k' <- (w ^? hud . hudElement . diSections . ix 3 . ssItems) k <- (w ^? hud . hudElement . diSections . ix 3 . ssItems)
>>= (fmap fst . IM.lookupMin) >>= (fmap fst . IM.lookupMin)
Left <$> w ^? hud . closeItems . ix k' Left <$> w ^? hud . closeItems . ix k
topcbut = do topcbut = do
k <- w ^? hud . closeButtons . ix 0 k <- w ^? hud . closeButtons . ix 0
Right <$> w ^? cWorld . lWorld . buttons . ix k Right <$> w ^? cWorld . lWorld . buttons . ix k
tryCombine :: (Int, Int) -> World -> World tryCombine :: (Int, Int) -> World -> World
tryCombine (i, j) w = fromMaybe w $ do tryCombine (i, j) w = fromMaybe w $ do
sss <- w ^? hud . hudElement . subInventory . ciSections CombinableItem is it <- w ^? hud . hudElement . subInventory
CombinableItem is it <- sss ^? ix i . ssItems . ix j . siPayload . _Just . ciSections . ix i . ssItems . ix j . siPayload . _Just
p <- w ^? cWorld . lWorld . creatures . ix 0 . crPos p <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
return $ return $
(createItemYou it (foldr (destroyInvItem 0 . NInt) w (sort is))) (createItemYou it (foldr (destroyInvItem 0 . NInt) w (sort is)))