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

More cleanup

Browse Source
This commit is contained in:
justin
2022-12-27 14:53:59 +00:00
parent 9ada489993
commit c71af99ff7
1 changed files with 45 additions and 43 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Update/Input.hs
+45 -43
View File
@@ -1,38 +1,37 @@
module Dodge.Update.Input module Dodge.Update.Input (
( updateKeyInGame updateKeyInGame,
, updateKeysInTerminal updateKeysInTerminal,
, doInputScreenInput doInputScreenInput,
) where ) where
import Dodge.Terminal.LeftButton
import Dodge.Save
import Dodge.Debug.Terminal
import Dodge.WorldPos
import Dodge.Button.Event
import Dodge.Inventory
import Dodge.Combine
import Dodge.Event.Test
import Dodge.Base.You
import Dodge.Reloading
import Dodge.Creature.Action
import Dodge.Menu
import Dodge.Data.Universe
import SDL
import LensHelp
import qualified Data.Text as T
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import qualified Data.Text as T
import Dodge.Base.You
import Dodge.Button.Event
import Dodge.Combine
import Dodge.Creature.Action
import Dodge.Data.Universe
import Dodge.Debug.Terminal
import Dodge.Event.Test
import Dodge.Inventory
import Dodge.Menu
import Dodge.Reloading
import Dodge.Save
import Dodge.Terminal.LeftButton
import Dodge.WorldPos
import LensHelp
import SDL
doInputScreenInput :: T.Text -> Universe -> Universe doInputScreenInput :: T.Text -> Universe -> Universe
doInputScreenInput s u = u & uvScreenLayers . _head . scInput %~ (`T.append` T.toUpper thetext) doInputScreenInput s u =
& checkBackspace u & uvScreenLayers . _head . scInput %~ (`T.append` T.toUpper thetext)
& checkEndStatus & checkBackspace
& checkEndStatus
where where
thetext = u ^. uvWorld . input . textInput thetext = u ^. uvWorld . input . textInput
checkBackspace = case u ^. uvWorld . input . pressedKeys . at ScancodeBackspace of checkBackspace
Just InitialPress -> f | backspaceInputted u = uvScreenLayers . _head . scInput %~ doBackspace
Just LongPress -> f | otherwise = id
_ -> id
f = uvScreenLayers . _head . scInput %~ doBackspace
pkeys = u ^. uvWorld . input . pressedKeys pkeys = u ^. uvWorld . input . pressedKeys
checkEndStatus checkEndStatus
| ScancodeReturn `M.member` pkeys = (uvScreenLayers %~ tail) . applyTerminalString (words $ T.unpack s) | ScancodeReturn `M.member` pkeys = (uvScreenLayers %~ tail) . applyTerminalString (words $ T.unpack s)
@@ -44,28 +43,31 @@ doBackspace t = case T.unsnoc t of
Nothing -> t Nothing -> t
Just (t', _) -> t' Just (t', _) -> t'
backspaceInputted :: Universe -> Bool
backspaceInputted u = case u ^. uvWorld . input . pressedKeys . at ScancodeBackspace of
Just InitialPress -> True
Just LongPress -> True
_ -> False
updateKeysInTerminal :: Int -> Universe -> Universe updateKeysInTerminal :: Int -> Universe -> Universe
updateKeysInTerminal tmid u= u & tmpoint %~ (`T.append` T.toUpper thetext) updateKeysInTerminal tmid u =
& checkBackspace u & tmpoint %~ (`T.append` T.toUpper thetext)
& checkEndStatus & checkBackspace
& checkEndStatus
where where
tmpoint = uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiText tmpoint = uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiText
thetext = u ^. uvWorld . input . textInput thetext = u ^. uvWorld . input . textInput
checkBackspace = case u ^. uvWorld . input . pressedKeys . at ScancodeBackspace of checkBackspace
Just InitialPress -> f | backspaceInputted u = tmpoint %~ doBackspace
Just LongPress -> f | otherwise = id
_ -> id
f = tmpoint %~ doBackspace
pkeys = u ^. uvWorld . input . pressedKeys pkeys = u ^. uvWorld . input . pressedKeys
checkEndStatus checkEndStatus
| pkeys ^. at ScancodeReturn == Just InitialPress | pkeys ^. at ScancodeReturn == Just InitialPress =
= over uvWorld (\w -> terminalReturnEffect (w ^?! cWorld . lWorld . terminals . ix tmid) w) over uvWorld (\w -> terminalReturnEffect (w ^?! cWorld . lWorld . terminals . ix tmid) w)
-- | pkeys ^. at ScancodeEscape == Just InitialPress
-- = uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const False
| otherwise = id | otherwise = id
updateKeyInGame :: Universe -> Scancode -> PressType -> Universe updateKeyInGame :: Universe -> Scancode -> PressType -> Universe
updateKeyInGame uv sc InitialPress = case sc of updateKeyInGame uv sc InitialPress = case sc of
ScancodeF5 -> doQuicksave uv ScancodeF5 -> doQuicksave uv
ScancodeF9 -> loadSaveSlot QuicksaveSlot uv ScancodeF9 -> loadSaveSlot QuicksaveSlot uv
ScancodeEscape -> pauseGame uv ScancodeEscape -> pauseGame uv
@@ -80,7 +82,7 @@ updateKeyInGame uv sc InitialPress = case sc of
_ -> uv _ -> uv
where where
w = _uvWorld uv w = _uvWorld uv
updateKeyInGame uv _ _ = uv updateKeyInGame uv _ _ = uv
pauseGame :: Universe -> Universe pauseGame :: Universe -> Universe
pauseGame u = u & uvScreenLayers .~ [pauseMenu u] pauseGame u = u & uvScreenLayers .~ [pauseMenu u]