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

Work on press-continue terminal prompts

Browse Source
This commit is contained in:
justin
2025-08-19 11:08:54 +01:00
parent e7b66b4fa4
commit 2f4fcb42e5
14 changed files with 84 additions and 71 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/Input.hs
+1
View File
@@ -29,6 +29,7 @@ data MouseContext
| OverCombFilter
| OverCombEscape
| OverTerminalReturn {_mcoTermID :: Int}
| OverTerminalContinue {_mcoTermID :: Int}
| OverTerminalEscape
| MouseGameRotate
deriving (Show)
src/Dodge/Data/Terminal.hs
+1 -2
View File
@@ -36,7 +36,6 @@ data Terminal = Terminal
, _tmStatus :: TerminalStatus
, _tmCommandHistory :: [String]
, _tmToggles :: M.Map String TerminalToggle
-- , _tmPartialCommand :: Maybe TerminalCommand
}
data TerminalLineString = TerminalLineConst String Color
@@ -77,7 +76,7 @@ data TerminalCommandEffect
-- , _tcEffect :: TerminalCommandEffect -- Terminal -> World -> EffectArguments
-- }
data TCom = TCInfo String String
data TCom = TCInfo String String -- this may not be necessary, to revisit
| TCBase
| TCDamageCommand
| TCSensorInfo
src/Dodge/Data/Terminal/Status.hs
+1 -1
View File
@@ -9,7 +9,7 @@ import Data.Aeson.TH
data TerminalStatus
= TerminalOff
| TerminalBusy
| TerminalLineRead
| TerminalTextInput {_tiText :: String}
| TerminalPressTo {_tptString :: String}
deriving (Eq)
src/Dodge/Data/WorldEffect.hs
+1 -1
View File
@@ -20,7 +20,7 @@ data ItCrWdWd = ItCrWdItemHeldEffect
data WdWd
= NoWorldEffect
| SetTrigger Bool Int
| WorldEffects [WdWd]
| WorldEffects [WdWd] -- probably best to avoid recursive types if possible...
| SetLSCol Point3 Int
| AccessTerminal (Maybe Int)
| UnlockInv
src/Dodge/Default/Terminal.hs
+1 -1
View File
@@ -16,7 +16,7 @@ defaultTerminal =
, _tmMachineID = 0
, _tmDisplayedLines = []
, _tmFutureLines = []
, _tmCommands = [TCInfo "TESA" "text 2",TCInfo "TEST" "display text",TCBase]
, _tmCommands = [TCBase]
, _tmDeathEffect = TmWdWdDoDeathTriggers
, _tmStatus = TerminalOff
, _tmCommandHistory = []
src/Dodge/Render/HUD.hs
+2 -8
View File
@@ -383,17 +383,11 @@ drawTerminalDisplay tid cfig w = fromMaybe mempty $ do
$ _tmDisplayedLines tm
displayTermInput tm = case _tmStatus tm of
TerminalOff -> id
TerminalBusy -> (++ [([cFilledRect], white)])
TerminalLineRead -> id
TerminalTextInput s ->
(++ [(getPromptTM ++ s ++ [cFilledRect], white)])
TerminalPressTo s ->
(++ [("PRESS TO "++s, white)])
-- partcommand tm = maybe "" (++ " ") $ tm ^? tmPartialCommand . _Just . tcString
-- displayInputText tm s
-- | TerminalTextInput <- _tmStatus tm = getPromptTM ++ s
---- | _tmStatus tm == TerminalReady = partcommand tm ++ getPromptTM ++ s
-- | otherwise = ""
(++ [(getPromptTM ++ "PRESS TO "++s, white)])
-- | hasfoc = clockCycle 10 (V.fromList [[cFilledRect] , "."]) w
lnkMidPosInvSelsCol :: Configuration -> World -> Int -> Color -> [Int] -> Picture
src/Dodge/Render/Picture.hs
+1
View File
@@ -109,6 +109,7 @@ mouseCursorType u = case u ^. uvWorld . input . mouseContext of
OverCombFilter{} -> drawJumpDown 5
OverCombCombine{} -> drawGapPlus 5
OverCombEscape -> rotate (pi / 4) $ drawPlus 5
OverTerminalContinue{} -> drawReturn 5
OverTerminalReturn{} -> drawReturn 5
OverTerminalEscape -> rotate (pi / 4) $ drawPlus 5
MouseGameRotate -> rotate a (drawVerticalDoubleArrow 5)
src/Dodge/Room/RezBox.hs
+4 -1
View File
@@ -1,5 +1,6 @@
module Dodge.Room.RezBox where
import Dodge.Default.Terminal
import Dodge.Terminal
import Control.Monad
import qualified Data.Set as S
@@ -25,12 +26,14 @@ rezBox :: LightSource -> Room
rezBox ls =
roomRect 40 60 1 1
& rmPmnts .~ [sPS (V2 20 1) 0 $ PutLS ls
, putMessageTerminal terminalColor (simpleTermMessage ["HELLOW","THIS"])
, putMessageTerminal terminalColor (defaultTerminal & tmBootLines .~ (makeTermPara s) <> tlSetStatus (TerminalPressTo "QUIT") <> [TLine 1 [] TmWdWdDisconnectTerminal])
& plSpot .~ PS (V2 20 0) 0
]
& restrictInLinks (\(V2 _ h, _) -> h < 1)
& restrictOutLinks (\(V2 _ h, _) -> h > 59)
& rmName .~ "rezBox"
where
s = "RESPAWN POINT SET AT THIS LOCATION."
rezBox' :: RandomGen g => State g (MetaTree Room String)
rezBox' = do
src/Dodge/Terminal.hs
+13 -18
View File
@@ -1,12 +1,7 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Terminal (
-- doTerminalCommandEffect,
makeTermLine,
-- commandFutureLines,
-- quitCommand,
-- helpCommand,
-- commandsCommand,
connectionBlurbLines,
disconnectTerminal,
textTerminal,
@@ -21,6 +16,7 @@ module Dodge.Terminal (
makeColorTermPara,
commandColor,
tabComplete,
tlSetStatus,
) where
--import Dodge.Data.WorldEffect
@@ -158,9 +154,7 @@ helpCommand = PTE.singleton "HELP" (fmap makeTermPara helpStrings)
helpStrings :: PTE.TrieMap Char String
helpStrings =
PTE.fromList
[ ("", "THIS TERMINAL PROCESSES TEXT INPUT. USE [TAB] FOR AVAILABLE COMMANDS AND AUTOCOMPLETE.")
, ("HELP", "BASIC HELP. ACCEPTS A COMMAND AS AN ARGUMENT.")
, ("QUIT", "SHUTDOWN TERMINAL.")
[ ("", "THIS TERMINAL PROCESSES KEYBOARD INPUT. USE [RETURN] OR [LMB] TO REGISTER YOUR INPUT. AVAILABLE COMMANDS CAN BE SCROLLED THROUGH, HOLD [RMB] TO SCROLL THROUGH ARGUMENTS. USE [TAB] FOR AUTOCOMPLETE.")
]
quitCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
@@ -169,6 +163,9 @@ quitCommand = PTE.singleton "QUIT" (PTE.singleton "" [TLine 0 [] TmWdWdDisconnec
makeTermLine :: String -> TerminalLine
makeTermLine = makeColorTermLine termTextColor
tlSetStatus :: TerminalStatus -> [TerminalLine]
tlSetStatus x = [TLine 1 [] $ TmTmSetStatus x]
makeTermPara :: String -> [TerminalLine]
makeTermPara = makeColorTermPara termTextColor
@@ -192,12 +189,13 @@ tabComplete s' tm = case PTE.lookup s $ getCommands tm of
a = fromMaybe "" $ ss ^? ix 1
f y m' = case fmap fst m' of
[] -> tm
[x] -> tm & tmStatus .~ TerminalTextInput (y ++ x)
[x] -> tm & tmStatus . tiText .~ (y ++ x)
xs ->
tm & tmFutureLines
.~ makeColorTermPara
tm & tmStatus .~ TerminalLineRead
& tmFutureLines
.~ (makeColorTermPara
commandColor
(unwords xs)
(unwords xs) <> [TLine 1 [] . TmTmSetStatus $ TerminalTextInput s])
--doTerminalCommandEffect :: TerminalCommandEffect -> Terminal -> World -> EffectArguments
--doTerminalCommandEffect tce = case tce of
@@ -274,8 +272,7 @@ disconnectTerminal :: Terminal -> World -> World
disconnectTerminal tm =
(cWorld . lWorld . terminals . ix (_tmID tm) . tmStatus .~ TerminalOff)
. exitTerminalSubInv
. ( cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines
.~ [TLine 0 [] TmTmClearDisplayedLines]
. ( cWorld . lWorld . terminals . ix (_tmID tm) . tmDisplayedLines .~ []
)
exitTerminalSubInv :: World -> World
@@ -342,11 +339,9 @@ terminalReturnEffect tmid w = fromMaybe w $ do
runTerminalInput :: String -> Terminal -> World -> World
runTerminalInput s tm w =
w & cWorld . lWorld . terminals . ix (_tmID tm)
%~ ( --(tmInput .~ TerminalInput{ _tiSel = (0, 0)})
(tmFutureLines ++.~ ss)
%~ ( (tmFutureLines ++.~ ss <> [TLine 1 [] (TmTmSetStatus $ TerminalTextInput "")])
. (tmCommandHistory %~ take 10 . (s :))
. (tmStatus .~ TerminalTextInput "")
. (tmStatus .~ TerminalLineRead)
)
where
ss = fromMaybe [makeTermLine "ERROR: INPUT NOT RECOGNISED"] $ do
src/Dodge/Terminal/Color.hs
+1 -1
View File
@@ -12,4 +12,4 @@ termScreenColor tm = case tm ^. tmStatus of
TerminalOff -> Nothing
TerminalTextInput _ -> Just green
TerminalPressTo{} -> Just green
TerminalBusy -> Just white
TerminalLineRead -> Just white
src/Dodge/Update.hs
+41 -34
View File
@@ -7,10 +7,6 @@ Description : Simulation update
-}
module Dodge.Update (updateUniverse) where
import Dodge.SpawnAt
import Dodge.Prop.Moving
import Dodge.WorldEvent.Explosion
import Dodge.Data.Object
import Color
import Control.Applicative
import Control.Monad
@@ -27,6 +23,7 @@ import Dodge.Creature.Radius
import Dodge.Creature.Update
import Dodge.Damage
import Dodge.Data.CrWlID
import Dodge.Data.Object
import Dodge.Data.Universe
import Dodge.Debug
import Dodge.DisplayInventory
@@ -44,6 +41,7 @@ import Dodge.Machine.Update
import Dodge.ModificationEffect
import Dodge.PressPlate
import Dodge.Projectile.Update
import Dodge.Prop.Moving
import Dodge.Prop.Update
import Dodge.RadarBlip
import Dodge.RadarSweep
@@ -54,6 +52,7 @@ import Dodge.Shockwave.Update
import Dodge.SmoothScroll
import Dodge.SoundLogic
import Dodge.Spark
import Dodge.SpawnAt
import Dodge.Terminal.Type
import Dodge.TractorBeam.Update
import Dodge.Update.Camera
@@ -64,6 +63,7 @@ import Dodge.Update.Scroll
import Dodge.Update.WallDamage
import Dodge.WallCreatureCollisions
import Dodge.WorldEffect
import Dodge.WorldEvent.Explosion
import Dodge.WorldEvent.ThingsHit
import Dodge.Zoning.Cloud
import Dodge.Zoning.Creature
@@ -467,27 +467,27 @@ updatePulseLasers w = f w & cWorld . lWorld . pulseLasers .~ pzs
updatePulseBall :: PulseBall -> World -> World
updatePulseBall pb w
| Just (_, ecrwl) <- thit =
w & cWorld . lWorld . pulseBalls . at (pb ^. pbID) .~ Nothing
w & cWorld . lWorld . pulseBalls . at (pb ^. pbID) .~ Nothing
& cWorld . lWorld %~ dodam ecrwl
| pb ^. pbTimer <= 0 =
w & cWorld . lWorld . pulseBalls . at (pb ^. pbID) .~ Nothing
w & cWorld . lWorld . pulseBalls . at (pb ^. pbID) .~ Nothing
| otherwise =
w & cWorld . lWorld . pulseBalls . ix (pb ^. pbID) . pbTimer -~ 1
w & cWorld . lWorld . pulseBalls . ix (pb ^. pbID) . pbTimer -~ 1
& cWorld . lWorld . pulseBalls . ix (pb ^. pbID) . pbPos .~ ep
& pbFlicker pb
where
dodam = \case
Left cr -> creatures . ix (_crID cr) . crDamage .:~ thedam
Right wl -> wallDamages . at (_wlID wl) . non mempty .:~ thedam
thedam = Lasering 100 ep (pb ^. pbVel)
thedam = Lasering 100 ep (pb ^. pbVel)
sp = pb ^. pbPos
ep = sp + pb ^. pbVel
thit = thingHit sp ep w
pbFlicker :: PulseBall -> World -> World
pbFlicker pt =
cWorld . lWorld . lights
.:~ LSParam (addZ 5 $ _pbPos pt) d (0.5 * xyzV4 chartreuse)
cWorld . lWorld . lights
.:~ LSParam (addZ 5 $ _pbPos pt) d (0.5 * xyzV4 chartreuse)
where
d = 4 * fromIntegral (10 + abs ((_pbTimer pt `mod` 20) - 10))
@@ -501,20 +501,23 @@ displayTerminalLineString :: TerminalLineString -> (String, Color)
displayTerminalLineString (TerminalLineConst str col) = (str, col)
tmUpdate :: Terminal -> World -> World
tmUpdate tm w = case w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines . ix 0 of
Nothing -> w
Just tl | _tlPause tl > 0 -> w & pointTermParams . tmFutureLines . ix 0 . tlPause -~ 1
Just (TLine _ tls g) ->
w & pointTermParams
%~ ( (tmFutureLines %~ tail)
. (tmDisplayedLines %~ (map displayTerminalLineString tls ++))
)
& doTmWdWd g tm
-- Just (TerminalLineEffect _ eff) ->
-- w
-- & pointTermParams . tmFutureLines %~ tail
-- & doTmWdWd eff tm
tmUpdate tm w = fromMaybe w $ do
guard $ tm ^. tmStatus == TerminalLineRead
tl <- w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines . ix 0
return $ case tl of
_ | _tlPause tl > 0 -> w & pointTermParams . tmFutureLines . ix 0 . tlPause -~ 1
(TLine _ tls g) ->
w & pointTermParams
%~ ( (tmFutureLines %~ tail)
. (tmDisplayedLines %~ (map displayTerminalLineString tls ++))
)
& doTmWdWd g tm
where
-- Just (TerminalLineEffect _ eff) ->
-- w
-- & pointTermParams . tmFutureLines %~ tail
-- & doTmWdWd eff tm
pointTermParams = cWorld . lWorld . terminals . ix (_tmID tm)
setOldPos :: Creature -> Creature
@@ -641,22 +644,24 @@ updatePulseLaser pz = case pz ^. pzTimer of
5 -> (Endo f, [pz & pzTimer -~ 1])
_ -> (Endo g, [pz & pzTimer -~ 1])
where
f w = dodam thHit
f w =
dodam
thHit
w
& cWorld . lWorld . flares <>~ drawLaser cyan (sp : ps)
where
(thHit, ps) = reflectPulseLaserAlong phasev sp xp w
dodam thit = case thit of
((p, OCreature cr):_) ->
cWorld . lWorld . creatures . ix (_crID cr) . crDamage
((p, OCreature cr) : _) ->
cWorld . lWorld . creatures . ix (_crID cr) . crDamage
.:~ Lasering (pz ^. pzDamage) p (xp - sp)
((p, OWall wl):_) ->
((p, OWall wl) : _) ->
cWorld . lWorld . wallDamages . at (_wlID wl) . non mempty
.:~ Lasering (pz ^. pzDamage) p (xp - sp)
((_, OPulseBall pb):xs) -> dodam xs
.
(cWorld . lWorld . pulseBalls . ix (_pbID pb) . pbTimer .~ 0)
. makeExplosionAt (_pbPos pb `v2z` 20) 0
((_, OPulseBall pb) : xs) ->
dodam xs
. (cWorld . lWorld . pulseBalls . ix (_pbID pb) . pbTimer .~ 0)
. makeExplosionAt (_pbPos pb `v2z` 20) 0
_ -> id
phasev = _pzPhaseV pz
sp = _pzPos pz
@@ -796,9 +801,11 @@ ppEvents w = IM.foldl' (flip $ \pp -> doPressPlateEvent (_ppEvent pp) pp) w $ w
checkEndGame :: Universe -> Universe
checkEndGame uv = case w ^? timeFlow . respawnDelay of
Just x | x < 0 -> uv -- & uvScreenLayers .~ [gameOverMenu uv]
& uvWorld . timeFlow .~ NormalTimeFlow
& uvWorld %~ respawn
Just x
| x < 0 ->
uv -- & uvScreenLayers .~ [gameOverMenu uv]
& uvWorld . timeFlow .~ NormalTimeFlow
& uvWorld %~ respawn
Just _ -> uv & uvWorld . timeFlow . respawnDelay -~ 1
_ | _crHP (you w) < 1 -> uv & uvWorld . timeFlow .~ RespawnDelay 50
_ -> uv
src/Dodge/Update/Input/InGame.hs
+14 -1
View File
@@ -219,6 +219,7 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
w & input . mouseContext .~ OverInvDragSelect x (Just $ snd x)
OverInvSelect x -> startDrag x cfig w
OverTerminalReturn tmid -> terminalReturnEffect tmid w
OverTerminalContinue tmid -> undefined
OverTerminalEscape -> w & hud . hudElement . subInventory .~ NoSubInventory
OverCombSelect x ->
w & hud . hudElement . subInventory . ciSelection ?~ f x
@@ -381,7 +382,19 @@ updateFunctionKey uv ScancodeF4 _ = doDebugTest2 uv
updateFunctionKey uv _ _ = uv
updateKeysInTerminal :: Int -> Universe -> Universe
updateKeysInTerminal tmid u =
updateKeysInTerminal tmid u = fromMaybe u $ do
tm <- u ^? uvWorld . cWorld . lWorld . terminals . ix tmid
return $ case tm ^. tmStatus of
TerminalTextInput{} -> updateKeysTextInputTerminal tmid u
TerminalPressTo{} -> updateKeyContinueTerminal tmid u
_ -> u
updateKeyContinueTerminal :: Int -> Universe -> Universe
updateKeyContinueTerminal tmid u
| any (==0) $ u ^. uvWorld . input . pressedKeys =
u & uvWorld . cWorld . lWorld . terminals . ix tmid . tmStatus .~ TerminalLineRead
| otherwise = u
updateKeysTextInputTerminal :: Int -> Universe -> Universe
updateKeysTextInputTerminal tmid u =
u
& doTextInputOverUniverse
(uvWorld . cWorld . lWorld . terminals . ix tmid . tmStatus . tiText)
src/Dodge/WorldEffect.hs
+2 -2
View File
@@ -60,12 +60,12 @@ accessTerminal mtmid w = fromMaybe w $ do
where
tryToBoot tm = case _tmStatus tm of
TerminalTextInput{} -> tm
TerminalBusy -> tm
TerminalLineRead -> tm
TerminalPressTo{} -> tm
TerminalOff ->
tm
& tmFutureLines .~ _tmBootLines tm
& tmStatus .~ TerminalBusy
& tmStatus .~ TerminalLineRead
torqueCr :: Float -> Int -> World -> World
torqueCr x cid w