Work on terminals, add deactive data type status

This commit is contained in:
2025-08-19 13:48:54 +01:00
parent 2f4fcb42e5
commit b8581a7862
13 changed files with 331 additions and 269 deletions
+42 -25
View File
@@ -3,7 +3,8 @@
module Dodge.Terminal (
makeTermLine,
connectionBlurbLines,
disconnectTerminal,
powerDownTerminal,
deactivateTerminal,
textTerminal,
simpleTermMessage,
damageCodeCommand,
@@ -21,11 +22,11 @@ module Dodge.Terminal (
--import Dodge.Data.WorldEffect
import qualified Data.Map.Strict as M
import Color
import Data.Char
import qualified Data.List as List
import Color
import qualified Data.ListTrie.Patricia.Map.Enum as PTE
import qualified Data.Map.Strict as M
--import Control.Monad
--import Data.Char
--import qualified Data.Map.Strict as M
@@ -122,30 +123,38 @@ getCommand tm = \case
TCSensorInfo -> sensorCommand
damageCodeCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
damageCodeCommand = PTE.singleton "DAMAGECODE" $ PTE.fromList $ mapMaybe f [minBound..]
damageCodeCommand = PTE.singleton "DAMAGECODE" $ PTE.fromList $ mapMaybe f [minBound ..]
where
f :: SensorType -> Maybe (String, [TerminalLine])
f st = do
s <- g st
return (s, [TLine 0 [] $ TmGetDamageCoding st])
g = fmap (map toUpper) . fmap reverse . List.stripPrefix (reverse "Sensor")
. reverse . show
g =
fmap (map toUpper) . fmap reverse . List.stripPrefix (reverse "Sensor")
. reverse
. show
-- ugly, when changing check getSensorInfo
sensorCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
sensorCommand = PTE.singleton "SENSOR" $ PTE.fromList
[("REQUIREMENT", [])
,("DISTANCE",[])
,("STATUS",[])
]
sensorCommand =
PTE.singleton "SENSOR" $
PTE.fromList
[ ("REQUIREMENT", [])
, ("DISTANCE", [])
, ("STATUS", [])
]
toggleCommand :: Terminal -> PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
toggleCommand tm = PTE.singleton "TOGGLE" $ PTE.fromList $
M.toList $ fmap f $ tm ^. tmToggles
toggleCommand tm =
PTE.singleton "TOGGLE" $
PTE.fromList $
M.toList $ fmap f $ tm ^. tmToggles
where
f x = [TLine 1
[TerminalLineConst "TOGGLE DONE!" termTextColor]
(TmWdWdfromWdWd (WdWdNegateTrig $ x ^. ttTriggerID))
f x =
[ TLine
1
[TerminalLineConst "TOGGLE DONE!" termTextColor]
(TmWdWdfromWdWd (WdWdNegateTrig $ x ^. ttTriggerID))
]
helpCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
@@ -158,7 +167,7 @@ helpStrings =
]
quitCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
quitCommand = PTE.singleton "QUIT" (PTE.singleton "" [TLine 0 [] TmWdWdDisconnectTerminal])
quitCommand = PTE.singleton "QUIT" (PTE.singleton "" [TLine 0 [] TmWdWdPowerDownTerminal])
makeTermLine :: String -> TerminalLine
makeTermLine = makeColorTermLine termTextColor
@@ -191,11 +200,13 @@ tabComplete s' tm = case PTE.lookup s $ getCommands tm of
[] -> tm
[x] -> tm & tmStatus . tiText .~ (y ++ x)
xs ->
tm & tmStatus .~ TerminalLineRead
tm & tmStatus .~ TerminalLineRead
& tmFutureLines
.~ (makeColorTermPara
commandColor
(unwords xs) <> [TLine 1 [] . TmTmSetStatus $ TerminalTextInput s])
.~ ( makeColorTermPara
commandColor
(unwords xs)
<> [TLine 1 [] . TmTmSetStatus $ TerminalTextInput s]
)
--doTerminalCommandEffect :: TerminalCommandEffect -> Terminal -> World -> EffectArguments
--doTerminalCommandEffect tce = case tce of
@@ -258,7 +269,6 @@ tabComplete s' tm = case PTE.lookup s $ getCommands tm of
-- (makeTermPara . map toLower . show . f)
-- (w ^? cWorld . lWorld . machines . ix (_tmMachineID tm) . mcType . _McSensor)
--sensorCommand :: TerminalCommand
--sensorCommand =
-- TerminalCommand
@@ -268,12 +278,19 @@ tabComplete s' tm = case PTE.lookup s $ getCommands tm of
-- , _tcEffect = TerminalCommandEffectSensorParameter -- \tm -> OneArgument "A SENSOR PARAMETER" . sensorInfoMap tm
-- }
disconnectTerminal :: Terminal -> World -> World
disconnectTerminal tm =
powerDownTerminal :: Terminal -> World -> World
powerDownTerminal tm =
(cWorld . lWorld . terminals . ix (_tmID tm) . tmStatus .~ TerminalOff)
. exitTerminalSubInv
. ( 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