Cleanup

src/Dodge/Terminal.hs

@@ -3,8 +3,6 @@
 module Dodge.Terminal (
     makeTermLine,
     connectionBlurbLines,
-    powerDownTerminal,
-    deactivateTerminal,
     textTerminal,
     simpleTermMessage,
     damageCodeCommand,
@@ -14,14 +12,10 @@ module Dodge.Terminal (
     toggleCommand,
     terminalReturnEffect,
     getCommands,
-    makeColorTermPara,
-    commandColor,
     tabComplete,
     tlSetStatus,
 ) where
 
---import Dodge.Data.WorldEffect
-
 import Color
 import Data.Char
 import qualified Data.List as List
@@ -42,10 +36,7 @@ import LensHelp
 import Sound.Data
 
 textTerminal :: Terminal
-textTerminal =
-    defaultTerminal
-        { _tmBootLines = connectionBlurb
-        }
+textTerminal = defaultTerminal{_tmBootLines = connectionBlurb}
 
 connectionBlurbLines :: [TerminalLine] -> [TerminalLine]
 connectionBlurbLines tls =
@@ -55,53 +46,6 @@ connectionBlurbLines tls =
         ++ tls
         ++ [TLine 10 [TerminalLineConst "READY FOR INPUT" termTextColor] (TmTmSetStatus (TerminalTextInput ""))]
 
---        ++ [TerminalLineEffect 0 (TmTmSetStatus (TerminalTextInput "" 0))]
-
---quitCommand :: TerminalCommand
---quitCommand =
---    TerminalCommand
---        { _tcString = "QUIT"
---        , _tcAlias = ["Q", "EXIT", "X", "SHUTDOWN", ""]
---        , _tcHelp = "Disconnects the terminal."
---        , _tcEffect = TerminalCommandArguments $ NoArguments [TLine 0 [] TmWdWdDisconnectTerminal]
---        }
-
---helpCommand :: TerminalCommand
---helpCommand =
---    TerminalCommand
---        { _tcString = "HELP"
---        , _tcAlias = ["H", "MAN"]
---        , _tcHelp = "Displays help for a specific command."
---        , _tcEffect = TerminalCommandEffectHelp -- \tm -> OneArgument "AN AVAILABLE COMMAND" . getCommandsHelp tm
---        }
-
---getCommandsHelp :: Terminal -> World -> M.Map String [TerminalLine]
---getCommandsHelp tm w = foldr f mempty $ getCommands tm
---  where
---    f tc =
---        M.insert
---            (_tcString tc)
---            ( [ makeTermLine "Command:"
---              , makeColorTermLine commandColor (_tcString tc)
---              , makeTermLine "Aliases:"
---              , makeColorTermLine commandColor (unwords (_tcAlias tc))
---              ]
---                ++ case argumentHelp tc tm w of
---                    (arghelp, Nothing) -> makeTermPara $ _tcHelp tc ++ " " ++ arghelp
---                    (arghelp, Just args) ->
---                        makeTermPara (_tcHelp tc ++ " " ++ arghelp)
---                            ++ [makeColorTermLine commandColor $ unwords args]
---            )
-
---commandsCommand :: TerminalCommand
---commandsCommand =
---    TerminalCommand
---        { _tcString = "COMMANDS"
---        , _tcAlias = ["COMMAND", "COM"]
---        , _tcHelp = "Displays available commands."
---        , _tcEffect = TerminalCommandEffectCommands
---        }
-
 connectionBlurb :: [TerminalLine]
 connectionBlurb = connectionBlurbLines []
 
@@ -208,97 +152,6 @@ tabComplete s' tm = case PTE.lookup s $ getCommands tm of
                         <> [TLine 1 [] . TmTmSetStatus $ TerminalTextInput s]
                    )
 
