Work on terminals, add deactive data type status

src/Dodge/Data/Input.hs

@@ -5,6 +5,7 @@
 
 module Dodge.Data.Input where
 
+import Dodge.Data.Terminal.Status
 import Control.Lens
 import qualified Data.Map.Strict as M
 import Geometry.Data
@@ -28,9 +29,8 @@ data MouseContext
     | OverCombCombine { _mcoCombCombine :: (Int,Int)}
     | OverCombFilter
     | OverCombEscape
-    | OverTerminalReturn {_mcoTermID :: Int}
+    | OverTerminal {_mcoTermID :: Int, _mcoTermStatus :: TerminalStatus}
-    | OverTerminalContinue {_mcoTermID :: Int}
+    | OutsideTerminal
-    | OverTerminalEscape
     | MouseGameRotate
     deriving (Show)
 

src/Dodge/Data/Terminal.hs

@@ -89,7 +89,8 @@ data TCom = TCInfo String String -- this may not be necessary, to revisit
 
 data TmWdWd
     = TmWdId
-    | TmWdWdDisconnectTerminal
+    | TmWdWdPowerDownTerminal
+    | TmWdWdDeactivateTerminal
     | TmWdWdfromWdWd WdWd
     | TmWdWdTermSound SoundID
     | TmWdWdDoDeathTriggers

src/Dodge/Data/Terminal/Status.hs

@@ -9,10 +9,11 @@ import Data.Aeson.TH
 
 data TerminalStatus
     = TerminalOff
+    | TerminalDeactivated
     | TerminalLineRead
     | TerminalTextInput {_tiText :: String}
     | TerminalPressTo {_tptString :: String}
-    deriving (Eq)
+    deriving (Eq,Show)
 
 makeLenses ''TerminalStatus
 deriveJSON defaultOptions ''TerminalStatus

src/Dodge/Render/HUD.hs

@@ -383,6 +383,7 @@ drawTerminalDisplay tid cfig w = fromMaybe mempty $ do
             $ _tmDisplayedLines tm
     displayTermInput tm = case _tmStatus tm of
         TerminalOff -> id
+        TerminalDeactivated -> id
         TerminalLineRead -> id
         TerminalTextInput s ->
             (++ [(getPromptTM ++ s ++ [cFilledRect], white)])

src/Dodge/Render/Picture.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
 module Dodge.Render.Picture (
     fixedCoordPictures,
 ) where
@@ -109,9 +110,8 @@ mouseCursorType u = case u ^. uvWorld . input . mouseContext of
     OverCombFilter{} -> drawJumpDown 5
     OverCombCombine{} -> drawGapPlus 5
     OverCombEscape -> rotate (pi / 4) $ drawPlus 5
-    OverTerminalContinue{} -> drawReturn 5
+    OverTerminal _ ts -> drawCursorByTerminalStatus ts
-    OverTerminalReturn{} -> drawReturn 5
+    OutsideTerminal -> rotate (pi / 4) $ drawPlus 5
-    OverTerminalEscape -> rotate (pi / 4) $ drawPlus 5
     MouseGameRotate -> rotate a (drawVerticalDoubleArrow 5)
   where
     w = u ^. uvWorld
@@ -122,6 +122,21 @@ mouseCursorType u = case u ^. uvWorld . input . mouseContext of
             argV (w ^. cWorld . lWorld . lAimPos -.- cpos)
                 - w ^. wCam . camRot
 
+drawCursorByTerminalStatus :: TerminalStatus -> Picture
+drawCursorByTerminalStatus = \case
+    TerminalPressTo "QUIT" -> drawQuitTerminal 5
+    TerminalPressTo _ -> drawArrowDown 5
+    TerminalTextInput "QUIT" -> drawQuitTerminal 5
+    TerminalTextInput{} -> drawReturn 5
+    _ -> drawEmptySet 5
+
+drawQuitTerminal :: Float -> Picture
+drawQuitTerminal x = fold 
+        [ line [V2 x x, V2 (- x) (- x)]
+        , line [V2 x (-x), V2 (- x) x]
+        , polygonWire (square x)
+        ]
+
 drawEmptySet :: Float -> Picture
 drawEmptySet x =
     fold
