Cancel terminal display if destroyed while displaying

src/Dodge/Button/Draw.hs

@@ -11,8 +11,7 @@ drawButton :: Button -> SPic
 drawButton bt = case bt ^. btEvent of
     ButtonPress {_bpColor = col} -> defaultDrawButton col bt
     ButtonSwitch {_bsColor1 = col1, _bsColor2 = col2} -> drawSwitch col1 col2 bt
-    ButtonAccessTerminal -> mempty
+    ButtonAccessTerminal _ -> mempty
---    ButtonDoNothing -> mempty
 
 drawSwitch :: Color -> Color -> Button -> SPic
 drawSwitch col1 col2 bt

src/Dodge/Button/Event.hs

@@ -5,7 +5,6 @@ import Control.Lens
 import Dodge.Data.World
 import Dodge.SoundLogic
 import Dodge.WorldEffect
-import Sound.Data
 
 doButtonEvent :: ButtonEvent -> Button -> World -> World
 doButtonEvent = \case
@@ -13,10 +12,10 @@ doButtonEvent = \case
     ButtonPress False f _ -> buttonFlip f
     ButtonSwitch _ f _ _ True -> buttonFlip f
     ButtonSwitch f _ _ _ False -> buttonFlip f
-    ButtonAccessTerminal -> accessTerminal . _btTermMID
+    ButtonAccessTerminal tid -> const $ accessTerminal tid
 
 buttonFlip :: WdWd -> Button -> World -> World
 buttonFlip f bt =
     doWdWd f
-        . soundWithStatus ToStart (LeverSound 0) (bt ^. btPos) click1S Nothing
+        . soundStart (ButtonSound (bt ^. btID)) (bt ^. btPos) click1S Nothing
         . over (cWorld . lWorld . buttons . ix (bt ^. btID) . btEvent . btOn) not

src/Dodge/Combine.hs

@@ -21,14 +21,14 @@ combineList :: World -> [SelectionItem CombinableItem]
 combineList = map f . combineItemListYouX
   where
     f (is, itm) =
-        SelectionItem
+        SelItem
             { _siPictures = basicItemDisplay itm
             , _siHeight = itInvHeight itm
             , _siWidth = 15
             , _siIsSelectable = True
             , _siColor = itemInvColor $ baseCI itm
             , _siOffX = 0
-            , _siPayload = CombinableItem is itm
+            , _siPayload = Just $ CombinableItem is itm
             }
 
 combineItemListYouX :: World -> [([Int], Item)]

src/Dodge/Data/Button.hs

@@ -25,14 +25,13 @@ data ButtonEvent
         , _bsColor2 :: Color
         , _btOn :: Bool
         }
-    | ButtonAccessTerminal
+    | ButtonAccessTerminal {_btTermID :: Int}
 
 data Button = Button
     { _btPos :: Point2
     , _btRot :: Float
     , _btEvent :: ButtonEvent
     , _btID :: Int
-    , _btTermMID :: Maybe Int
     }
 
 makeLenses ''Button

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/SelectionList.hs

@@ -41,22 +41,14 @@ data SelectionWidth
     | UseItemWidth
 
 data SelectionItem a
-    = SelectionItem
+    = SelItem
-        { _siPictures :: [String]
-        , _siHeight :: Int
-        , _siWidth :: Int
-        , _siIsSelectable :: Bool
-        , _siColor :: Color
-        , _siOffX :: Int
-        , _siPayload :: a
-        }
-    | SelectionInfo
         { _siPictures :: [String]
         , _siHeight :: Int
         , _siWidth :: Int
         , _siIsSelectable :: Bool
         , _siColor :: Color
         , _siOffX :: Int
+        , _siPayload :: Maybe a
         }
 
 makeLenses ''ListDisplayParams

src/Dodge/Data/SoundOrigin.hs

@@ -34,7 +34,7 @@ data SoundOrigin
     | GlassBreakSound Int
     | MaterialSound Material Int
     | TeleSound Int
-    | LeverSound Int
+    | ButtonSound Int
     | Explosion Int
     | Tap Int
     | EBSound Int

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/Data/WorldEffect.hs

@@ -22,7 +22,7 @@ data WdWd
     | SetTrigger Bool Int
     | WorldEffects [WdWd] -- probably best to avoid recursive types if possible...
     | SetLSCol Point3 Int
-    | AccessTerminal (Maybe Int)
+    | AccessTerminal Int
     | UnlockInv
     | SoundStart SoundOrigin Point2 SoundID (Maybe Int)
     | MakeStartCloudAt Point3

src/Dodge/Default.hs

