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

Slightly rethink display of inventories and terminals

Browse Source
This commit is contained in:
justin
2025-09-18 19:56:12 +01:00
parent e017a92892
commit 2d856ddf9e
13 changed files with 156 additions and 139 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/Terminal.hs
+1 -1
View File
@@ -54,7 +54,7 @@ data TCom
data TmWdWd
= TmWdId
| TmWdWdPowerDownTerminal
| TmWdWdLeaveTerminal
| TmWdWdLeaveTerminal String
| TmWdWdDeactivateTerminal
| TmWdWdfromWdWd WdWd
| TmWdWdTermSound SoundID
src/Dodge/DisplayInventory.hs
+21 -11
View File
@@ -61,13 +61,13 @@ updateCombineSections w cfig =
filtcurs
(flip . andOrRegex $ regexCombs invitms)
(IM.fromDistinctAscList . zip [0 ..] $ combineList w)
"COMBINATIONS"
"POSSIBLE COMBINATIONS"
$ w ^? hud . subInventory . ciFilter . _Just
invitms = _unNIntMap $ fmap (\k -> w ^?! cWorld . lWorld . items . ix k) $ fold $ w ^? cWorld . lWorld . creatures . ix 0 . crInv
sclose'
| null sclose =
IM.singleton 0 $
SelItem ["No possible combinations"] 1 25 False white 0 Nothing
SelItem ["NONE"] 1 25 False white 0 Nothing
| otherwise = sclose
regexCombs :: IM.IntMap Item -> SelectionItem CombinableItem -> String -> Bool
@@ -169,24 +169,34 @@ filterSectionsPair ::
String ->
Maybe String ->
(IM.IntMap (SelectionItem a), IM.IntMap (SelectionItem a))
filterSectionsPair infocus filtfn itms filtdescription mfilt = (filtsis, itms')
filterSectionsPair infocus filtfn itms s mfilt = (x, itms')
where
filtcurs = if infocus then cFilledRect else cWireRect
filtsis = fold $ do
x = IM.singleton 0 $ fromMaybe (SelItem [s] 1 (length s) False white 0 Nothing) $ do
str <- mfilt
return $
IM.singleton
0
$ SelItem
[filtdescription ++ " FILTER/" ++ str ++ [filtcurs], numfiltitems]
return $ SelItem
[s ++ " FILTER/" ++ str ++ [filtcurs], numfiltitems]
2
(length (filtdescription ++ " FILTER/" ++ str ++ [filtcurs]))
(length (s ++ " FILTER/" ++ str ++ [filtcurs]))
True
white
0
Nothing
-- filtsis = fold $ do
-- str <- mfilt
-- return $
-- IM.singleton
-- 0
-- $ SelItem
-- [filtdescription ++ " FILTER/" ++ str ++ [filtcurs], numfiltitems]
-- 2
-- (length (filtdescription ++ " FILTER/" ++ str ++ [filtcurs]))
-- True
-- white
-- 0
-- Nothing
itms' = maybe id (IM.filter . filtfn) mfilt itms
numfiltitems = " " ++ show (length itms - length itms') ++ " FILTERED"
numfiltitems = show (length itms - length itms') ++ " FILTERED"
invDimColor :: Color
invDimColor = greyN 0.7
src/Dodge/ListDisplayParams.hs
+1 -3
View File
@@ -41,9 +41,7 @@ invCursorParams w = BoundaryCursor $ case w ^? hud . subInventory of
_ -> [North, South, West]
secondColumnLDP :: ListDisplayParams
secondColumnLDP =
defaultListDisplayParams
& ldpPos . spPixelOff .~ V2 subInvX (-81)
secondColumnLDP = defaultListDisplayParams & ldpPos . spPixelOff .~ V2 subInvX (-80)
subInvX :: Float
subInvX = 10 * fromIntegral topInvW + 70
src/Dodge/Machine/Update.hs
+1 -1
View File
@@ -176,7 +176,7 @@ mcProximitySensorUpdate mc sens pr w
& mctermlens . tmFutureLines
<>~ [makeTermLine "SENSOR SUCCESS, DEACTIVATED"]
<> tlSetStatus (TerminalPressTo "QUIT")
<> tlDoEffect TmWdWdLeaveTerminal
<> tlDoEffect (TmWdWdLeaveTerminal "QUIT")
| notog =
w & playsound dedumS
& mcsenslens . proxToggle ?~ False
src/Dodge/Render/HUD.hs
+18 -17
View File
@@ -52,12 +52,14 @@ drawHUD :: Config -> World -> Picture
drawHUD cfig w = case w ^. hud of
-- DisplayCarte -> drawCarte cfig w
HUD {_diSections = sections, _subInventory = subinv} ->
drawInventory sections w cfig
drawInventory sections w cfig subinv
<> drawSubInventory subinv cfig w
drawInventory :: IM.IntMap (SelectionSection ()) -> World -> Config -> Picture
drawInventory sss w cfig =
drawSelectionSections sss invDP cfig
drawInventory
:: IM.IntMap (SelectionSection ()) -> World -> Config -> SubInventory -> Picture
drawInventory sss w cfig = \case
DisplayTerminal {} -> mempty
_ -> drawSelectionSections sss invDP cfig
<> drawSSCursor sss invDP curs cfig (f $ w ^? hud . diSelection . _Just)
<> drawRootCursor w sss (f $ w ^? hud . diSelection . _Just) invDP cfig
<> itemconnections
@@ -184,8 +186,8 @@ drawCombineInventory ::
World ->
Picture
drawCombineInventory cfig sss w =
invHead cfig "COMBINE"
<> drawSelectionSections sss secondColumnLDP cfig
-- invHead cfig "COMBINE"
drawSelectionSections sss secondColumnLDP cfig
<> drawSSCursor sss secondColumnLDP curs cfig msel
<> combineInventoryExtra sss msel cfig w
where
@@ -363,22 +365,21 @@ combineInventoryExtra sss msel cfig w = fold $ do
drawTerminalDisplay :: LWorld -> Config -> Terminal -> Picture
drawTerminalDisplay lw cfig tm =
invHead cfig ("T-" ++ show tid)
<> drawSelectionList secondColumnLDP cfig f
<> color
(withAlpha 0.5 green) -- consider integrating termScreenColor somehow
(drawSelectionListBackground secondColumnLDP cfig tsize)
<> color (dark $ _tmExternalColor tm) (drawTitleBackground cfig)
drawSelectionList invDP cfig f
-- <> invHead cfig ("TERMINAL-" ++ show tid)
-- <> color
-- (withAlpha 0.5 green) -- consider integrating termScreenColor somehow
-- (drawSelectionListBackground secondColumnLDP cfig tsize)
-- <> color (dark $ _tmExternalColor tm) (drawTitleBackground cfig)
where
tid = tm ^. tmID
tsize = getMaxLinesTM + 1
-- tsize = getMaxLinesTM + 1
toselitm (str, col) = SelItem [str] 1 55 True col 0 Nothing
-- not sure if the width (55) is correct here
f =
map toselitm . displayTermInput
f = toselitm ("TERMINAL " ++ show tid,white) :
(map (toselitm . (_1 %~ (" "<>))) . displayTermInput
. reverse
-- . take getMaxLinesTM
$ _tmDisplayedLines tm
$ _tmDisplayedLines tm)
displayTermInput = case _tmStatus tm of
TerminalOff -> id
TerminalDeactivated -> id
src/Dodge/Room/Tutorial.hs
+26 -8
View File
@@ -43,12 +43,13 @@ import TreeHelp
tutAnoTree :: Annotation
tutAnoTree =
OnwardList
[ AnTree $ return $ tToBTree "teststart" $ return $ cleatOnward corridor
, AnTree $ tutDrop
-- [ AnTree $ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
-- [ AnTree $ return $ tToBTree "teststart" $ return $ cleatOnward corridor
-- , AnTree $ tutDrop
[ AnTree $ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
, AnTree corDoor
, AnTree $ tutRooms
, AnTree $ tutDrop
, AnTree $ return $ tToBTree "cor" $ return $ cleatOnward corridor
---- , AnTree $ pickupTut
---- , AnTree $ weaponTut
]
@@ -66,7 +67,7 @@ tutRooms = do
i <- nextLayoutInt
j <- nextLayoutInt
x <- shuffleLinks =<< analyserByDoor (RequireEquipment (AMMOMAG DRUMMAG)) i
<$> addDoorAtNthLinkToggleTerminal 1 (makeTermPara s) j
<$> addDoorAtNthLinkToggleTerminal 1 ss j
<$> roomNgon 6 100
bcor <- blockedCorridor
r1 <-(r burstRifle)
@@ -77,7 +78,12 @@ tutRooms = do
,bcor
]
where
s = "INTERACTION TEST: USE KEYBOARD OR SCROLL TO ENTER COMMANDS."
ss = [makeTermLine "BE READY TO PERFORM SOME BASIC TASKS"
, makeTermLine ""
, makeTermLine "INTERACTION TEST"
, makeTermLine "<TYPE OR SCROLL TO SELECT COMMANDS>"
, makeTermLine "<USE CLICK OR RETURN TO ENTER COMMANDS>"
]
r x = roomRectAutoLinks 100 100 <&> rmPmnts .:~ sps (PS 50 0) (PutFlIt x)
tutRezBox :: RandomGen g => State g Room
@@ -87,7 +93,10 @@ tutRezBox = do
roomRect 40 60 1 1
& rmPmnts
.~ [ sPS (V2 20 1) 0 $ PutLS ls
, putImmediateMessageTerminal terminalColor (defaultTerminal & tmBootLines .~ makeTermPara s <> tlSetStatus (TerminalPressTo "QUIT") <> tlDoEffect TmWdWdDeactivateTerminal)
, putImmediateMessageTerminal terminalColor
(defaultTerminal & tmBootLines .~ s
<> tlSetStatus (TerminalPressTo "USE [WASD] TO MOVE") <> tlDoEffect
(TmWdWdLeaveTerminal "USE [WASD] TO MOVE"))
& plSpot .~ PS (V2 20 0) 0
]
& restrictInLinks (\(V2 _ h, _) -> h < 1)
@@ -96,5 +105,14 @@ tutRezBox = do
where
s = tutorialMessage1
tutorialMessage1 :: String
tutorialMessage1 = "SYNTHESIS SUCCESSFUL. MOBILITY TEST INITIATED [WASD]. INTERACTION TEST IN QUEUE [SPACE]."
tutorialMessage1 :: [TerminalLine]
tutorialMessage1 =
[makeTermLine "SYNTHESIS SUCCESSFUL..."
,makeTermLine "WELCOME TO THE STATION!"
,makeTermLine ""
,makeTermLine "INTERACTION TEST"
] <> tlSetStatus (TerminalPressTo "USE [SPACE] TO INTERACT")
<> [makeTermLine "<USE [SPACE] TO INTERACT>"
,makeTermLine ""
,makeTermLine "MOBILITY TEST"
]
src/Dodge/Terminal.hs
+3 -5
View File
@@ -36,14 +36,12 @@ textTerminal = defaultTerminal{_tmBootLines = textInputBlurb []}
textInputBlurb :: [TerminalLine] -> [TerminalLine]
textInputBlurb tls =
[ termSoundLine computerBeepingS
, TLine 0 [TerminalLineConst "LOADING TEXT INTERFACE..." termTextColor] TmWdId
]
[termSoundLine computerBeepingS]
++ tls
++ [TLine 10 [TerminalLineConst "READY FOR INPUT" termTextColor] (TmTmSetStatus (TerminalTextInput ""))]
++ tlSetStatus (TerminalTextInput "")
termSoundLine :: SoundID -> TerminalLine
termSoundLine sid = TLine 0 [] (TmWdWdTermSound sid)
termSoundLine = TLine 0 [] . TmWdWdTermSound
termTextColor :: Color
termTextColor = greyN 0.9
src/Dodge/WorldEffect.hs
+4 -4
View File
@@ -94,7 +94,7 @@ doTmWdWd tmwdwd = case tmwdwd of
TmWdId -> const id
TmWdWdPowerDownTerminal -> resetTerminal TerminalOff
TmWdWdDeactivateTerminal -> resetTerminal TerminalDeactivated
TmWdWdLeaveTerminal -> leaveResetQuitTerminal
TmWdWdLeaveTerminal s -> leaveResetQuitTerminal s
TmWdWdTermSound sid -> \tm w -> fromMaybe w $ do
tpos <- w ^? cWorld . lWorld . buttons . ix (_tmButtonID tm) . btPos
return $ soundStart TerminalSound tpos sid Nothing w
@@ -107,10 +107,10 @@ resetTerminal x tm =
. (cWorld . lWorld . terminals . ix (_tmID tm) . tmDisplayedLines .~ [])
. exitTerminalSubInv
leaveResetQuitTerminal :: Terminal -> World -> World
leaveResetQuitTerminal tm =
leaveResetQuitTerminal :: String -> Terminal -> World -> World
leaveResetQuitTerminal s tm =
(cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines
.~ (tlSetStatus (TerminalPressTo "QUIT")) <> tlDoEffect TmWdWdLeaveTerminal)
.~ (tlSetStatus (TerminalPressTo s)) <> tlDoEffect (TmWdWdLeaveTerminal s))
. exitTerminalSubInv
exitTerminalSubInv :: World -> World