Cleanup

src/Dodge/Terminal.hs

@@ -13,7 +13,7 @@ import Data.Maybe
 import qualified Data.Map.Strict as M
 import qualified Data.IntMap.Strict as IM
 import qualified Data.Text as T
-import Text.Read
+--import Text.Read
 import Data.List (find)
 
 quitCommand :: TerminalCommand
@@ -52,11 +52,6 @@ getDamageCoding = decodedtmap . _sensorCoding . _genParams
 decodedtmap :: M.Map DamageType (PaletteColor,DecorationShape) 
     -> M.Map String [TerminalLine]
 decodedtmap = M.mapKeys show . M.map ((:[]) . makeTermLine . show)
-  where
-    f args _ w = fromMaybe (Left "") $ do
-        dtype <- safeHead args >>= readMaybe
-        dinfo <- _sensorCoding (_genParams w) M.!? dtype
-        return $ Right [makeTermLine $ show (fst dinfo) ++ " " ++ show (snd dinfo)]
 
 sensorCommand :: TerminalCommand
 sensorCommand = TerminalCommand
@@ -106,18 +101,24 @@ helpCommand :: TerminalCommand
 helpCommand = TerminalCommand
     { _tcString = "HELP"
     , _tcAlias  = ["H","MAN"]
-    , _tcHelp   = "DISPLAYS HELP FOR A SPECIFIC COMMAND. TO DISPLAY AVAILABLE COMMANDS USE \"COMMANDS\"."
-    , _tcEffect = \tm w -> OneArgument "AN AVAILABLE COMMAND" $ getCommandsHelp tm w
+    , _tcHelp   = "DISPLAYS HELP FOR A SPECIFIC COMMAND."
+    , _tcEffect = \tm -> OneArgument "AN AVAILABLE COMMAND" . getCommandsHelp tm
     }
 getCommandsHelp :: Terminal -> World -> M.Map String [TerminalLine]
-getCommandsHelp tm w = fromMaybe mempty $ do
-    tcs <- getCommands tm w
-    return $ foldr f mempty tcs
+--getCommandsHelp tm w = fromMaybe mempty $ do
+--    tcs <- getCommands tm w
+--    return $ foldr f mempty tcs
+getCommandsHelp tm w = maybe mempty (foldr f mempty) (getCommands tm w)
   where
     f tc = M.insert (_tcString tc) 
-        ( [makeTermLine ("COMMAND:" ++ _tcString tc) 
-            ,makeTermLine ("ALIASES:" ++ unwords (_tcAlias tc)) ] 
-            ++ (makeTermPara $ _tcHelp tc)
+        ( [makeTermLine "COMMAND:"
+            , makeColorTermLine yellow (_tcString tc)
+            ,makeTermLine "ALIASES:" 
+            , makeColorTermLine yellow ( unwords (_tcAlias tc)) ] 
+            ++ case argumentHelp tc tm w of
+                (arghelp,Nothing) -> makeTermPara $ _tcHelp tc ++ " " ++ arghelp
+                (arghelp,Just args) -> makeTermPara (_tcHelp tc ++ " " ++ arghelp)
+                    ++ [makeColorTermLine yellow $ unwords args]
         )
 getCommands :: Terminal -> World -> Maybe [TerminalCommand]
 getCommands tm w = do
@@ -132,10 +133,11 @@ infoClearInput tm tls = terminals . ix (_tmID tm) %~
       )
     )
 
-argumentHelp :: Maybe String -> String
-argumentHelp mstr = case mstr of
-    Nothing -> "ANY ARGUMENTS PROVIDED TO THIS COMMAND ARE IGNORED."
-    Just str -> "EXPECTS " ++ str ++ " AS ARGUMENT."
+argumentHelp :: TerminalCommand -> Terminal -> World -> (String,Maybe [String])
+argumentHelp tc tm w = case _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) )
 
 makeTermPara :: String -> [TerminalLine]
 makeTermPara = map makeTermLine . makeParagraph 60
