Commit before removing "un-input-able" terminals

2022-06-06 18:33:44 +01:00
parent 4e181b8273
commit b20502bc35
6 changed files with 77 additions and 56 deletions
@@ -41,19 +41,14 @@ import Data.Maybe
 --import System.Random

 analyser 
-    :: [String] -- | initial text
-    -> String   -- | succeed text
-    -> String   -- | fail text
-    -> [String] -- | after text
-    -> (Machine -> World -> World)
+    :: (Machine -> World -> World)
    -> PlacementSpot
    -> PlacementSpot
    -> Placement
-analyser starts sucs _ afters upf pslight psmc = extTrigLitPos pslight $ \tp ->
+analyser upf pslight psmc = extTrigLitPos pslight $ \tp ->
    Just $ plSpot .~ psmc $ putTerminal' aquamarine tparams (termupdate tp)
  where
-    tparams = defaultTermParams & tmFutureLines ++.~ 
-        (map makeTermLine starts ++ [makeTermLine sucs] ++ map makeTermLine afters)
+    tparams = defaultTermParams & tmScrollCommands .:~ sensorCommand
    termupdate tp _ mc = upf mc . (triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc))

 analyserTest :: (World -> Bool) -> Machine -> World -> World
@@ -27,13 +27,12 @@ putTerminal''
    -> Terminal
    -> (Int -> Machine -> World -> World)  -- | machine update, takes button id as input
    -> Placement
-putTerminal'' mc tm mcf = ps0PushPS (PutTerminal tm) $ \tmpl -> Just $
-    ps0PushPS (PutButton termButton)
+putTerminal'' mc tm mcf = ps0PushPS (PutTerminal tm) 
+    $ \tmpl -> Just $ ps0PushPS (PutButton termButton)
    $ \btpl -> Just $ pt0 (PutMachine (reverse $ square 10)
        (mc & mcUpdate .~ machineAddSound fridgeHumS (mcf (fromJust $ _plMID btpl))
-            & mcDeath %~ (\fd mc' -> (buttons . at (fromJust (_plMID btpl)) .~ Nothing) . fd mc')
-        )
-    )
+            & mcDeath %~ (\fd mc' -> mcKillTerm mc . (buttons . at (fromJust (_plMID btpl)) .~ Nothing) . fd mc')
+        )       )
    $ \mcpl -> Just $ sps0 $ PutWorldUpdate (const $ setids tmpl btpl mcpl) 
  where
    setids tmpl btpl mcpl w = w
@@ -46,6 +45,13 @@ putTerminal'' mc tm mcf = ps0PushPS (PutTerminal tm) $ \tmpl -> Just $
        btid = fromJust (_plMID btpl)
        mcid = fromJust (_plMID mcpl)

+mcKillTerm :: Machine -> World -> World
+mcKillTerm mc w = fromMaybe w $ do
+    tmid <- _mcTermMID mc
+    tm <- w ^? terminals . ix tmid 
+    return $ w 
+        & _tmDeathEffect tm tm
+
 putTerminal' 
    :: Color
    -> Terminal
@@ -84,20 +84,7 @@ subInventoryDisplay subinv cfig w = case subinv of
        , invHead cfig "TWEAK"
        , listTextPicturesAt subInvX 60 cfig $ map text (ammoTweakStrings it)
        ]
-    DisplayTerminal {_termID = tid} -> 
-      let tp = w ^?! terminals . ix tid
-      in pictures
-        [ invHead cfig (_tmTitle tp ++ ":T" ++ show tid)
-        , renderListAt subInvX 60 cfig 
-            . displayTermInput tp
--            . (++ map (\(str,_) -> (str,white)) (_termOptions tp))
-            . reverse 
-            . take (_tmMaxLines tp) 
-            $ _tmDisplayedLines tp
--        , fromMaybe mempty $ do
--            cursori <- _termSel tp <&> (+ _termMaxLines tp)
--            return $ listCursorNSW subInvX 60 cfig cursori white 15 1
-        ]
+    DisplayTerminal tid -> displayTerminal tid cfig w
    CombineInventory mi -> pictures
        [ invHead cfig "COMBINE"
        , listTextPicturesAt subInvX 60 cfig $ combineListStringPictures w
@@ -111,7 +98,6 @@ subInventoryDisplay subinv cfig w = case subinv of
            cpos  <- combinePoss  w !? i
            csize <- combineSizes w !? i
            col   <- (combineItemListYou w !? i) <&> _itInvColor . snd
-            --return $ listCursorNSW subInvX 60 cfig cpos col 15 csize
            return $ listCursorNSW subInvX 60 cfig cpos col 15 csize
        , fromMaybe mempty $ do
            i <- mi
@@ -124,12 +110,6 @@ subInventoryDisplay subinv cfig w = case subinv of
        ]
    InspectInventory -> invHead cfig "INSPECT"
  where 
