diff --git a/src/Dodge/Data/Input.hs b/src/Dodge/Data/Input.hs index 9862b7d25..e8a7708d3 100644 --- a/src/Dodge/Data/Input.hs +++ b/src/Dodge/Data/Input.hs @@ -28,11 +28,8 @@ data Input = Input , _lSelect :: Point2 , _rSelect :: Point2 , _clickMousePos :: Point2 - , _backspaceTimer :: Int - , _textInput :: TextInput + , _textInput :: T.Text } -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 diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 825c8c78e..63d7fd7a9 100644 --- a/src/Dodge/Default/World.hs +++ b/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 diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 990167eaa..551b1f4ce 100644 --- a/src/Dodge/Event.hs +++ b/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) diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index 6951471ac..99a69291d 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/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 diff --git a/src/Dodge/Event/Menu.hs b/src/Dodge/Event/Menu.hs index f3568a52d..cbe704ddf 100644 --- a/src/Dodge/Event/Menu.hs +++ b/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)) -> diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index e10f1e002..5b735ee11 100644 --- a/src/Dodge/Update.hs +++ b/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 diff --git a/src/Dodge/Update/Input.hs b/src/Dodge/Update/Input.hs index 11b2fda44..8d7b17a7d 100644 --- a/src/Dodge/Update/Input.hs +++ b/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