87 lines
2.5 KiB
Haskell
87 lines
2.5 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.Machine
|
|
import Dodge.SoundLogic
|
|
import Dodge.Terminal
|
|
import Color
|
|
import Geometry
|
|
import ShapePicture
|
|
import LensHelp
|
|
import Shape
|
|
--import ShapePicture
|
|
--import Sound.Data
|
|
|
|
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
|
|
|
|
|
|
accessTerminal :: Maybe Int -> World -> World
|
|
accessTerminal mtmid w = case mtmid of
|
|
Nothing -> w
|
|
Just tmid -> w & hud . hudElement .~ DisplayInventory (DisplayTerminal tmid)
|
|
& terminals . ix tmid . tmInput . tiFocus .~ True
|
|
& terminals . ix tmid %~ tryToBoot
|
|
where
|
|
tryToBoot tm = case _tmStatus tm of
|
|
TerminalReady -> tm
|
|
TerminalBusy -> tm
|
|
TerminalOff -> tm
|
|
& tmFutureLines .~ _tmBootProgram tm tm w
|
|
& tmStatus .~ TerminalBusy
|
|
|
|
simpleTermMessage :: [String] -> Terminal
|
|
simpleTermMessage strs = defaultTerminal & tmFutureLines .~ map makeTermLine strs
|