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

Work on terminals, add deactive data type status

Browse Source
This commit is contained in:
justin
2025-08-19 13:48:54 +01:00
parent 2f4fcb42e5
commit b8581a7862
13 changed files with 331 additions and 269 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/Input.hs
+3 -3
View File
@@ -5,6 +5,7 @@
module Dodge.Data.Input where
import Dodge.Data.Terminal.Status
import Control.Lens
import qualified Data.Map.Strict as M
import Geometry.Data
@@ -28,9 +29,8 @@ data MouseContext
| OverCombCombine { _mcoCombCombine :: (Int,Int)}
| OverCombFilter
| OverCombEscape
| OverTerminalReturn {_mcoTermID :: Int}
| OverTerminalContinue {_mcoTermID :: Int}
| OverTerminalEscape
| OverTerminal {_mcoTermID :: Int, _mcoTermStatus :: TerminalStatus}
| OutsideTerminal
| MouseGameRotate
deriving (Show)
src/Dodge/Data/Terminal.hs
+2 -1
View File
@@ -89,7 +89,8 @@ data TCom = TCInfo String String -- this may not be necessary, to revisit
data TmWdWd
= TmWdId
| TmWdWdDisconnectTerminal
| TmWdWdPowerDownTerminal
| TmWdWdDeactivateTerminal
| TmWdWdfromWdWd WdWd
| TmWdWdTermSound SoundID
| TmWdWdDoDeathTriggers
src/Dodge/Data/Terminal/Status.hs
+2 -1
View File
@@ -9,10 +9,11 @@ import Data.Aeson.TH
data TerminalStatus
= TerminalOff
| TerminalDeactivated
| TerminalLineRead
| TerminalTextInput {_tiText :: String}
| TerminalPressTo {_tptString :: String}
deriving (Eq)
deriving (Eq,Show)
makeLenses ''TerminalStatus
deriveJSON defaultOptions ''TerminalStatus
src/Dodge/Render/HUD.hs
+1
View File
@@ -383,6 +383,7 @@ drawTerminalDisplay tid cfig w = fromMaybe mempty $ do
$ _tmDisplayedLines tm
displayTermInput tm = case _tmStatus tm of
TerminalOff -> id
TerminalDeactivated -> id
TerminalLineRead -> id
TerminalTextInput s ->
(++ [(getPromptTM ++ s ++ [cFilledRect], white)])
src/Dodge/Render/Picture.hs
+26 -3
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Render.Picture (
fixedCoordPictures,
) where
@@ -109,9 +110,8 @@ 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
OverTerminal _ ts -> drawCursorByTerminalStatus ts
OutsideTerminal -> rotate (pi / 4) $ drawPlus 5
MouseGameRotate -> rotate a (drawVerticalDoubleArrow 5)
where
w = u ^. uvWorld
@@ -122,6 +122,21 @@ mouseCursorType u = case u ^. uvWorld . input . mouseContext of
argV (w ^. cWorld . lWorld . lAimPos -.- cpos)
- w ^. wCam . camRot
drawCursorByTerminalStatus :: TerminalStatus -> Picture
drawCursorByTerminalStatus = \case
TerminalPressTo "QUIT" -> drawQuitTerminal 5
TerminalPressTo _ -> drawArrowDown 5
TerminalTextInput "QUIT" -> drawQuitTerminal 5
TerminalTextInput{} -> drawReturn 5
_ -> drawEmptySet 5
drawQuitTerminal :: Float -> Picture
drawQuitTerminal x = fold
[ line [V2 x x, V2 (- x) (- x)]
, line [V2 x (-x), V2 (- x) x]
, polygonWire (square x)
]
drawEmptySet :: Float -> Picture
drawEmptySet x =
fold
@@ -202,6 +217,14 @@ drawVerticalDoubleArrow x =
z = 1.5 * x
w = 0.6 * x
drawArrowDown :: Float -> Picture
drawArrowDown x =
line [V2 0 z, V2 0 (- z)]
<> line [V2 (- w) (w - z), V2 0 (- z), V2 w (w - z)]
where
z = 1 * x
w = 0.6 * x
drawDragDrop :: Float -> Picture
drawDragDrop x =
line (fmap (+ V2 z (- x)) [V2 (- x) x, V2 0 x, V2 0 (- x)])
src/Dodge/Room/RezBox.hs
+4 -1
View File
@@ -26,7 +26,7 @@ rezBox :: LightSource -> Room
rezBox ls =
roomRect 40 60 1 1
& rmPmnts .~ [sPS (V2 20 1) 0 $ PutLS ls
, putMessageTerminal terminalColor (defaultTerminal & tmBootLines .~ (makeTermPara s) <> tlSetStatus (TerminalPressTo "QUIT") <> [TLine 1 [] TmWdWdDisconnectTerminal])
, putMessageTerminal terminalColor (defaultTerminal & tmBootLines .~ (makeTermPara s) <> tlSetStatus (TerminalPressTo "QUIT") <> [TLine 1 [] TmWdWdDeactivateTerminal])
& plSpot .~ PS (V2 20 0) 0
]
& restrictInLinks (\(V2 _ h, _) -> h < 1)
@@ -35,6 +35,9 @@ rezBox ls =
where
s = "RESPAWN POINT SET AT THIS LOCATION."
tutorialMessage1 :: String
tutorialMessage1 = "SYNTHESIS SUCCESSFUL. MOVEMENT TEST 1 INITIATED [WASD]. INTERACTION TEST 1 IN QUEUE [SPACE]."
rezBox' :: RandomGen g => State g (MetaTree Room String)
rezBox' = do
col <- rezColor
src/Dodge/Terminal.hs
+42 -25
View File
@@ -3,7 +3,8 @@
module Dodge.Terminal (
makeTermLine,
connectionBlurbLines,
disconnectTerminal,
powerDownTerminal,
deactivateTerminal,
textTerminal,
simpleTermMessage,
damageCodeCommand,
@@ -21,11 +22,11 @@ module Dodge.Terminal (
--import Dodge.Data.WorldEffect
import qualified Data.Map.Strict as M
import Color
import Data.Char
import qualified Data.List as List
import Color
import qualified Data.ListTrie.Patricia.Map.Enum as PTE
import qualified Data.Map.Strict as M
--import Control.Monad
--import Data.Char
--import qualified Data.Map.Strict as M
@@ -122,30 +123,38 @@ getCommand tm = \case
TCSensorInfo -> sensorCommand
damageCodeCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
damageCodeCommand = PTE.singleton "DAMAGECODE" $ PTE.fromList $ mapMaybe f [minBound..]
damageCodeCommand = PTE.singleton "DAMAGECODE" $ PTE.fromList $ mapMaybe f [minBound ..]
where
f :: SensorType -> Maybe (String, [TerminalLine])
f st = do
s <- g st
return (s, [TLine 0 [] $ TmGetDamageCoding st])
g = fmap (map toUpper) . fmap reverse . List.stripPrefix (reverse "Sensor")
. reverse . show
g =
fmap (map toUpper) . fmap reverse . List.stripPrefix (reverse "Sensor")
. reverse
. show
-- ugly, when changing check getSensorInfo
sensorCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
sensorCommand = PTE.singleton "SENSOR" $ PTE.fromList
[("REQUIREMENT", [])
,("DISTANCE",[])
,("STATUS",[])
]
sensorCommand =
PTE.singleton "SENSOR" $
PTE.fromList
[ ("REQUIREMENT", [])
, ("DISTANCE", [])
, ("STATUS", [])
]
toggleCommand :: Terminal -> PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
toggleCommand tm = PTE.singleton "TOGGLE" $ PTE.fromList $
M.toList $ fmap f $ tm ^. tmToggles
toggleCommand tm =
PTE.singleton "TOGGLE" $
PTE.fromList $
M.toList $ fmap f $ tm ^. tmToggles
where
f x = [TLine 1
[TerminalLineConst "TOGGLE DONE!" termTextColor]
(TmWdWdfromWdWd (WdWdNegateTrig $ x ^. ttTriggerID))
f x =
[ TLine
1
[TerminalLineConst "TOGGLE DONE!" termTextColor]
(TmWdWdfromWdWd (WdWdNegateTrig $ x ^. ttTriggerID))
]
helpCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
@@ -158,7 +167,7 @@ helpStrings =
]
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 [] TmWdWdPowerDownTerminal])
makeTermLine :: String -> TerminalLine
makeTermLine = makeColorTermLine termTextColor
@@ -191,11 +200,13 @@ tabComplete s' tm = case PTE.lookup s $ getCommands tm of
[] -> tm
[x] -> tm & tmStatus . tiText .~ (y ++ x)
xs ->
tm & tmStatus .~ TerminalLineRead
tm & tmStatus .~ TerminalLineRead
& tmFutureLines
.~ (makeColorTermPara
commandColor
(unwords xs) <> [TLine 1 [] . TmTmSetStatus $ TerminalTextInput s])
.~ ( makeColorTermPara
commandColor
(unwords xs)
<> [TLine 1 [] . TmTmSetStatus $ TerminalTextInput s]
)
--doTerminalCommandEffect :: TerminalCommandEffect -> Terminal -> World -> EffectArguments
--doTerminalCommandEffect tce = case tce of
@@ -258,7 +269,6 @@ tabComplete s' tm = case PTE.lookup s $ getCommands tm of
-- (makeTermPara . map toLower . show . f)
-- (w ^? cWorld . lWorld . machines . ix (_tmMachineID tm) . mcType . _McSensor)
--sensorCommand :: TerminalCommand
--sensorCommand =
-- TerminalCommand
@@ -268,12 +278,19 @@ tabComplete s' tm = case PTE.lookup s $ getCommands tm of
-- , _tcEffect = TerminalCommandEffectSensorParameter -- \tm -> OneArgument "A SENSOR PARAMETER" . sensorInfoMap tm
-- }
disconnectTerminal :: Terminal -> World -> World
disconnectTerminal tm =
powerDownTerminal :: Terminal -> World -> World
powerDownTerminal tm =
(cWorld . lWorld . terminals . ix (_tmID tm) . tmStatus .~ TerminalOff)
. exitTerminalSubInv
. ( cWorld . lWorld . terminals . ix (_tmID tm) . tmDisplayedLines .~ []
)
. exitTerminalSubInv
deactivateTerminal :: Terminal -> World -> World
deactivateTerminal tm =
(cWorld . lWorld . terminals . ix (_tmID tm) . tmStatus .~ TerminalOff)
. ( cWorld . lWorld . terminals . ix (_tmID tm) . tmDisplayedLines .~ []
)
. exitTerminalSubInv
exitTerminalSubInv :: World -> World
exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of
src/Dodge/Terminal/Color.hs
+1
View File
@@ -10,6 +10,7 @@ import Control.Lens
termScreenColor :: Terminal -> Maybe Color
termScreenColor tm = case tm ^. tmStatus of
TerminalOff -> Nothing
TerminalDeactivated -> Nothing
TerminalTextInput _ -> Just green
TerminalPressTo{} -> Just green
TerminalLineRead -> Just white
src/Dodge/Update.hs
+2 -5
View File
@@ -397,11 +397,8 @@ updateMouseContextGame cfig u = case u ^. uvWorld . input . mouseContext of
tm <- w ^? cWorld . lWorld . terminals . ix tmid
return $
if isOverTerminalScreen cfig mpos
then fromMaybe NoMouseContext $ do
let s = tm ^. tmStatus . tiText
guard $ not (null s) -- && _tmStatus tm == TerminalTextInput
return $ OverTerminalReturn tmid
else OverTerminalEscape
then OverTerminal tmid (tm ^. tmStatus)
else OutsideTerminal
getMenuMouseContext :: ScreenLayer -> Universe -> MouseContext
getMenuMouseContext screen u = case screen ^. scOptions of
src/Dodge/Update/Input/InGame.hs
+9 -4
View File
@@ -218,9 +218,9 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
&& isGroupSelectableSection (fst x) ->
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
OverTerminal tmid (TerminalTextInput {}) -> terminalReturnEffect tmid w
OverTerminal tmid (TerminalPressTo{}) -> continueTerminal tmid w
OutsideTerminal -> w & hud . hudElement . subInventory .~ NoSubInventory
OverCombSelect x ->
w & hud . hudElement . subInventory . ciSelection ?~ f x
& worldEventFlags . at CombineInventoryChange ?~ ()
@@ -388,11 +388,16 @@ updateKeysInTerminal tmid u = fromMaybe u $ do
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
u & uvWorld %~ continueTerminal tmid
| otherwise = u
continueTerminal :: Int -> World -> World
continueTerminal tmid = cWorld . lWorld . terminals . ix tmid . tmStatus .~ TerminalLineRead
updateKeysTextInputTerminal :: Int -> Universe -> Universe
updateKeysTextInputTerminal tmid u =
u
src/Dodge/WorldEffect.hs
+3 -1
View File
@@ -66,6 +66,7 @@ accessTerminal mtmid w = fromMaybe w $ do
tm
& tmFutureLines .~ _tmBootLines tm
& tmStatus .~ TerminalLineRead
TerminalDeactivated -> error "managed to boot a deactivated terminal"
torqueCr :: Float -> Int -> World -> World
torqueCr x cid w
@@ -116,7 +117,8 @@ doTmWdWd tmwdwd = case tmwdwd of
-- tid <- tm ^? tmID
-- return $ cWorld . lWorld . terminals . ix tid . tmPartialCommand .~ x
TmWdId -> const id
TmWdWdDisconnectTerminal -> disconnectTerminal
TmWdWdPowerDownTerminal -> powerDownTerminal
TmWdWdDeactivateTerminal -> deactivateTerminal
TmWdWdTermSound sid -> \tm w ->
let tpos = fromMaybe 0 $ w ^? cWorld . lWorld . buttons . ix (_tmButtonID tm) . btPos
in soundStart TerminalSound tpos sid Nothing w