Allow terminals to block input

src/Dodge/Data.hs

@@ -939,7 +939,8 @@ data Block = Block
     , _blMaterial :: BlockMaterial
     }
 data BlockMaterial = WoodBlock | DirtBlock | StoneBlock | GlassBlock | MetalBlock
-data TerminalStatus = Connected | Disconnected
+data TerminalStatus = TerminalOff | TerminalBusy | TerminalReady
+  deriving (Eq,Ord,Show)
 data TerminalInput = TerminalInput
     { _tiText   :: T.Text
     , _tiFocus  :: Bool

src/Dodge/Default.hs

@@ -257,7 +257,7 @@ defaultTerminal = Terminal
     , _tmScrollCommands = []
     , _tmWriteCommands  = []
     , _tmDeathEffect    = const id
-    , _tmStatus = Disconnected
+    , _tmStatus = TerminalOff
     , _tmCommandHistory = []
     , _tmToggles = M.empty
     }

src/Dodge/Event.hs

@@ -45,7 +45,7 @@ import SDL
 
 handleEvent :: Event -> Universe -> IO (Maybe Universe)
 handleEvent e = case eventPayload e of
-    TextInputEvent tev         -> handleTextInput (textInputEventText tev)
+    TextInputEvent tev         -> return . Just . handleTextInput (textInputEventText tev)
     KeyboardEvent kev          -> handleKeyboardEvent kev
     MouseMotionEvent mmev      -> return . handleMouseMotionEvent mmev
     MouseButtonEvent mbev      -> return . Just . over uvWorld (handleMouseButtonEvent mbev)
@@ -144,7 +144,7 @@ wheelEvent y w = case _hudElement $ _hud w of
     DisplayInventory (CombineInventory _) -> w
         & hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi)
     DisplayInventory (DisplayTerminal tmid)
-        | rbDown && inTermFocus w -> w
+        | rbDown && inTermFocus w -> guardDisconnectedID tmid w $ w
             & terminals . ix tmid %~ updatetermsubsel
         | inTermFocus w -> w
             & terminals . ix tmid %~ updatetermsel

src/Dodge/Event/Keyboard.hs

@@ -2,6 +2,7 @@
 module Dodge.Event.Keyboard
     ( handleKeyboardEvent
     , handleTextInput
+    , guardDisconnectedID
     ) where
 import Dodge.Terminal
 import Dodge.InputFocus
@@ -30,20 +31,26 @@ import qualified Data.Text as T
 -- dealt with using key presses (handlePressedKey)
 -- also, note that this currently "doubles" the inputs to both terminals if both
 -- are open
-handleTextInput :: T.Text -> Universe -> IO (Maybe Universe)
-handleTextInput text u = return . Just $ u
+handleTextInput :: T.Text -> Universe -> Universe
+handleTextInput text u = u
     & menuLayers . ix 0 . scInput %~ updateText
     & updateTerminalText
   where
     updateTerminalText = case u ^? uvWorld . hud . hudElement . subInventory of
         Just (DisplayTerminal tmid) | hasfocus tmid 
-            -> uvWorld . terminals . ix tmid . tmInput . tiText %~ updateText
+            -> uvWorld %~ \w -> guardDisconnectedID tmid w (w & terminals . ix tmid . tmInput . tiText %~ updateText)
         _   -> id
     hasfocus tmid = fromMaybe False $ u ^? uvWorld . terminals . ix tmid . tmInput . tiFocus
     updateText s = case T.unpack text of 
         ";" -> s
         _ -> s `T.append` T.toUpper text
 
+guardDisconnectedID :: Int -> World -> World -> World
+guardDisconnectedID tmid w w' = case w ^? terminals . ix tmid . tmStatus of
+    Just TerminalReady -> w'
+    _ -> w
+
+
 {- | Handles keyboard press and release.
 On release, remove scancode from the 'Set' of pressed keys.
 On press, adds the scancode, and perhaps applies a direct effect:

src/Dodge/InputFocus.hs

@@ -7,5 +7,7 @@ import Data.Maybe
 inTermFocus :: World -> Bool
 inTermFocus w = fromMaybe False $ do
     tmid <- w ^? hud . hudElement . subInventory . termID
-    w ^? terminals . ix tmid . tmInput . tiFocus
+    hasfocus <- w ^? terminals . ix tmid . tmInput . tiFocus
+    connectionstatus <- w ^? terminals . ix tmid . tmStatus
+    return $ hasfocus && connectionstatus == TerminalReady
 

src/Dodge/Placement/Instance/Terminal.hs

@@ -120,10 +120,11 @@ accessTerminal mtmid w = case mtmid of
         & terminals . ix tmid %~ tryToBoot
       where
         tryToBoot tm = case _tmStatus tm of
-            Connected -> tm
-            Disconnected -> tm
-                & tmFutureLines ++.~ _tmProgram tm tm w
-                & tmStatus .~ Connected
+            TerminalReady -> tm
+            TerminalBusy -> tm
+            TerminalOff -> tm
+                & tmFutureLines .~ _tmProgram tm tm w
+                & tmStatus .~ TerminalBusy
 
 simpleTermMessage :: [String] -> Terminal
 simpleTermMessage strs = defaultTerminal & tmFutureLines .~ map makeTermLine strs

src/Dodge/Render/HUD.hs

@@ -6,6 +6,7 @@ import Dodge.Data
 import Dodge.Combine
 import Dodge.Clock
 import Dodge.Base
+--import Dodge.InputFocus
 --import Dodge.Combine.Combinations
 import Dodge.Inventory
 import Dodge.Inventory.ItemSpace
@@ -144,10 +145,12 @@ displayTerminal tid cfig w = fromMaybe mempty $ do
             $ _tmDisplayedLines tm
         ]
   where
