Continue work on terminals

src/Dodge/Data/Machine/Sensor/Type.hs

@@ -1,19 +1,22 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
-module Dodge.Data.Machine.Sensor.Type
-    where
+
+module Dodge.Data.Machine.Sensor.Type where
+
 import Data.Aeson
 import Data.Aeson.TH
 
-data SensorType 
+data SensorType
     = LaserSensor
     | ElectricSensor
     | ThermalSensor
     | PhysicalSensor
-    deriving (Eq,Ord,Show,Read,Bounded,Enum)
+    deriving (Eq, Ord, Show, Read, Bounded, Enum)
 
 deriveJSON defaultOptions ''SensorType
+
 instance ToJSONKey SensorType
+
 instance FromJSONKey SensorType

src/Dodge/Data/Terminal.hs

@@ -80,6 +80,8 @@ data TerminalCommandEffect
 data TCom = TCInfo String String
     | TCBase
     | TCDamageCommand
+    | TCSensorInfo
+    | TCToggles
 
 --data TEff = TEff
 --    { _teffHelp :: String
@@ -95,6 +97,7 @@ data TmWdWd
     | TmTmClearDisplayedLines
     | TmTmSetStatus TerminalStatus
     | TmGetDamageCoding SensorType
+    | TmGetSensor String
 --    | TmDisplayCommands
 
 makeLenses ''Terminal

src/Dodge/Placement/Instance/Analyser.hs

@@ -21,8 +21,7 @@ analyser proxreq pslight psmc = extTrigLitPos pslight $ \tp ->
                 (themachine & mcMounts . at OTTrigger .~ _plMID tp)
                 tparams -- (linksensortotrigger tp)
   where
-    --tparams = basicTerminal & tmCommands .:~ sensorCommand
-    tparams = basicTerminal
+    tparams = textTerminal & tmCommands .:~ TCSensorInfo
     --    linksensortotrigger tp _ mc
     --        = triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc)
     themachine =

src/Dodge/Room/SensorDoor.hs

@@ -74,7 +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 .:~ TCDamageCommand)
+                 , putMessageTerminal terminalColor (textTerminal & tmCommands .:~ TCDamageCommand)
                     & plSpot .~ rprBoolShift isUnusedLnk (shiftInBy 10)
                  ]
         & rmOutPmnt .~ [OutPlacement (sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100)) outplid]

src/Dodge/Room/Warning.hs

@@ -47,7 +47,7 @@ addWarningTerminal str outplid =
             )
     termMessages trpl =
         lineOutputTerminal (makeColorTermLine red "WARNING" : makeTermPara str)
---            & tmCommands .:~ toggleCommand
+            & tmCommands .:~ TCToggles
             & tmToggles
                 .~ M.fromList
                     [("DOOR", TerminalToggle (fromJust $ _plMID trpl) (BlConst True))]

src/Dodge/Terminal.hs

@@ -9,7 +9,7 @@ module Dodge.Terminal (
     --    commandsCommand,
     connectionBlurbLines,
     disconnectTerminal,
-    basicTerminal,
+    textTerminal,
     simpleTermMessage,
     damageCodeCommand,
     sensorCommand,
@@ -25,6 +25,7 @@ module Dodge.Terminal (
 
 --import Dodge.Data.WorldEffect
 
+import qualified Data.Map.Strict as M
 import Data.Char
 import qualified Data.List as List
 import Color
@@ -43,11 +44,10 @@ import LensHelp
 --import ListHelp (safeHead, safeUncons)
 import Sound.Data
 
-basicTerminal :: Terminal
-basicTerminal =
+textTerminal :: Terminal
+textTerminal =
     defaultTerminal
         { _tmBootLines = connectionBlurb
-        , _tmDeathEffect = TmWdWdDoDeathTriggers
         }
 
 connectionBlurbLines :: [TerminalLine] -> [TerminalLine]
@@ -115,13 +115,15 @@ termTextColor :: Color
 termTextColor = greyN 0.9
 
 getCommands :: Terminal -> PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
-getCommands = foldMap getCommand . _tmCommands -- tm -- ++ _tmWriteCommands tm
+getCommands tm = foldMap (getCommand tm) $ tm ^. tmCommands
 
-getCommand :: TCom -> PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
-getCommand = \case
+getCommand :: Terminal -> TCom -> PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
+getCommand tm = \case
     TCInfo x z -> PTE.singleton x (PTE.singleton "" (makeTermPara z))
     TCBase -> helpCommand <> quitCommand
     TCDamageCommand -> damageCodeCommand
+    TCToggles -> toggleCommand tm
+    TCSensorInfo -> sensorCommand
 
 damageCodeCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
 damageCodeCommand = PTE.singleton "DAMAGECODE" $ PTE.fromList $ mapMaybe f [minBound..]
@@ -133,11 +135,22 @@ damageCodeCommand = PTE.singleton "DAMAGECODE" $ PTE.fromList $ mapMaybe f [minB
     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" mempty
+sensorCommand = PTE.singleton "SENSOR" $ PTE.fromList 
+    [("REQUIREMENT", [])
+    ,("DISTANCE",[])
+    ,("STATUS",[])
+    ]
 
-toggleCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
-toggleCommand = PTE.singleton "TOGGLE" mempty
+toggleCommand :: Terminal -> PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
+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))
+        ]
 
 helpCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
 helpCommand = PTE.singleton "HELP" (fmap makeTermPara helpStrings)
@@ -247,17 +260,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)
 
---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 =

src/Dodge/WorldEffect.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
 module Dodge.WorldEffect (
     doWdWd,
     accessTerminal,
@@ -99,6 +100,9 @@ doTmWdWd tmwdwd = case tmwdwd of
         tid <- tm ^? tmID
         return $ w & cWorld . lWorld . terminals . ix tid . tmFutureLines 
             .~ decodeSensorType st w
+    TmGetSensor s -> \tm w -> fromMaybe w $ do
+        tid <- tm ^? tmID
+        return $ w & cWorld . lWorld . terminals . ix tid . tmFutureLines .~ getSensorInfo w tm s
     TmTmSetStatus x -> \tm -> fromMaybe id $ do
         tid <- tm ^? tmID
         return $ cWorld . lWorld . terminals . ix tid . tmStatus .~ x
@@ -124,3 +128,12 @@ decodeSensorType st w = fromMaybe [] $ do
     x <- w ^? cWorld . cwGen . cwgParams . sensorCoding . ix st
     return [makeTermLine $ show x]
     
+-- ugly, when changing check sensorCommand
+getSensorInfo :: World -> Terminal -> String -> [TerminalLine]
+getSensorInfo w tm = \case
+    "REQUIREMENT" -> maybe [] f $ w ^? cWorld . lWorld . machines . ix (tm ^. tmMachineID) . mcType . _McSensor . proxRequirement
+    "DISTANCE" -> maybe [] f $ w ^? cWorld . lWorld . machines . ix (tm ^. tmMachineID) . mcType . _McSensor . proxDist
+    "STATUS" -> maybe [] f $ w ^? cWorld . lWorld . machines . ix (tm ^. tmMachineID) . mcType . _McSensor . sensToggle
+    _ -> []
+  where
+    f s = [makeTermLine $ show s]