Work on press-continue terminal prompts

src/Dodge/Data/Input.hs

@@ -29,6 +29,7 @@ data MouseContext
     | OverCombFilter
     | OverCombEscape
     | OverTerminalReturn {_mcoTermID :: Int}
+    | OverTerminalContinue {_mcoTermID :: Int}
     | OverTerminalEscape
     | MouseGameRotate
     deriving (Show)

src/Dodge/Data/Terminal.hs

@@ -36,7 +36,6 @@ data Terminal = Terminal
     , _tmStatus :: TerminalStatus
     , _tmCommandHistory :: [String]
     , _tmToggles :: M.Map String TerminalToggle
---    , _tmPartialCommand :: Maybe TerminalCommand
     }
 
 data TerminalLineString = TerminalLineConst String Color
@@ -77,7 +76,7 @@ data TerminalCommandEffect
 --    , _tcEffect :: TerminalCommandEffect -- Terminal -> World -> EffectArguments
 --    }
 
-data TCom = TCInfo String String
+data TCom = TCInfo String String -- this may not be necessary, to revisit
     | TCBase
     | TCDamageCommand
     | TCSensorInfo

src/Dodge/Data/Terminal/Status.hs

@@ -9,7 +9,7 @@ import Data.Aeson.TH
 
 data TerminalStatus
     = TerminalOff
-    | TerminalBusy
+    | TerminalLineRead
     | TerminalTextInput {_tiText :: String}
     | TerminalPressTo {_tptString :: String}
     deriving (Eq)

src/Dodge/Data/WorldEffect.hs

@@ -20,7 +20,7 @@ data ItCrWdWd = ItCrWdItemHeldEffect
 data WdWd
     = NoWorldEffect
     | SetTrigger Bool Int
-    | WorldEffects [WdWd]
+    | WorldEffects [WdWd] -- probably best to avoid recursive types if possible...
     | SetLSCol Point3 Int
     | AccessTerminal (Maybe Int)
     | UnlockInv

src/Dodge/Debug/Terminal.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE TupleSections #-}
 
-module Dodge.Debug.Console where
+module Dodge.Debug.Terminal where
 
 import Data.Foldable
 import Dodge.Item.Location.Initialize
@@ -19,14 +19,14 @@ import LensHelp
 import MaybeHelp
 import Text.Read (readMaybe)
 
-applyConsoleString :: [String] -> Universe -> Universe
+applyTerminalString :: [String] -> Universe -> Universe
-applyConsoleString ss = case ss of
+applyTerminalString ss = case ss of
     [] -> id
