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

Work on more complicated terminals

Browse Source
This commit is contained in:
justin
2022-05-31 13:30:27 +01:00
parent 79b3a86520
commit b54864bbda
13 changed files with 159 additions and 64 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Placement/Instance/Terminal.hs
+33 -18
View File
@@ -27,7 +27,7 @@ putTerminal'
-> Placement
putTerminal' col mcf = ps0PushPS (PutButton thebutton)
$ \pl -> Just $ pt0 (PutMachine col (reverse $ square 10) defaultMachine
{ _mcDraw = noPic . colorSH col . terminalShape
{ _mcDraw = noPic . terminalShape col
, _mcHP = 100
, _mcUpdate = mcf (fromJust $ _plMID pl)
, _mcSensor = SensorCloseToggle NotClose False
@@ -42,13 +42,13 @@ putTerminal' col mcf = ps0PushPS (PutButton thebutton)
, _btID = 0
, _btText = "TERMINAL"
, _btState = BtOff
, _btTerminalParams = TerminalParams [] [] 10 "TERMINAL"
, _btTerminalParams = TerminalParams [] [] 10 "TERMINAL" Nothing []
}
putTerminal :: (GenParams -> TerminalParams) -> Placement
putTerminal f = plGenUpdate ?~ g $ ps0PushPS (PutButton thebutton)
$ \pl -> Just $ pt0 (PutMachine terminalColor (reverse $ square 10) defaultMachine
{ _mcDraw = noPic . colorSH terminalColor . terminalShape
{ _mcDraw = noPic . terminalShape terminalColor
, _mcHP = 100
, _mcUpdate = machineAddSound fridgeHumS
$ machineUpdateDeathEff $ \mc -> (buttons . at (fromJust (_plMID pl)) .~ Nothing)
@@ -68,14 +68,24 @@ putTerminal f = plGenUpdate ?~ g $ ps0PushPS (PutButton thebutton)
, _btID = 0
, _btText = "TERMINAL"
, _btState = BtOff
, _btTerminalParams = TerminalParams [] [] 10 "TERMINAL"
, _btTerminalParams = TerminalParams [] [] 10 "TERMINAL" Nothing []
}
terminalColor :: Color
terminalColor = dark magenta
terminalShape :: Machine -> Shape
terminalShape _ = upperPrismPoly 15 $ square 10
terminalShape :: Color -> Machine -> Shape
--terminalShape _ = upperPrismPoly 15 $ square 10
terminalShape col _ = colorSH col (prismPoly
[V3 10 10 20, V3 (-10) 10 20, V3 (-10) (-10) 10, V3 10 (-10) 10]
[V3 10 10 0, V3 (-10) 10 0, V3 (-10) (-10) 0, V3 10 (-10) 0]
)
<> colorSH black (prismPoly
[V3 8 8 20, V3 (-8) 8 20, V3 0 (-8) 10]
[V3 8 8 19, V3 (-8) 8 19, V3 0 (-8) 9]
--[V3 8 8 20, V3 (-8) 8 20, V3 (-8) (-8) 10, V3 8 (-8) 10]
--[V3 8 8 19, V3 (-8) 8 19, V3 (-8) (-8) 9, V3 8 (-8) 9]
)
displayTerminalMessage :: Int -> World -> World
displayTerminalMessage btid w = w & hud . hudElement .~ DisplayInventory DisplayTerminal
@@ -84,18 +94,21 @@ displayTerminalMessage btid w = w & hud . hudElement .~ DisplayInventory Display
}
simpleTermMessage :: [String] -> (GenParams -> TerminalParams)
simpleTermMessage ss = const $ TerminalParams
{_termDisplayedLines = []
,_termFutureLines = TerminalLineEffect 0 termsound
: map totermline (topFlushStrings ss ++ ss)
,_termMaxLines = 7
,_termTitle = "TERMINAL"
}
where
totermline s = TerminalLineDisplay 0 (const (s,white))
termsound subinv w' = soundStart TerminalSound tpos computerBeepingS Nothing w'
where
tpos = fromMaybe 0 $ w' ^? buttons . ix (_termID subinv) . btPos
simpleTermMessage = genTermMessage . const
--simpleTermMessage ss = const $ TerminalParams
-- {_termDisplayedLines = []
-- ,_termFutureLines = TerminalLineEffect 0 termsound
-- : map totermline (topFlushStrings ss ++ ss)
-- ,_termMaxLines = 7
-- ,_termTitle = "TERMINAL"
-- ,_termSel = Nothing
-- ,_termMaxSel = Nothing
-- }
-- where
-- totermline s = TerminalLineDisplay 0 (const (s,white))
-- termsound subinv w' = soundStart TerminalSound tpos computerBeepingS Nothing w'
-- where
-- tpos = fromMaybe 0 $ w' ^? buttons . ix (_termID subinv) . btPos
topFlushStrings :: [String] -> [String]
topFlushStrings = topFlush . maximum . map length
@@ -110,6 +123,8 @@ genTermMessage f = \gp -> TerminalParams
: map totermline (topFlushStrings (f gp) ++ f gp)
,_termMaxLines = 7
,_termTitle = "TERMINAL"
,_termSel = Nothing
,_termOptions = []
}
where
totermline s = TerminalLineDisplay 0 (const (s,white))