justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Reinstate damagecode terminal commands

Browse Source
This commit is contained in:
justin
2025-08-18 14:39:30 +01:00
parent 33b90d637a
commit 1c9d58c716
6 changed files with 111 additions and 94 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Terminal.hs
+54 -45
View File
@@ -25,6 +25,8 @@ module Dodge.Terminal (
--import Dodge.Data.WorldEffect
import Data.Char
import qualified Data.List as List
import Color
import qualified Data.ListTrie.Patricia.Map.Enum as PTE
--import Control.Monad
@@ -119,6 +121,23 @@ getCommand :: TCom -> PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
getCommand = \case
TCInfo x z -> PTE.singleton x (PTE.singleton "" (makeTermPara z))
TCBase -> helpCommand <> quitCommand
TCDamageCommand -> damageCodeCommand
damageCodeCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
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
sensorCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
sensorCommand = PTE.singleton "SENSOR" mempty
toggleCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
toggleCommand = PTE.singleton "TOGGLE" mempty
helpCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
helpCommand = PTE.singleton "HELP" (fmap makeTermPara helpStrings)
@@ -126,15 +145,11 @@ helpCommand = PTE.singleton "HELP" (fmap makeTermPara helpStrings)
helpStrings :: PTE.TrieMap Char String
helpStrings =
PTE.fromList
[ ("", "THIS TERMINAL PROCESSES TEXT INPUT. USE TAB FOR AVAILABLE COMMANDS AND AUTOCOMPLETE.")
[ ("", "THIS TERMINAL PROCESSES TEXT INPUT. USE [TAB] FOR AVAILABLE COMMANDS AND AUTOCOMPLETE.")
, ("HELP", "BASIC HELP. ACCEPTS A COMMAND AS AN ARGUMENT.")
, ("QUIT", "SHUTDOWN TERMINAL.")
, ("QTEST", "TEST.")
]
--commandsCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
--commandsCommand = PTE.singleton "COMMANDS" (PTE.singleton "" [TLine 0 [] TmDisplayCommands])
quitCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
quitCommand = PTE.singleton "QUIT" (PTE.singleton "" [TLine 0 [] TmWdWdDisconnectTerminal])
@@ -156,26 +171,20 @@ commandColor = yellow
-- ugly
tabComplete :: String -> Terminal -> Terminal
tabComplete s' tm = case PTE.lookup s $ getCommands tm of
Just m -> case fmap fst $ PTE.toList $ PTE.lookupPrefix a m of
[] -> tm
[x] -> tm & tmStatus .~ TerminalTextInput (s ++ " " ++ x)
xs ->
tm & tmFutureLines
.~ makeColorTermPara
commandColor
(unwords xs)
Nothing -> case fmap fst $ PTE.toList $ PTE.lookupPrefix s $ getCommands tm of
[] -> tm
[x] -> tm & tmStatus .~ TerminalTextInput x
xs ->
tm & tmFutureLines
.~ makeColorTermPara
commandColor
(unwords xs)
Just m -> f (s ++ " ") $ PTE.toList $ PTE.lookupPrefix a m
Nothing -> f "" $ PTE.toList $ PTE.lookupPrefix s $ getCommands tm
where
ss = words s'
s = fromMaybe "" $ ss ^? ix 0
a = fromMaybe "" $ ss ^? ix 1
f y m' = case fmap fst m' of
[] -> tm
[x] -> tm & tmStatus .~ TerminalTextInput (y ++ x)
xs ->
tm & tmFutureLines
.~ makeColorTermPara
commandColor
(unwords xs)
--doTerminalCommandEffect :: TerminalCommandEffect -> Terminal -> World -> EffectArguments
--doTerminalCommandEffect tce = case tce of
@@ -238,26 +247,26 @@ tabComplete s' tm = case PTE.lookup s $ getCommands tm of
-- (makeTermPara . map toLower . show . f)
-- (w ^? cWorld . lWorld . machines . ix (_tmMachineID tm) . mcType . _McSensor)
toggleCommand :: TerminalCommand
toggleCommand =
TerminalCommand
{ _tcString = "TOGGLE"
, _tcAlias = ["TOG"]
, _tcHelp = "Performs a reversable effect."
, _tcEffect = TerminalCommandEffectLinkedObject -- \tm _ -> OneArgument "A LINKED OBJECT" (togglesToEffects tm)
}
--toggleCommand :: TerminalCommand
--toggleCommand =
-- TerminalCommand
-- { _tcString = "TOGGLE"
-- , _tcAlias = ["TOG"]
-- , _tcHelp = "Performs a reversable effect."
-- , _tcEffect = TerminalCommandEffectLinkedObject -- \tm _ -> OneArgument "A LINKED OBJECT" (togglesToEffects tm)
-- }
--decodedtmap :: M.Map SensorType (PaletteColor, DecorationShape) -> M.Map String [TerminalLine]
--decodedtmap = M.mapKeys show . M.map ((: []) . makeTermLine . show)
sensorCommand :: TerminalCommand
sensorCommand =
TerminalCommand
{ _tcString = "SENSOR"
, _tcAlias = ["SEN"]
, _tcHelp = "Access information concerning the connected sensor."
, _tcEffect = TerminalCommandEffectSensorParameter -- \tm -> OneArgument "A SENSOR PARAMETER" . sensorInfoMap tm
}
--sensorCommand :: TerminalCommand
--sensorCommand =
-- TerminalCommand
-- { _tcString = "SENSOR"
-- , _tcAlias = ["SEN"]
-- , _tcHelp = "Access information concerning the connected sensor."
-- , _tcEffect = TerminalCommandEffectSensorParameter -- \tm -> OneArgument "A SENSOR PARAMETER" . sensorInfoMap tm
-- }
disconnectTerminal :: Terminal -> World -> World
disconnectTerminal tm =
@@ -274,14 +283,14 @@ exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of
.~ NoSubInventory --MouseInvNothing
_ -> w
damageCodeCommand :: TerminalCommand
damageCodeCommand =
TerminalCommand
{ _tcString = "DAMAGECODE"
, _tcAlias = ["DCODE", "DC"]
, _tcHelp = "Displays the shape and color associated with a given damage type."
, _tcEffect = TerminalCommandEffectDamageCoding -- \_ -> OneArgument "A DAMAGE TYPE" . getDamageCoding
}
--damageCodeCommand :: TerminalCommand
--damageCodeCommand =
-- TerminalCommand
-- { _tcString = "DAMAGECODE"
-- , _tcAlias = ["DCODE", "DC"]
-- , _tcHelp = "Displays the shape and color associated with a given damage type."
-- , _tcEffect = TerminalCommandEffectDamageCoding -- \_ -> OneArgument "A DAMAGE TYPE" . getDamageCoding
-- }
--infoClearInput :: Terminal -> [TerminalLine] -> World -> World
--infoClearInput tm tls =