Improve terminal update/display

This commit is contained in:
2025-08-19 19:37:36 +01:00
parent 1cfb581e15
commit a373b31152
6 changed files with 27 additions and 24 deletions
+8 -7
View File
@@ -8,16 +8,16 @@ module Dodge.Data.Terminal (
module Dodge.Data.Terminal.Status,
) where
import Dodge.Data.Machine.Sensor.Type
import Sound.Data
import Color
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import qualified Data.Map.Strict as M
import Dodge.Data.BlBl
import Dodge.Data.Machine.Sensor.Type
import Dodge.Data.Terminal.Status
import Dodge.Data.WorldEffect
import Sound.Data
data Terminal = Terminal
{ _tmID :: Int
@@ -37,17 +37,18 @@ data Terminal = Terminal
data TerminalLineString = TerminalLineConst String Color
data TerminalLine = TLine
{ _tlPause :: Int
, _tlString :: [TerminalLineString] -- World -> (String, Color)
, _tlEffect :: TmWdWd --Terminal -> World -> World
}
{ _tlPause :: Int
, _tlString :: [TerminalLineString] -- World -> (String, Color)
, _tlEffect :: TmWdWd --Terminal -> World -> World
}
data TerminalToggle = TerminalToggle
{ _ttTriggerID :: Int
, _ttDeathEffect :: BlBl
}
data TCom = TCInfo String String -- this may not be necessary, to revisit
data TCom
= TCInfo String String -- this may not be necessary, to revisit
| TCBase
| TCDamageCommand
| TCSensorInfo
+10 -11
View File
@@ -159,7 +159,7 @@ drawSubInventory subinv cfig w = case subinv of
-- LockedInventory -> mempty -- topInvCursor col cursPos cfig w
NoSubInventory{} -> drawRBOptions cfig w
ExamineInventory -> drawExamineInventory cfig w
DisplayTerminal tid -> drawTerminalDisplay tid cfig (w ^. cWorld . lWorld)
DisplayTerminal tid -> foldMap (drawTerminalDisplay cfig) (w ^? cWorld . lWorld . terminals . ix tid)
CombineInventory{_ciSections = sss} -> drawCombineInventory cfig sss w
MapperInventory _ _ itid -> drawMapperInventory itid w
@@ -354,26 +354,25 @@ combineInventoryExtra sss msel cfig w = fold $ do
sss'
(Just (0, i))
drawTerminalDisplay :: Int -> Configuration -> LWorld -> Picture
drawTerminalDisplay tid cfig w = fold $ do
tm <- w ^? terminals . ix tid
let tsize = getMaxLinesTM + 1
return $
invHead cfig ("T-" ++ show tid)
<> drawSelectionList secondColumnParams cfig (f tm)
--drawTerminalDisplay :: Int -> Configuration -> LWorld -> Picture
drawTerminalDisplay :: Configuration -> Terminal -> Picture
drawTerminalDisplay cfig tm = invHead cfig ("T-" ++ show tid)
<> drawSelectionList secondColumnParams cfig f
<> color
(withAlpha 0.5 green) -- consider integrating termScreenColor somehow
(drawSelectionListBackground secondColumnParams cfig tsize)
<> color (dark $ _tmExternalColor tm) (drawTitleBackground cfig)
where
tid = tm ^. tmID
tsize = getMaxLinesTM + 1
toselitm (str, col) = SelItem [str] 1 55 True col 0 Nothing
-- not sure if the width (55) is correct here
f tm =
map toselitm . displayTermInput tm
f =
map toselitm . displayTermInput
. reverse
. take getMaxLinesTM
$ _tmDisplayedLines tm
displayTermInput tm = case _tmStatus tm of
displayTermInput = case _tmStatus tm of
TerminalOff -> id
TerminalDeactivated -> id
TerminalLineRead -> id
+1 -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 [] TmWdWdDeactivateTerminal])
, putMessageTerminal terminalColor (defaultTerminal & tmBootLines .~ makeTermPara s <> tlSetStatus (TerminalPressTo "QUIT") <> tlDoEffect TmWdWdDeactivateTerminal)
& plSpot .~ PS (V2 20 0) 0
]
& restrictInLinks (\(V2 _ h, _) -> h < 1)
+1 -4
View File
@@ -14,6 +14,7 @@ module Dodge.Terminal (
getCommands,
tabComplete,
tlSetStatus,
tlDoEffect,
) where
import Color
@@ -21,9 +22,6 @@ import Data.Char
import qualified Data.List as List
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
import Data.Maybe
import Dodge.Data.Terminal.Status
import Dodge.Data.World
@@ -32,7 +30,6 @@ import Dodge.SoundLogic
import Dodge.Terminal.Type
import Justify
import LensHelp
--import ListHelp (safeHead, safeUncons)
import Sound.Data
textTerminal :: Terminal
+1 -1
View File
@@ -28,7 +28,7 @@ import qualified IntMapHelp as IM
import qualified Data.Map.Strict as M
testStringInit :: Universe -> [String]
testStringInit u = map show $ u ^.. uvWorld . cWorld . lWorld . terminals . each . tmStatus
testStringInit _ = []
-- map shortShow (u ^.. uvWorld . cWorld . lWorld . debris . each . to g)
-- where
-- g db = (pz,z,norm v)
+6
View File
@@ -5,6 +5,8 @@ module Dodge.Update.Input.InGame (
updateMouseInGame,
) where
import Dodge.Base.Collide
import Geometry.Vector
import Dodge.Data.Terminal.Status
import Control.Applicative
import Control.Monad
@@ -384,7 +386,11 @@ updateFunctionKey uv _ _ = uv
updateKeysInTerminal :: Int -> Universe -> Universe
updateKeysInTerminal tmid u = fromMaybe u $ do
tm <- u ^? uvWorld . cWorld . lWorld . terminals . ix tmid
x <- u ^? uvWorld . cWorld . lWorld . buttons . ix (tm ^. tmButtonID) . btPos
y <- u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crPos
return $ case tm ^. tmStatus of
_ | dist x y > 40 || not (hasButtonLOS x y (u ^. uvWorld))
-> u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory
TerminalDeactivated -> u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory
TerminalTextInput{} -> updateKeysTextInputTerminal tmid u
TerminalPressTo{} -> updateKeyContinueTerminal tmid u