-    displayTermInput tp = case _tmInput tp of
-        Nothing -> id
-        Just (TerminalInput s inputstatus _) 
-                -> (++ [('>':T.unpack s++displayBlinkCursor inputstatus,white)])
-    displayBlinkCursor inputstatus | inputstatus = clockCycle 10 (V.fromList ["_",""]) w
-        | otherwise = []
    closeobjectcursor = case selectedCloseObject w of
        Nothing -> mempty
        Just (i,co) -> listCursorNS clObjFloatIn 0 cfig (selNumPos i w) (closeObjectCol co) topInvW (invSelSize i w)
@@ -152,6 +132,25 @@ subInventoryDisplay subinv cfig w = case subinv of
        then drawRBOptions cfig w (_rbOptions w)
        else mempty

+displayTerminal :: Int -> Configuration -> World -> Picture
+displayTerminal tid cfig w = fromMaybe mempty $ do
+    tm <- w ^? terminals . ix tid
+    return $ pictures
+        [ invHead cfig (_tmTitle tm ++ ":T" ++ show tid)
+        , renderListAt subInvX 60 cfig 
+            . displayTermInput tm
+            . reverse 
+            . take (_tmMaxLines tm) 
+            $ _tmDisplayedLines tm
+        ]
+  where
+    displayTermInput tp = case _tmInput tp of
+        Nothing -> id
+        Just (TerminalInput s inputstatus _) 
+                -> (++ [('>':T.unpack s++displayBlinkCursor inputstatus,white)])
+    displayBlinkCursor inputstatus | inputstatus = clockCycle 10 (V.fromList ["_",""]) w
+        | otherwise = []
+
 drawRBOptions :: Configuration -> World -> RightButtonOptions -> Picture
 drawRBOptions cfig w EquipOptions{_opEquip = es,_opSel=i, _opAllocateEquipment=ae} = 
  listTextPicturesAtOffset 342 0 cfig (curpos-i) (map (text . eqPosText) es)
@@ -85,12 +85,6 @@ keyCardRoomRunPast keyid rmid = do

 keyCardAnalyserByDoor :: Int -> Int -> Room -> Room
 keyCardAnalyserByDoor keyid = analyserByDoor 
-    [ bar
-    , hic
-    , bar ] 
-    "UNLOCKED" 
-    ("REQUIRES KEYCARD-"++ show keyid)
-    (bar : replicate 2 "")
    (machineAddSound fridgeHumS $ testYouHave (KEYCARD 0))
  where
    hic = "SECURITY CHECK"
@@ -98,27 +92,20 @@ keyCardAnalyserByDoor keyid = analyserByDoor

 healthAnalyserByDoor :: Int -> Room -> Room
 healthAnalyserByDoor = analyserByDoor 
-    [ bar
-    , hic
-    , bar ] 
-    "PASSED" 
-    "REQUIRES HEALTH 1100" 
-    (bar : replicate 2 "")
    (machineAddSound fridgeHumS $ testYourHealth 1100)
  where
    hic = "HEALTH INTEGRITY CHECK"
    bar = replicate (length hic) '-'