---doTerminalCommandEffect :: TerminalCommandEffect -> Terminal -> World -> EffectArguments
---doTerminalCommandEffect tce = case tce of
---    TerminalCommandArguments eas -> \_ _ -> eas
---    TerminalCommandEffectDamageCoding -> \_ -> OneArgument "a damage type" . getDamageCoding
---    TerminalCommandEffectSensorParameter -> \tm -> OneArgument "a sensor parameter" . sensorInfoMap tm
---    TerminalCommandEffectLinkedObject -> \tm _ -> OneArgument "a linked object" (togglesToEffects tm)
---    TerminalCommandEffectHelp -> \tm -> OneArgument "an available command" . getCommandsHelp tm
---    TerminalCommandEffectNoArgumentsStr str -> \_ _ -> NoArguments (makeTermPara str)
---    TerminalCommandEffectCommands -> \tm _ ->
---        NoArguments
---            ( makeTermLine "Available commands:" :
---              makeColorTermPara commandColor (unwords (map _tcString $ getCommands tm))
---            )
---    TerminalCommandEffectSingleCommand eff followingLines -> \_ _ -> NoArguments $ TLine 0 [] (TmWdWdfromWdWd eff) : map makeTermLine followingLines
---    TerminalCommandEffectNone -> \_ _ -> NoArguments []
-
---argumentHelp :: TerminalCommand -> Terminal -> World -> (String, Maybe [String])
---argumentHelp tc tm w = case doTerminalCommandEffect (_tcEffect tc) tm w of
---    NoArguments{} -> ("Any arguments provided to this command are ignored.", Nothing)
---    OneArgument argtype argm ->
---        ( "Expects " ++ argtype ++ " as argument. Available arguments: "
---        , Just (M.keys argm)
---        )
-
---infoCommand :: String -> TerminalCommand
---infoCommand str =
---    TerminalCommand
---        { _tcString = "INFORMATION"
---        , _tcAlias = ["INFO", "I"]
---        , _tcHelp = "DISPLAYS INFORMATION CONCERNING THE TERMINAL."
---        , _tcEffect = TerminalCommandEffectNoArgumentsStr str -- \_ _ -> NoArguments (makeTermPara str)
---        }
-
---singleCommand :: [String] -> String -> [String] -> String -> WdWd -> TerminalCommand
---singleCommand followingLines command aliases htext eff =
---    TerminalCommand
---        { _tcString = command
---        , _tcAlias = aliases
---        , _tcHelp = htext
---        , _tcEffect = TerminalCommandEffectSingleCommand eff followingLines
---        }
-
---getDamageCoding :: World -> M.Map String [TerminalLine]
---getDamageCoding = decodedtmap . _sensorCoding . _cwgParams . _cwGen . _cWorld
-
---sensorInfoMap :: Terminal -> World -> M.Map String [TerminalLine]
---sensorInfoMap tm w =
---    M.fromList
---        [ ("Requirement", getSensor _proxRequirement tm w)
---        , ("Distance", getSensor _proxDist tm w)
---        , ("Currentstatus", getSensor _proxStatus tm w)
---        , ("Paststatus", getSensor _sensToggle tm w)
---        ]
-
---getSensor :: Show a => (Sensor -> a) -> Terminal -> World -> [TerminalLine]
---getSensor f tm w =
---    maybe
---        []
---        (makeTermPara . map toLower . show . f)
---        (w ^? cWorld . lWorld . machines . ix (_tmMachineID tm) . mcType . _McSensor)
-
---sensorCommand :: TerminalCommand
---sensorCommand =
---    TerminalCommand
---        { _tcString = "SENSOR"
---        , _tcAlias = ["SEN"]
---        , _tcHelp = "Access information concerning the connected sensor."
---        , _tcEffect = TerminalCommandEffectSensorParameter -- \tm -> OneArgument "A SENSOR PARAMETER" . sensorInfoMap tm
---        }
-
-powerDownTerminal :: Terminal -> World -> World
-powerDownTerminal tm =
-    (cWorld . lWorld . terminals . ix (_tmID tm) . tmStatus .~ TerminalOff)
-        . ( cWorld . lWorld . terminals . ix (_tmID tm) . tmDisplayedLines .~ []
-          )
-        . exitTerminalSubInv
-
-deactivateTerminal :: Terminal -> World -> World
-deactivateTerminal tm =
-    (cWorld . lWorld . terminals . ix (_tmID tm) . tmStatus .~ TerminalOff)
-        . ( cWorld . lWorld . terminals . ix (_tmID tm) . tmDisplayedLines .~ []
-          )
-        . exitTerminalSubInv
-
-exitTerminalSubInv :: World -> World
-exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of
-    Just _ ->
-        w & hud . hudElement . subInventory
-            .~ NoSubInventory --MouseInvNothing
-    _ -> w
-
 --damageCodeCommand :: TerminalCommand
 --damageCodeCommand =
 --    TerminalCommand
