Allow for ingame terminal input

This commit is contained in:
2022-06-01 15:42:30 +01:00
parent 2cedc1b968
commit 61722e55e8
6 changed files with 45 additions and 36 deletions
+6 -4
View File
@@ -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. -}
+1 -1
View File
@@ -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
+28 -12
View File
@@ -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
+6 -17
View File
@@ -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))
+2 -1
View File
@@ -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
+2 -1
View File
@@ -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)