@@ -46,16 +46,11 @@ defaultMachine =
         }
 
 defaultButton :: Button
-defaultButton =
+defaultButton = Button
-    Button
+        { _btPos = 0
-        { _btPos = V2 0 0
         , _btRot = 0
         , _btEvent = ButtonPress False NoWorldEffect (dark red)
         , _btID = 0
---        , _btState = BtOff
-        , _btTermMID = Nothing
---        , _btName = ""
---        , _btColor = red
         }
 
 defaultPP :: PressPlate

src/Dodge/DisplayInventory.hs

@@ -65,12 +65,12 @@ updateCombineSections w cfig =
     sclose'
         | null sclose =
             IM.singleton 0 $
-                SelectionInfo ["No possible combinations"] 1 25 False white 0
+                SelItem ["No possible combinations"] 1 25 False white 0 Nothing
         | otherwise = sclose
 
 regexCombs :: IM.IntMap Item -> SelectionItem CombinableItem -> String -> Bool
 regexCombs inv ci = \case
-    '#' : str -> any (g str) (_ciInvIDs $ _siPayload ci)
+    '#' : str -> any (g str) (_ciInvIDs $ fromJust $ _siPayload ci)
     str -> (regexList str . _siPictures) ci
   where
     g str i = maybe False (regexList str . basicItemDisplay) (inv ^? ix i)
@@ -129,7 +129,7 @@ updateDisplaySections w cfig =
                 [ invhead
                 , sinv
                 , IM.singleton 0 
-                    $ SelectionItem [displayFreeSlots (crNumFreeSlots cr)] 1 15 True invDimColor 2 ()
+                    $ SelItem [displayFreeSlots (crNumFreeSlots cr)] 1 15 True invDimColor 2 Nothing
                 , nearbyhead
                 , sclose
                 , interfaceshead
@@ -153,7 +153,7 @@ updateDisplaySections w cfig =
     btitems =
         IM.fromDistinctAscList . zip [0 ..] $
             mapMaybe (closeButtonToSelectionItem w) (w ^. hud . closeButtons)
-    makehead str = IM.singleton 0 $ SelectionInfo [str] 1 15 False white 0
+    makehead str = IM.singleton 0 $ SelItem [str] 1 15 False white 0 Nothing
     invhead = if null sfinv then makehead "INVENTORY" else sfinv
     cr = you w
     closeitms =
@@ -179,13 +179,14 @@ filterSectionsPair infocus filtfn itms filtdescription mfilt = (filtsis, itms')
         return $
             IM.singleton
                 0
-                $ SelectionInfo
+                $ SelItem
                     [filtdescription ++ " FILTER/" ++ str ++ [filtcurs], numfiltitems]
                     2
                     (length (filtdescription ++ " FILTER/" ++ str ++ [filtcurs]))
                     True
                     white
                     0
+                    Nothing
     itms' = maybe id (IM.filter . filtfn) mfilt itms
     numfiltitems = "  " ++ show (length itms - length itms') ++ " FILTERED"
 

src/Dodge/Inventory.hs

@@ -116,7 +116,6 @@ rmInvItem cid invid w =
         | x > invid || Just x == maxk = max 0 $ x - 1
         | otherwise = x
 
-
 -- this looks ugly...
 updateCloseObjects :: World -> World
 updateCloseObjects w =
@@ -137,6 +136,9 @@ updateCloseObjects w =
     activeButtons = filter canpress . IM.elems $ w ^. cWorld . lWorld . buttons
     canpress bt = case bt ^. btEvent of
         ButtonPress {_btOn = t} -> not t
+        ButtonAccessTerminal tid -> fromMaybe False $ do
+            x <- w ^? cWorld . lWorld . terminals . ix tid . tmStatus
+            return (x /= TerminalDeactivated)
         _ -> True
 
 changeSwapSel :: Int -> World -> World

src/Dodge/Inventory/SelectionList.hs

@@ -31,14 +31,14 @@ import Picture.Base
 
 invSelectionItem :: World -> Int -> LocationDT OItem -> SelectionItem ()
 invSelectionItem w indent loc =
-    SelectionItem
+    SelItem
         { _siPictures = itemDisplay w cr ci
         , _siHeight = itInvHeight $ ci ^. _1
         , _siWidth = 15
         , _siIsSelectable = True
         , _siColor = itemInvColor ci
         , _siOffX = indent
-        , _siPayload = ()
+        , _siPayload = Nothing
         }
   where
     ci = (a,b)
@@ -207,35 +207,35 @@ closeItemToSelectionItem w (NInt i) = do
     e <- w ^? cWorld . lWorld . floorItems . unNIntMap . ix i
     let (pics, col) = closeItemToTextPictures e
     return
-        SelectionItem
+        SelItem
             { _siPictures = pics
             , _siHeight = length pics
             , _siWidth = 15
             , _siIsSelectable = True
             , _siColor = col
             , _siOffX = 0
-            , _siPayload = ()
+            , _siPayload = Nothing
             }
 
 closeButtonToSelectionItem :: World -> Int -> Maybe (SelectionItem ())
 closeButtonToSelectionItem w i = do
     bt <- w ^? cWorld . lWorld . buttons . ix i
     return
-        SelectionItem
+        SelItem
             { _siPictures = [btText bt]
             , _siHeight = 1
             , _siWidth = 15
             , _siIsSelectable = True
             , _siColor = yellow
             , _siOffX = 0
-            , _siPayload = ()
+            , _siPayload = Nothing
             }
 
 btText :: Button -> String
 btText bt = case _btEvent bt of
     ButtonPress {} -> "BUTTON"
     ButtonSwitch {_btOn = t} -> if t then "SWITCH\\" else "SWITCH/"
-    ButtonAccessTerminal -> "TERMINAL"
+    ButtonAccessTerminal {} -> "TERMINAL"
 
 closeItemToTextPictures :: FloorItem -> ([String], Color)
 closeItemToTextPictures flit = (basicItemDisplay it, itemInvColor $ baseCI it)

src/Dodge/Menu/Option.hs

@@ -96,14 +96,14 @@ menuOptionToSelectionItem ::
     MenuOption ->
     SelectionItem (Universe -> Universe, Universe -> Universe)
 menuOptionToSelectionItem w padAmount mo =
-    SelectionItem
+    SelItem
         { _siPictures = [optionText]
         , _siHeight = 1
         , _siWidth = 50
         , _siIsSelectable = isselectable
         , _siColor = thecol
         , _siOffX = 0
-        , _siPayload = (f, g)
+        , _siPayload = Just (f, g)
         }
   where
     isselectable = case _moString mo w of

src/Dodge/Placement/Instance/Terminal.hs

@@ -17,7 +17,7 @@ putTerminal :: Color -> Machine -> Terminal -> Placement
 putTerminal col mc tm =
     ps0PushPS (PutTerminal (tm & tmExternalColor .~ col)) $
         \tmpl -> Just $
-            ps0PushPS (PutButton termButton) $
+            ps0PushPS (PutButton defaultButton) $
                 \btpl -> Just $
                     pt0
                         ( PutMachine
@@ -34,7 +34,7 @@ putTerminal col mc tm =
             & cWorld . lWorld . terminals . ix tmid . tmButtonID .~ btid
             & cWorld . lWorld . terminals . ix tmid . tmMachineID .~ mcid
             & cWorld . lWorld . machines . ix mcid . mcMounts . at OTTerminal ?~ tmid
-            & cWorld . lWorld . buttons . ix btid . btTermMID ?~ tmid
+            & cWorld . lWorld . buttons . ix btid . btEvent .~ ButtonAccessTerminal tmid
       where
         tmid = fromJust (_plMID tmpl)
         btid = fromJust (_plMID btpl)
@@ -48,15 +48,5 @@ putMessageTerminal col =
             & mcType .~ McTerminal
             & mcHP .~ 100
 
-termButton :: Button
-termButton =
-    Button
-        { _btPos = 0
-        , _btRot = 0
-        , _btEvent = ButtonAccessTerminal
-        , _btID = 0
-        , _btTermMID = Nothing
-        }
-
 terminalColor :: Color
 terminalColor = dark magenta

src/Dodge/Render/HUD.hs

@@ -1,10 +1,7 @@
 {-# LANGUAGE LambdaCase #-}
 
-module Dodge.Render.HUD (
+module Dodge.Render.HUD (drawHUD) where
-    drawHUD,
-) where
 
-import Dodge.Data.Terminal.Status
 import Control.Applicative
 import Control.Lens
 import Control.Monad
@@ -23,6 +20,7 @@ import Dodge.Data.Config
 import Dodge.Data.DoubleTree
 import Dodge.Data.EquipType
 import Dodge.Data.SelectionList
+import Dodge.Data.Terminal.Status
 import Dodge.Data.World
 import Dodge.DoubleTree
 import Dodge.Equipment.Text
@@ -34,7 +32,6 @@ import Dodge.Item.InvSize
 import Dodge.Item.Location
 import Dodge.ListDisplayParams
 import Dodge.Render.Connectors
---import Dodge.Render.HUD.Carte
 import Dodge.Render.List
 import Dodge.ScreenPos
 import Dodge.SelectionSections
@@ -105,9 +102,7 @@ getRootItemBounds i inv = do
 drawMouseOver :: Configuration -> World -> Picture
 drawMouseOver cfig w =
     concat
-        ( invsel <|> combinvsel
+        (invsel <|> combinvsel <|> drawDragSelecting cfig w)
-            <|> drawDragSelecting cfig w
-        )
         <> concat (drawDragSelected cfig w)
   where
     invsel = do
@@ -211,14 +206,14 @@ drawExamineInventory cfig w =
             )
   where
     f str =
-        SelectionItem
+        SelItem
             { _siPictures = [str]
             , _siWidth = 55
             , _siHeight = 1
             , _siIsSelectable = True
             , _siColor = white
             , _siOffX = 0
-            , _siPayload = ()
+            , _siPayload = Nothing
             }
 
 closeObjectInfo :: Int -> Either FloorItem Button -> String
@@ -240,11 +235,10 @@ yourAugmentedItem f x g w = case you w ^? crManipulation . manObject of
         j <- w ^? hud . closeItems . ix i . unNInt
         flit <- w ^? cWorld . lWorld . floorItems . unNIntMap . ix j
         return . g $ Left flit
-    --        g . Left $ w ^?! hud . closeItems . ix i
     Just (SelCloseButton i) -> fromMaybe x $ do
         j <- w ^? hud . closeButtons . ix i
-        flit <- w ^? cWorld . lWorld . buttons . ix j
+        but <- w ^? cWorld . lWorld . buttons . ix j
-        return . g $ Right flit
+        return . g $ Right but
     _ -> x
 
 drawRBOptions :: Configuration -> World -> Picture
@@ -343,13 +337,12 @@ combineInventoryExtra ::
     Configuration ->
     World ->
     Picture
-combineInventoryExtra sss msel cfig w = fromMaybe mempty $ do
+combineInventoryExtra sss msel cfig w = fold $ do
     (i, j) <- msel
     si <- sss ^? ix i . ssItems . ix j
     let col = _siColor si
-    lnks <- si ^? siPayload . ciInvIDs
+    lnks <- si ^? siPayload . _Just . ciInvIDs
-    return (lnkMidPosInvSelsCol cfig w j col lnks)
+    return (lnkMidPosInvSelsCol cfig w j col lnks) <> foldMap invcursor lnks
-        <> foldMap invcursor lnks
   where
     invcursor i = do
         sss' <- w ^? hud . hudElement . diSections
@@ -362,32 +355,33 @@ combineInventoryExtra sss msel cfig w = fromMaybe mempty $ do
                     (Just (0, i))
 
 drawTerminalDisplay :: Int -> Configuration -> LWorld -> Picture
-drawTerminalDisplay tid cfig w = fromMaybe mempty $ do
+drawTerminalDisplay tid cfig w = fold $ do
     tm <- w ^? terminals . ix tid
     let tsize = getMaxLinesTM + 1
     return $
         invHead cfig ("T-" ++ show tid)
-            <> drawSelectionList secondColumnParams cfig (thesellist tm)
+            <> drawSelectionList secondColumnParams cfig (f tm)
             <> color
                 (withAlpha 0.5 green) -- consider integrating termScreenColor somehow
                 (drawSelectionListBackground secondColumnParams cfig tsize)
             <> color (dark $ _tmExternalColor tm) (drawTitleBackground cfig)
   where
-    toselitm (str, col) = SelectionItem [str] 1 55 True col 0 ()
+    toselitm (str, col) = SelItem [str] 1 55 True col 0 Nothing
     -- not sure if the width (55) is correct here
-    thesellist tm = thelist tm
+    f tm =
-    thelist tm =
         map toselitm . displayTermInput tm
             . reverse
             . take getMaxLinesTM
             $ _tmDisplayedLines tm
     displayTermInput tm = case _tmStatus tm of
         TerminalOff -> id
+        TerminalDeactivated -> id
         TerminalLineRead -> id
         TerminalTextInput s ->
             (++ [(getPromptTM ++ s ++ [cFilledRect], white)])
         TerminalPressTo s ->
             (++ [(getPromptTM ++ "PRESS TO " ++ s, white)])
+
 --        | hasfoc = clockCycle 10 (V.fromList [[cFilledRect] , "."]) w
 
 lnkMidPosInvSelsCol :: Configuration -> World -> Int -> Color -> [Int] -> Picture
@@ -505,4 +499,4 @@ selNumPosCardinal card cfig ldp sss i j = do
     ygap = _ldpVerticalGap ldp
 
 selSecSelCol :: Int -> Int -> IM.IntMap (SelectionSection a) -> Maybe Color
-selSecSelCol i j sss = sss ^? ix i . ssItems . ix j . siColor
+selSecSelCol i j = (^? ix i . ssItems . ix j . siColor)

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/SoundLogic.hs

@@ -11,7 +11,7 @@ module Dodge.SoundLogic (
     soundContinueVol,
     soundMultiFrom,
     stopSoundFrom,
-    soundWithStatus,
+--    soundWithStatus,
 
     -- * helper to determine the angle of a sound given a world position
     soundAngle,

src/Dodge/Terminal.hs

@@ -3,7 +3,6 @@
 module Dodge.Terminal (
     makeTermLine,
     connectionBlurbLines,
-    disconnectTerminal,
     textTerminal,
     simpleTermMessage,
     damageCodeCommand,
@@ -13,19 +12,15 @@ module Dodge.Terminal (
     toggleCommand,
     terminalReturnEffect,
     getCommands,
-    makeColorTermPara,
-    commandColor,
     tabComplete,
     tlSetStatus,
 ) where
 
---import Dodge.Data.WorldEffect
+import Color
-
-import qualified Data.Map.Strict as M
 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
@@ -41,10 +36,7 @@ import LensHelp
 import Sound.Data
 
 textTerminal :: Terminal
-textTerminal =
+textTerminal = defaultTerminal{_tmBootLines = connectionBlurb}
-    defaultTerminal
-        { _tmBootLines = connectionBlurb
-        }
 
 connectionBlurbLines :: [TerminalLine] -> [TerminalLine]
 connectionBlurbLines tls =
@@ -54,53 +46,6 @@ connectionBlurbLines tls =
         ++ tls
         ++ [TLine 10 [TerminalLineConst "READY FOR INPUT" termTextColor] (TmTmSetStatus (TerminalTextInput ""))]
 
---        ++ [TerminalLineEffect 0 (TmTmSetStatus (TerminalTextInput "" 0))]
-
---quitCommand :: TerminalCommand
---quitCommand =
---    TerminalCommand
---        { _tcString = "QUIT"
---        , _tcAlias = ["Q", "EXIT", "X", "SHUTDOWN", ""]
---        , _tcHelp = "Disconnects the terminal."
---        , _tcEffect = TerminalCommandArguments $ NoArguments [TLine 0 [] TmWdWdDisconnectTerminal]
---        }
-
---helpCommand :: TerminalCommand
---helpCommand =
---    TerminalCommand
---        { _tcString = "HELP"
---        , _tcAlias = ["H", "MAN"]
---        , _tcHelp = "Displays help for a specific command."
---        , _tcEffect = TerminalCommandEffectHelp -- \tm -> OneArgument "AN AVAILABLE COMMAND" . getCommandsHelp tm
---        }
-
---getCommandsHelp :: Terminal -> World -> M.Map String [TerminalLine]
---getCommandsHelp tm w = foldr f mempty $ getCommands tm
---  where
---    f tc =
---        M.insert
---            (_tcString tc)
---            ( [ makeTermLine "Command:"
---              , makeColorTermLine commandColor (_tcString tc)
---              , makeTermLine "Aliases:"
---              , makeColorTermLine commandColor (unwords (_tcAlias tc))
---              ]
---                ++ case argumentHelp tc tm w of
---                    (arghelp, Nothing) -> makeTermPara $ _tcHelp tc ++ " " ++ arghelp
---                    (arghelp, Just args) ->
---                        makeTermPara (_tcHelp tc ++ " " ++ arghelp)
---                            ++ [makeColorTermLine commandColor $ unwords args]
---            )
-
---commandsCommand :: TerminalCommand
---commandsCommand =
---    TerminalCommand
---        { _tcString = "COMMANDS"
---        , _tcAlias = ["COMMAND", "COM"]
---        , _tcHelp = "Displays available commands."
---        , _tcEffect = TerminalCommandEffectCommands
---        }
-
 connectionBlurb :: [TerminalLine]
 connectionBlurb = connectionBlurbLines []
 
@@ -128,22 +73,30 @@ damageCodeCommand = PTE.singleton "DAMAGECODE" $ PTE.fromList $ mapMaybe f [minB
     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 =
+    PTE.singleton "SENSOR" $
+        PTE.fromList
             [ ("REQUIREMENT", [])
             , ("DISTANCE", [])
             , ("STATUS", [])
             ]
 
 toggleCommand :: Terminal -> PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
-toggleCommand tm = PTE.singleton "TOGGLE" $ PTE.fromList $
+toggleCommand tm =
+    PTE.singleton "TOGGLE" $
+        PTE.fromList $
             M.toList $ fmap f $ tm ^. tmToggles
   where
-    f x = [TLine 1 
+    f x =
+        [ TLine
+            1
             [TerminalLineConst "TOGGLE DONE!" termTextColor]
             (TmWdWdfromWdWd (WdWdNegateTrig $ x ^. ttTriggerID))
         ]
@@ -158,7 +111,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
@@ -195,93 +148,10 @@ tabComplete s' tm = case PTE.lookup s $ getCommands tm of
                 & tmFutureLines
                 .~ ( makeColorTermPara
                         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
---    TerminalCommandArguments eas -> \_ _ -> eas
---    TerminalCommandEffectDamageCoding -> \_ -> OneArgument "a damage type" . getDamageCoding
---    TerminalCommandEffectSensorParameter -> \tm -> OneArgument "a sensor parameter" . sensorInfoMap tm
---    TerminalCommandEffectLinkedObject -> \tm _ -> OneArgument "a linked object" (togglesToEffects tm)
---    TerminalCommandEffectHelp -> \tm -> OneArgument "an available command" . getCommandsHelp tm
---    TerminalCommandEffectNoArgumentsStr str -> \_ _ -> NoArguments (makeTermPara str)
---    TerminalCommandEffectCommands -> \tm _ ->
---        NoArguments
---            ( makeTermLine "Available commands:" :
---              makeColorTermPara commandColor (unwords (map _tcString $ getCommands tm))
---            )
---    TerminalCommandEffectSingleCommand eff followingLines -> \_ _ -> NoArguments $ TLine 0 [] (TmWdWdfromWdWd eff) : map makeTermLine followingLines
---    TerminalCommandEffectNone -> \_ _ -> NoArguments []
-
---argumentHelp :: TerminalCommand -> Terminal -> World -> (String, Maybe [String])
---argumentHelp tc tm w = case doTerminalCommandEffect (_tcEffect tc) tm w of
---    NoArguments{} -> ("Any arguments provided to this command are ignored.", Nothing)
---    OneArgument argtype argm ->
---        ( "Expects " ++ argtype ++ " as argument. Available arguments: "
---        , Just (M.keys argm)
---        )
-
---infoCommand :: String -> TerminalCommand
---infoCommand str =
---    TerminalCommand
---        { _tcString = "INFORMATION"
---        , _tcAlias = ["INFO", "I"]
---        , _tcHelp = "DISPLAYS INFORMATION CONCERNING THE TERMINAL."
---        , _tcEffect = TerminalCommandEffectNoArgumentsStr str -- \_ _ -> NoArguments (makeTermPara str)
---        }
-
---singleCommand :: [String] -> String -> [String] -> String -> WdWd -> TerminalCommand
---singleCommand followingLines command aliases htext eff =
---    TerminalCommand
---        { _tcString = command
---        , _tcAlias = aliases
---        , _tcHelp = htext
---        , _tcEffect = TerminalCommandEffectSingleCommand eff followingLines
---        }
-
---getDamageCoding :: World -> M.Map String [TerminalLine]
---getDamageCoding = decodedtmap . _sensorCoding . _cwgParams . _cwGen . _cWorld
-
---sensorInfoMap :: Terminal -> World -> M.Map String [TerminalLine]
---sensorInfoMap tm w =
---    M.fromList
---        [ ("Requirement", getSensor _proxRequirement tm w)
---        , ("Distance", getSensor _proxDist tm w)
---        , ("Currentstatus", getSensor _proxStatus tm w)
---        , ("Paststatus", getSensor _sensToggle tm w)
---        ]
-
---getSensor :: Show a => (Sensor -> a) -> Terminal -> World -> [TerminalLine]
---getSensor f tm w =
---    maybe
---        []
---        (makeTermPara . map toLower . show . f)
---        (w ^? cWorld . lWorld . machines . ix (_tmMachineID tm) . mcType . _McSensor)
-
-
---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 =
-    (cWorld . lWorld . terminals . ix (_tmID tm) . tmStatus .~ TerminalOff)
-        . exitTerminalSubInv
-        . ( cWorld . lWorld . terminals . ix (_tmID tm) . tmDisplayedLines .~ []
                    )
 
-exitTerminalSubInv :: World -> World
-exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of
-    Just _ ->
-        w & hud . hudElement . subInventory
-            .~ NoSubInventory --MouseInvNothing
-    _ -> w
-
 --damageCodeCommand :: TerminalCommand
 --damageCodeCommand =
 --    TerminalCommand
@@ -306,47 +176,20 @@ exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of
 simpleTermMessage :: [String] -> Terminal
 simpleTermMessage strs = defaultTerminal & tmBootLines .~ map makeTermLine strs
 
---commandFutureLines :: String -> Terminal -> World -> [TerminalLine]
---commandFutureLines s tm w = fromMaybe [errline "^ Invalid command"] $ do
---    (str, args) <- safeUncons $ words s
---    command <- find (\tc -> _tcString tc == str || str `elem` _tcAlias tc) (getCommands tm)
---    case doTerminalCommandEffect (_tcEffect command) tm w of
---        NoArguments tls -> Just tls
---        OneArgument argtype m ->
---            let setpartial
---                    | null (_tmPartialCommand tm) =
---                        TLine 0 [] (TmTmSetPartialCommand (Just command)) :
---                        makeTermPara ("Expects " ++ argtype ++ " as an argument")
---                    | otherwise =
---                        TLine 0 [] (TmTmSetPartialCommand Nothing) :
---                        makeTermPara "No argument input, cancelling"
---             in Just $
---                    fromMaybe setpartial $
---                        safeHead args >>= (m M.!?)
---  where
---    errline = makeColorTermLine red
-
 terminalReturnEffect :: Int -> World -> World
 terminalReturnEffect tmid w = fromMaybe w $ do
     tm <- w ^? cWorld . lWorld . terminals . ix tmid
     s <- tm ^? tmStatus . tiText
-    return $
+    let ss = fromMaybe [makeTermLine "ERROR: INPUT NOT RECOGNISED"] $ do
-        runTerminalInput s tm $
-            w
-                & cWorld . lWorld . terminals . ix tmid . tmDisplayedLines
-                    .:~ (getPromptTM ++ s, termTextColor)
-
-runTerminalInput :: String -> Terminal -> World -> World
-runTerminalInput s tm w =
-    w & cWorld . lWorld . terminals . ix (_tmID tm)
-        %~ ( (tmFutureLines ++.~ ss <> [TLine 1 [] (TmTmSetStatus $ TerminalTextInput "")])
-                . (tmCommandHistory %~ take 10 . (s :))
-                . (tmStatus .~ TerminalLineRead)
-           )
-  where
-    ss = fromMaybe [makeTermLine "ERROR: INPUT NOT RECOGNISED"] $ do
             let args = words s
             x <- args ^? ix 0
             teff <- PTE.lookup x (getCommands tm)
             let y = fromMaybe "" (args ^? ix 1)
             PTE.lookup y teff
+    return $ w 
+        & totm . tmDisplayedLines .:~ (getPromptTM ++ s, termTextColor)
+        & totm . tmFutureLines .~ ss <> tlSetStatus (TerminalTextInput "")
+        & totm . tmCommandHistory %~ take 10 . (s :)
+        & totm . tmStatus .~ TerminalLineRead
+  where
+    totm = cWorld . lWorld . terminals . ix tmid

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/TestString.hs

@@ -28,8 +28,7 @@ import qualified IntMapHelp as IM
 import qualified Data.Map.Strict as M
 
 testStringInit :: Universe -> [String]
-testStringInit u = [show $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crHP
+testStringInit u = map show $ u ^.. uvWorld . cWorld . lWorld . terminals . each . tmStatus
-    , show $ u ^? uvWorld . timeFlow . respawnDelay]
 -- map shortShow (u ^.. uvWorld . cWorld . lWorld . debris . each . to g)
 --  where
 --    g db = (pz,z,norm v)

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 ?~ ()
@@ -385,14 +385,20 @@ updateKeysInTerminal :: Int -> Universe -> Universe
 updateKeysInTerminal tmid u = fromMaybe u $ do
     tm <- u ^? uvWorld . cWorld . lWorld . terminals . ix tmid
     return $ case tm ^. tmStatus of
+        TerminalDeactivated -> u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory
         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
@@ -546,7 +552,7 @@ getCloseObj w = getSelectedCloseObj w <|> firstcitem <|> firstcbut
 tryCombine :: (Int, Int) -> World -> World
 tryCombine (i, j) w = fromMaybe w $ do
     sss <- w ^? hud . hudElement . subInventory . ciSections
-    CombinableItem is it <- sss ^? ix i . ssItems . ix j . siPayload
+    CombinableItem is it <- sss ^? ix i . ssItems . ix j . siPayload . _Just
     p <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
     return $
         snd (createItemYou it (foldr (destroyInvItem 0) w (sort is)))

src/Dodge/Update/Input/ScreenLayer.hs

@@ -63,11 +63,11 @@ mouseClickOptionsList u = fromMaybe u $ do
     case u ^. uvWorld . input . mouseButtons of
         mbs | mbs ^. at ButtonLeft == Just 0 -> do
             i <- u ^? uvWorld . input . mouseContext . mcoMenuClick
-            f <- sl ^? ix i . siPayload . _1
+            f <- sl ^? ix i . siPayload . _Just . _1
             return $ f u & uvSoundQueue .:~ click1S
         mbs | mbs ^. at ButtonRight == Just 0 -> do
             i <- u ^? uvWorld . input . mouseContext . mcoMenuClick
-            f <- sl ^? ix i . siPayload . _2
+            f <- sl ^? ix i . siPayload . _Just . _2
             return $ f u & uvSoundQueue .:~ click1S
         _ -> Nothing
 

src/Dodge/WorldEffect.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE LambdaCase #-}
+
 module Dodge.WorldEffect (
     doWdWd,
     accessTerminal,
@@ -6,6 +7,7 @@ module Dodge.WorldEffect (
     lineOutputTerminal,
 ) where
 
+import Control.Monad
 import Data.Foldable
 import qualified Data.Map.Strict as M
 import Data.Maybe
@@ -51,12 +53,13 @@ doWdWd we = case we of
         loc <- invIndents (cr ^. crInv) ^? ix invid . _2
         return $ heldEffectMuzzles loc cr w
 
-accessTerminal :: Maybe Int -> World -> World
+accessTerminal :: Int -> World -> World
-accessTerminal mtmid w = fromMaybe w $ do
+accessTerminal tid w = fromMaybe w $ do
-    tmid <- mtmid
+    tm <- w ^? cWorld . lWorld . terminals . ix tid
+    guard (tm ^. tmStatus /= TerminalDeactivated)
     return $
-        w & hud . hudElement . subInventory .~ DisplayTerminal tmid
+        w & hud . hudElement . subInventory .~ DisplayTerminal tid
-            & cWorld . lWorld . terminals . ix tmid %~ tryToBoot
+            & cWorld . lWorld . terminals . ix tid %~ tryToBoot
   where
     tryToBoot tm = case _tmStatus tm of
         TerminalTextInput{} -> tm
@@ -66,6 +69,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
@@ -84,7 +88,8 @@ lineOutputTerminal tls =
         }
 
 doDeathTriggers :: Terminal -> World -> World
-doDeathTriggers tm = cWorld . lWorld . triggers %~ flip (foldl' $ flip doDeathToggle) xs
+doDeathTriggers tm = (cWorld . lWorld . triggers %~ flip (foldl' $ flip doDeathToggle) xs)
+    . (cWorld . lWorld . terminals . ix (tm ^. tmID) . tmStatus .~ TerminalDeactivated)
   where
     xs = M.elems $ _tmToggles tm
 
@@ -98,7 +103,8 @@ doTmWdWd tmwdwd = case tmwdwd of
         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 
+        return $
+            w & cWorld . lWorld . terminals . ix tid . tmFutureLines
                 .~ decodeSensorType st w
     TmGetSensor s -> \tm w -> fromMaybe w $ do
         tid <- tm ^? tmID
@@ -116,13 +122,33 @@ 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
     TmWdWdDoDeathTriggers -> doDeathTriggers
     TmWdWdfromWdWd f -> \_ -> doWdWd f
 
+powerDownTerminal :: Terminal -> World -> World
+powerDownTerminal tm =
+    (cWorld . lWorld . terminals . ix (_tmID tm) . tmStatus .~ TerminalOff)
+        . (cWorld . lWorld . terminals . ix (_tmID tm) . tmDisplayedLines .~ [])
+        . exitTerminalSubInv
+
+deactivateTerminal :: Terminal -> World -> World
+deactivateTerminal tm =
+    (cWorld . lWorld . terminals . ix (_tmID tm) . tmStatus .~ TerminalDeactivated)
+        . (cWorld . lWorld . terminals . ix (_tmID tm) . tmDisplayedLines .~ [])
+        . exitTerminalSubInv
+
+exitTerminalSubInv :: World -> World
+exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of
+    Just _ ->
+        w & hud . hudElement . subInventory
+            .~ NoSubInventory --MouseInvNothing
+    _ -> w
+
 decodeSensorType :: SensorType -> World -> [TerminalLine]
 decodeSensorType st w = fromMaybe [] $ do
     x <- w ^? cWorld . cwGen . cwgParams . sensorCoding . ix st