This commit is contained in:
2024-09-12 18:30:38 +01:00
parent e69abf1715
commit d2e1b054d0
4 changed files with 24 additions and 22 deletions
+1 -1
View File
@@ -1 +1 @@
All good (615 modules, at 18:14:34) All good (615 modules, at 18:28:18)
+11 -9
View File
@@ -28,6 +28,7 @@ import Geometry
import LensHelp import LensHelp
import SDL import SDL
-- might not need the full universe here
updateUseInputInGame :: Universe -> Universe updateUseInputInGame :: Universe -> Universe
updateUseInputInGame u = case u ^. uvWorld . hud . hudElement of updateUseInputInGame u = case u ^. uvWorld . hud . hudElement of
DisplayCarte -> over uvWorld updatePressedButtonsCarte u DisplayCarte -> over uvWorld updatePressedButtonsCarte u
@@ -40,7 +41,8 @@ updateUseInputInGame u = case u ^. uvWorld . hud . hudElement of
u & uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const True u & uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const True
CombineInventory{_ciSections = sss} CombineInventory{_ciSections = sss}
| inSubInvRegex (u ^. uvWorld) -> | inSubInvRegex (u ^. uvWorld) ->
u & uvWorld . hud . hudElement . subInventory . ciSections %~ doRegexInput u (-1) u & uvWorld . hud . hudElement . subInventory . ciSections
%~ doRegexInput (u ^. uvWorld . input) (-1)
& uvWorld . worldEventFlags . at CombineInventoryChange ?~ () & uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
| lbinitialpress -> | lbinitialpress ->
(uvWorld . worldEventFlags . at InventoryChange ?~ ()) . maybeExitCombine $ (uvWorld . worldEventFlags . at InventoryChange ?~ ()) . maybeExitCombine $
@@ -48,12 +50,12 @@ updateUseInputInGame u = case u ^. uvWorld . hud . hudElement of
& uvWorld . worldEventFlags . at CombineInventoryChange ?~ () & uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
_ _
| inInvRegex (u ^. uvWorld) -> | inInvRegex (u ^. uvWorld) ->
u & uvWorld . hud . hudElement . diSections %~ doRegexInput u (-1) u & uvWorld . hud . hudElement . diSections %~ doRegexInput (u ^. uvWorld . input) (-1)
& uvWorld . worldEventFlags . at InventoryChange ?~ () & uvWorld . worldEventFlags . at InventoryChange ?~ ()
& uvWorld %~ setInvPosFromSS & uvWorld %~ setInvPosFromSS
_ _
| inCloseRegex (u ^. uvWorld) -> | inCloseRegex (u ^. uvWorld) ->
u & uvWorld . hud . hudElement . diSections %~ doRegexInput u 2 u & uvWorld . hud . hudElement . diSections %~ doRegexInput (u ^. uvWorld . input) 2
& uvWorld . worldEventFlags . at InventoryChange ?~ () & uvWorld . worldEventFlags . at InventoryChange ?~ ()
& uvWorld %~ setInvPosFromSS & uvWorld %~ setInvPosFromSS
_ -> M.foldlWithKey' updateKeyInGame u pkeys _ -> M.foldlWithKey' updateKeyInGame u pkeys
@@ -89,7 +91,7 @@ updatePressedButtonsCarte' pkeys w
updateKeysInTerminal :: Int -> Universe -> Universe updateKeysInTerminal :: Int -> Universe -> Universe
updateKeysInTerminal tmid u = updateKeysInTerminal tmid u =
u & doTextInputOver (uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiText) u & doTextInputOverUniverse (uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiText)
& checkEndStatus & checkEndStatus
where where
pkeys = u ^. uvWorld . input . pressedKeys pkeys = u ^. uvWorld . input . pressedKeys
@@ -130,11 +132,11 @@ updateLongPressInGame uv sc = case sc of
ScancodeSpace -> over uvWorld spaceAction uv ScancodeSpace -> over uvWorld spaceAction uv
_ -> uv _ -> uv
doRegexInput :: Universe -> Int -> SelectionSections a -> SelectionSections a doRegexInput :: Input -> Int -> SelectionSections a -> SelectionSections a
doRegexInput u i sss doRegexInput inp i sss
| backspacetonothing || escapekey = endregex i 0 | backspacetonothing || escapekey = endregex i 0
| endkeys || endmouse = endregex (i + 1) (j -1) | endkeys || endmouse = endregex (i + 1) (j -1)
| otherwise = sss & doTextInputOver' u (sssExtra . sssFilters . ix i . _Just) | otherwise = sss & doTextInputOver inp (sssExtra . sssFilters . ix i . _Just)
where where
endregex a b = endregex a b =
sss sss
@@ -149,11 +151,11 @@ doRegexInput u i sss
any any
((== Just InitialPress) . (`M.lookup` pkeys)) ((== Just InitialPress) . (`M.lookup` pkeys))
[ScancodeReturn, ScancodeSlash] [ScancodeReturn, ScancodeSlash]
endmouse = (Just 0 ==) $ u ^? uvWorld . input . mouseButtons . ix ButtonLeft endmouse = (Just 0 ==) $ inp ^? mouseButtons . ix ButtonLeft
backspacetonothing = backspacetonothing =
sss ^? sssExtra . sssFilters . ix i . _Just == Just "" sss ^? sssExtra . sssFilters . ix i . _Just == Just ""
&& ScancodeBackspace `M.lookup` pkeys == Just InitialPress && ScancodeBackspace `M.lookup` pkeys == Just InitialPress
pkeys = u ^. uvWorld . input . pressedKeys pkeys = inp ^. pressedKeys
updateBackspaceRegex :: World -> World updateBackspaceRegex :: World -> World
updateBackspaceRegex w = case di ^? subInventory of updateBackspaceRegex w = case di ^? subInventory of
+1 -1
View File
@@ -24,7 +24,7 @@ updateUseInputOnScreen sl = case sl of
doInputScreenInput :: String -> Universe -> Universe doInputScreenInput :: String -> Universe -> Universe
doInputScreenInput s u = doInputScreenInput s u =
u & doTextInputOver (uvScreenLayers . _head . scInput) u & doTextInputOverUniverse (uvScreenLayers . _head . scInput)
& checkEndStatus & checkEndStatus
where where
ispressed = (`M.member` (u ^. uvWorld . input . pressedKeys)) ispressed = (`M.member` (u ^. uvWorld . input . pressedKeys))
+11 -11
View File
@@ -1,30 +1,30 @@
module Dodge.Update.Input.Text ( module Dodge.Update.Input.Text (
doTextInputOverUniverse,
doTextInputOver, doTextInputOver,
doTextInputOver',
) where ) where
import Data.Either import Data.Either
--import Data.Char import Data.Char
import Dodge.Data.Universe import Dodge.Data.Universe
import LensHelp import LensHelp
import SDL import SDL
doTextInputOver :: ASetter' Universe String -> Universe -> Universe doTextInputOverUniverse :: ASetter' Universe String -> Universe -> Universe
doTextInputOver p u = doTextInputOver' u p u doTextInputOverUniverse p u = doTextInputOver (u ^. uvWorld . input) p u
doTextInputOver' :: Universe -> ASetter' a String -> a -> a doTextInputOver :: Input -> ASetter' a String -> a -> a
doTextInputOver' u p x = doTextInputOver u p x =
--x & p %~ (++ map toUpper (rights str)) x & p %~ (++ map toUpper (rights str))
x & p %~ (++ rights str) --x & p %~ (++ rights str)
& checkBackspace & checkBackspace
where where
str = u ^. uvWorld . input . textInput str = u ^. textInput
checkBackspace checkBackspace
| backspaceInputted u = p %~ doBackspace | backspaceInputted u = p %~ doBackspace
| otherwise = id | otherwise = id
backspaceInputted :: Universe -> Bool backspaceInputted :: Input -> Bool
backspaceInputted u = case u ^. uvWorld . input . pressedKeys . at ScancodeBackspace of backspaceInputted u = case u ^. pressedKeys . at ScancodeBackspace of
Just InitialPress -> True Just InitialPress -> True
Just LongPress -> True Just LongPress -> True
_ -> False _ -> False