Start to refactor terminals

src/Dodge/Terminal.hs

@@ -1,4 +1,5 @@
 module Dodge.Terminal (
+    doTerminalEffectLB,
     doTerminalCommandEffect,
     makeTermLine,
     commandFutureLines,
@@ -14,8 +15,10 @@ module Dodge.Terminal (
     makeColorTermLine,
     makeTermPara,
     toggleCommand,
+    terminalReturnEffect,
 ) where
 
+import Control.Monad
 import Color
 import Data.Char
 import Data.Foldable
@@ -55,8 +58,8 @@ connectionBlurbLines tls =
 quitCommand :: TerminalCommand
 quitCommand =
     TerminalCommand
-        { _tcString = "quit"
-        , _tcAlias = ["q", "exit", "x", "shutdown", ""]
+        { _tcString = "QUIT"
+        , _tcAlias = ["Q", "EXIT", "X", "SHUTDOWN", ""]
         , _tcHelp = "Disconnects the terminal."
         , _tcEffect = TerminalCommandArguments $ NoArguments [TerminalLineEffect 0 TmWdWdDisconnectTerminal]
         }
@@ -64,8 +67,8 @@ quitCommand =
 helpCommand :: TerminalCommand
 helpCommand =
     TerminalCommand
-        { _tcString = "help"
-        , _tcAlias = ["h", "man"]
+        { _tcString = "HELP"
+        , _tcAlias = ["H", "MAN"]
         , _tcHelp = "Displays help for a specific command."
         , _tcEffect = TerminalCommandEffectHelp -- \tm -> OneArgument "AN AVAILABLE COMMAND" . getCommandsHelp tm
         }
@@ -91,8 +94,8 @@ getCommandsHelp tm w = foldr f mempty $ getCommands tm
 commandsCommand :: TerminalCommand
 commandsCommand =
     TerminalCommand
-        { _tcString = "commands"
-        , _tcAlias = ["command", "com"]
+        { _tcString = "COMMANDS"
+        , _tcAlias = ["COMMAND", "COM"]
         , _tcHelp = "Displays available commands."
         , _tcEffect = TerminalCommandEffectCommands
         }
@@ -119,10 +122,10 @@ makeTermLine :: String -> TerminalLine
 makeTermLine = makeColorTermLine termTextColor
 
 makeTermPara :: String -> [TerminalLine]
-makeTermPara = map makeTermLine . makeParagraph 60
+makeTermPara = makeColorTermPara termTextColor
 
 makeColorTermPara :: Color -> String -> [TerminalLine]
-makeColorTermPara col = map (makeColorTermLine col) . makeParagraph 60
+makeColorTermPara col = map (makeColorTermLine col) . makeParagraph 55
 
 makeColorTermLine :: Color -> String -> TerminalLine
 makeColorTermLine col str = TerminalLineDisplay 0 $ TerminalLineConst str col
@@ -194,8 +197,8 @@ getSensor f tm w =
 toggleCommand :: TerminalCommand
 toggleCommand =
     TerminalCommand
-        { _tcString = "toggle"
-        , _tcAlias = ["tog"]
+        { _tcString = "TOGGLE"
+        , _tcAlias = ["TOG"]
         , _tcHelp = "Performs a reversable effect."
         , _tcEffect = TerminalCommandEffectLinkedObject -- \tm _ -> OneArgument "A LINKED OBJECT" (togglesToEffects tm)
         }
@@ -206,8 +209,8 @@ decodedtmap = M.mapKeys show . M.map ((: []) . makeTermLine . show)
 sensorCommand :: TerminalCommand
 sensorCommand =
     TerminalCommand
-        { _tcString = "sensor"
-        , _tcAlias = ["sen"]
+        { _tcString = "SENSOR"
+        , _tcAlias = ["SEN"]
         , _tcHelp = "Access information concerning the connected sensor."
         , _tcEffect = TerminalCommandEffectSensorParameter -- \tm -> OneArgument "A SENSOR PARAMETER" . sensorInfoMap tm
         }
@@ -229,8 +232,8 @@ exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of
 damageCodeCommand :: TerminalCommand
 damageCodeCommand =
     TerminalCommand
-        { _tcString = "damagecode"
-        , _tcAlias = ["dcode", "dc"]
+        { _tcString = "DAMAGECODE"
+        , _tcAlias = ["DCODE", "DC"]
         , _tcHelp = "Displays the shape and color associated with a given damage type."
         , _tcEffect = TerminalCommandEffectDamageCoding -- \_ -> OneArgument "A DAMAGE TYPE" . getDamageCoding
         }
@@ -269,3 +272,36 @@ commandFutureLines s tm w = fromMaybe [errline "^ Invalid command"] $ do
                         safeHead args >>= (m M.!?)
   where
     errline = makeColorTermLine red
+
+terminalReturnEffect :: Terminal -> World -> World
+terminalReturnEffect tm w = fromMaybe w $ do
+    guard $ _tmStatus tm == TerminalReady
+    s <- w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmInput . tiText
+    let pc = maybe "" (++ " ") $ tm ^? tmPartialCommand . _Just . tcString
+    return $
+        runTerminalString (pc ++ s) tm $
+            w
+                & cWorld . lWorld . terminals . ix (_tmID tm) . tmPartialCommand .~ Nothing
+                & cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines
+                    .~ [makeTermLine (pc ++ _tmPromptString tm ++ s)]
+
+runTerminalString :: String -> Terminal -> World -> World
+runTerminalString s tm w =
+    w & cWorld . lWorld . terminals . ix (_tmID tm)
+        %~ ( (tmInput .~ TerminalInput{_tiText = mempty, _tiFocus = True, _tiSel = (0, 0)})
+                . (tmFutureLines ++.~ commandFutureLines s tm w)
+                . (tmCommandHistory %~ take 10 . (s :))
+           )
+
+doTerminalEffectLB :: Terminal -> World -> World
+doTerminalEffectLB tm w = fromMaybe w $ do
+    guard (_tmStatus tm == TerminalReady)
+    s <- w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmInput . tiText
+    if null (words s) && null (_tmPartialCommand tm)
+        then Just $ defocusTerminalInput w
+        else return $ terminalReturnEffect tm w
+
+defocusTerminalInput :: World -> World
+defocusTerminalInput w = fromMaybe w $ do
+    tmid <- w ^? hud . hudElement . subInventory . termID
+    return $ w & cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const False