Refactor text input

src/Dodge/Event/Keyboard.hs

@@ -5,23 +5,14 @@ module Dodge.Event.Keyboard (
     guardDisconnectedID,
 ) where
 
-import Data.Maybe
+--import Data.Maybe
 --import Data.Text (unpack)
 import qualified Data.Text as T
-import Dodge.Base
-import Dodge.Button.Event
-import Dodge.Combine
-import Dodge.Creature.Action
 import Dodge.Data.Universe
 import Dodge.Event.Menu
-import Dodge.Event.Test
 import Dodge.InputFocus
-import Dodge.Inventory
-import Dodge.Menu
-import Dodge.Reloading
 import Dodge.Save
 import Dodge.Terminal.LeftButton
-import Dodge.WorldPos
 import LensHelp
 import SDL
 --import qualified Data.Map.Strict as M
@@ -31,20 +22,20 @@ import SDL
 -- also, note that this currently "doubles" the inputs to both terminals if both
 -- are open
 handleTextInput :: T.Text -> Universe -> Universe
---handleTextInput text = input . textInput . textInputText %~ T.append (T.toUpper text)
-handleTextInput text u = u
-        & uvScreenLayers . ix 0 . scInput %~ updateText
-        & updateTerminalText
-  where
-    updateTerminalText = case u ^? uvWorld . cWorld . lWorld . hud . hudElement . subInventory of
-        Just (DisplayTerminal tmid)
-            | hasfocus tmid ->
-                uvWorld %~ \w -> guardDisconnectedID tmid w (w & cWorld . lWorld . terminals . ix tmid . tmInput . tiText %~ updateText)
-        _ -> id
-    hasfocus tmid = fromMaybe False $ u ^? uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus
-    updateText s = case T.unpack text of
-        ";" -> s
-        _ -> s `T.append` T.toUpper text
+handleTextInput text = uvWorld . input . textInput %~ T.append text
+--handleTextInput text u = u
+--        & uvScreenLayers . ix 0 . scInput %~ updateText
+--        & updateTerminalText
+--  where
+--    updateTerminalText = case u ^? uvWorld . cWorld . lWorld . hud . hudElement . subInventory of
+--        Just (DisplayTerminal tmid)
+--            | hasfocus tmid ->
+--                uvWorld %~ \w -> guardDisconnectedID tmid w (w & cWorld . lWorld . terminals . ix tmid . tmInput . tiText %~ updateText)
+--        _ -> id
+--    hasfocus tmid = fromMaybe False $ u ^? uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus
+--    updateText s = case T.unpack text of
+--        ";" -> s
+--        _ -> s `T.append` T.toUpper text
 
 guardDisconnectedID :: Int -> World -> World -> World
 guardDisconnectedID tmid w w' = case w ^? cWorld . lWorld . terminals . ix tmid . tmStatus of
@@ -71,15 +62,8 @@ handleKeyboardEvent kev u = case keyboardEventKeyMotion kev of
     scode = (keysymScancode . keyboardEventKeysym) kev
 
 handlePressedKey :: Bool -> Scancode -> Universe -> IO (Maybe Universe)
-handlePressedKey True ScancodeBackspace u
-    | _backspaceTimer (_input $ _uvWorld u) <= 0 =
-        handlePressedKey False ScancodeBackspace u
-            <&> _Just . uvWorld . input . backspaceTimer .~ 0
-    | otherwise = return $ Just $ u & uvWorld . input . backspaceTimer -~ 1
 handlePressedKey True _ u = return $ Just u
 handlePressedKey _ scode u = case scode of
---    ScancodeF1 -> Just <$> (writeSaveSlot (SaveSlotNum 1) u >> return u)
---    ScancodeF2 -> Just <$> readSaveSlot (SaveSlotNum 1) u
     ScancodeF5 -> return . Just $ doQuicksave u
     ScancodeF9 -> return . Just $ loadSaveSlot QuicksaveSlot u
     ScancodeSemicolon -> return . Just $ gotoTerminal u
@@ -87,43 +71,21 @@ handlePressedKey _ scode u = case scode of
         Just (DisplayTerminal tmid)
             | inTermFocus (_uvWorld u) ->
                 return $ uvWorld (Just . handlePressedKeyTerminal tmid scode) u
-        _ -> return $ (Just . handlePressedKeyInGame scode) u
+        _ -> return $ Just u
     _ -> handlePressedKeyInMenu (head $ _uvScreenLayers u) scode u
 
-handlePressedKeyInGame :: Scancode -> Universe -> Universe
-handlePressedKeyInGame scode uv = case scode of
-    _ -> uv
+--doBackspace :: T.Text -> T.Text
+--doBackspace t = case T.unsnoc t of
+--    Nothing -> t
+--    Just (t', _) -> t'
 
 handlePressedKeyTerminal :: Int -> Scancode -> World -> World
 handlePressedKeyTerminal tmid scode w = case scode of
     ScancodeEscape -> w & cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const False
     ScancodeReturn -> w & terminalReturnEffect (w ^?! cWorld . lWorld . terminals . ix tmid)
-    ScancodeBackspace ->
-        w
-            & cWorld . lWorld . terminals . ix tmid . tmInput . tiText %~ doBackspace
-            & input . backspaceTimer .~ 5
     _ -> w
-  where
-    doBackspace t = case T.unsnoc t of
-        Nothing -> t
-        Just (t', _) -> t'
-
 
 gotoTerminal :: Universe -> Universe
 gotoTerminal w = case _uvScreenLayers w of
     (InputScreen{} : _) -> w
     _ -> w & uvScreenLayers .:~ InputScreen T.empty "Enter command"
-
-
-pauseGame :: Universe -> Universe
-pauseGame = uvScreenLayers .~ [pauseMenu]
-
-toggleMap :: World -> World
-toggleMap w = case w ^?! cWorld . lWorld . hud . hudElement of
-    DisplayCarte -> w & cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory
-    _ -> w & cWorld . lWorld . hud . hudElement .~ DisplayCarte
-
-escapeMap :: World -> World
-escapeMap w = case w ^?! cWorld . lWorld . hud . hudElement of
-    DisplayCarte -> w & cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory
-    _ -> w

src/Dodge/Event/Menu.hs

@@ -22,13 +22,7 @@ handlePressedKeyInMenu mState scode = case mState of
         ScancodeEscape -> popScreen
         ScancodeReturn -> popScreen . applyTerminalString (words $ T.unpack s)
         ScancodeTab -> autoCompleteTerminal (T.unpack s) help
-        ScancodeBackspace -> return . Just . (uvScreenLayers . ix 0 . scInput %~ doBackspace)
-        -- text input handled by handleTextInput
         _ -> return . Just
-  where
-    doBackspace t = case T.unsnoc t of
-        Nothing -> t
-        Just (t', _) -> t'
 
 optionListToEffects ::
     (Universe -> IO (Maybe Universe)) ->