@@ -323,47 +176,20 @@ exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of
 simpleTermMessage :: [String] -> Terminal
 simpleTermMessage strs = defaultTerminal & tmBootLines .~ map makeTermLine strs
 
---commandFutureLines :: String -> Terminal -> World -> [TerminalLine]
---commandFutureLines s tm w = fromMaybe [errline "^ Invalid command"] $ do
---    (str, args) <- safeUncons $ words s
---    command <- find (\tc -> _tcString tc == str || str `elem` _tcAlias tc) (getCommands tm)
---    case doTerminalCommandEffect (_tcEffect command) tm w of
---        NoArguments tls -> Just tls
---        OneArgument argtype m ->
---            let setpartial
---                    | null (_tmPartialCommand tm) =
---                        TLine 0 [] (TmTmSetPartialCommand (Just command)) :
---                        makeTermPara ("Expects " ++ argtype ++ " as an argument")
---                    | otherwise =
---                        TLine 0 [] (TmTmSetPartialCommand Nothing) :
---                        makeTermPara "No argument input, cancelling"
---             in Just $
---                    fromMaybe setpartial $
---                        safeHead args >>= (m M.!?)
---  where
---    errline = makeColorTermLine red
-
 terminalReturnEffect :: Int -> World -> World
 terminalReturnEffect tmid w = fromMaybe w $ do
     tm <- w ^? cWorld . lWorld . terminals . ix tmid
     s <- tm ^? tmStatus . tiText
-    return $
-        runTerminalInput s tm $
-            w
-                & cWorld . lWorld . terminals . ix tmid . tmDisplayedLines
-                    .:~ (getPromptTM ++ s, termTextColor)
-
-runTerminalInput :: String -> Terminal -> World -> World
-runTerminalInput s tm w =
-    w & cWorld . lWorld . terminals . ix (_tmID tm)
-        %~ ( (tmFutureLines ++.~ ss <> [TLine 1 [] (TmTmSetStatus $ TerminalTextInput "")])
-                . (tmCommandHistory %~ take 10 . (s :))
-                . (tmStatus .~ TerminalLineRead)
-           )
+    let ss = fromMaybe [makeTermLine "ERROR: INPUT NOT RECOGNISED"] $ do
+            let args = words s
+            x <- args ^? ix 0
+            teff <- PTE.lookup x (getCommands tm)
+            let y = fromMaybe "" (args ^? ix 1)
+            PTE.lookup y teff
+    return $ w 
+        & totm . tmDisplayedLines .:~ (getPromptTM ++ s, termTextColor)
+        & totm . tmFutureLines .~ ss <> tlSetStatus (TerminalTextInput "")
+        & totm . tmCommandHistory %~ take 10 . (s :)
+        & totm . tmStatus .~ TerminalLineRead
   where
-    ss = fromMaybe [makeTermLine "ERROR: INPUT NOT RECOGNISED"] $ do
-        let args = words s
-        x <- args ^? ix 0
-        teff <- PTE.lookup x (getCommands tm)
-        let y = fromMaybe "" (args ^? ix 1)
-        PTE.lookup y teff
+    totm = cWorld . lWorld . terminals . ix tmid