diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index 79eddcdf4..ff58149e8 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -15,8 +15,8 @@ import qualified Data.Set as S import Data.Maybe {- | The AI equivalent for your control. -} yourControl :: Creature -> World -> World -yourControl cr w = case w ^? hud . hudElement . subInventory . termParams . termInput . _Just of - Just _ -> w +yourControl cr w = case w ^? hud . hudElement . subInventory . onInputLine of + Just True -> w _ -> w & creatures . ix (_crID cr) %~ (wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons w)) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index ee0f32423..d41d5ba18 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -203,8 +203,8 @@ data SubInventory | InspectInventory | LockedInventory | DisplayTerminal - {_termParams :: TerminalParams - ,_termID :: Int + {_termID :: Int + ,_onInputLine :: Bool } -- deriving (Eq,Ord,Show) @@ -408,18 +408,6 @@ data Button = Button , _btTermMID :: Maybe Int , _btName :: String } -data TerminalParams = NoTerminalParams | TerminalParams - { _termDisplayedLines :: [World -> (String,Color)] - , _termFutureLines :: [TerminalLine] - , _termMaxLines :: Int - , _termTitle :: String - , _termSel :: Maybe (Int,Int) --- , _termOptions :: [(String, World -> World)] - , _termInput :: Maybe T.Text - , _termScrollCommands :: [TerminalCommand] - , _termWriteCommands :: [TerminalCommand] - , _termDeathCommand :: Maybe String - } data TerminalLine = TerminalLineDisplay {_tlPause :: Int @@ -432,7 +420,7 @@ data TerminalLine } | TerminalLineEffect {_tlPause :: Int - ,_tlEffect :: SubInventory -> World -> World + ,_tlEffect :: Terminal -> World -> World } data ButtonState = BtOn | BtOff | BtNoLabel deriving (Eq, Show) @@ -948,9 +936,10 @@ data Block = Block , _blMaterial :: BlockMaterial } data BlockMaterial = WoodBlock | DirtBlock | StoneBlock | GlassBlock | MetalBlock +data TerminalStatus = Connected | Disconnected data Terminal = Terminal { _tmID :: Int - , _tmProgram :: Terminal -> World -> TerminalParams + , _tmProgram :: Terminal -> World -> [TerminalLine] , _tmButtonID :: Int , _tmMachineID :: Int , _tmName :: String @@ -963,6 +952,7 @@ data Terminal = Terminal , _tmScrollCommands :: [TerminalCommand] , _tmWriteCommands :: [TerminalCommand] , _tmDeathEffect :: Terminal -> World -> World + , _tmStatus :: TerminalStatus } data Machine = Machine { _mcID :: Int @@ -1384,8 +1374,8 @@ data TerminalCommand = TerminalCommand , _tcAlias :: [String] , _tcHelp :: String , _tcArgumentType :: Maybe String - , _tcArguments :: World -> [String] - , _tcEffect :: [String] -> World -> Either String World + , _tcArguments :: Terminal -> World -> [String] + , _tcEffect :: [String] -> Terminal -> World -> Either String World } @@ -1601,7 +1591,6 @@ makeLenses ''Nozzle makeLenses ''HUD makeLenses ''HUDElement makeLenses ''SubInventory -makeLenses ''TerminalParams makeLenses ''TerminalLine makeLenses ''ItemValue makeLenses ''Equipment diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 7f9a3d775..97386800a 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -244,7 +244,7 @@ defaultDrawButton col bt = defaultTerminal :: Terminal defaultTerminal = Terminal { _tmID = 0 - , _tmProgram = (\_ _ -> NoTerminalParams) + , _tmProgram = (\_ _ -> []) , _tmButtonID = 0 , _tmMachineID = 0 , _tmName = "TESTTERMINAL" @@ -257,6 +257,7 @@ defaultTerminal = Terminal , _tmScrollCommands = [] , _tmWriteCommands = [] , _tmDeathEffect = const id + , _tmStatus = Disconnected } defaultButton :: Button diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 4781f2343..c5fbdbc38 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -94,8 +94,8 @@ handlePressedMouseButton :: MouseButton -> Universe -> Maybe Universe handlePressedMouseButton but w = case (_hudElement (_hud $ _uvWorld w), but) of (DisplayCarte,_) -> Just $ w & uvWorld . clickMousePos .~ _mousePos (_uvWorld w) (_,ButtonMiddle) -> Just $ w & uvWorld . clickMousePos .~ _mousePos (_uvWorld w) - ( DisplayInventory (DisplayTerminal _ _) , ButtonLeft) - -> Just $ over uvWorld doTerminalEffect w + ( DisplayInventory (DisplayTerminal tmid _) , ButtonLeft) + -> Just $ over uvWorld (doTerminalEffect (w ^?! uvWorld . terminals . ix tmid)) w ( DisplayInventory (CombineInventory mi) , ButtonLeft) -> Just $ fromMaybe (w & uvWorld . hud . hudElement .~ DisplayInventory NoSubInventory) $ do -- ugly @@ -144,30 +144,30 @@ wheelEvent y w = case _hudElement $ _hud w of | otherwise -> w & moveTweakSel yi DisplayInventory (CombineInventory _) -> w & hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi) - DisplayInventory DisplayTerminal{} - | rbDown -> w - & hud . hudElement . subInventory . termParams %~ updatetermsubsel - | otherwise -> w - & hud . hudElement . subInventory . termParams %~ updatetermsel +-- DisplayInventory (DisplayTerminal tmid True) +-- | rbDown -> w +-- & terminals . ix tmid %~ updatetermsubsel +-- | otherwise -> w +-- & terminals . ix tmid %~ updatetermsel _ -> w where - updatetermsel tp = case _termSel tp of - Nothing -> tp & termSel ?~ (0,0) - & termInput . _Just %~ replacewith tp 0 - Just (i,_) -> let newi = ((`mod` length (_termScrollCommands tp)) . subtract yi) i - in tp & termSel . _Just .~ (newi,0) - & termInput . _Just %~ replacewith tp newi - updatetermsubsel tp = case _termSel tp of - Nothing -> tp - Just (i,j) -> let newj = (j - yi) `mod` (1 + length (_tcArguments (_termScrollCommands tp !! i) w)) - in tp & termSel . _Just .~ (i,newj) - & termInput . _Just %~ replacewith' tp i newj w - replacewith tp newi _ = T.pack (_tcString (_termScrollCommands tp !! newi)) - replacewith' tp i j w' _ = T.pack $ _tcString tc ++ " " ++ arg-- ++ ((_tcArguments tp) w !! j) - where - arg :: String - arg = ("": _tcArguments tc w' )!! j - tc = _termScrollCommands tp !! i +-- updatetermsel tp = case _tmSel tp of +-- Nothing -> tp & tmSel ?~ (0,0) +-- & tmInput . _Just %~ replacewith tp 0 +-- Just (i,_) -> let newi = ((`mod` length (_tmScrollCommands tp)) . subtract yi) i +-- in tp & tmSel . _Just .~ (newi,0) +-- & tmInput . _Just %~ replacewith tp newi +-- updatetermsubsel tp = case _tmSel tp of +-- Nothing -> tp +-- Just (i,j) -> let newj = (j - yi) `mod` (1 + length (_tcArguments (_tmScrollCommands tp !! i) tp w)) +-- in tp & tmSel . _Just .~ (i,newj) +-- & tmInput . _Just %~ replacewith' tp i newj w +-- replacewith tp newi _ = T.pack (_tcString (_tmScrollCommands tp !! newi)) +-- replacewith' tp i j w' _ = T.pack $ _tcString tc ++ " " ++ arg-- ++ ((_tcArguments tp) w !! j) +-- where +-- arg :: String +-- arg = ("": _tcArguments tc w' )!! j +-- tc = _tmScrollCommands tp !! i numcombs = length $ combineItemListYou w yi = round $ signum y numLocs = (fst . IM.findMax $ _seenLocations w) + 1 diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index 95e0b534b..8d4762349 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -30,9 +30,13 @@ import qualified Data.Text as T -- also, note that this currently "doubles" the inputs to both terminals if both -- are open handleTextInput :: T.Text -> Universe -> IO (Maybe Universe) -handleTextInput text = return . Just . (menuLayers . ix 0 . scInput %~ updateText) - . (uvWorld . hud . hudElement . subInventory . termParams . termInput . _Just %~ updateText) +handleTextInput text u = return . Just $ u + & menuLayers . ix 0 . scInput %~ updateText + & updateTerminalText where + updateTerminalText = case u ^? uvWorld . hud . hudElement . subInventory of + Just (DisplayTerminal tmid True) -> uvWorld . terminals . ix tmid . tmInput . _Just %~ updateText + _ -> id updateText s = case T.unpack text of ";" -> s _ -> s `T.append` T.toUpper text @@ -60,8 +64,8 @@ handlePressedKey _ scode u = case scode of ScancodeF5 -> return . Just $ doQuicksave u ScancodeF9 -> return . Just $ loadSaveSlot QuicksaveSlot u ScancodeSemicolon -> return . Just $ gotoTerminal u - _ | null (_menuLayers u) -> case u ^? uvWorld . hud . hudElement . subInventory . termParams . termInput . _Just of - Just {} -> return $ uvWorld (handlePressedKeyTerminal scode) u + _ | null (_menuLayers u) -> case u ^? uvWorld . hud . hudElement . subInventory of + Just (DisplayTerminal tmid True) -> return $ uvWorld (handlePressedKeyTerminal tmid scode) u _ -> return $ uvWorld (Just . handlePressedKeyInGame scode) u _ -> handlePressedKeyInMenu (head $ _menuLayers u) scode u @@ -80,12 +84,12 @@ handlePressedKeyInGame scode w = case scode of _ -> w -handlePressedKeyTerminal :: Scancode -> World -> Maybe World -handlePressedKeyTerminal scode w = case scode of - ScancodeEscape -> Just $ w & hud . hudElement . subInventory .~ NoSubInventory - ScancodeReturn -> Just $ w & doTerminalEffect +handlePressedKeyTerminal :: Int -> Scancode -> World -> Maybe World +handlePressedKeyTerminal tmid scode w = case scode of + ScancodeEscape -> Just $ w & hud . hudElement . subInventory . onInputLine .~ False + ScancodeReturn -> Just $ w & doTerminalEffect (w ^?! terminals . ix tmid) ScancodeBackspace -> Just $ w - & hud . hudElement . subInventory . termParams . termInput . _Just %~ doBackspace + & terminals . ix tmid . tmInput . _Just %~ doBackspace & backspaceTimer .~ 5 _ -> Just w where diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 5d4598900..1d58a9861 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -146,7 +146,7 @@ invSelPos w = splitgap + (foldl' (+) 0 . fst $ IM.split invsel (augmentedInvSize | otherwise = 1 updateTerminal :: World -> World -updateTerminal = checkTermDist . updateTerminalLine +updateTerminal = checkTermDist checkTermDist :: World -> World checkTermDist w = case w ^? hud . hudElement . subInventory . termID of @@ -155,25 +155,6 @@ checkTermDist w = case w ^? hud . hudElement . subInventory . termID of if dist btpos (_crPos $ you w) < 40 then Just w else Nothing Nothing -> w -updateTerminalLine :: World -> World -updateTerminalLine w = case w ^? hud . hudElement . subInventory . termParams . termFutureLines . ix 0 of - Nothing -> w - Just tl | _tlPause tl > 0 -> w & pointTermParams . termFutureLines . ix 0 . tlPause -~ 1 - Just (TerminalLineDisplay _ f) -> w & pointTermParams %~ - ( ( termFutureLines %~ tail ) - . ( termDisplayedLines .:~ f ) - ) - Just (TerminalLineEffect _ eff) -> w - & pointTermParams . termFutureLines %~ tail - & eff (_subInventory . _hudElement $ _hud w) - Just (TerminalLineInput _) -> w & pointTermParams %~ - ( ( termFutureLines %~ tail ) --- . ( termScrollCommands .~ scrollc ) --- . ( termWriteCommands .~ writec ) - . ( termInput ?~ T.empty ) ) - where - pointTermParams = hud . hudElement . subInventory . termParams - -- this looks ugly... updateCloseObjects :: World -> World updateCloseObjects w = w & closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose diff --git a/src/Dodge/Placement/Instance/Analyser.hs b/src/Dodge/Placement/Instance/Analyser.hs index 1d5ad3637..2de3af9c7 100644 --- a/src/Dodge/Placement/Instance/Analyser.hs +++ b/src/Dodge/Placement/Instance/Analyser.hs @@ -52,7 +52,7 @@ analyser analyser starts sucs fails afters upf pslight psmc = extTrigLitPos pslight $ \tp -> Just $ plSpot .~ psmc $ putTerminal' aquamarine tparams (termupdate tp) where - tparams = const $ defaultTermParams & termFutureLines ++.~ + tparams = const $ defaultTermParams & tmFutureLines ++.~ (map makeTermLine starts ++ [makeTermLine sucs] ++ map makeTermLine afters) termupdate tp btid = (\mc -> upf mc . (triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc)) diff --git a/src/Dodge/Placement/Instance/Terminal.hs b/src/Dodge/Placement/Instance/Terminal.hs index 3a8c72625..011ba0ca5 100644 --- a/src/Dodge/Placement/Instance/Terminal.hs +++ b/src/Dodge/Placement/Instance/Terminal.hs @@ -25,7 +25,7 @@ import Data.Maybe putTerminal'' :: Machine - -> (World -> TerminalParams) + -> (World -> Terminal) -> (Int -> Machine -> World -> World) -- | machine update, takes button id as input -> Placement putTerminal'' mc f mcf = ps0PushPS (PutTerminal theterminal) $ \tmpl -> Just $ @@ -46,11 +46,11 @@ putTerminal'' mc f mcf = ps0PushPS (PutTerminal theterminal) $ \tmpl -> Just $ tmid = fromJust (_plMID tmpl) btid = fromJust (_plMID btpl) mcid = fromJust (_plMID mcpl) - theterminal = defaultTerminal & tmProgram .~ const f + theterminal = defaultTerminal & tmProgram .~ (\_ w -> _tmFutureLines (f w)) putTerminal' :: Color - -> (World -> TerminalParams) + -> (World -> Terminal) -> (Int -> Machine -> World -> World) -- | machine update, takes button id as input -> Placement putTerminal' col = putTerminal'' (defaultMachine & mcColor .~ col) @@ -59,7 +59,7 @@ putTerminal' col = putTerminal'' (defaultMachine & mcColor .~ col) , _mcSensor = SensorCloseToggle NotClose False } -putTerminal :: Color -> (World -> TerminalParams) -> Placement +putTerminal :: Color -> (World -> Terminal) -> Placement putTerminal col f = putTerminal'' (mc & mcColor .~ col) f (\_ -> basicMachineUpdate $ const id) where mc = defaultMachine @@ -73,7 +73,7 @@ termButton = Button { _btPict = const mempty , _btPos = 0 , _btRot = 0 - , _btEvent = displayTerminalMessage . _btTermMID + , _btEvent = bootTerminal . _btTermMID , _btID = 0 , _btText = "TERMINAL" , _btState = BtOff @@ -100,19 +100,16 @@ terminalShape mc = colorSH col (prismPoly where col = _mcColor mc -displayTerminalMessage :: Maybe Int -> World -> World -displayTerminalMessage mtmid w = case mtmid of +bootTerminal :: Maybe Int -> World -> World +bootTerminal mtmid w = case mtmid of Nothing -> w - Just tmid -> w & hud . hudElement .~ DisplayInventory DisplayTerminal - { _termID = tmid - , _termParams = message tmid - } - where - message tmid = fromMaybe NoTerminalParams $ do - tm <- w ^? terminals . ix tmid - return $ _tmProgram tm tm w + Just tmid -> w & hud . hudElement .~ DisplayInventory (DisplayTerminal tmid False) + & terminals . ix tmid . tmFutureLines ++.~ _tmProgram tm tm w + & terminals . ix tmid . tmStatus .~ Connected + where + tm = w ^?! terminals . ix tmid -simpleTermMessage :: [String] -> World -> TerminalParams +simpleTermMessage :: [String] -> World -> Terminal simpleTermMessage = genTermMessage . const --simpleTermMessage ss = const $ TerminalParams -- {_termDisplayedLines = [] @@ -135,5 +132,5 @@ topFlushStrings = topFlush . maximum . map length topFlush :: Int -> [String] topFlush twidth = [replicate i ' ' ++ "*" | i <- [0, max 1 $ twidth `div` 5 .. twidth]] -genTermMessage :: (World -> [String]) -> World -> TerminalParams -genTermMessage f w = defaultTermParams & termFutureLines ++.~ map makeTermLine (f w) +genTermMessage :: (World -> [String]) -> World -> Terminal +genTermMessage f w = defaultTermParams & tmFutureLines ++.~ map makeTermLine (f w) diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 844aea1e8..7a63763e4 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -84,14 +84,16 @@ subInventoryDisplay subinv cfig w = case subinv of , invHead cfig "TWEAK" , listTextPicturesAt subInvX 60 cfig $ map text (ammoTweakStrings it) ] - DisplayTerminal {_termParams = tp,_termID = tid} -> pictures - [ invHead cfig (_termTitle tp ++ ":T" ++ show tid) + DisplayTerminal {_termID = tid,_onInputLine=isoninput} -> + 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 (_termMaxLines tp) - $ _termDisplayedLines tp <&> ($ w) + . take (_tmMaxLines tp) + $ _tmDisplayedLines tp -- , fromMaybe mempty $ do -- cursori <- _termSel tp <&> (+ _termMaxLines tp) -- return $ listCursorNSW subInvX 60 cfig cursori white 15 1 @@ -122,7 +124,7 @@ subInventoryDisplay subinv cfig w = case subinv of ] InspectInventory -> invHead cfig "INSPECT" where - displayTermInput tp = case _termInput tp of + displayTermInput tp = case _tmInput tp of Nothing -> id Just s -> (++ [('>':T.unpack s++clockCycle 10 (V.fromList ["_",""]) w,white)]) closeobjectcursor = case selectedCloseObject w of diff --git a/src/Dodge/Terminal.hs b/src/Dodge/Terminal.hs index cf9ac828d..cf0b4825f 100644 --- a/src/Dodge/Terminal.hs +++ b/src/Dodge/Terminal.hs @@ -1,5 +1,6 @@ module Dodge.Terminal where import Dodge.Data +import Dodge.Default import Dodge.Base import Dodge.SoundLogic import Color @@ -20,28 +21,28 @@ quitCommand = TerminalCommand , _tcAlias = ["Q","EXIT","X","SHUTDOWN",""] , _tcHelp = "DISCONNECTS THE TERMINAL." , _tcArgumentType = Nothing - , _tcArguments = const [] - , _tcEffect = const $ \w -> Right $ w & disconnectTerminal + , _tcArguments = const (const []) + , _tcEffect = const $ \tm w -> Right $ w & disconnectTerminal tm } -disconnectTerminal :: World -> World -disconnectTerminal = hud . hudElement . subInventory . termParams %~ - ( (termInput .~ Nothing) - . (termFutureLines ++.~ [makeTermLine "DISCONNECTION COMPLETE"] ) - ) +disconnectTerminal :: Terminal -> World -> World +disconnectTerminal tm w = w + & terminals . ix (_tmID tm) . tmStatus .~ Disconnected + & terminals . ix (_tmID tm) . tmFutureLines ++.~ [makeTermLine "DISCONNECTION COMPLETE"] + damageCodeCommand :: TerminalCommand damageCodeCommand = TerminalCommand { _tcString = "DAMAGECODE" , _tcAlias = ["DCODE","DC"] , _tcHelp = "DISPLAYS THE SHAPE AND COLOR ASSOCIATED WITH A GIVEN DAMAGE TYPE." , _tcArgumentType = Just "A DAMAGE TYPE" - , _tcArguments = map (map toUpper . show) . M.keys . _sensorCoding . _genParams + , _tcArguments = \_ -> map (map toUpper . show) . M.keys . _sensorCoding . _genParams , _tcEffect = f } where - f args w = fromMaybe (Left "") $ do + f args tm w = fromMaybe (Left "") $ do dtype <- safeHead args >>= readMaybe dinfo <- _sensorCoding (_genParams w) M.!? dtype - return $ Right $ w & infoClearInput [makeTermLine $ show (fst dinfo) ++ " " ++ show (snd dinfo)] + return $ Right $ w & infoClearInput tm [makeTermLine $ show (fst dinfo) ++ " " ++ show (snd dinfo)] helpCommand :: TerminalCommand helpCommand = TerminalCommand @@ -49,31 +50,31 @@ helpCommand = TerminalCommand , _tcAlias = ["H","MAN"] , _tcHelp = "DISPLAYS HELP FOR A SPECIFIC COMMAND. TO DISPLAY AVAILABLE COMMANDS USE \"COMMANDS\"." , _tcArgumentType = Just "AN AVAILABLE COMMAND" - , _tcArguments = \w -> fromMaybe [] $ do - commands <- getCommands w + , _tcArguments = \tm w -> fromMaybe [] $ do + commands <- getCommands tm w return $ map _tcString commands , _tcEffect = helpf } -helpf :: [String] -> World -> Either String World -helpf [] w = helpf ["HELP"] w -helpf (str:_) w = maybe (Left "") Right $ do - commands <- getCommands w +helpf :: [String] -> Terminal -> World -> Either String World +helpf [] tm w = helpf ["HELP"] tm w +helpf (str:_) tm w = maybe (Left "") Right $ do + commands <- getCommands tm w command <- find (\tc -> _tcString tc == str || str `elem` _tcAlias tc) commands - return $ w & infoClearInput + return $ w & infoClearInput tm ([makeTermLine ("COMMAND:" ++ _tcString command) ,makeTermLine ("ALIASES:" ++ unwords (_tcAlias command)) ] ++ makeTermPara (_tcHelp command ++ " " ++ argumentHelp (_tcArgumentType command)) ) -getCommands :: World -> Maybe [TerminalCommand] -getCommands w = do - commands1 <- w ^? hud . hudElement . subInventory . termParams . termScrollCommands - commands2 <- w ^? hud . hudElement . subInventory . termParams . termWriteCommands +getCommands :: Terminal -> World -> Maybe [TerminalCommand] +getCommands tm w = do + commands1 <- w ^? terminals . ix (_tmID tm) . tmScrollCommands + commands2 <- w ^? terminals . ix (_tmID tm) . tmWriteCommands return $ commands1 ++ commands2 -infoClearInput :: [TerminalLine] -> World -> World -infoClearInput tls = hud . hudElement . subInventory . termParams %~ - ( (termInput ?~ T.empty) - . (termFutureLines ++.~ tls +infoClearInput :: Terminal -> [TerminalLine] -> World -> World +infoClearInput tm tls = terminals . ix (_tmID tm) %~ + ( (tmInput ?~ T.empty) + . (tmFutureLines ++.~ tls ) ) @@ -94,9 +95,9 @@ makeTermLine = makeColorTermLine white termSoundLine :: SoundID -> TerminalLine termSoundLine sid = TerminalLineEffect 0 termsound where - termsound subinv w = soundStart TerminalSound tpos sid Nothing w + termsound tm w = soundStart TerminalSound tpos sid Nothing w where - tpos = fromMaybe 0 $ w ^? buttons . ix (_termID subinv) . btPos + tpos = fromMaybe 0 $ w ^? buttons . ix (_tmButtonID tm) . btPos infoCommand :: String -> TerminalCommand infoCommand str = TerminalCommand @@ -104,8 +105,8 @@ infoCommand str = TerminalCommand , _tcAlias = ["INFO","I"] , _tcHelp = "DISPLAYS INFORMATION CONCERNING THE TERMINAL." , _tcArgumentType = Nothing - , _tcArguments = const [] - , _tcEffect = const $ \w -> Right $ w & infoClearInput + , _tcArguments = const (const []) + , _tcEffect = const $ \tm w -> Right $ w & infoClearInput tm ( makeTermPara str) } @@ -115,10 +116,10 @@ commandsCommand = TerminalCommand , _tcAlias = ["COMMAND","COM"] , _tcHelp = "DISPLAYS AVAILABLE COMMANDS." , _tcArgumentType = Nothing - , _tcArguments = const [] - , _tcEffect = const $ \w -> Right $ w & infoClearInput + , _tcArguments = const $ const [] + , _tcEffect = \_ tm w -> Right $ w & infoClearInput tm ( makeTermLine "AVAILABLE COMMANDS:" - : makeTermPara (unwords (maybe [""] (map _tcString) $ getCommands w)) + : makeTermPara (unwords (maybe [""] (map _tcString) $ getCommands tm w)) ) } @@ -128,59 +129,57 @@ singleCommand command aliases htext eff = TerminalCommand ,_tcAlias = aliases ,_tcHelp = htext ,_tcArgumentType = Nothing - , _tcArguments = const [] - ,_tcEffect = const $ \w -> Right $ eff $ disconnectTerminal w + , _tcArguments = const $ const [] + ,_tcEffect = \_ tm w -> Right $ eff $ disconnectTerminal tm w } -doTerminalEffect :: World -> World -doTerminalEffect w = fromMaybe w $ do - s <- fmap T.unpack $ w ^? hud . hudElement . subInventory . termParams . termInput . _Just - return $ doTerminalEffect' s $ w - & hud . hudElement . subInventory . termParams . termFutureLines +doTerminalEffect :: Terminal -> World -> World +doTerminalEffect tm w = fromMaybe w $ do + s <- fmap T.unpack $ w ^? terminals . ix (_tmID tm) . tmInput . _Just + return $ doTerminalEffect' s tm $ w + & terminals . ix (_tmID tm) . tmFutureLines .~ [makeColorTermLine (greyN 0.9) ('>':s)] -doTerminalEffect' :: String -> World -> World -doTerminalEffect' s w = fromMaybe (w & badinput) $ do - commands <- getCommands w - if null (words s) then Just $ disconnectTerminal w else do +doTerminalEffect' :: String -> Terminal -> World -> World +doTerminalEffect' s tm w = fromMaybe (w & badinput) $ do + commands <- getCommands tm w + if null (words s) then Just $ disconnectTerminal tm w else do let (str:args) = words s command <- find (\tc -> _tcString tc == str || str `elem` _tcAlias tc) commands - case _tcEffect command args w of + case _tcEffect command args tm w of Right w' -> return w' - Left err -> return $ w & hud . hudElement . subInventory . termParams %~ - ( (termInput ?~ T.empty) - . (termFutureLines ++.~ + Left err -> return $ w & terminals . ix (_tmID tm) %~ + ( (tmInput ?~ T.empty) + . (tmFutureLines ++.~ [makeColorTermLine red ("^ INVALID ARGUMENT: EXPECTS "++fromJust (_tcArgumentType command)++ err) ] ) ) where - badinput = hud . hudElement . subInventory . termParams %~ - ( (termInput ?~ T.empty) - . (termFutureLines ++.~ [makeColorTermLine red "^ INVALID INPUT" - ] + badinput = terminals . ix (_tmID tm) %~ + ( (tmInput ?~ T.empty) + . (tmFutureLines ++.~ [makeColorTermLine red "^ INVALID INPUT" ] ) ) -addInputLine :: [TerminalCommand] -> [TerminalCommand] -> TerminalParams -> TerminalParams +addInputLine :: [TerminalCommand] -> [TerminalCommand] -> Terminal -> Terminal addInputLine searchablecommands hiddencommands = - (termFutureLines ++.~ [TerminalLineInput 0]) - . (termScrollCommands ++.~ searchablecommands) - . (termWriteCommands ++.~ hiddencommands) + (tmFutureLines ++.~ [TerminalLineInput 0]) + . (tmScrollCommands .~ searchablecommands) + . (tmWriteCommands .~ hiddencommands) -defaultTermParams :: TerminalParams -defaultTermParams = TerminalParams - {_termDisplayedLines = [] - ,_termFutureLines = termSoundLine computerBeepingS +defaultTermParams :: Terminal +defaultTermParams = defaultTerminal + {_tmDisplayedLines = [] + ,_tmFutureLines = termSoundLine computerBeepingS : map makeTermLine connectionBlurb - ,_termMaxLines = 14 - ,_termTitle = "TERMINAL" - ,_termSel = Nothing - ,_termInput = Nothing - ,_termScrollCommands = [] - ,_termWriteCommands = [] - ,_termDeathCommand = Nothing + ,_tmMaxLines = 14 + ,_tmTitle = "TERMINAL" + ,_tmSel = Nothing + ,_tmInput = Nothing + ,_tmScrollCommands = [] + ,_tmWriteCommands = [] } connectionBlurb :: [String] diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 63ead4dd6..fa17e4964 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -109,7 +109,7 @@ tmUpdate tm w = case w ^? terminals . ix (_tmID tm) . tmFutureLines . ix 0 of ) Just (TerminalLineEffect _ eff) -> w & pointTermParams . tmFutureLines %~ tail - & eff (_subInventory . _hudElement $ _hud w) + & eff tm Just (TerminalLineInput _) -> w & pointTermParams %~ ( ( tmFutureLines %~ tail ) -- . ( tmScrollCommands .~ scrollc ) diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index e647d3506..38d51f0f8 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -167,8 +167,9 @@ rotateCamera cfig w keyl = SDL.ScancodeQ `S.member` _keys w && notAtTerminal w keyr = SDL.ScancodeE `S.member` _keys w && notAtTerminal w +-- TODO check where/how this is used notAtTerminal :: World -> Bool -notAtTerminal w = isNothing $ w ^? hud . hudElement . subInventory . termParams . termInput . _Just +notAtTerminal w = isNothing $ w ^? hud . hudElement . subInventory . termID --zoomCamBy :: Float -> World -> World --zoomCamBy x w = w {_cameraZoom = max (_cameraZoom w + x) 0.01}