justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Commit before changing TerminalCommand to produce [TerminalLine]

Browse Source
This commit is contained in:
justin
2022-06-06 20:25:38 +01:00
parent b20502bc35
commit 1fe41889fe
8 changed files with 32 additions and 28 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data.hs
+1 -1
View File
@@ -955,7 +955,7 @@ data Terminal = Terminal
, _tmFutureLines :: [TerminalLine]
, _tmMaxLines :: Int
, _tmTitle :: String
, _tmInput :: Maybe TerminalInput
, _tmInput :: TerminalInput
, _tmScrollCommands :: [TerminalCommand]
, _tmWriteCommands :: [TerminalCommand]
, _tmDeathEffect :: Terminal -> World -> World
src/Dodge/Default.hs
+7 -1
View File
@@ -18,6 +18,7 @@ import Shape
import Control.Lens
import qualified Data.IntMap.Strict as IM
import qualified Data.Text as T
import qualified Data.Map.Strict as M
--import qualified Data.Vector as V
--import Data.Monoid
@@ -252,12 +253,17 @@ defaultTerminal = Terminal
, _tmFutureLines = []
, _tmMaxLines = 14
, _tmTitle = "TERMINAL IN LOCATION"
, _tmInput = Nothing
, _tmInput = defaultTerminalInput
, _tmScrollCommands = []
, _tmWriteCommands = []
, _tmDeathEffect = const id
, _tmStatus = Disconnected
}
defaultTerminalInput = TerminalInput
{ _tiText = T.pack ""
, _tiFocus = True
, _tiSel = (0,0)
}
defaultButton :: Button
defaultButton = Button
src/Dodge/Event.hs
+9 -9
View File
@@ -97,7 +97,7 @@ handlePressedMouseButton but w = case (_hudElement (_hud w), but) of
(_,ButtonMiddle) -> w & clickMousePos .~ _mousePos w
( DisplayInventory (DisplayTerminal tmid) , ButtonLeft)
| hasTerminalFocus w -> doTerminalEffectLB (w ^?! terminals . ix tmid) w
| otherwise -> w & terminals . ix tmid . tmInput . _Just . tiFocus %~ const True
| otherwise -> w & terminals . ix tmid . tmInput . tiFocus %~ const True
( DisplayInventory (CombineInventory mi) , ButtonLeft)
-> maybe (hud . hudElement .~ DisplayInventory NoSubInventory) doCombine mi w
_ -> w
@@ -150,17 +150,17 @@ wheelEvent y w = case _hudElement $ _hud w of
& terminals . ix tmid %~ updatetermsel
_ -> w
where
updatetermsel tm = case tm ^? tmInput . _Just . tiSel of
Nothing -> tm & tmInput . _Just . tiSel .~ (0,0)
& tmInput . _Just . tiText %~ replacewith tm 0
updatetermsel tm = case tm ^? tmInput . tiSel of
Nothing -> tm & tmInput . tiSel .~ (0,0)
& tmInput . tiText %~ replacewith tm 0
Just (i,_) -> let newi = ((`mod` length (scrollCommands tm)) . subtract yi) i
in tm & tmInput . _Just . tiSel .~ (newi,0)
& tmInput . _Just . tiText %~ replacewith tm newi
updatetermsubsel tm = case tm ^? tmInput . _Just . tiSel of
in tm & tmInput . tiSel .~ (newi,0)
& tmInput . tiText %~ replacewith tm newi
updatetermsubsel tm = case tm ^? tmInput . tiSel of
Nothing -> tm
Just (i,j) -> let newj = (j - yi) `mod` (1 + length (_tcArguments (scrollCommands tm !! i) tm w))
in tm & tmInput . _Just . tiSel .~ (i,newj)
& tmInput . _Just . tiText %~ replacewith' tm i newj w
in tm & tmInput . tiSel .~ (i,newj)
& tmInput . tiText %~ replacewith' tm i newj w
replacewith tp newi _ = T.pack (_tcString (scrollCommands tp !! newi))
replacewith' tp i j w' _ = T.pack $ _tcString tc ++ " " ++ arg-- ++ ((_tcArguments tp) w !! j)
where
src/Dodge/Event/Keyboard.hs
+4 -4
View File
@@ -37,9 +37,9 @@ handleTextInput text u = return . Just $ u
where
updateTerminalText = case u ^? uvWorld . hud . hudElement . subInventory of
Just (DisplayTerminal tmid) | hasfocus tmid
-> uvWorld . terminals . ix tmid . tmInput . _Just . tiText %~ updateText
-> uvWorld . terminals . ix tmid . tmInput . tiText %~ updateText
_ -> id
hasfocus tmid = fromMaybe False $ u ^? uvWorld . terminals . ix tmid . tmInput . _Just . tiFocus
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
@@ -90,10 +90,10 @@ handlePressedKeyInGame scode w = case scode of
handlePressedKeyTerminal :: Int -> Scancode -> World -> Maybe World
handlePressedKeyTerminal tmid scode w = case scode of
ScancodeEscape -> Just $ w & terminals . ix tmid . tmInput . _Just . tiFocus %~ const False
ScancodeEscape -> Just $ w & terminals . ix tmid . tmInput . tiFocus %~ const False
ScancodeReturn -> Just $ w & doTerminalEffect (w ^?! terminals . ix tmid)
ScancodeBackspace -> Just $ w
& terminals . ix tmid . tmInput . _Just . tiText %~ doBackspace
& terminals . ix tmid . tmInput . tiText %~ doBackspace
& backspaceTimer .~ 5
_ -> Just w
where
src/Dodge/InputFocus.hs
+1 -1
View File
@@ -7,5 +7,5 @@ import Data.Maybe
hasTerminalFocus :: World -> Bool
hasTerminalFocus w = fromMaybe False $ do
tmid <- w ^? hud . hudElement . subInventory . termID
w ^? terminals . ix tmid . tmInput . _Just . tiFocus
w ^? terminals . ix tmid . tmInput . tiFocus
src/Dodge/Render/HUD.hs
+1 -2
View File
@@ -145,8 +145,7 @@ displayTerminal tid cfig w = fromMaybe mempty $ do
]
where
displayTermInput tp = case _tmInput tp of
Nothing -> id
Just (TerminalInput s inputstatus _)
TerminalInput s inputstatus _
-> (++ [('>':T.unpack s++displayBlinkCursor inputstatus,white)])
displayBlinkCursor inputstatus | inputstatus = clockCycle 10 (V.fromList ["_",""]) w
| otherwise = []
src/Dodge/Terminal.hs
+8 -9
View File
@@ -27,7 +27,6 @@ quitCommand = TerminalCommand
disconnectTerminal :: Terminal -> World -> World
disconnectTerminal tm w = w
& terminals . ix (_tmID tm) . tmStatus .~ Disconnected
& terminals . ix (_tmID tm) . tmInput .~ Nothing
& exitTerminalSubInv
& terminals . ix (_tmID tm) . tmFutureLines .~
[ TerminalLineTerminalEffect 0 (tmDisplayedLines .~ [])
@@ -105,7 +104,7 @@ getCommands tm w = do
infoClearInput :: Terminal -> [TerminalLine] -> World -> World
infoClearInput tm tls = terminals . ix (_tmID tm) %~
( (tmInput ?~ TerminalInput T.empty True (0,0))
( (tmInput .~ TerminalInput T.empty True (0,0))
. (tmFutureLines ++.~ tls
)
)
@@ -163,19 +162,19 @@ singleCommand followingLines command aliases htext eff = TerminalCommand
,_tcArgumentType = Nothing
, _tcArguments = const $ const []
,_tcEffect = \_ tm w -> Right $ eff $ w
& terminals . ix (_tmID tm) . tmInput . _Just . tiText .~ T.pack ""
& terminals . ix (_tmID tm) . tmInput . tiText .~ T.pack ""
& terminals . ix (_tmID tm) . tmFutureLines ++.~ map makeTermLine followingLines
-- & hud . hudElement . subInventory . onInputLine %~ const False
}
doTerminalEffectLB :: Terminal -> World -> World
doTerminalEffectLB tm w = fromMaybe w $ do
s <- fmap T.unpack $ w ^? terminals . ix (_tmID tm) . tmInput . _Just . tiText
s <- fmap T.unpack $ w ^? terminals . ix (_tmID tm) . tmInput . tiText
if null (words s) then Just $ defocusTerminalInput w else return $ doTerminalEffect tm w
doTerminalEffect :: Terminal -> World -> World
doTerminalEffect tm w = fromMaybe w $ do
s <- fmap T.unpack $ w ^? terminals . ix (_tmID tm) . tmInput . _Just . tiText
s <- fmap T.unpack $ w ^? terminals . ix (_tmID tm) . tmInput . tiText
return $ doTerminalEffect' s tm $ w
& terminals . ix (_tmID tm) . tmFutureLines
.~ [makeColorTermLine (greyN 0.9) ('>':s)]
@@ -190,7 +189,7 @@ doTerminalEffect' s tm w = fromMaybe (w & badinput) $ do
case _tcEffect command args tm w of
Right w' -> return w'
Left err -> return $ w & terminals . ix (_tmID tm) %~
( (tmInput ?~ TerminalInput T.empty True (0,0))
( (tmInput .~ TerminalInput T.empty True (0,0))
. (tmFutureLines ++.~
[makeColorTermLine red
("^ INVALID ARGUMENT: EXPECTS "++fromJust (_tcArgumentType command)++ err)
@@ -199,7 +198,7 @@ doTerminalEffect' s tm w = fromMaybe (w & badinput) $ do
)
where
badinput = terminals . ix (_tmID tm) %~
( (tmInput ?~ TerminalInput T.empty True (0,0))
( (tmInput .~ TerminalInput T.empty True (0,0))
. (tmFutureLines ++.~ [makeColorTermLine red "^ INVALID INPUT" ]
)
)
@@ -207,7 +206,7 @@ doTerminalEffect' s tm w = fromMaybe (w & badinput) $ do
defocusTerminalInput :: World -> World
defocusTerminalInput w = fromMaybe w $ do
tmid <- w ^? hud . hudElement . subInventory . termID
return $ w & terminals . ix tmid . tmInput . _Just . tiFocus %~ const False
return $ w & terminals . ix tmid . tmInput . tiFocus %~ const False
addInputLine :: [TerminalCommand] -> [TerminalCommand] -> Terminal -> Terminal
addInputLine searchablecommands hiddencommands =
@@ -221,7 +220,7 @@ defaultTermParams = defaultTerminal
,_tmFutureLines = []
,_tmMaxLines = 14
,_tmTitle = "TERMINAL"
,_tmInput = Nothing
,_tmInput = defaultTerminalInput
,_tmScrollCommands = []
,_tmWriteCommands = [helpCommand,commandsCommand]
,_tmProgram = \_ _ -> termSoundLine computerBeepingS
src/Dodge/Update.hs
+1 -1
View File
@@ -116,7 +116,7 @@ tmUpdate tm w = case w ^? terminals . ix (_tmID tm) . tmFutureLines . ix 0 of
Just (TerminalLineInput _) -> w
& pointTermParams %~
( ( tmFutureLines %~ tail )
. ( tmInput ?~ TerminalInput T.empty True (0,0)) )
. ( tmInput .~ TerminalInput T.empty True (0,0)) )
where
pointTermParams = terminals . ix (_tmID tm)