diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index c31ade777..0c60ae162 100644 --- a/src/Dodge/Data.hs +++ b/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 diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 360c36161..048e53188 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -257,7 +257,7 @@ defaultTerminal = Terminal , _tmScrollCommands = [] , _tmWriteCommands = [] , _tmDeathEffect = const id - , _tmStatus = Disconnected + , _tmStatus = TerminalOff , _tmCommandHistory = [] , _tmToggles = M.empty } diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 9b3884ead..7a1ba9c94 100644 --- a/src/Dodge/Event.hs +++ b/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 diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index bf0b2260c..9f9e7092c 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/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: diff --git a/src/Dodge/InputFocus.hs b/src/Dodge/InputFocus.hs index 99f5a9dd9..71c37b549 100644 --- a/src/Dodge/InputFocus.hs +++ b/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 diff --git a/src/Dodge/Placement/Instance/Terminal.hs b/src/Dodge/Placement/Instance/Terminal.hs index b69f96fd9..9d6d70112 100644 --- a/src/Dodge/Placement/Instance/Terminal.hs +++ b/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 diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index e19d4deec..20b0f3350 100644 --- a/src/Dodge/Render/HUD.hs +++ b/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 diff --git a/src/Dodge/Terminal.hs b/src/Dodge/Terminal.hs index 904a4f96f..0591328b8 100644 --- a/src/Dodge/Terminal.hs +++ b/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)] +