Work on more complicated terminals
This commit is contained in:
@@ -1,9 +1,13 @@
|
||||
module Dodge.Placement.Instance.Analyser where
|
||||
module Dodge.Placement.Instance.Analyser
|
||||
( analyser'
|
||||
, testYouHave
|
||||
, testYourHealth
|
||||
) where
|
||||
import Dodge.LevelGen.Data
|
||||
--import Dodge.PlacementSpot
|
||||
import Dodge.Data
|
||||
import Dodge.Base.You
|
||||
import Dodge.Default
|
||||
--import Dodge.Default
|
||||
--import Dodge.Tree
|
||||
--import Dodge.RoomLink
|
||||
--import Dodge.Room.Door
|
||||
@@ -14,7 +18,7 @@ import Dodge.Default
|
||||
--import Dodge.Room.Foreground
|
||||
--import Dodge.Room.RoadBlock
|
||||
import Dodge.Placement.Instance
|
||||
import Dodge.Placement.Shift
|
||||
--import Dodge.Placement.Shift
|
||||
import Dodge.SoundLogic
|
||||
--import Dodge.Default.Room
|
||||
--import Dodge.Item.Weapon.BulletGuns
|
||||
@@ -24,8 +28,8 @@ import Dodge.SoundLogic
|
||||
import Geometry
|
||||
--import Padding
|
||||
import Color
|
||||
import Shape
|
||||
import ShapePicture
|
||||
--import Shape
|
||||
--import ShapePicture
|
||||
import LensHelp
|
||||
--import Dodge.RandomHelp
|
||||
|
||||
@@ -67,6 +71,8 @@ analyser' starts sucs fails afters upf pslight psmc = extTrigLitPos pslight $ \t
|
||||
++ map simpleline afters
|
||||
, _termMaxLines = 7
|
||||
, _termTitle = "ANALYSER"
|
||||
, _termSel = Nothing
|
||||
, _termOptions = []
|
||||
}
|
||||
)
|
||||
(\mc -> upf mc . (triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc))
|
||||
@@ -79,41 +85,6 @@ analyser' starts sucs fails afters upf pslight psmc = extTrigLitPos pslight $ \t
|
||||
_ -> (fails,red)
|
||||
updatebuttonname = plType . putButton . btText .~ "ANALYSER"
|
||||
|
||||
analyser
|
||||
:: [String] -- | initial text
|
||||
-> String -- | succeed text
|
||||
-> String -- | fail text
|
||||
-> [String] -- | after text
|
||||
-> (Machine -> World -> World)
|
||||
-> PlacementSpot
|
||||
-> PlacementSpot
|
||||
-> Placement
|
||||
analyser starts sucs fails afters upf pslight psmc = extTrigLitPos pslight $ \tp ->
|
||||
Just $ psPtCont psmc
|
||||
(PutMachine aquamarine (reverse $ square 10) defaultMachine
|
||||
{ _mcDraw = const . noPic . colorSH aquamarine . upperPrismPoly 25 $ square 10
|
||||
, _mcUpdate = \mc -> (triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc))
|
||||
. upf mc
|
||||
, _mcSensor = SensorCloseToggle NotClose False
|
||||
}
|
||||
) $ \anmc -> Just
|
||||
$ plSpot .~ shiftRelativeToPS (V2 20 0) (_plSpot anmc)
|
||||
$ updatebuttontext $ putTerminal $ const $ TerminalParams
|
||||
{ _termDisplayedLines = []
|
||||
, _termFutureLines = map simpleline starts
|
||||
++ [testline' (fromJust $ _plMID anmc)]
|
||||
++ map simpleline afters
|
||||
, _termMaxLines = 7
|
||||
, _termTitle = "ANALYSER"
|
||||
}
|
||||
where
|
||||
simpleline str = TerminalLineDisplay {_tlPause = 0, _tlString = const (str,white)}
|
||||
testline' mcid = TerminalLineDisplay 0 (testline mcid)
|
||||
testline mcid w = case w ^? machines . ix mcid . mcSensor . sensToggle of
|
||||
Just True -> (sucs,green)
|
||||
_ -> (fails,red)
|
||||
updatebuttontext = plType . putButton . btText .~ "ANALYSER"
|
||||
|
||||
analyserTest :: (World -> Bool) -> Machine -> World -> World
|
||||
analyserTest t mc w = case
|
||||
(_sensCloseToggle sens
|
||||
|
||||
@@ -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))
|
||||
|
||||
Reference in New Issue
Block a user