Implement "tab" button in terminal

This commit is contained in:
2025-08-17 00:12:05 +01:00
parent 76b6cda19b
commit 24027367dc
7 changed files with 43 additions and 29 deletions
+1 -1
View File
File diff suppressed because one or more lines are too long
+1 -1
View File
@@ -92,7 +92,7 @@ data TmWdWd
| TmWdWdDoDeathTriggers | TmWdWdDoDeathTriggers
| TmTmClearDisplayedLines | TmTmClearDisplayedLines
| TmTmSetStatus TerminalStatus | TmTmSetStatus TerminalStatus
| TmDisplayCommands -- | TmDisplayCommands
makeLenses ''Terminal makeLenses ''Terminal
makeLenses ''TerminalLine makeLenses ''TerminalLine
-1
View File
@@ -12,7 +12,6 @@ data TerminalStatus
| TerminalBusy | TerminalBusy
| TerminalTextInput {_tiText :: String} | TerminalTextInput {_tiText :: String}
| TerminalPressTo {_tptString :: String} | TerminalPressTo {_tptString :: String}
-- | TerminalArgumentInput TerminalCommand
deriving (Eq) deriving (Eq)
makeLenses ''TerminalStatus makeLenses ''TerminalStatus
+1 -1
View File
@@ -16,7 +16,7 @@ defaultTerminal =
, _tmMachineID = 0 , _tmMachineID = 0
, _tmDisplayedLines = [] , _tmDisplayedLines = []
, _tmFutureLines = [] , _tmFutureLines = []
, _tmCommands = [TCInfo "TEST" "display text",TCBase] , _tmCommands = [TCInfo "TESA" "text 2",TCInfo "TEST" "display text",TCBase]
, _tmDeathEffect = TmWdWdDoDeathTriggers , _tmDeathEffect = TmWdWdDoDeathTriggers
, _tmStatus = TerminalOff , _tmStatus = TerminalOff
, _tmCommandHistory = [] , _tmCommandHistory = []
+13 -4
View File
@@ -19,6 +19,7 @@ module Dodge.Terminal (
getCommands, getCommands,
makeColorTermPara, makeColorTermPara,
commandColor, commandColor,
tabComplete,
) where ) where
import qualified Data.ListTrie.Patricia.Map.Enum as PTE import qualified Data.ListTrie.Patricia.Map.Enum as PTE
@@ -114,19 +115,19 @@ getCommands = foldMap getCommand . _tmCommands -- tm -- ++ _tmWriteCommands tm
getCommand :: TCom -> PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine]) getCommand :: TCom -> PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
getCommand = \case getCommand = \case
TCInfo x z -> PTE.singleton x (PTE.singleton "" (makeTermPara z)) TCInfo x z -> PTE.singleton x (PTE.singleton "" (makeTermPara z))
TCBase -> helpCommand <> commandsCommand <> quitCommand TCBase -> helpCommand <> quitCommand
helpCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine]) helpCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
helpCommand = PTE.singleton "HELP" (fmap makeTermPara helpStrings) helpCommand = PTE.singleton "HELP" (fmap makeTermPara helpStrings)
helpStrings :: PTE.TrieMap Char String helpStrings :: PTE.TrieMap Char String
helpStrings = PTE.fromList helpStrings = PTE.fromList
[("", "THIS TERMINAL PROCESSES TEXT INPUT. INPUT \"COMMANDS\" TO LIST AVAILABLE FUNCTIONALITY.") [("", "THIS TERMINAL PROCESSES TEXT INPUT. USE TAB FOR AVAILABLE COMMANDS AND AUTOCOMPLETE.")
,("HELP", "BASIC HELP. ACCEPTS A COMMAND AS AN ARGUMENT.") ,("HELP", "BASIC HELP. ACCEPTS A COMMAND AS AN ARGUMENT.")
] ]
commandsCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine]) --commandsCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
commandsCommand = PTE.singleton "COMMANDS" (PTE.singleton "" [TLine 0 [] TmDisplayCommands]) --commandsCommand = PTE.singleton "COMMANDS" (PTE.singleton "" [TLine 0 [] TmDisplayCommands])
quitCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine]) 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 [] TmWdWdDisconnectTerminal])
@@ -146,6 +147,14 @@ makeColorTermLine col str = TLine 1 [TerminalLineConst str col] TmWdId
commandColor :: Color commandColor :: Color
commandColor = yellow commandColor = yellow
tabComplete :: String -> Terminal -> Terminal
tabComplete s tm = case fmap fst $ PTE.toList $ PTE.lookupPrefix s $ getCommands tm of
[] -> tm
[x] -> tm & tmStatus .~ TerminalTextInput x
xs -> tm & tmFutureLines .~
makeColorTermPara commandColor
(unwords xs)
--doTerminalCommandEffect :: TerminalCommandEffect -> Terminal -> World -> EffectArguments --doTerminalCommandEffect :: TerminalCommandEffect -> Terminal -> World -> EffectArguments
--doTerminalCommandEffect tce = case tce of --doTerminalCommandEffect tce = case tce of
-- TerminalCommandArguments eas -> \_ _ -> eas -- TerminalCommandArguments eas -> \_ _ -> eas
+6
View File
@@ -386,11 +386,17 @@ updateKeysInTerminal tmid u =
& doTextInputOverUniverse & doTextInputOverUniverse
(uvWorld . cWorld . lWorld . terminals . ix tmid . tmStatus . tiText) (uvWorld . cWorld . lWorld . terminals . ix tmid . tmStatus . tiText)
& checkEndStatus & checkEndStatus
& tryTabComplete
where where
checkEndStatus checkEndStatus
| u ^. uvWorld . input . pressedKeys . at ScancodeReturn == Just 0 = | u ^. uvWorld . input . pressedKeys . at ScancodeReturn == Just 0 =
uvWorld %~ terminalReturnEffect tmid uvWorld %~ terminalReturnEffect tmid
| otherwise = id | otherwise = id
tryTabComplete
| u ^. uvWorld . input . pressedKeys . at ScancodeTab == Just 0 = fromMaybe id $ do
s <- u ^? uvWorld . cWorld . lWorld . terminals . ix tmid . tmStatus . tiText
return $ uvWorld . cWorld . lWorld . terminals . ix tmid %~ tabComplete s
| otherwise = id
updateKeyInGame :: Universe -> Scancode -> Int -> Universe updateKeyInGame :: Universe -> Scancode -> Int -> Universe
updateKeyInGame uv sc pt = case pt of updateKeyInGame uv sc pt = case pt of
+13 -13
View File
@@ -5,19 +5,17 @@ module Dodge.WorldEffect (
lineOutputTerminal, lineOutputTerminal,
) where ) where
import qualified Data.ListTrie.Patricia.Map.Enum as PTE
--import Dodge.DoubleTree
import Dodge.Data.Terminal.Status
import Dodge.Item.Grammar
import Dodge.Creature.Impulse.UseItem
import Dodge.BlBl
import Dodge.HeldUse
import Data.Foldable import Data.Foldable
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import Data.Maybe import Data.Maybe
import Dodge.BlBl
import Dodge.Creature.Impulse.UseItem
import Dodge.Data.Terminal.Status
import Dodge.Data.World import Dodge.Data.World
import Dodge.Default import Dodge.Default
import Dodge.HeldUse
import Dodge.Inventory.Lock import Dodge.Inventory.Lock
import Dodge.Item.Grammar
--import Dodge.Item.Location --import Dodge.Item.Location
import Dodge.SoundLogic import Dodge.SoundLogic
import Dodge.Terminal import Dodge.Terminal
@@ -42,7 +40,8 @@ doWdWd we = case we of
-- cr <- w ^? cWorld . lWorld . creatures . ix crid -- cr <- w ^? cWorld . lWorld . creatures . ix crid
-- return $ doItCrWdWd f it cr w -- return $ doItCrWdWd f it cr w
MakeTempLight _ 0 -> id MakeTempLight _ 0 -> id
MakeTempLight x t -> (cWorld . lWorld . lights .:~ x) MakeTempLight x t ->
(cWorld . lWorld . lights .:~ x)
. (cWorld . lWorld . worldEvents .:~ MakeTempLight x (t -1)) . (cWorld . lWorld . worldEvents .:~ MakeTempLight x (t -1))
UseInvItem invid pt -> \w -> fromMaybe w (useItem invid pt w) UseInvItem invid pt -> \w -> fromMaybe w (useItem invid pt w)
WdWdBurstFireRepetition cid invid -> \w -> fromMaybe w $ do WdWdBurstFireRepetition cid invid -> \w -> fromMaybe w $ do
@@ -99,11 +98,12 @@ doTmWdWd tmwdwd = case tmwdwd of
TmTmSetStatus x -> \tm -> fromMaybe id $ do TmTmSetStatus x -> \tm -> fromMaybe id $ do
tid <- tm ^? tmID tid <- tm ^? tmID
return $ cWorld . lWorld . terminals . ix tid . tmStatus .~ x return $ cWorld . lWorld . terminals . ix tid . tmStatus .~ x
TmDisplayCommands -> \tm -> fromMaybe id $ do -- TmDisplayCommands -> \tm -> fromMaybe id $ do
tid <- tm ^? tmID -- tid <- tm ^? tmID
return $ cWorld . lWorld . terminals . ix tid . tmFutureLines .~ -- return $ cWorld . lWorld . terminals . ix tid %~ tabComplete ""
makeColorTermPara commandColor --return $ cWorld . lWorld . terminals . ix tid . tmFutureLines .~
(unwords (map fst (PTE.toList $ getCommands tm))) -- makeColorTermPara commandColor
-- (unwords (map fst (PTE.toList $ getCommands tm)))
-- TmTmSetPartialCommand x -> \tm -> fromMaybe id $ do -- TmTmSetPartialCommand x -> \tm -> fromMaybe id $ do
-- tid <- tm ^? tmID -- tid <- tm ^? tmID
-- return $ cWorld . lWorld . terminals . ix tid . tmPartialCommand .~ x -- return $ cWorld . lWorld . terminals . ix tid . tmPartialCommand .~ x