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/Data/Terminal.hs
+11 -8
View File
@@ -8,6 +8,7 @@ module Dodge.Data.Terminal (
module Dodge.Data.Terminal.Status,
) where
import Dodge.Data.Machine.Sensor.Type
import Sound.Data
import Color
import Control.Lens
@@ -69,15 +70,16 @@ data TerminalCommandEffect
| TerminalCommandEffectSingleCommand WdWd [String]
| TerminalCommandEffectNone
data TerminalCommand = TerminalCommand
{ _tcString :: String
, _tcAlias :: [String]
, _tcHelp :: String
, _tcEffect :: TerminalCommandEffect -- Terminal -> World -> EffectArguments
}
--data TerminalCommand = TerminalCommand
-- { _tcString :: String
-- , _tcAlias :: [String]
-- , _tcHelp :: String
-- , _tcEffect :: TerminalCommandEffect -- Terminal -> World -> EffectArguments
-- }
data TCom = TCInfo String String
| TCBase
| TCDamageCommand
--data TEff = TEff
-- { _teffHelp :: String
@@ -92,13 +94,14 @@ data TmWdWd
| TmWdWdDoDeathTriggers
| TmTmClearDisplayedLines
| TmTmSetStatus TerminalStatus
| TmGetDamageCoding SensorType
-- | TmDisplayCommands
makeLenses ''Terminal
makeLenses ''TerminalLine
makeLenses ''TerminalToggle
makeLenses ''EffectArguments
makeLenses ''TerminalCommand
--makeLenses ''TerminalCommand
makeLenses ''TCom
concat
<$> mapM
@@ -108,7 +111,7 @@ concat
, ''TerminalToggle
, ''EffectArguments
, ''TerminalCommandEffect
, ''TerminalCommand
-- , ''TerminalCommand
, ''TCom
, ''TmWdWd
, ''Terminal
src/Dodge/Room/SensorDoor.hs
+1 -2
View File
@@ -74,8 +74,7 @@ sensInsideDoor senseType outplid rm =
.++~ [ psPt atFstLnkOut . PutForeground $ floorWire (V2 20 0) (V2 20 (-100))
, psPt atFstLnkOut . PutForeground $ floorWire (V2 0 (-100)) (V2 20 (-100))
, psPt atFstLnkOut . PutForeground $ verticalWire (V2 20 0) 0 80
, putMessageTerminal terminalColor (basicTerminal-- & tmCommands .:~ damageCodeCommand)
)
, putMessageTerminal terminalColor (basicTerminal & tmCommands .:~ TCDamageCommand)
& plSpot .~ rprBoolShift isUnusedLnk (shiftInBy 10)
]
& rmOutPmnt .~ [OutPlacement (sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100)) outplid]
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 =
src/Dodge/WorldEffect.hs
+10
View File
@@ -95,6 +95,10 @@ doTmWdWd tmwdwd = case tmwdwd of
TmTmClearDisplayedLines -> \tm -> fromMaybe id $ do
tid <- tm ^? tmID
return $ cWorld . lWorld . terminals . ix tid . tmDisplayedLines .~ []
TmGetDamageCoding st -> \tm w -> fromMaybe w $ do
tid <- tm ^? tmID
return $ w & cWorld . lWorld . terminals . ix tid . tmFutureLines
.~ decodeSensorType st w
TmTmSetStatus x -> \tm -> fromMaybe id $ do
tid <- tm ^? tmID
return $ cWorld . lWorld . terminals . ix tid . tmStatus .~ x
@@ -114,3 +118,9 @@ doTmWdWd tmwdwd = case tmwdwd of
in soundStart TerminalSound tpos sid Nothing w
TmWdWdDoDeathTriggers -> doDeathTriggers
TmWdWdfromWdWd f -> \_ -> doWdWd f
decodeSensorType :: SensorType -> World -> [TerminalLine]
decodeSensorType st w = fromMaybe [] $ do
x <- w ^? cWorld . cwGen . cwgParams . sensorCoding . ix st
return [makeTermLine $ show x]