Cleanup terminal display

src/Dodge/Terminal.hs

@@ -1,11 +1,17 @@
 module Dodge.Terminal where
 import Dodge.Data
+import Dodge.Base
+import Dodge.SoundLogic
 import Color
 import Justify
 import LensHelp
+import Sound.Data
 
+import Data.Char
 import Data.Maybe
+import qualified Data.Map as M
 import qualified Data.Text as T
+import Text.Read
 import Data.List (find)
 
 quitCommand :: TerminalCommand
@@ -22,6 +28,21 @@ disconnectTerminal = hud . hudElement . subInventory . termParams %~
     ( (termInput .~ Nothing)
     . (termFutureLines ++.~ [makeTermLine "DISCONNECTION COMPLETE"] )
     )
+damageCodeCommand :: TerminalCommand
+damageCodeCommand = TerminalCommand
+    { _tcString = "DAMAGECODE"
+    , _tcAlias  = ["DCODE","DC"]
+    , _tcHelp   = "DISPLAYS THE SHAPE AND COLOR ASSOCIATED WITH A GIVEN DAMAGE TYPE."
+    , _tcArgumentType = Just "A DAMAGE TYPE"
+    , _tcArguments = map (map toUpper . show) . M.keys . _sensorCoding . _genParams
+    , _tcEffect = f
+    }
+  where
+    f args w = fromMaybe (Left "") $ do
+        dtype <- safeHead args >>= readMaybe
+        dinfo <- _sensorCoding (_genParams w) M.!? dtype
+        return $ Right $ w & infoClearInput [makeTermLine $ show (fst dinfo) ++ " " ++ show (snd dinfo)]
+
 helpCommand :: TerminalCommand
 helpCommand = TerminalCommand
     { _tcString = "HELP"
@@ -70,6 +91,12 @@ makeColorTermLine col str = TerminalLineDisplay 0 $ const (str,col)
 makeTermLine :: String -> TerminalLine
 makeTermLine = makeColorTermLine white
 
+termSoundLine :: SoundID -> TerminalLine
+termSoundLine sid = TerminalLineEffect 0 termsound
+  where
+    termsound subinv w = soundStart TerminalSound tpos sid Nothing w
+      where
+        tpos = fromMaybe 0 $ w ^? buttons . ix (_termID subinv) . btPos
 
 infoCommand :: String -> TerminalCommand
 infoCommand str = TerminalCommand
@@ -136,3 +163,25 @@ doTerminalEffect' s w = fromMaybe (w & badinput) $ do
             )
         )
 
+addInputLine :: [TerminalCommand] -> [TerminalCommand] -> TerminalParams -> TerminalParams
+addInputLine searchablecommands hiddencommands = termFutureLines ++.~
+    [TerminalLineInput 0 searchablecommands hiddencommands]
+
+defaultTermParams :: TerminalParams
+defaultTermParams = TerminalParams
+    {_termDisplayedLines = []
+    ,_termFutureLines = termSoundLine computerBeepingS
+        : map makeTermLine connectionBlurb
+    ,_termMaxLines = 14
+    ,_termTitle = "TERMINAL"
+    ,_termSel = Nothing
+    ,_termInput   = Nothing
+    ,_termScrollCommands = []
+    ,_termWriteCommands = []
+    }
+
+connectionBlurb :: [String]
+connectionBlurb =
+    ["CONNECTING ..."
+    ,"COMPLETE"
+    ]