Implement "tab" button in terminal
This commit is contained in:
File diff suppressed because one or more lines are too long
@@ -92,7 +92,7 @@ data TmWdWd
|
||||
| TmWdWdDoDeathTriggers
|
||||
| TmTmClearDisplayedLines
|
||||
| TmTmSetStatus TerminalStatus
|
||||
| TmDisplayCommands
|
||||
-- | TmDisplayCommands
|
||||
|
||||
makeLenses ''Terminal
|
||||
makeLenses ''TerminalLine
|
||||
|
||||
@@ -12,7 +12,6 @@ data TerminalStatus
|
||||
| TerminalBusy
|
||||
| TerminalTextInput {_tiText :: String}
|
||||
| TerminalPressTo {_tptString :: String}
|
||||
-- | TerminalArgumentInput TerminalCommand
|
||||
deriving (Eq)
|
||||
|
||||
makeLenses ''TerminalStatus
|
||||
|
||||
@@ -16,7 +16,7 @@ defaultTerminal =
|
||||
, _tmMachineID = 0
|
||||
, _tmDisplayedLines = []
|
||||
, _tmFutureLines = []
|
||||
, _tmCommands = [TCInfo "TEST" "display text",TCBase]
|
||||
, _tmCommands = [TCInfo "TESA" "text 2",TCInfo "TEST" "display text",TCBase]
|
||||
, _tmDeathEffect = TmWdWdDoDeathTriggers
|
||||
, _tmStatus = TerminalOff
|
||||
, _tmCommandHistory = []
|
||||
|
||||
+13
-4
@@ -19,6 +19,7 @@ module Dodge.Terminal (
|
||||
getCommands,
|
||||
makeColorTermPara,
|
||||
commandColor,
|
||||
tabComplete,
|
||||
) where
|
||||
|
||||
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 = \case
|
||||
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.singleton "HELP" (fmap makeTermPara helpStrings)
|
||||
|
||||
helpStrings :: PTE.TrieMap Char String
|
||||
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.")
|
||||
]
|
||||
|
||||
commandsCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
|
||||
commandsCommand = PTE.singleton "COMMANDS" (PTE.singleton "" [TLine 0 [] TmDisplayCommands])
|
||||
--commandsCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
|
||||
--commandsCommand = PTE.singleton "COMMANDS" (PTE.singleton "" [TLine 0 [] TmDisplayCommands])
|
||||
|
||||
quitCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
|
||||
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 = 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 tce = case tce of
|
||||
-- TerminalCommandArguments eas -> \_ _ -> eas
|
||||
|
||||
@@ -386,11 +386,17 @@ updateKeysInTerminal tmid u =
|
||||
& doTextInputOverUniverse
|
||||
(uvWorld . cWorld . lWorld . terminals . ix tmid . tmStatus . tiText)
|
||||
& checkEndStatus
|
||||
& tryTabComplete
|
||||
where
|
||||
checkEndStatus
|
||||
| u ^. uvWorld . input . pressedKeys . at ScancodeReturn == Just 0 =
|
||||
uvWorld %~ terminalReturnEffect tmid
|
||||
| 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 uv sc pt = case pt of
|
||||
|
||||
+21
-21
@@ -5,19 +5,17 @@ module Dodge.WorldEffect (
|
||||
lineOutputTerminal,
|
||||
) 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 qualified Data.Map.Strict as M
|
||||
import Data.Maybe
|
||||
import Dodge.BlBl
|
||||
import Dodge.Creature.Impulse.UseItem
|
||||
import Dodge.Data.Terminal.Status
|
||||
import Dodge.Data.World
|
||||
import Dodge.Default
|
||||
import Dodge.HeldUse
|
||||
import Dodge.Inventory.Lock
|
||||
import Dodge.Item.Grammar
|
||||
--import Dodge.Item.Location
|
||||
import Dodge.SoundLogic
|
||||
import Dodge.Terminal
|
||||
@@ -38,12 +36,13 @@ doWdWd we = case we of
|
||||
TorqueCr x cid -> torqueCr x cid
|
||||
SoundStart so p sid mi -> soundStart so p sid mi
|
||||
WdWdNegateTrig trid -> cWorld . lWorld . triggers . ix trid %~ not
|
||||
-- WdWdFromItCrixWdWd it crid f -> \w -> fromMaybe w $ do
|
||||
-- cr <- w ^? cWorld . lWorld . creatures . ix crid
|
||||
-- return $ doItCrWdWd f it cr w
|
||||
-- WdWdFromItCrixWdWd it crid f -> \w -> fromMaybe w $ do
|
||||
-- cr <- w ^? cWorld . lWorld . creatures . ix crid
|
||||
-- return $ doItCrWdWd f it cr w
|
||||
MakeTempLight _ 0 -> id
|
||||
MakeTempLight x t -> (cWorld . lWorld . lights .:~ x)
|
||||
. (cWorld . lWorld . worldEvents .:~ MakeTempLight x (t-1))
|
||||
MakeTempLight x t ->
|
||||
(cWorld . lWorld . lights .:~ x)
|
||||
. (cWorld . lWorld . worldEvents .:~ MakeTempLight x (t -1))
|
||||
UseInvItem invid pt -> \w -> fromMaybe w (useItem invid pt w)
|
||||
WdWdBurstFireRepetition cid invid -> \w -> fromMaybe w $ do
|
||||
cr <- w ^? cWorld . lWorld . creatures . ix cid
|
||||
@@ -59,9 +58,9 @@ accessTerminal mtmid w = fromMaybe w $ do
|
||||
& cWorld . lWorld . terminals . ix tmid %~ tryToBoot
|
||||
where
|
||||
tryToBoot tm = case _tmStatus tm of
|
||||
TerminalTextInput {} -> tm
|
||||
TerminalTextInput{} -> tm
|
||||
TerminalBusy -> tm
|
||||
TerminalPressTo {} -> tm
|
||||
TerminalPressTo{} -> tm
|
||||
TerminalOff ->
|
||||
tm
|
||||
& tmFutureLines .~ _tmBootLines tm
|
||||
@@ -99,14 +98,15 @@ doTmWdWd tmwdwd = case tmwdwd of
|
||||
TmTmSetStatus x -> \tm -> fromMaybe id $ do
|
||||
tid <- tm ^? tmID
|
||||
return $ cWorld . lWorld . terminals . ix tid . tmStatus .~ x
|
||||
TmDisplayCommands -> \tm -> fromMaybe id $ do
|
||||
tid <- tm ^? tmID
|
||||
return $ cWorld . lWorld . terminals . ix tid . tmFutureLines .~
|
||||
makeColorTermPara commandColor
|
||||
(unwords (map fst (PTE.toList $ getCommands tm)))
|
||||
-- TmTmSetPartialCommand x -> \tm -> fromMaybe id $ do
|
||||
-- TmDisplayCommands -> \tm -> fromMaybe id $ do
|
||||
-- tid <- tm ^? tmID
|
||||
-- return $ cWorld . lWorld . terminals . ix tid . tmPartialCommand .~ x
|
||||
-- return $ cWorld . lWorld . terminals . ix tid %~ tabComplete ""
|
||||
--return $ cWorld . lWorld . terminals . ix tid . tmFutureLines .~
|
||||
-- makeColorTermPara commandColor
|
||||
-- (unwords (map fst (PTE.toList $ getCommands tm)))
|
||||
-- TmTmSetPartialCommand x -> \tm -> fromMaybe id $ do
|
||||
-- tid <- tm ^? tmID
|
||||
-- return $ cWorld . lWorld . terminals . ix tid . tmPartialCommand .~ x
|
||||
TmWdId -> const id
|
||||
TmWdWdDisconnectTerminal -> disconnectTerminal
|
||||
TmWdWdTermSound sid -> \tm w ->
|
||||
|
||||
Reference in New Issue
Block a user