Allow for ingame terminal input
This commit is contained in:
@@ -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
@@ -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
@@ -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
@@ -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))
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user