Refactor text input

src/Dodge/Data/Input.hs

@@ -28,11 +28,8 @@ data Input = Input
     , _lSelect :: Point2
     , _rSelect :: Point2
     , _clickMousePos :: Point2
-    , _backspaceTimer :: Int
+    , _textInput :: T.Text
-    , _textInput :: TextInput
     }
-data TextInput = RejectTextInput
-    | AcceptTextInput {_textInputText :: T.Text}
 
 data WorldHammer
     = SubInvHam
@@ -40,4 +37,3 @@ data WorldHammer
     deriving (Eq, Ord, Show, Read, Enum, Bounded)
 
 makeLenses ''Input
-makeLenses ''TextInput

src/Dodge/Default/World.hs

@@ -12,7 +12,7 @@ import System.Random
 defaultInput :: Input
 defaultInput = Input
         { _clickMousePos = V2 0 0
-        , _textInput = RejectTextInput
+        , _textInput = mempty
         , _pressedKeys = mempty
         , _mouseButtons = mempty
         , _mousePos = V2 0 0
@@ -24,7 +24,6 @@ defaultInput = Input
         , _rLine = (0, 0)
         , _lSelect = 0
         , _rSelect = 0
-        , _backspaceTimer = 0
     }
 
 defaultWorld :: World

src/Dodge/Event.hs

@@ -23,7 +23,7 @@ import SDL
 
 handleEvent :: Event -> Universe -> IO (Maybe Universe)
 handleEvent e = case eventPayload e of
-    TextInputEvent tev -> return . Just . (handleTextInput (textInputEventText tev))
+    TextInputEvent tev -> return . Just . handleTextInput (textInputEventText tev)
     KeyboardEvent kev -> handleKeyboardEvent kev
     MouseMotionEvent mmev -> return . handleMouseMotionEvent mmev
     MouseButtonEvent mbev -> return . Just . over uvWorld (handleMouseButtonEvent mbev)

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 = uvWorld . input . textInput %~ T.append text
-handleTextInput text u = u
+--handleTextInput text u = u
-        & uvScreenLayers . ix 0 . scInput %~ updateText
+--        & uvScreenLayers . ix 0 . scInput %~ updateText
-        & updateTerminalText
+--        & updateTerminalText
-  where
+--  where
-    updateTerminalText = case u ^? uvWorld . cWorld . lWorld . hud . hudElement . subInventory of
+--    updateTerminalText = case u ^? uvWorld . cWorld . lWorld . hud . hudElement . subInventory of
-        Just (DisplayTerminal tmid)
+--        Just (DisplayTerminal tmid)
-            | hasfocus tmid ->
+--            | hasfocus tmid ->
-                uvWorld %~ \w -> guardDisconnectedID tmid w (w & cWorld . lWorld . terminals . ix tmid . tmInput . tiText %~ updateText)
+--                uvWorld %~ \w -> guardDisconnectedID tmid w (w & cWorld . lWorld . terminals . ix tmid . tmInput . tiText %~ updateText)
-        _ -> id
+--        _ -> id
-    hasfocus tmid = fromMaybe False $ u ^? uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus
+--    hasfocus tmid = fromMaybe False $ u ^? uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus
-    updateText s = case T.unpack text of
+--    updateText s = case T.unpack text of
-        ";" -> s
+--        ";" -> s
-        _ -> s `T.append` T.toUpper text
+--        _ -> 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
+--doBackspace :: T.Text -> T.Text
-handlePressedKeyInGame scode uv = case scode of
+--doBackspace t = case T.unsnoc t of
-    _ -> uv
+--    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)) ->

src/Dodge/Update.hs

@@ -63,7 +63,10 @@ import Sound.Data
 import StrictHelp
 
 updateUniverse :: Universe -> Universe
-updateUniverse u = updateUniverseLast . updateUniverseMid
+updateUniverse u = 
+    updateUniverseLast 
+    . over (uvWorld . input . textInput) (const mempty)
+    . updateUniverseMid
         . updateUseInput
         . over uvWorld (updateCamera cfig)
         . over (uvWorld . cWorld . cClock) ( + 1)
@@ -72,7 +75,9 @@ updateUniverse u = updateUniverseLast . updateUniverseMid
     cfig = u ^. uvConfig
 
 updateUseInput :: Universe -> Universe
-updateUseInput u = M.foldlWithKey' updateKeyInGame u (u ^. uvWorld . input . pressedKeys)
+updateUseInput u = case u ^? uvScreenLayers . _head of
+    Just InputScreen{} -> doInputScreenInput u
+    _ -> M.foldlWithKey' updateKeyInGame u (u ^. uvWorld . input . pressedKeys)
 
 
 updateUniverseLast :: Universe -> Universe

src/Dodge/Update/Input.hs

@@ -1,5 +1,6 @@
 module Dodge.Update.Input 
     ( updateKeyInGame
+    , doInputScreenInput
     ) where
 
 import Dodge.WorldPos
@@ -14,6 +15,24 @@ import Dodge.Menu
 import Dodge.Data.Universe
 import SDL
 import LensHelp
+import qualified Data.Text as T
+
+doInputScreenInput :: Universe -> Universe
+doInputScreenInput u = u & uvScreenLayers . _head . scInput %~ (`T.append` thetext)
+    & checkBackspace
+  where
+    thetext = u ^. uvWorld . input . textInput
+    checkBackspace = case u ^. uvWorld . input . pressedKeys . at ScancodeBackspace of
+        Just InitialPress -> f
+        Just LongPress -> f
+        _ -> id
+    f = uvScreenLayers . _head . scInput %~ doBackspace
+
+doBackspace :: T.Text -> T.Text
+doBackspace t = case T.unsnoc t of
+    Nothing -> t
+    Just (t', _) -> t'
+
 
 updateKeyInGame :: Universe -> Scancode -> PressType -> Universe
 updateKeyInGame  uv sc InitialPress = case sc of