-analyserByDoor :: [String] -> String -> String -> [String]
-    -> (Machine -> World -> World) -> Int -> Room -> Room
-analyserByDoor sa sb sc sd mcf outplid rm = rm 
+analyserByDoor :: (Machine -> World -> World) -> Int -> Room -> Room
+analyserByDoor mcf outplid rm = rm 
    & rmPmnts .++~ 
        [ psPt atFstLnkOut $ PutShape $ colorSH yellow 
            $ barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80)
        ]
    & rmOutPmnt .~ 
        [OutPlacement 
-            (analyser sa sb sc sd
+            (analyser
                mcf
                (atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
                (atFstLnkOutShiftBy sensorshift)
@@ -56,7 +56,7 @@ addWarningTerminal outplid = (rmName .++~ "warningTerm-")
    termMessages trid = defaultTermParams & addInputLine
        [unlockCommand trid,quitCommand] 
        [helpCommand,infoCommand theinfo,commandsCommand]
-    unlockCommand trid = singleCommand "OPEN" ["YES","Y"] "OPEN THE CONNECTED DOOR." (toggledoor trid)
+    unlockCommand trid = singleCommand ["DOOR OPENED"] "OPEN" ["YES","Y"] "OPEN THE CONNECTED DOOR." (toggledoor trid)
    toggledoor trid w' = w' & triggers . ix (fromJust $ _plMID trid) .~ const True
    theinfo = "DOOR CONTROLABLE WITH THE \"OPEN\" COMMAND. THIS TERMINAL CANNOT CLOSE THE DOOR."

@@ -27,7 +27,16 @@ quitCommand = TerminalCommand
 disconnectTerminal :: Terminal -> World -> World
 disconnectTerminal tm w = w 
    & terminals . ix (_tmID tm) . tmStatus .~ Disconnected
-    & terminals . ix (_tmID tm) . tmFutureLines ++.~ [makeTermLine "DISCONNECTION COMPLETE"]
+    & terminals . ix (_tmID tm) . tmInput .~ Nothing
+    & exitTerminalSubInv
+    & terminals . ix (_tmID tm) . tmFutureLines .~ 
+        [ TerminalLineTerminalEffect 0 (tmDisplayedLines .~ [])
+        ]
+
+exitTerminalSubInv :: World -> World
+exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of
+    Just _ -> w & hud . hudElement . subInventory .~ NoSubInventory
+    _ -> w

 damageCodeCommand :: TerminalCommand
 damageCodeCommand = TerminalCommand
@@ -44,6 +53,29 @@ damageCodeCommand = TerminalCommand
        dinfo <- _sensorCoding (_genParams w) M.!? dtype
        return $ Right $ w & infoClearInput tm [makeTermLine $ show (fst dinfo) ++ " " ++ show (snd dinfo)]

+sensorCommand :: TerminalCommand
+sensorCommand = TerminalCommand
+    { _tcString = "SENSOR"
+    , _tcAlias  = ["SEN"]
+    , _tcHelp   = "ACCESS THE CONNECTED SENSOR"
+    , _tcArgumentType = Just "A SENSOR PARAMETER"
+    , _tcArguments  = \tm w -> ["BOOL","VALUE"]
+    , _tcEffect = effectArgMessage sensf
+    }
+effectArgMessage :: (String -> Terminal -> World -> Maybe [String])
+    -> [String] -> Terminal -> World -> Either String World
+effectArgMessage f args tm w = maybe (Left "") Right $ do
+    arg <- safeHead args
+    strs <- f arg tm w
+    return $ w & terminals . ix (_tmID tm) . tmFutureLines ++.~ map makeTermLine strs
+
+sensf :: String -> Terminal -> World -> Maybe [String]
+sensf arg tm w = case arg of
+    "BOOL" -> Just [show $ w ^? machines . ix (_tmMachineID tm) . mcSensor . sensToggle]
+    _ -> Nothing
+
+
+
 helpCommand :: TerminalCommand
 helpCommand = TerminalCommand
    { _tcString = "HELP"
@@ -123,14 +155,16 @@ commandsCommand = TerminalCommand
                )
    }

-singleCommand :: String -> [String] -> String -> (World -> World) -> TerminalCommand
-singleCommand command aliases htext eff = TerminalCommand
+singleCommand :: [String] -> String -> [String] -> String -> (World -> World) -> TerminalCommand
+singleCommand followingLines command aliases htext eff = TerminalCommand
    {_tcString = command
    ,_tcAlias = aliases
    ,_tcHelp = htext
    ,_tcArgumentType = Nothing
    , _tcArguments = const $ const []
-    ,_tcEffect = \_ tm w -> Right $ eff $ w & terminals . ix (_tmID tm) . tmInput .~ Nothing
+    ,_tcEffect = \_ tm w -> Right $ eff $ w 
+        & terminals . ix (_tmID tm) . tmInput . _Just . tiText .~ T.pack ""
+        & terminals . ix (_tmID tm) . tmFutureLines ++.~ map makeTermLine followingLines
 --        & hud . hudElement . subInventory . onInputLine %~ const False
    }

@@ -189,7 +223,7 @@ defaultTermParams = defaultTerminal
    ,_tmTitle = "TERMINAL"
    ,_tmInput   = Nothing
    ,_tmScrollCommands = []
-    ,_tmWriteCommands = []
+    ,_tmWriteCommands = [helpCommand,commandsCommand]
    ,_tmProgram = \_ _ -> termSoundLine computerBeepingS
        : TerminalLineTerminalEffect 0 (tmStatus .~ Connected)
        : map makeTermLine connectionBlurb