From b20502bc350af7817514805146d791592a735a0b Mon Sep 17 00:00:00 2001 From: justin Date: Mon, 6 Jun 2022 18:33:44 +0100 Subject: [PATCH] Commit before removing "un-input-able" terminals --- src/Dodge/Placement/Instance/Analyser.hs | 11 ++---- src/Dodge/Placement/Instance/Terminal.hs | 16 ++++++--- src/Dodge/Render/HUD.hs | 41 +++++++++++----------- src/Dodge/Room/LasTurret.hs | 19 ++-------- src/Dodge/Room/Warning.hs | 2 +- src/Dodge/Terminal.hs | 44 +++++++++++++++++++++--- 6 files changed, 77 insertions(+), 56 deletions(-) diff --git a/src/Dodge/Placement/Instance/Analyser.hs b/src/Dodge/Placement/Instance/Analyser.hs index 7b7ef0300..29be9250f 100644 --- a/src/Dodge/Placement/Instance/Analyser.hs +++ b/src/Dodge/Placement/Instance/Analyser.hs @@ -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 diff --git a/src/Dodge/Placement/Instance/Terminal.hs b/src/Dodge/Placement/Instance/Terminal.hs index c76081b26..4ffaef239 100644 --- a/src/Dodge/Placement/Instance/Terminal.hs +++ b/src/Dodge/Placement/Instance/Terminal.hs @@ -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 diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index eb247c75a..06edf8cc7 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -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) diff --git a/src/Dodge/Room/LasTurret.hs b/src/Dodge/Room/LasTurret.hs index b5df0ebea..b76aae78c 100644 --- a/src/Dodge/Room/LasTurret.hs +++ b/src/Dodge/Room/LasTurret.hs @@ -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) diff --git a/src/Dodge/Room/Warning.hs b/src/Dodge/Room/Warning.hs index c2692e034..494661cc7 100644 --- a/src/Dodge/Room/Warning.hs +++ b/src/Dodge/Room/Warning.hs @@ -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." diff --git a/src/Dodge/Terminal.hs b/src/Dodge/Terminal.hs index 25124b6ef..af9d95837 100644 --- a/src/Dodge/Terminal.hs +++ b/src/Dodge/Terminal.hs @@ -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