-    [s] -> applyConsoleCommand s
+    [s] -> applyTerminalCommand s
-    (s : ss') -> applyConsoleCommandArguments s ss'
+    (s : ss') -> applyTerminalCommandArguments s ss'
 
-applyConsoleCommand :: String -> Universe -> Universe
+applyTerminalCommand :: String -> Universe -> Universe
-applyConsoleCommand s = case s of
+applyTerminalCommand s = case s of
     "NOCLIP" -> uvConfig . debug_booleans . at Noclip %~ toggleJust
     ['L', x] ->
             (uvWorld . cWorld . lWorld %~ initSpecificCrItemLocations 0)
@@ -39,8 +39,8 @@ applyConsoleCommand s = case s of
         (ibt, n) <- parseItem [x]
         return $ uvWorld %~ flip (foldl' (&)) (replicate n (snd . createItemYou (itemFromBase ibt)))
 
-applyConsoleCommandArguments :: String -> [String] -> Universe -> Universe
+applyTerminalCommandArguments :: String -> [String] -> Universe -> Universe
-applyConsoleCommandArguments command args u = case command of
+applyTerminalCommandArguments command args u = case command of
     "IT" -> fromMaybe u $ do
         (ibt, n) <- parseItem args
         return $ u & uvWorld %~ flip (foldl' (&)) (replicate n (snd . createItemYou (itemFromBase ibt)))
@@ -75,33 +75,33 @@ parseItem [] = Nothing
 parseNum :: [String] -> Int
 parseNum xs = fromMaybe 1 $ xs ^? ix 0 >>= readMaybe
 
-showConsoleError :: String -> String -> Universe -> Universe
+showTerminalError :: String -> String -> Universe -> Universe
-showConsoleError cmd s = uvScreenLayers .:~ InputScreen cmd s
+showTerminalError cmd s = uvScreenLayers .:~ InputScreen cmd s
 
-applySetConsoleString :: String -> Universe -> Universe
+applySetTerminalString :: String -> Universe -> Universe
-applySetConsoleString [] = id
+applySetTerminalString [] = id
-applySetConsoleString var = case key' of
+applySetTerminalString var = case key' of
-    "" -> showConsoleError ("set " ++ var) ("Unable to read as argument as float: " ++ val)
+    "" -> showTerminalError ("set " ++ var) ("Unable to read as argument as float: " ++ val)
     "hp" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crHP .~ round (fromJust val')
 --    "invcap" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crInvCapacity .~ round (fromJust val')
 --    "mass" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crMass .~ fromJust val'
 --    "mvspeed" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crMvType . mvSpeed .~ fromJust val'
     "mvspeed" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crType . avMoveSpeed .~ fromJust val'
-    _ -> showConsoleError ("set " ++ var) ("Invalid set command: " ++ key) -- never reached?
+    _ -> showTerminalError ("set " ++ var) ("Invalid set command: " ++ key) -- never reached?
   where
     (key, val) = getSplitString var
     val' = readMaybe val :: Maybe Float
     key' = if isNothing val' then "" else key
 
---autoCompleteConsole :: String -> String -> Universe -> IO (Maybe Universe)
+--autoCompleteTerminal :: String -> String -> Universe -> IO (Maybe Universe)
---autoCompleteConsole s _ =
+--autoCompleteTerminal s _ =
 --    return
 --        . (popScreen' >=> pushScreen' (InputScreen (T.pack input_str) valid_commands))
 --  where
 --    (key, val) = getSplitString $ tail s
 --    command_options = case val of
---        "" -> filter (isInfixOf key) (validConsoleCommands "")
+--        "" -> filter (isInfixOf key) (validTerminalCommands "")
---        _ -> filter (isInfixOf val) (validConsoleCommands key)
+--        _ -> filter (isInfixOf val) (validTerminalCommands key)
 --    -- basic autocomplete if single option available (or as far as possible)
 --    input_str = case (key, val) of
 --        (_, "") ->
@@ -117,7 +117,7 @@ applySetConsoleString var = case key' of
 --                        else ">" ++ key ++ " " ++ longestCommonPrefix command_options
 --    command_options' =
 --        if not (null command_options) && head command_options == key
---            then validConsoleCommands key
+--            then validTerminalCommands key
 --            else command_options
 --
 --    --val' = Debug.Trace.trace key tail val
@@ -129,12 +129,12 @@ getSplitString str = case break (== ' ') str of
     (a, _) -> (a, "")
 
 isValidCommand :: String -> String -> Bool
-isValidCommand arg1 arg2 = arg2 `elem` validConsoleCommands arg1
+isValidCommand arg1 arg2 = arg2 `elem` validTerminalCommands arg1
-validConsoleCommands :: String -> [String]
+
-validConsoleCommands "set" = ["hp", "invcap", "invsel", "mass", "mvspeed"]
+validTerminalCommands :: String -> [String]
-validConsoleCommands "god" = ["on", "off"]
+validTerminalCommands "set" = ["hp", "invcap", "invsel", "mass", "mvspeed"]
-validConsoleCommands _ = ["set", "spawn", "god"]
+validTerminalCommands "god" = ["on", "off"]
-validConsoleCommands _ = ["set", "spawn", "god"]
+validTerminalCommands _ = ["set", "spawn", "god"]
 
 loadme :: a
 loadme = undefined

src/Dodge/Default/Terminal.hs

@@ -16,7 +16,7 @@ defaultTerminal =
         , _tmMachineID = 0
         , _tmDisplayedLines = []
         , _tmFutureLines = []
-        , _tmCommands = [TCInfo "TESA" "text 2",TCInfo "TEST" "display text",TCBase]
+        , _tmCommands = [TCBase]
         , _tmDeathEffect = TmWdWdDoDeathTriggers
         , _tmStatus = TerminalOff
         , _tmCommandHistory = []

src/Dodge/Render/HUD.hs

@@ -383,17 +383,11 @@ drawTerminalDisplay tid cfig w = fromMaybe mempty $ do
             $ _tmDisplayedLines tm
     displayTermInput tm = case _tmStatus tm of
         TerminalOff -> id
-        TerminalBusy -> (++ [([cFilledRect], white)])
+        TerminalLineRead -> id
         TerminalTextInput s ->
             (++ [(getPromptTM ++ s ++ [cFilledRect], white)])
         TerminalPressTo s ->
-            (++ [("PRESS TO "++s, white)])
+            (++ [(getPromptTM ++ "PRESS TO "++s, white)])
---    partcommand tm = maybe "" (++ " ") $ tm ^? tmPartialCommand . _Just . tcString
---    displayInputText tm s
---        | TerminalTextInput <- _tmStatus tm = getPromptTM ++ s 
-----        | _tmStatus tm == TerminalReady = partcommand tm ++ getPromptTM ++ s
---        | otherwise = ""
-
 --        | hasfoc = clockCycle 10 (V.fromList [[cFilledRect] , "."]) w
 
 lnkMidPosInvSelsCol :: Configuration -> World -> Int -> Color -> [Int] -> Picture

src/Dodge/Render/Picture.hs

@@ -109,6 +109,7 @@ mouseCursorType u = case u ^. uvWorld . input . mouseContext of
     OverCombFilter{} -> drawJumpDown 5
     OverCombCombine{} -> drawGapPlus 5
     OverCombEscape -> rotate (pi / 4) $ drawPlus 5
+    OverTerminalContinue{} -> drawReturn 5
     OverTerminalReturn{} -> drawReturn 5
     OverTerminalEscape -> rotate (pi / 4) $ drawPlus 5
     MouseGameRotate -> rotate a (drawVerticalDoubleArrow 5)

src/Dodge/Room/RezBox.hs

@@ -1,5 +1,6 @@
 module Dodge.Room.RezBox where
 
+import Dodge.Default.Terminal
 import Dodge.Terminal
 import Control.Monad
 import qualified Data.Set as S
@@ -25,12 +26,14 @@ rezBox :: LightSource -> Room
 rezBox ls =
     roomRect 40 60 1 1
         & rmPmnts .~ [sPS (V2 20 1) 0 $ PutLS ls
-            , putMessageTerminal terminalColor (simpleTermMessage ["HELLOW","THIS"])
+            , putMessageTerminal terminalColor (defaultTerminal & tmBootLines .~ (makeTermPara s) <> tlSetStatus (TerminalPressTo "QUIT") <> [TLine 1 [] TmWdWdDisconnectTerminal])
                 & plSpot .~ PS (V2 20 0) 0
             ]
         & restrictInLinks (\(V2 _ h, _) -> h < 1)
         & restrictOutLinks (\(V2 _ h, _) -> h > 59)
         & rmName .~ "rezBox"
+  where
+    s = "RESPAWN POINT SET AT THIS LOCATION."
 
 rezBox' :: RandomGen g => State g (MetaTree Room String)
 rezBox' = do

src/Dodge/Terminal.hs

@@ -1,12 +1,7 @@
 {-# LANGUAGE LambdaCase #-}
 
 module Dodge.Terminal (
-    --    doTerminalCommandEffect,
     makeTermLine,
-    --    commandFutureLines,
-    --    quitCommand,
-    --    helpCommand,
-    --    commandsCommand,
     connectionBlurbLines,
     disconnectTerminal,
     textTerminal,
@@ -21,6 +16,7 @@ module Dodge.Terminal (
     makeColorTermPara,
     commandColor,
     tabComplete,
+    tlSetStatus,
 ) where
 
 --import Dodge.Data.WorldEffect
@@ -158,9 +154,7 @@ helpCommand = PTE.singleton "HELP" (fmap makeTermPara helpStrings)
 helpStrings :: PTE.TrieMap Char String
 helpStrings =
     PTE.fromList
-        [ ("", "THIS TERMINAL PROCESSES TEXT INPUT. USE [TAB] FOR AVAILABLE COMMANDS AND AUTOCOMPLETE.")
+        [ ("", "THIS TERMINAL PROCESSES KEYBOARD INPUT. USE [RETURN] OR [LMB] TO REGISTER YOUR INPUT. AVAILABLE COMMANDS CAN BE SCROLLED THROUGH, HOLD [RMB] TO SCROLL THROUGH ARGUMENTS. USE [TAB] FOR AUTOCOMPLETE.")
-        , ("HELP", "BASIC HELP. ACCEPTS A COMMAND AS AN ARGUMENT.")
-        , ("QUIT", "SHUTDOWN TERMINAL.")
         ]
 
 quitCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
@@ -169,6 +163,9 @@ quitCommand = PTE.singleton "QUIT" (PTE.singleton "" [TLine 0 [] TmWdWdDisconnec
 makeTermLine :: String -> TerminalLine
 makeTermLine = makeColorTermLine termTextColor
 
+tlSetStatus :: TerminalStatus -> [TerminalLine]
+tlSetStatus x = [TLine 1 [] $ TmTmSetStatus x]
+
 makeTermPara :: String -> [TerminalLine]
 makeTermPara = makeColorTermPara termTextColor
 
@@ -192,12 +189,13 @@ tabComplete s' tm = case PTE.lookup s $ getCommands tm of
     a = fromMaybe "" $ ss ^? ix 1
     f y m' = case fmap fst m' of
         [] -> tm
-        [x] -> tm & tmStatus .~ TerminalTextInput (y ++ x)
+        [x] -> tm & tmStatus . tiText .~ (y ++ x)
         xs ->
-            tm & tmFutureLines
+            tm  & tmStatus .~ TerminalLineRead
-                .~ makeColorTermPara
+                & tmFutureLines
+                .~ (makeColorTermPara
                     commandColor
-                    (unwords xs)
+                    (unwords xs) <> [TLine 1 [] . TmTmSetStatus $ TerminalTextInput s])
 
 --doTerminalCommandEffect :: TerminalCommandEffect -> Terminal -> World -> EffectArguments
 --doTerminalCommandEffect tce = case tce of
@@ -274,8 +272,7 @@ disconnectTerminal :: Terminal -> World -> World
 disconnectTerminal tm =
     (cWorld . lWorld . terminals . ix (_tmID tm) . tmStatus .~ TerminalOff)
         . exitTerminalSubInv
-        . ( cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines
+        . ( cWorld . lWorld . terminals . ix (_tmID tm) . tmDisplayedLines .~ []
-                .~ [TLine 0 [] TmTmClearDisplayedLines]
           )
 
 exitTerminalSubInv :: World -> World
@@ -342,11 +339,9 @@ terminalReturnEffect tmid w = fromMaybe w $ do
 runTerminalInput :: String -> Terminal -> World -> World
 runTerminalInput s tm w =
     w & cWorld . lWorld . terminals . ix (_tmID tm)
-        %~ ( --(tmInput .~ TerminalInput{ _tiSel = (0, 0)})
+        %~ ( (tmFutureLines ++.~ ss <> [TLine 1 [] (TmTmSetStatus $ TerminalTextInput "")])
-
-             (tmFutureLines ++.~ ss)
                 . (tmCommandHistory %~ take 10 . (s :))
-                . (tmStatus .~ TerminalTextInput "")
+                . (tmStatus .~ TerminalLineRead)
            )
   where
     ss = fromMaybe [makeTermLine "ERROR: INPUT NOT RECOGNISED"] $ do

src/Dodge/Terminal/Color.hs

@@ -12,4 +12,4 @@ termScreenColor tm = case tm ^. tmStatus of
     TerminalOff -> Nothing
     TerminalTextInput _ -> Just green
     TerminalPressTo{} -> Just green
-    TerminalBusy -> Just white
+    TerminalLineRead -> Just white

src/Dodge/Update.hs

@@ -7,10 +7,6 @@ Description : Simulation update
 -}
 module Dodge.Update (updateUniverse) where
 
-import Dodge.SpawnAt
-import Dodge.Prop.Moving
-import Dodge.WorldEvent.Explosion
-import Dodge.Data.Object
 import Color
 import Control.Applicative
 import Control.Monad
@@ -27,6 +23,7 @@ import Dodge.Creature.Radius
 import Dodge.Creature.Update
 import Dodge.Damage
 import Dodge.Data.CrWlID
+import Dodge.Data.Object
 import Dodge.Data.Universe
 import Dodge.Debug
 import Dodge.DisplayInventory
@@ -44,6 +41,7 @@ import Dodge.Machine.Update
 import Dodge.ModificationEffect
 import Dodge.PressPlate
 import Dodge.Projectile.Update
+import Dodge.Prop.Moving
 import Dodge.Prop.Update
 import Dodge.RadarBlip
 import Dodge.RadarSweep
@@ -54,6 +52,7 @@ import Dodge.Shockwave.Update
 import Dodge.SmoothScroll
 import Dodge.SoundLogic
 import Dodge.Spark
+import Dodge.SpawnAt
 import Dodge.Terminal.Type
 import Dodge.TractorBeam.Update
 import Dodge.Update.Camera
@@ -64,6 +63,7 @@ import Dodge.Update.Scroll
 import Dodge.Update.WallDamage
 import Dodge.WallCreatureCollisions
 import Dodge.WorldEffect
+import Dodge.WorldEvent.Explosion
 import Dodge.WorldEvent.ThingsHit
 import Dodge.Zoning.Cloud
 import Dodge.Zoning.Creature
@@ -501,20 +501,23 @@ displayTerminalLineString :: TerminalLineString -> (String, Color)
 displayTerminalLineString (TerminalLineConst str col) = (str, col)
 
 tmUpdate :: Terminal -> World -> World
-tmUpdate tm w = case w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines . ix 0 of
+tmUpdate tm w = fromMaybe w $ do
-    Nothing -> w
+    guard $ tm ^. tmStatus == TerminalLineRead
-    Just tl | _tlPause tl > 0 -> w & pointTermParams . tmFutureLines . ix 0 . tlPause -~ 1
+    tl <- w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines . ix 0
-    Just (TLine _ tls g) ->
+    return $ case tl of
+        _ | _tlPause tl > 0 -> w & pointTermParams . tmFutureLines . ix 0 . tlPause -~ 1
+        (TLine _ tls g) ->
             w & pointTermParams
                 %~ ( (tmFutureLines %~ tail)
                         . (tmDisplayedLines %~ (map displayTerminalLineString tls ++))
                    )
                 & doTmWdWd g tm
+  where
     --    Just (TerminalLineEffect _ eff) ->
     --        w
     --            & pointTermParams . tmFutureLines %~ tail
     --            & doTmWdWd eff tm
-  where
+
     pointTermParams = cWorld . lWorld . terminals . ix (_tmID tm)
 
 setOldPos :: Creature -> Creature
@@ -641,7 +644,9 @@ updatePulseLaser pz = case pz ^. pzTimer of
     5 -> (Endo f, [pz & pzTimer -~ 1])
     _ -> (Endo g, [pz & pzTimer -~ 1])
   where
-    f w = dodam thHit
+    f w =
+        dodam
+            thHit
             w
             & cWorld . lWorld . flares <>~ drawLaser cyan (sp : ps)
       where
@@ -653,9 +658,9 @@ updatePulseLaser pz = case pz ^. pzTimer of
         ((p, OWall wl) : _) ->
             cWorld . lWorld . wallDamages . at (_wlID wl) . non mempty
                 .:~ Lasering (pz ^. pzDamage) p (xp - sp)
-        ((_, OPulseBall pb):xs) -> dodam xs
+        ((_, OPulseBall pb) : xs) ->
-            .
+            dodam xs
-            (cWorld . lWorld . pulseBalls . ix (_pbID pb) . pbTimer .~ 0)
+                . (cWorld . lWorld . pulseBalls . ix (_pbID pb) . pbTimer .~ 0)
                 . makeExplosionAt (_pbPos pb `v2z` 20) 0
         _ -> id
     phasev = _pzPhaseV pz
@@ -796,7 +801,9 @@ ppEvents w = IM.foldl' (flip $ \pp -> doPressPlateEvent (_ppEvent pp) pp) w $ w
 
 checkEndGame :: Universe -> Universe
 checkEndGame uv = case w ^? timeFlow . respawnDelay of
-    Just x | x < 0 -> uv -- & uvScreenLayers .~ [gameOverMenu uv]
+    Just x
+        | x < 0 ->
+            uv -- & uvScreenLayers .~ [gameOverMenu uv]
                 & uvWorld . timeFlow .~ NormalTimeFlow
                 & uvWorld %~ respawn
     Just _ -> uv & uvWorld . timeFlow . respawnDelay -~ 1

src/Dodge/Update/Input/InGame.hs

@@ -219,6 +219,7 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
             w & input . mouseContext .~ OverInvDragSelect x (Just $ snd x)
     OverInvSelect x -> startDrag x cfig w
     OverTerminalReturn tmid -> terminalReturnEffect tmid w
+    OverTerminalContinue tmid -> undefined
     OverTerminalEscape -> w & hud . hudElement . subInventory .~ NoSubInventory
     OverCombSelect x ->
         w & hud . hudElement . subInventory . ciSelection ?~ f x
@@ -381,7 +382,19 @@ updateFunctionKey uv ScancodeF4 _ = doDebugTest2 uv
 updateFunctionKey uv _ _ = uv
 
 updateKeysInTerminal :: Int -> Universe -> Universe
-updateKeysInTerminal tmid u =
+updateKeysInTerminal tmid u = fromMaybe u $ do
+    tm <- u ^? uvWorld . cWorld . lWorld . terminals . ix tmid
+    return $ case tm ^. tmStatus of
+        TerminalTextInput{} -> updateKeysTextInputTerminal tmid u
+        TerminalPressTo{} -> updateKeyContinueTerminal tmid u
+        _ -> u
+updateKeyContinueTerminal :: Int -> Universe -> Universe
+updateKeyContinueTerminal tmid u
+    | any (==0) $ u ^. uvWorld . input . pressedKeys =
+        u & uvWorld . cWorld . lWorld . terminals . ix tmid . tmStatus .~ TerminalLineRead
+    | otherwise = u
+updateKeysTextInputTerminal :: Int -> Universe -> Universe
+updateKeysTextInputTerminal tmid u =
     u
         & doTextInputOverUniverse
             (uvWorld . cWorld . lWorld . terminals . ix tmid . tmStatus . tiText)

src/Dodge/Update/Input/ScreenLayer.hs

@@ -11,7 +11,7 @@ import qualified Data.Map.Strict as M
 import Data.Maybe
 import Dodge.Data.ScreenPos
 import Dodge.Data.Universe
-import Dodge.Debug.Console
+import Dodge.Debug.Terminal
 import Dodge.Menu.Option
 import Dodge.SelectionList
 import Dodge.Update.Input.Text
@@ -34,7 +34,7 @@ doInputScreenInput s u =
     checkEndStatus
         | ispressed ScancodeReturn =
             (uvScreenLayers %~ tail)
-                . applyConsoleString (words $ map toUpper s)
+                . applyTerminalString (words $ map toUpper s)
                 . (uvWorld . worldEventFlags . at InventoryChange ?~ ())
         | ispressed ScancodeEscape = uvScreenLayers %~ tail
         | otherwise = id

src/Dodge/WorldEffect.hs

@@ -60,12 +60,12 @@ accessTerminal mtmid w = fromMaybe w $ do
   where
     tryToBoot tm = case _tmStatus tm of
         TerminalTextInput{} -> tm
-        TerminalBusy -> tm
+        TerminalLineRead -> tm
         TerminalPressTo{} -> tm
         TerminalOff ->
             tm
                 & tmFutureLines .~ _tmBootLines tm
-                & tmStatus .~ TerminalBusy
+                & tmStatus .~ TerminalLineRead
 
 torqueCr :: Float -> Int -> World -> World
 torqueCr x cid w