-    displayTermInput tp = case _tmInput tp of
-        TerminalInput s inputstatus _
-                -> (++ [('>':T.unpack s++displayBlinkCursor inputstatus,white)])
-    displayBlinkCursor inputstatus | inputstatus = clockCycle 10 (V.fromList ["_",""]) w
+    displayTermInput tm = case _tmInput tm of
+        TerminalInput s hasfoc _ -> (++ [(displayInputText tm s++displayBlinkCursor hasfoc,white)])
+    displayInputText tm s
+        | _tmStatus tm == TerminalReady = '>':T.unpack s
+        | otherwise = ""
+    displayBlinkCursor hasfoc | hasfoc = clockCycle 10 (V.fromList ["_",""]) w
         | otherwise = []
 
 drawRBOptions :: Configuration -> World -> RightButtonOptions -> Picture

src/Dodge/Terminal.hs

@@ -25,7 +25,7 @@ quitCommand = TerminalCommand
     }
 disconnectTerminal :: Terminal -> World -> World
 disconnectTerminal tm w = w 
-    & terminals . ix (_tmID tm) . tmStatus .~ Disconnected
+    & terminals . ix (_tmID tm) . tmStatus .~ TerminalOff
     & exitTerminalSubInv
     & terminals . ix (_tmID tm) . tmFutureLines .~ 
         [ TerminalLineTerminalEffect 0 (tmDisplayedLines .~ [])
@@ -185,15 +185,21 @@ singleCommand followingLines command aliases htext eff = TerminalCommand
     ,_tcEffect = \_ _ -> NoArguments $ TerminalLineEffect 0 (const eff) : map makeTermLine followingLines
     }
 
+guardDisconnected :: Terminal -> World -> World -> World
+guardDisconnected tm w w' = case _tmStatus tm of
+    TerminalOff -> w
+    TerminalBusy -> w
+    TerminalReady -> w'
+
 doTerminalEffectLB :: Terminal -> World -> World
-doTerminalEffectLB tm w = fromMaybe w $ do
+doTerminalEffectLB tm w = guardDisconnected tm w $ fromMaybe w $ do
     s <- fmap T.unpack $ w ^? terminals . ix (_tmID tm) . tmInput . tiText
     if null (words s) 
         then Just $ defocusTerminalInput w 
         else return $ terminalReturnEffect tm w
 
 terminalReturnEffect :: Terminal -> World -> World
-terminalReturnEffect tm w = fromMaybe w $ do
+terminalReturnEffect tm w = guardDisconnected tm w $ fromMaybe w $ do
     s <- fmap T.unpack $ w ^? terminals . ix (_tmID tm) . tmInput . tiText
     return $ runTerminalString s tm $ w
             & terminals . ix (_tmID tm) . tmFutureLines .~ [makeTermLine ('>':s)]
@@ -241,9 +247,7 @@ basicTerminal = defaultTerminal
     ,_tmInput   = defaultTerminalInput
     ,_tmScrollCommands = [quitCommand]
     ,_tmWriteCommands = [helpCommand,commandsCommand]
-    ,_tmProgram = \_ _ -> termSoundLine computerBeepingS
-        : TerminalLineTerminalEffect 0 (tmStatus .~ Connected)
-        : map makeTermLine connectionBlurb
+    ,_tmProgram = \_ _ -> connectionBlurb1
     , _tmDeathEffect = doDeathTriggers
     }
 
@@ -255,8 +259,11 @@ doDeathTriggers tm w = w
 doDeathToggle :: TerminalToggle -> IM.IntMap (World -> Bool) -> IM.IntMap (World -> Bool)
 doDeathToggle (TerminalToggle trid f) = ix trid %~ f
 
-connectionBlurb :: [String]
-connectionBlurb =
-    ["CONNECTING ..."
-    ,"COMPLETE"
-    ]
+connectionBlurb1 :: [TerminalLine]
+connectionBlurb1 = 
+    [termSoundLine computerBeepingS
+    ,TerminalLineDisplay 0 (const ("CONNECTING ...",white))
+    ,TerminalLineDisplay 10 (const ("...",white))
+    ,TerminalLineDisplay 10 (const ("CONNECTED",white))
+    ,TerminalLineTerminalEffect 0 (tmStatus .~ TerminalReady)]
+