From 61722e55e803320a0429995beb6c9436ed8d185c Mon Sep 17 00:00:00 2001 From: justin Date: Wed, 1 Jun 2022 15:42:30 +0100 Subject: [PATCH] Allow for ingame terminal input --- src/Dodge/Creature/YourControl.hs | 10 ++++---- src/Dodge/Data.hs | 2 +- src/Dodge/Event/Keyboard.hs | 40 +++++++++++++++++++++---------- src/Dodge/Event/Menu.hs | 23 +++++------------- src/Dodge/Inventory.hs | 3 ++- src/Dodge/Render/HUD.hs | 3 ++- 6 files changed, 45 insertions(+), 36 deletions(-) diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index c2df9f587..571c68749 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -14,10 +14,12 @@ import qualified Data.Set as S import Data.Maybe {- | The AI equivalent for your control. -} yourControl :: Creature -> World -> World -yourControl cr w = w - & creatures . ix (_crID cr) %~ - (wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons w)) - & updateUsingInput +yourControl cr w = case w ^? hud . hudElement . subInventory . termParams . termInput . _Just of + Just _ -> w + _ -> w + & creatures . ix (_crID cr) %~ + (wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons w)) + & updateUsingInput -- note the order of operation, setting the posture first--this prevents the twist fire bug {- | Turn key presses into creature movement. -} diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index e4eb423bb..38de32ca7 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -388,7 +388,7 @@ data TerminalParams = NoTerminalParams | TerminalParams , _termTitle :: String , _termSel :: Maybe Int , _termOptions :: [(String, World -> World)] - , _termInput :: Maybe (String, String -> World -> World) + , _termInput :: Maybe (T.Text, String -> World -> World) } data TerminalLine = TerminalLineDisplay diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index e0a067e82..b7918eeba 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -22,18 +22,15 @@ import SDL --import Data.Text (unpack) import qualified Data.Text as T +-- annoyingly, the text input event doesn't register backspace, so this has to be +-- dealt with elsewhere handleTextInput :: T.Text -> Universe -> IO (Maybe Universe) -handleTextInput text = return . Just . -- case mState of --- InputScreen {} -> - (menuLayers . ix 0 . scInput %~ updateText) --- _ -> id +handleTextInput text = return . Just . (menuLayers . ix 0 . scInput %~ updateText) + . (uvWorld . hud . hudElement . subInventory . termParams . termInput . _Just . _1 %~ updateText) where - updateText s = case T.unpack text of - "\b" -> undefined - _ -> s `T.append` text - --- | null (_menuLayers w) = return $ Just w --- | otherwise = handleTextInMenu (head $ _menuLayers w) text w + updateText s = case T.unpack text of + ";" -> s + _ -> s `T.append` T.toUpper text {- | Handles keyboard press and release. On release, remove scancode from the 'Set' of pressed keys. @@ -54,12 +51,14 @@ handlePressedKey _ scode w = case scode of ScancodeF5 -> return . Just $ doQuicksave w ScancodeF9 -> return . Just $ loadSaveSlot QuicksaveSlot w ScancodeSemicolon -> return . Just $ gotoTerminal w - _ | null (_menuLayers w) -> return $ uvWorld (handlePressedKeyInGame scode) w + _ | null (_menuLayers w) -> case w ^? uvWorld . hud . hudElement . subInventory . termParams . termInput . _Just of + Just {} -> return $ uvWorld (handlePressedKeyTerminal scode) w + _ -> return $ uvWorld (handlePressedKeyInGame scode) w _ -> handlePressedKeyInMenu (head $ _menuLayers w) scode w handlePressedKeyInGame :: Scancode -> World -> Maybe World handlePressedKeyInGame scode w = case scode of - ScancodeEscape -> Nothing + ScancodeEscape -> Just $ pauseGame $ escapeMap w ScancodeSpace -> Just $ spaceAction w ScancodeP -> Just $ pauseGame $ escapeMap w ScancodeF -> Just $ youDropItem w @@ -71,6 +70,23 @@ handlePressedKeyInGame scode w = case scode of ScancodeI -> Just $ w & hud . hudElement %~ toggleInspectInv _ -> Just w + +handlePressedKeyTerminal :: Scancode -> World -> Maybe World +handlePressedKeyTerminal scode w = case scode of + ScancodeEscape -> Just $ w & hud . hudElement . subInventory .~ NoSubInventory + ScancodeReturn -> Just $ w & doTerminalEffect + ScancodeBackspace -> Just $ w + & hud . hudElement . subInventory . termParams . termInput . _Just . _1 %~ doBackspace + _ -> Just w + where + doBackspace t = case T.unsnoc t of + Nothing -> t + Just (t',_) -> t' + doTerminalEffect w' = fromMaybe w' $ do + f <- w' ^? hud . hudElement . subInventory . termParams . termInput . _Just . _2 + s <- w' ^? hud . hudElement . subInventory . termParams . termInput . _Just . _1 + return $ f (T.unpack s) w' + toggleTweakInv :: HUDElement -> HUDElement toggleTweakInv he = case he of DisplayInventory TweakInventory -> DisplayInventory NoSubInventory diff --git a/src/Dodge/Event/Menu.hs b/src/Dodge/Event/Menu.hs index 72468698e..c710de8c4 100644 --- a/src/Dodge/Event/Menu.hs +++ b/src/Dodge/Event/Menu.hs @@ -1,6 +1,5 @@ module Dodge.Event.Menu ( handlePressedKeyInMenu --- , handleTextInMenu ) where import Dodge.Data import Dodge.Debug.Terminal @@ -9,21 +8,11 @@ import Dodge.Menu.PushPop import Data.Maybe --import Control.Monad ---import Control.Lens +import Control.Lens import SDL --import qualified Debug.Trace import qualified Data.Text as T ---handleTextInMenu :: ScreenLayer -> T.Text -> Universe -> IO (Maybe Universe) ---handleTextInMenu mState text = return . Just . -- case mState of ----- InputScreen {} -> --- (menuLayers . ix 0 . scInput %~ updateText) ----- _ -> id --- where --- updateText s = case T.unpack text of --- "\b" -> undefined --- _ -> s `T.append` text - handlePressedKeyInMenu :: ScreenLayer -> Scancode -> Universe -> IO (Maybe Universe) handlePressedKeyInMenu mState scode = case mState of OptionScreen { _scOptions = mos, _scDefaultEff = defeff} @@ -35,13 +24,13 @@ handlePressedKeyInMenu mState scode = case mState of ScancodeEscape -> popScreen ScancodeReturn -> popScreen . applyTerminalString (T.unpack s) ScancodeTab -> autoCompleteTerminal (T.unpack s) help --- ScancodeBackspace -> return . Just . (menuLayers . ix 0 . scInput %~ doBackspace) - -- text input handled by handleText + ScancodeBackspace -> return . Just . (menuLayers . ix 0 . scInput %~ doBackspace) + -- text input handled by handleTextInput _ -> return . Just where --- doBackspace [_] = ['>'] --- doBackspace (x:xs) = init (x:xs) --- doBackspace _ = ['>'] + doBackspace t = case T.unsnoc t of + Nothing -> t + Just (t',_) -> t' optionListToEffects :: (Universe -> IO (Maybe Universe)) diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index f1d5a8068..5be58bf90 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -42,6 +42,7 @@ import LensHelp import qualified Data.Map.Strict as M --import qualified Data.Set as S import Data.Maybe +import qualified Data.Text as T --import SDL --import Data.List --import System.Random @@ -170,7 +171,7 @@ updateTerminalLine w = case w ^? hud . hudElement . subInventory . termParams . & hud . hudElement . subInventory . termParams . termSel ?~ 0 Just (TerminalLineInput _ func) -> w & hud . hudElement . subInventory . termParams . termFutureLines %~ tail - & hud . hudElement . subInventory . termParams . termInput ?~ ("",func) + & hud . hudElement . subInventory . termParams . termInput ?~ (T.empty,func) -- this looks ugly... updateCloseObjects :: World -> World diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 9f883cf08..7ccbf8fd4 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -24,6 +24,7 @@ import qualified Data.Set as S --import qualified Data.IntSet as IS import Control.Lens import SDL (MouseButton (..)) +import qualified Data.Text as T --import Data.List --import Data.Bifunctor @@ -123,7 +124,7 @@ subInventoryDisplay subinv cfig w = case subinv of where displayTermInput tp = case _termInput tp of Nothing -> id - Just (s,_) -> (++ [('>':s++clockCycle 10 (V.fromList ["_",""]) w,white)]) + Just (s,_) -> (++ [('>':T.unpack s++clockCycle 10 (V.fromList ["_",""]) w,white)]) closeobjectcursor = case selectedCloseObject w of Nothing -> mempty Just (i,co) -> listCursorNS clObjFloatIn 0 cfig (selNumPos i w) (closeObjectCol co) topInvW (invSelSize i w)