@@ -202,6 +217,14 @@ drawVerticalDoubleArrow x =
     z = 1.5 * x
     w = 0.6 * x
 
+drawArrowDown :: Float -> Picture
+drawArrowDown x =
+    line [V2 0 z, V2 0 (- z)]
+        <> line [V2 (- w) (w - z), V2 0 (- z), V2 w (w - z)]
+  where
+    z = 1 * x
+    w = 0.6 * x
+
 drawDragDrop :: Float -> Picture
 drawDragDrop x =
     line (fmap (+ V2 z (- x)) [V2 (- x) x, V2 0 x, V2 0 (- x)])

src/Dodge/Room/RezBox.hs

@@ -26,7 +26,7 @@ rezBox :: LightSource -> Room
 rezBox ls =
     roomRect 40 60 1 1
         & rmPmnts .~ [sPS (V2 20 1) 0 $ PutLS ls
-            , putMessageTerminal terminalColor (defaultTerminal & tmBootLines .~ (makeTermPara s) <> tlSetStatus (TerminalPressTo "QUIT") <> [TLine 1 [] TmWdWdDisconnectTerminal])
+            , putMessageTerminal terminalColor (defaultTerminal & tmBootLines .~ (makeTermPara s) <> tlSetStatus (TerminalPressTo "QUIT") <> [TLine 1 [] TmWdWdDeactivateTerminal])
                 & plSpot .~ PS (V2 20 0) 0
             ]
         & restrictInLinks (\(V2 _ h, _) -> h < 1)
@@ -35,6 +35,9 @@ rezBox ls =
   where
     s = "RESPAWN POINT SET AT THIS LOCATION."
 
+tutorialMessage1 :: String
+tutorialMessage1 = "SYNTHESIS SUCCESSFUL. MOVEMENT TEST 1 INITIATED [WASD]. INTERACTION TEST 1 IN QUEUE [SPACE]."
+
 rezBox' :: RandomGen g => State g (MetaTree Room String)
 rezBox' = do
     col <- rezColor

src/Dodge/Terminal.hs

@@ -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") 
+    g =
-        . reverse . show
+        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 
+sensorCommand =
-    [("REQUIREMENT", [])
+    PTE.singleton "SENSOR" $
-    ,("DISTANCE",[])
+        PTE.fromList
-    ,("STATUS",[])
+            [ ("REQUIREMENT", [])
-    ]
+            , ("DISTANCE", [])
+            , ("STATUS", [])
+            ]
 
 toggleCommand :: Terminal -> PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
-toggleCommand tm = PTE.singleton "TOGGLE" $ PTE.fromList $
+toggleCommand tm =
-    M.toList $ fmap f $ tm ^. tmToggles
+    PTE.singleton "TOGGLE" $
+        PTE.fromList $
+            M.toList $ fmap f $ tm ^. tmToggles
   where
