63 lines
1.7 KiB
Haskell
63 lines
1.7 KiB
Haskell
--{-# LANGUAGE TupleSections #-}
|
|
module Dodge.Placement.Instance.Terminal
|
|
( putMessageTerminal
|
|
, putTerminal
|
|
-- , simpleTermMessage
|
|
, terminalColor
|
|
-- , accessTerminal
|
|
) where
|
|
import Dodge.Data
|
|
import Dodge.LevelGen.Data
|
|
import Dodge.Default
|
|
import Dodge.SoundLogic
|
|
import Color
|
|
import Geometry
|
|
import LensHelp
|
|
|
|
import Data.Maybe
|
|
|
|
putTerminal :: Machine -> Terminal -> Placement
|
|
putTerminal mc tm
|
|
= ps0PushPS (PutTerminal tm)
|
|
$ \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
|
|
& terminals . ix tmid . tmButtonID .~ btid
|
|
& terminals . ix tmid . tmMachineID .~ mcid
|
|
& machines . ix mcid . mcMounts . at ObTerminal ?~ tmid
|
|
& 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 $ defaultMachine
|
|
& mcColor .~ col
|
|
& mcDraw .~ MachineDrawTerminal --terminalSPic
|
|
& mcHP .~ 100
|
|
|
|
termButton :: Button
|
|
termButton = Button
|
|
{ _btPict = DrawNoButton
|
|
, _btPos = 0
|
|
, _btRot = 0
|
|
, _btEvent = ButtonAccessTerminal
|
|
, _btID = 0
|
|
, _btText = "TERMINAL"
|
|
, _btState = BtOff
|
|
, _btTermMID = Nothing
|
|
, _btName = ""
|
|
, _btColor = dark magenta
|
|
}
|
|
|
|
terminalColor :: Color
|
|
terminalColor = dark magenta
|