66 lines
2.0 KiB
Haskell
66 lines
2.0 KiB
Haskell
module Dodge.Placement.Instance.Terminal (
|
|
putMessageTerminal,
|
|
putTerminal,
|
|
terminalColor,
|
|
) where
|
|
|
|
import Color
|
|
import Data.Maybe
|
|
import Dodge.Data.GenWorld
|
|
import Dodge.Default
|
|
import Dodge.LevelGen.PlacementHelper
|
|
import Dodge.SoundLogic
|
|
import Geometry
|
|
import LensHelp
|
|
|
|
putTerminal :: Color -> Machine -> Terminal -> Placement
|
|
putTerminal col mc tm =
|
|
ps0PushPS (PutTerminal (tm & tmExternalColor .~ col)) $
|
|
\tmpl -> Just $
|
|
ps0PushPS (PutButton termButton) $
|
|
\btpl -> Just $
|
|
pt0
|
|
( PutMachine
|
|
(reverse $ square 10)
|
|
( mc & mcMounts . at ObButton ?~ fromJust (_plMID btpl)
|
|
& mcCloseSound ?~ fridgeHumS
|
|
)
|
|
defaultSensorWall
|
|
)
|
|
$ \mcpl -> Just $ sps0 $ PutWorldUpdate $ const (setids tmpl btpl mcpl)
|
|
where
|
|
setids tmpl btpl mcpl w =
|
|
w
|
|
& cWorld . lWorld . terminals . ix tmid . tmButtonID .~ btid
|
|
& cWorld . lWorld . terminals . ix tmid . tmMachineID .~ mcid
|
|
& cWorld . lWorld . machines . ix mcid . mcMounts . at ObTerminal ?~ tmid
|
|
& cWorld . lWorld . buttons . ix btid . btTermMID ?~ tmid
|
|
where
|
|
tmid = fromJust (_plMID tmpl)
|
|
btid = fromJust (_plMID btpl)
|
|
mcid = fromJust (_plMID mcpl)
|
|
|
|
putMessageTerminal :: Color -> Terminal -> Placement
|
|
putMessageTerminal col =
|
|
putTerminal col $
|
|
defaultMachine
|
|
& mcColor .~ col
|
|
& mcType .~ McTerminal
|
|
& mcHP .~ 100
|
|
|
|
termButton :: Button
|
|
termButton =
|
|
Button
|
|
{ _btPos = 0
|
|
, _btRot = 0
|
|
, _btEvent = ButtonAccessTerminal
|
|
, _btID = 0
|
|
, _btState = BtOff
|
|
, _btTermMID = Nothing
|
|
, _btName = ""
|
|
, _btColor = dark magenta
|
|
}
|
|
|
|
terminalColor :: Color
|
|
terminalColor = dark magenta
|