-    f x = [TLine 1 
+    f x =
-        [TerminalLineConst "TOGGLE DONE!" termTextColor] 
+        [ TLine
-        (TmWdWdfromWdWd (WdWdNegateTrig $ x ^. ttTriggerID))
+            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
+                .~ ( makeColorTermPara
-                    commandColor
+                        commandColor
-                    (unwords xs) <> [TLine 1 [] . TmTmSetStatus $ TerminalTextInput s])
+                        (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
+powerDownTerminal :: Terminal -> World -> World
-disconnectTerminal tm =
+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

src/Dodge/Terminal/Color.hs

@@ -10,6 +10,7 @@ import Control.Lens
 termScreenColor :: Terminal -> Maybe Color
 termScreenColor tm = case tm ^. tmStatus of
     TerminalOff -> Nothing
+    TerminalDeactivated -> Nothing
     TerminalTextInput _ -> Just green
     TerminalPressTo{} -> Just green
     TerminalLineRead -> Just white

src/Dodge/Update.hs

@@ -397,11 +397,8 @@ updateMouseContextGame cfig u = case u ^. uvWorld . input . mouseContext of
         tm <- w ^? cWorld . lWorld . terminals . ix tmid
         return $
             if isOverTerminalScreen cfig mpos
-                then fromMaybe NoMouseContext $ do
+                then OverTerminal tmid (tm ^. tmStatus)
-                    let s = tm ^. tmStatus . tiText
+                else OutsideTerminal
-                    guard $ not (null s) -- && _tmStatus tm == TerminalTextInput
-                    return $ OverTerminalReturn tmid
-                else OverTerminalEscape
 
 getMenuMouseContext :: ScreenLayer -> Universe -> MouseContext
 getMenuMouseContext screen u = case screen ^. scOptions of

src/Dodge/Update/Input/InGame.hs

@@ -218,9 +218,9 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
             && isGroupSelectableSection (fst x) ->
             w & input . mouseContext .~ OverInvDragSelect x (Just $ snd x)
     OverInvSelect x -> startDrag x cfig w
-    OverTerminalReturn tmid -> terminalReturnEffect tmid w
+    OverTerminal tmid (TerminalTextInput {}) -> terminalReturnEffect tmid w
-    OverTerminalContinue tmid -> undefined
+    OverTerminal tmid (TerminalPressTo{}) -> continueTerminal tmid w
-    OverTerminalEscape -> w & hud . hudElement . subInventory .~ NoSubInventory
+    OutsideTerminal -> w & hud . hudElement . subInventory .~ NoSubInventory
     OverCombSelect x ->
         w & hud . hudElement . subInventory . ciSelection ?~ f x
             & worldEventFlags . at CombineInventoryChange ?~ ()
@@ -388,11 +388,16 @@ updateKeysInTerminal tmid u = fromMaybe u $ do
         TerminalTextInput{} -> updateKeysTextInputTerminal tmid u
         TerminalPressTo{} -> updateKeyContinueTerminal tmid u
         _ -> u
+
 updateKeyContinueTerminal :: Int -> Universe -> Universe
 updateKeyContinueTerminal tmid u
     | any (==0) $ u ^. uvWorld . input . pressedKeys =
-        u & uvWorld . cWorld . lWorld . terminals . ix tmid . tmStatus .~ TerminalLineRead
+        u & uvWorld %~ continueTerminal tmid
     | otherwise = u
+
+continueTerminal :: Int -> World -> World
+continueTerminal tmid = cWorld . lWorld . terminals . ix tmid . tmStatus .~ TerminalLineRead
+
 updateKeysTextInputTerminal :: Int -> Universe -> Universe
 updateKeysTextInputTerminal tmid u =
     u

src/Dodge/WorldEffect.hs

@@ -66,6 +66,7 @@ accessTerminal mtmid w = fromMaybe w $ do
             tm
                 & tmFutureLines .~ _tmBootLines tm
                 & tmStatus .~ TerminalLineRead
+        TerminalDeactivated -> error "managed to boot a deactivated terminal"
 
 torqueCr :: Float -> Int -> World -> World
 torqueCr x cid w
@@ -116,7 +117,8 @@ doTmWdWd tmwdwd = case tmwdwd of
     --        tid <- tm ^? tmID
     --        return $ cWorld . lWorld . terminals . ix tid . tmPartialCommand .~ x
     TmWdId -> const id
-    TmWdWdDisconnectTerminal -> disconnectTerminal
+    TmWdWdPowerDownTerminal -> powerDownTerminal
+    TmWdWdDeactivateTerminal -> deactivateTerminal
     TmWdWdTermSound sid -> \tm w ->
         let tpos = fromMaybe 0 $ w ^? cWorld . lWorld . buttons . ix (_tmButtonID tm) . btPos
          in soundStart TerminalSound tpos sid Nothing w