Move towards inputs in terminal

This commit is contained in:
2022-06-01 14:34:16 +01:00
parent b54864bbda
commit 2cedc1b968
13 changed files with 90 additions and 64 deletions
+3 -2
View File
@@ -62,7 +62,7 @@ analyser' starts sucs fails afters upf pslight psmc = extTrigLitPos pslight $ \t
where
termupdate tp btid = initMCUpdate
(\mc -> buttons . ix btid . btTerminalParams .~
TerminalParams
const (TerminalParams
{ _termDisplayedLines = []
, _termFutureLines =
map simpleline (topFlushStrings allstrings)
@@ -73,7 +73,8 @@ analyser' starts sucs fails afters upf pslight psmc = extTrigLitPos pslight $ \t
, _termTitle = "ANALYSER"
, _termSel = Nothing
, _termOptions = []
}
, _termInput = Nothing
})
)
(\mc -> upf mc . (triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc))
)
+12 -20
View File
@@ -25,7 +25,7 @@ putTerminal'
:: Color
-> (Int -> Machine -> World -> World) -- | machine update, takes button id as input
-> Placement
putTerminal' col mcf = ps0PushPS (PutButton thebutton)
putTerminal' col mcf = ps0PushPS (PutButton termButton)
$ \pl -> Just $ pt0 (PutMachine col (reverse $ square 10) defaultMachine
{ _mcDraw = noPic . terminalShape col
, _mcHP = 100
@@ -33,20 +33,9 @@ putTerminal' col mcf = ps0PushPS (PutButton thebutton)
, _mcSensor = SensorCloseToggle NotClose False
})
$ const Nothing
where
thebutton = Button
{ _btPict = const mempty
, _btPos = 0
, _btRot = 0
, _btEvent = displayTerminalMessage . _btID
, _btID = 0
, _btText = "TERMINAL"
, _btState = BtOff
, _btTerminalParams = TerminalParams [] [] 10 "TERMINAL" Nothing []
}
putTerminal :: (GenParams -> TerminalParams) -> Placement
putTerminal f = plGenUpdate ?~ g $ ps0PushPS (PutButton thebutton)
putTerminal :: (GenParams -> World -> TerminalParams) -> Placement
putTerminal f = plGenUpdate ?~ g $ ps0PushPS (PutButton termButton)
$ \pl -> Just $ pt0 (PutMachine terminalColor (reverse $ square 10) defaultMachine
{ _mcDraw = noPic . terminalShape terminalColor
, _mcHP = 100
@@ -60,7 +49,8 @@ putTerminal f = plGenUpdate ?~ g $ ps0PushPS (PutButton thebutton)
pl & plType . putButton . btTerminalParams .~ f gp
& plGenUpdate .~ Nothing
)
thebutton = Button
termButton :: Button
termButton = Button
{ _btPict = const mempty
, _btPos = 0
, _btRot = 0
@@ -68,9 +58,10 @@ putTerminal f = plGenUpdate ?~ g $ ps0PushPS (PutButton thebutton)
, _btID = 0
, _btText = "TERMINAL"
, _btState = BtOff
, _btTerminalParams = TerminalParams [] [] 10 "TERMINAL" Nothing []
, _btTerminalParams = const $ TerminalParams [] [] 10 "TERMINAL" Nothing [] Nothing
}
terminalColor :: Color
terminalColor = dark magenta
@@ -90,10 +81,10 @@ terminalShape col _ = colorSH col (prismPoly
displayTerminalMessage :: Int -> World -> World
displayTerminalMessage btid w = w & hud . hudElement .~ DisplayInventory DisplayTerminal
{ _termID = btid
, _termParams = fromMaybe NoTerminalParams $ w ^? buttons . ix btid . btTerminalParams
, _termParams = fromMaybe NoTerminalParams $ (w ^? buttons . ix btid . btTerminalParams) <&> ($ w)
}
simpleTermMessage :: [String] -> (GenParams -> TerminalParams)
simpleTermMessage :: [String] -> (GenParams -> World -> TerminalParams)
simpleTermMessage = genTermMessage . const
--simpleTermMessage ss = const $ TerminalParams
-- {_termDisplayedLines = []
@@ -116,8 +107,8 @@ topFlushStrings = topFlush . maximum . map length
topFlush :: Int -> [String]
topFlush twidth = [replicate i ' ' ++ "*" | i <- [0, max 1 $ twidth `div` 5 .. twidth]]
genTermMessage :: (GenParams -> [String]) -> (GenParams -> TerminalParams)
genTermMessage f = \gp -> TerminalParams
genTermMessage :: (GenParams -> [String]) -> (GenParams -> World -> TerminalParams)
genTermMessage f = \gp _ -> TerminalParams
{_termDisplayedLines = []
,_termFutureLines = termSoundLine computerBeepingS
: map totermline (topFlushStrings (f gp) ++ f gp)
@@ -125,6 +116,7 @@ genTermMessage f = \gp -> TerminalParams
,_termTitle = "TERMINAL"
,_termSel = Nothing
,_termOptions = []
,_termInput = Nothing
}
where
totermline s = TerminalLineDisplay 0 (const (s,white))