Work on terminals
This commit is contained in:
Binary file not shown.
|
Before Width: | Height: | Size: 4.7 KiB After Width: | Height: | Size: 4.7 KiB |
@@ -3,8 +3,8 @@ module Dodge.Render.HUD (
|
||||
drawHUD,
|
||||
) where
|
||||
|
||||
import Data.Foldable
|
||||
import Control.Lens
|
||||
import Data.Foldable
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Maybe
|
||||
import qualified Data.Vector as V
|
||||
@@ -203,14 +203,11 @@ displayTerminal :: Int -> Configuration -> LWorld -> Picture
|
||||
displayTerminal tid cfig w = fromMaybe mempty $ do
|
||||
tm <- w ^? terminals . ix tid
|
||||
return $
|
||||
pictures
|
||||
[ invHead cfig (_tmTitle tm ++ ":T" ++ show tid)
|
||||
, drawSelectionList secondColumnParams cfig (thesellist tm)
|
||||
]
|
||||
invHead cfig (_tmTitle tm ++ ":T" ++ show tid)
|
||||
<> drawSelectionList secondColumnParams cfig (thesellist tm)
|
||||
where
|
||||
toselitm (str, col) = SelectionItem [str] 1 True col 0 ()
|
||||
thesellist tm =
|
||||
defaultSelectionList & slItems .~ thelist tm
|
||||
thesellist tm = defaultSelectionList & slItems .~ thelist tm
|
||||
thelist tm =
|
||||
map toselitm . displayTermInput tm
|
||||
. reverse
|
||||
@@ -218,7 +215,7 @@ displayTerminal tid cfig w = fromMaybe mempty $ do
|
||||
$ _tmDisplayedLines tm
|
||||
displayTermInput tm = case _tmInput tm of
|
||||
TerminalInput s hasfoc _ -> (++ [(displayInputText tm s ++ displayBlinkCursor hasfoc, white)])
|
||||
partcommand tm = fromMaybe "" $ tm ^? tmPartialCommand . _Just
|
||||
partcommand tm = maybe "" (++ " ") $ tm ^? tmPartialCommand . _Just
|
||||
displayInputText tm s
|
||||
| _tmStatus tm == TerminalReady = partcommand tm ++ "> " ++ s
|
||||
| otherwise = ""
|
||||
|
||||
+34
-41
@@ -1,6 +1,5 @@
|
||||
module Dodge.Terminal (
|
||||
doTerminalCommandEffect,
|
||||
guardDisconnected,
|
||||
makeTermLine,
|
||||
commandFutureLines,
|
||||
quitCommand,
|
||||
@@ -46,9 +45,9 @@ basicTerminal =
|
||||
connectionBlurbLines :: [TerminalLine] -> [TerminalLine]
|
||||
connectionBlurbLines tls =
|
||||
[ termSoundLine computerBeepingS
|
||||
, TerminalLineDisplay 0 (TerminalLineConst "CONNECTING" termTextColor)
|
||||
, TerminalLineDisplay 0 (TerminalLineConst "Connecting" termTextColor)
|
||||
, TerminalLineDisplay 10 (TerminalLineConst "..." termTextColor)
|
||||
, TerminalLineDisplay 10 (TerminalLineConst "CONNECTED" termTextColor)
|
||||
, TerminalLineDisplay 10 (TerminalLineConst "Connected" termTextColor)
|
||||
]
|
||||
++ tls
|
||||
++ [TerminalLineTerminalEffect 0 (TmTmSetStatus TerminalReady)]
|
||||
@@ -56,18 +55,18 @@ connectionBlurbLines tls =
|
||||
quitCommand :: TerminalCommand
|
||||
quitCommand =
|
||||
TerminalCommand
|
||||
{ _tcString = "QUIT"
|
||||
, _tcAlias = ["Q", "EXIT", "X", "SHUTDOWN", ""]
|
||||
, _tcHelp = "DISCONNECTS THE TERMINAL."
|
||||
{ _tcString = "quit"
|
||||
, _tcAlias = ["q", "exit", "x", "shutdown", ""]
|
||||
, _tcHelp = "Disconnects the terminal."
|
||||
, _tcEffect = TerminalCommandArguments $ NoArguments [TerminalLineEffect 0 TmWdWdDisconnectTerminal]
|
||||
}
|
||||
|
||||
helpCommand :: TerminalCommand
|
||||
helpCommand =
|
||||
TerminalCommand
|
||||
{ _tcString = "HELP"
|
||||
, _tcAlias = ["H", "MAN"]
|
||||
, _tcHelp = "DISPLAYS HELP FOR A SPECIFIC COMMAND."
|
||||
{ _tcString = "help"
|
||||
, _tcAlias = ["h", "man"]
|
||||
, _tcHelp = "Displays help for a specific command."
|
||||
, _tcEffect = TerminalCommandEffectHelp -- \tm -> OneArgument "AN AVAILABLE COMMAND" . getCommandsHelp tm
|
||||
}
|
||||
|
||||
@@ -77,9 +76,9 @@ getCommandsHelp tm w = foldr f mempty $ getCommands tm
|
||||
f tc =
|
||||
M.insert
|
||||
(_tcString tc)
|
||||
( [ makeTermLine "COMMAND:"
|
||||
( [ makeTermLine "Command:"
|
||||
, makeColorTermLine commandColor (_tcString tc)
|
||||
, makeTermLine "ALIASES:"
|
||||
, makeTermLine "Aliases:"
|
||||
, makeColorTermLine commandColor (unwords (_tcAlias tc))
|
||||
]
|
||||
++ case argumentHelp tc tm w of
|
||||
@@ -92,18 +91,18 @@ getCommandsHelp tm w = foldr f mempty $ getCommands tm
|
||||
commandsCommand :: TerminalCommand
|
||||
commandsCommand =
|
||||
TerminalCommand
|
||||
{ _tcString = "COMMANDS"
|
||||
, _tcAlias = ["COMMAND", "COM"]
|
||||
, _tcHelp = "DISPLAYS AVAILABLE COMMANDS."
|
||||
{ _tcString = "commands"
|
||||
, _tcAlias = ["command", "com"]
|
||||
, _tcHelp = "Displays available commands."
|
||||
, _tcEffect = TerminalCommandEffectCommands
|
||||
}
|
||||
|
||||
connectionBlurb :: [TerminalLine]
|
||||
connectionBlurb =
|
||||
[ termSoundLine computerBeepingS
|
||||
, TerminalLineDisplay 0 (TerminalLineConst "CONNECTING" termTextColor)
|
||||
, TerminalLineDisplay 0 (TerminalLineConst "Connecting" termTextColor)
|
||||
, TerminalLineDisplay 10 (TerminalLineConst "..." termTextColor)
|
||||
, TerminalLineDisplay 10 (TerminalLineConst "CONNECTED" termTextColor)
|
||||
, TerminalLineDisplay 10 (TerminalLineConst "Connected" termTextColor)
|
||||
, TerminalLineTerminalEffect 0 (TmTmSetStatus TerminalReady)
|
||||
]
|
||||
|
||||
@@ -173,12 +172,6 @@ argumentHelp tc tm w = case doTerminalCommandEffect (_tcEffect tc) tm w of
|
||||
-- , _tcEffect = TerminalCommandEffectSingleCommand eff followingLines
|
||||
-- }
|
||||
|
||||
guardDisconnected :: Terminal -> World -> World -> World
|
||||
guardDisconnected tm w w' = case _tmStatus tm of
|
||||
TerminalOff -> w
|
||||
TerminalBusy -> w
|
||||
TerminalReady -> w'
|
||||
|
||||
getDamageCoding :: World -> M.Map String [TerminalLine]
|
||||
getDamageCoding = decodedtmap . _sensorCoding . _cwgParams . _cwGen . _cWorld
|
||||
|
||||
@@ -195,15 +188,15 @@ getSensor :: Show a => (Sensor -> a) -> Terminal -> World -> [TerminalLine]
|
||||
getSensor f tm w =
|
||||
maybe
|
||||
[]
|
||||
(makeTermPara . map toUpper . show . f)
|
||||
(makeTermPara . map toLower . show . f)
|
||||
(w ^? cWorld . lWorld . machines . ix (_tmMachineID tm) . mcType . _McSensor)
|
||||
|
||||
toggleCommand :: TerminalCommand
|
||||
toggleCommand =
|
||||
TerminalCommand
|
||||
{ _tcString = "TOGGLE"
|
||||
, _tcAlias = ["TOG"]
|
||||
, _tcHelp = "PERFORMS A REVERSABLE EFFECT."
|
||||
{ _tcString = "toggle"
|
||||
, _tcAlias = ["tog"]
|
||||
, _tcHelp = "Performs a reversable effect."
|
||||
, _tcEffect = TerminalCommandEffectLinkedObject -- \tm _ -> OneArgument "A LINKED OBJECT" (togglesToEffects tm)
|
||||
}
|
||||
|
||||
@@ -213,19 +206,19 @@ decodedtmap = M.mapKeys show . M.map ((: []) . makeTermLine . show)
|
||||
sensorCommand :: TerminalCommand
|
||||
sensorCommand =
|
||||
TerminalCommand
|
||||
{ _tcString = "SENSOR"
|
||||
, _tcAlias = ["SEN"]
|
||||
, _tcHelp = "ACCESS INFORMATION CONCERNING THE CONNECTED SENSOR."
|
||||
{ _tcString = "sensor"
|
||||
, _tcAlias = ["sen"]
|
||||
, _tcHelp = "Access information concerning the connected sensor."
|
||||
, _tcEffect = TerminalCommandEffectSensorParameter -- \tm -> OneArgument "A SENSOR PARAMETER" . sensorInfoMap tm
|
||||
}
|
||||
|
||||
disconnectTerminal :: Terminal -> World -> World
|
||||
disconnectTerminal tm w =
|
||||
w
|
||||
& cWorld . lWorld . terminals . ix (_tmID tm) . tmStatus .~ TerminalOff
|
||||
& exitTerminalSubInv
|
||||
& cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines
|
||||
disconnectTerminal tm =
|
||||
(cWorld . lWorld . terminals . ix (_tmID tm) . tmStatus .~ TerminalOff)
|
||||
. exitTerminalSubInv
|
||||
. ( cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines
|
||||
.~ [TerminalLineTerminalEffect 0 TmTmClearDisplayedLines]
|
||||
)
|
||||
|
||||
exitTerminalSubInv :: World -> World
|
||||
exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of
|
||||
@@ -235,9 +228,9 @@ exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of
|
||||
damageCodeCommand :: TerminalCommand
|
||||
damageCodeCommand =
|
||||
TerminalCommand
|
||||
{ _tcString = "DAMAGECODE"
|
||||
, _tcAlias = ["DCODE", "DC"]
|
||||
, _tcHelp = "DISPLAYS THE SHAPE AND COLOR ASSOCIATED WITH A GIVEN DAMAGE TYPE."
|
||||
{ _tcString = "damagecode"
|
||||
, _tcAlias = ["dcode", "dc"]
|
||||
, _tcHelp = "Displays the shape and color associated with a given damage type."
|
||||
, _tcEffect = TerminalCommandEffectDamageCoding -- \_ -> OneArgument "A DAMAGE TYPE" . getDamageCoding
|
||||
}
|
||||
|
||||
@@ -253,19 +246,19 @@ togglesToEffects = fmap f . _tmToggles
|
||||
where
|
||||
f tt = [TerminalLineEffect 0 $ TmWdWdfromWdWd $ WdWdNegateTrig (_ttTriggerID tt)]
|
||||
|
||||
-- \_ -> triggers . ix (_ttTriggerID tt) %~ not]
|
||||
simpleTermMessage :: [String] -> Terminal
|
||||
simpleTermMessage strs = defaultTerminal & tmFutureLines .~ map makeTermLine strs
|
||||
|
||||
commandFutureLines :: String -> Terminal -> World -> [TerminalLine]
|
||||
commandFutureLines s tm w = fromMaybe [errline "^ INVALID COMMAND"] $ do
|
||||
commandFutureLines s tm w = fromMaybe [errline "^ Invalid command"] $ do
|
||||
(str, args) <- safeUncons $ words s
|
||||
command <- find (\tc -> _tcString tc == str || str `elem` _tcAlias tc) (getCommands tm)
|
||||
case doTerminalCommandEffect (_tcEffect command) tm w of
|
||||
NoArguments tls -> Just tls
|
||||
OneArgument argtype m ->
|
||||
let setpartial = TerminalLineTerminalEffect 0 (TmTmSetPartialCommand (Just str))
|
||||
: makeTermPara ("expects " ++ argtype ++ " as an argument")
|
||||
let setpartial =
|
||||
TerminalLineTerminalEffect 0 (TmTmSetPartialCommand (Just str)) :
|
||||
makeTermPara ("expects " ++ argtype ++ " as an argument")
|
||||
in Just $
|
||||
fromMaybe setpartial $
|
||||
safeHead args >>= (m M.!?)
|
||||
|
||||
@@ -1,36 +1,23 @@
|
||||
module Dodge.Terminal.LeftButton where
|
||||
module Dodge.Terminal.LeftButton (
|
||||
doTerminalEffectLB,
|
||||
terminalReturnEffect,
|
||||
) where
|
||||
|
||||
import Control.Monad
|
||||
import Data.Maybe
|
||||
import Dodge.Data.World
|
||||
import Dodge.Terminal--oops
|
||||
import Dodge.Terminal.ReturnEffect
|
||||
import LensHelp
|
||||
|
||||
doTerminalEffectLB :: Terminal -> World -> World
|
||||
doTerminalEffectLB tm w = guardDisconnected tm w $
|
||||
fromMaybe w $ do
|
||||
doTerminalEffectLB tm w = fromMaybe w $ do
|
||||
guard (_tmStatus tm == TerminalReady)
|
||||
s <- w ^? cWorld . lWorld . 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 = guardDisconnected tm w $
|
||||
fromMaybe w $ do
|
||||
s <- w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmInput . tiText
|
||||
return $
|
||||
runTerminalString s tm $
|
||||
w
|
||||
& cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines .~ [makeTermLine ('>' : s)]
|
||||
|
||||
defocusTerminalInput :: World -> World
|
||||
defocusTerminalInput w = fromMaybe w $ do
|
||||
tmid <- w ^? hud . hudElement . subInventory . termID
|
||||
return $ w & cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const False
|
||||
|
||||
runTerminalString :: String -> Terminal -> World -> World
|
||||
runTerminalString s tm w =
|
||||
w & cWorld . lWorld . terminals . ix (_tmID tm)
|
||||
%~ ( (tmInput .~ TerminalInput mempty True (0, 0))
|
||||
. (tmFutureLines ++.~ commandFutureLines s tm w)
|
||||
. (tmCommandHistory %~ take 10 . (s :))
|
||||
)
|
||||
|
||||
@@ -90,10 +90,9 @@ updatePressedButtonsCarte' pkeys w
|
||||
|
||||
updateKeysInTerminal :: Int -> Universe -> Universe
|
||||
updateKeysInTerminal tmid u =
|
||||
u & doTextInputOver tmpoint
|
||||
u & doTextInputOver (uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiText)
|
||||
& checkEndStatus
|
||||
where
|
||||
tmpoint = uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiText
|
||||
pkeys = u ^. uvWorld . input . pressedKeys
|
||||
checkEndStatus
|
||||
| pkeys ^. at ScancodeReturn == Just InitialPress =
|
||||
@@ -110,7 +109,6 @@ updateInitialPressInGame :: Universe -> Scancode -> Universe
|
||||
updateInitialPressInGame uv sc = case sc of
|
||||
ScancodeF1 -> useNormalCamera uv
|
||||
ScancodeF2 -> pauseAndFloatCam uv
|
||||
-- ScancodeF3 -> pauseAndPanCam uv
|
||||
ScancodeF5 -> doQuicksave uv
|
||||
ScancodeF9 -> doQuickload uv
|
||||
ScancodeEscape -> pauseGame uv
|
||||
@@ -152,7 +150,7 @@ doRegexInput u i sss
|
||||
any
|
||||
((== Just InitialPress) . (`M.lookup` pkeys))
|
||||
[ScancodeReturn, ScancodeSlash]
|
||||
endmouse = (Just 0 == ) $ u ^? uvWorld . input . mouseButtons . ix ButtonLeft
|
||||
endmouse = (Just 0 ==) $ u ^? uvWorld . input . mouseButtons . ix ButtonLeft
|
||||
backspacetonothing =
|
||||
sss ^? sssExtra . sssFilters . ix i . _Just == Just ""
|
||||
&& ScancodeBackspace `M.lookup` pkeys == Just InitialPress
|
||||
|
||||
@@ -4,7 +4,7 @@ module Dodge.Update.Input.Text (
|
||||
) where
|
||||
|
||||
import Data.Either
|
||||
import Data.Char
|
||||
--import Data.Char
|
||||
import Dodge.Data.Universe
|
||||
import LensHelp
|
||||
import SDL
|
||||
@@ -14,7 +14,8 @@ doTextInputOver p u = doTextInputOver' u p u
|
||||
|
||||
doTextInputOver' :: Universe -> ASetter' a String -> a -> a
|
||||
doTextInputOver' u p x =
|
||||
x & p %~ (++ map toUpper (rights str))
|
||||
--x & p %~ (++ map toUpper (rights str))
|
||||
x & p %~ (++ rights str)
|
||||
& checkBackspace
|
||||
where
|
||||
str = u ^. uvWorld . input . textInput
|
||||
|
||||
+10
-12
@@ -1,9 +1,9 @@
|
||||
module Dodge.WorldEffect
|
||||
( doWdWd
|
||||
, accessTerminal
|
||||
, doTmWdWd
|
||||
, lineOutputTerminal
|
||||
) where
|
||||
module Dodge.WorldEffect (
|
||||
doWdWd,
|
||||
accessTerminal,
|
||||
doTmWdWd,
|
||||
lineOutputTerminal,
|
||||
) where
|
||||
|
||||
import Data.Foldable
|
||||
import qualified Data.Map.Strict as M
|
||||
@@ -46,9 +46,9 @@ doItCrWdWd icww = case icww of
|
||||
ItCrWdItemEffect -> flip itemEffect
|
||||
|
||||
accessTerminal :: Maybe Int -> World -> World
|
||||
accessTerminal mtmid w = case mtmid of
|
||||
Nothing -> w
|
||||
Just tmid ->
|
||||
accessTerminal mtmid w = fromMaybe w $ do
|
||||
tmid <- mtmid
|
||||
return $
|
||||
w & hud . hudElement . subInventory .~ DisplayTerminal tmid
|
||||
& cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus .~ True
|
||||
& cWorld . lWorld . terminals . ix tmid %~ tryToBoot
|
||||
@@ -82,9 +82,7 @@ lineOutputTerminal tls =
|
||||
}
|
||||
|
||||
doDeathTriggers :: Terminal -> World -> World
|
||||
doDeathTriggers tm w =
|
||||
w
|
||||
& cWorld . lWorld . triggers %~ flip (foldl' $ flip doDeathToggle) xs
|
||||
doDeathTriggers tm = cWorld . lWorld . triggers %~ flip (foldl' $ flip doDeathToggle) xs
|
||||
where
|
||||
xs = M.elems $ _tmToggles tm
|
||||
|
||||
|
||||
@@ -201,7 +201,6 @@ stackText = mconcat . zipWith (\y s -> translate 0 y $ centerText s) [0, 100 ..]
|
||||
|
||||
text :: String -> Picture
|
||||
{-# INLINE text #-}
|
||||
--text = translate (-50) (-100) . drawText (10)
|
||||
text = translate (-50) (-100) . drawText (-10)
|
||||
|
||||
drawText :: Float -> String -> [Verx]
|
||||
@@ -209,7 +208,6 @@ drawText gap = map f . stringToList gap
|
||||
where
|
||||
f (pos, col, V3 a b c) = Verx pos col [a, b, c, 1] BottomLayer textNum
|
||||
|
||||
|
||||
line :: [Point2] -> Picture
|
||||
{-# INLINE line #-}
|
||||
line = thickLine 1
|
||||
|
||||
Reference in New Issue
Block a user