@@ -144,7 +146,7 @@ makeColorTermLine :: Color -> String -> TerminalLine
 makeColorTermLine col str = TerminalLineDisplay 0 $ const (str,col)
 
 makeTermLine :: String -> TerminalLine
-makeTermLine = makeColorTermLine white
+makeTermLine = makeColorTermLine (greyN 0.9)
 
 termSoundLine :: SoundID -> TerminalLine
 termSoundLine sid = TerminalLineEffect 0 termsound
@@ -183,39 +185,34 @@ singleCommand followingLines command aliases htext eff = TerminalCommand
 doTerminalEffectLB :: Terminal -> World -> World
 doTerminalEffectLB tm w = fromMaybe w $ do
     s <- fmap T.unpack $ w ^? terminals . ix (_tmID tm) . tmInput . tiText
-    if null (words s) then Just $ defocusTerminalInput w else return $ doTerminalEffect tm w
+    if null (words s) 
+        then Just $ defocusTerminalInput w 
+        else return $ terminalReturnEffect tm w
 
-doTerminalEffect :: Terminal -> World -> World
-doTerminalEffect tm w = fromMaybe w $ do
+terminalReturnEffect :: Terminal -> World -> World
+terminalReturnEffect tm w = fromMaybe w $ do
     s <- fmap T.unpack $ w ^? terminals . ix (_tmID tm) . tmInput . tiText
-    return $ doTerminalEffect' s tm $ w
-            & terminals . ix (_tmID tm) . tmFutureLines .~ [makeColorTermLine (greyN 0.9) ('>':s)]
+    return $ runTerminalString s tm $ w
+            & terminals . ix (_tmID tm) . tmFutureLines .~ [makeTermLine ('>':s)]
 
 commandFutureLines :: String -> Terminal -> World -> [TerminalLine]
-commandFutureLines s tm w = fromMaybe [] $ do
+commandFutureLines s tm w = fromMaybe [errline "^ INVALID COMMAND"] $ do
     commands    <- getCommands tm w
     (str,args)  <- safeUncons $ words s
     command     <- find (\tc -> _tcString tc == str || str `elem` _tcAlias tc) commands
     case _tcEffect command tm w of
         NoArguments tls -> Just tls
-        OneArgument argtype m -> case args of
-            (arg:_) -> M.lookup arg m
-            []      -> Just [makeColorTermLine red $ "^ INVALID ARGUMENT: EXPECTS "++ argtype ]
-
-doTerminalEffect' :: String -> Terminal -> World -> World
-doTerminalEffect' s tm w = fromMaybe (w & badinput) $ do
-    if null (words s) then Just $ defocusTerminalInput w else do
-        let futlines = commandFutureLines s tm w
-        return $ w & terminals . ix (_tmID tm) %~
-            ( (tmInput .~ TerminalInput T.empty True (0,0))
-            . (tmFutureLines ++.~ futlines)
-            . (tmCommandHistory %~ take 10 . (s:))
-            )
+        OneArgument argtype m -> Just $ fromMaybe [errline $ "^ INVALID ARGUMENT: EXPECTS "++ argtype]
+            $ safeHead args >>= (m M.!?)
   where
-    badinput =  terminals . ix (_tmID tm) %~
-        ( (tmInput .~ TerminalInput T.empty True (0,0))
-        . (tmFutureLines ++.~ [makeColorTermLine red "^ INVALID INPUT" ])
-        )
+    errline = makeColorTermLine red
+
+runTerminalString :: String -> Terminal -> World -> World
+runTerminalString s tm w = w & terminals . ix (_tmID tm) %~
+    ( (tmInput .~ TerminalInput T.empty True (0,0))
+    . (tmFutureLines ++.~ commandFutureLines s tm w)
+    . (tmCommandHistory %~ take 10 . (s:))
+    )
 
 defocusTerminalInput :: World -> World
 defocusTerminalInput w = fromMaybe w $ do