53 lines
1.6 KiB
Haskell
53 lines
1.6 KiB
Haskell
{-# LANGUAGE TupleSections #-}
|
|
module Dodge.Placement.Instance.Terminal
|
|
( putTerminal
|
|
) where
|
|
import Dodge.Data
|
|
import Dodge.LevelGen.Data
|
|
import Dodge.Default
|
|
import Dodge.Machine
|
|
import Dodge.SoundLogic
|
|
import Dodge.WorldEvent.Explosion
|
|
import Color
|
|
import Geometry
|
|
import ShapePicture
|
|
import LensHelp
|
|
import Shape
|
|
|
|
import Data.Maybe
|
|
|
|
putTerminal :: (GenParams -> TerminalParams) -> Placement
|
|
putTerminal f = PlacementGenUpdate g $ ps0PushPS (PutButton $ thebutton)
|
|
$ \pl -> Just $ pt0 (PutMachine terminalColor (reverse $ square 10) defaultMachine
|
|
{ _mcDraw = drawTerminal
|
|
, _mcHP = 100
|
|
, _mcUpdate = machineAddSound fridgeHumS
|
|
$ machineUpdateDeathEff $ \mc -> (buttons . at (fromJust (_plMID pl)) .~ Nothing)
|
|
. makeExplosionAt (_mcPos mc)
|
|
})
|
|
$ const Nothing
|
|
where
|
|
g gp pl = (gp, pl & plType . pstPutButton . btTerminalParams .~ f gp)
|
|
thebutton = Button
|
|
{ _btPict = const mempty
|
|
, _btPos = 0
|
|
, _btRot = 0
|
|
, _btEvent = displayTerminalMessage . _btID
|
|
, _btID = 0
|
|
, _btText = "TERMINAL"
|
|
, _btState = BtOff
|
|
, _btTerminalParams = TerminalParams [] [] 10
|
|
}
|
|
|
|
terminalColor :: Color
|
|
terminalColor = dark magenta
|
|
|
|
drawTerminal :: Machine -> SPic
|
|
drawTerminal _ = noPic $ colorSH terminalColor $ upperPrismPoly 15 $ square 10
|
|
|
|
displayTerminalMessage :: Int -> World -> World
|
|
displayTerminalMessage btid w = w & hud . hudElement .~ DisplayInventory DisplayTerminal
|
|
{ _termID = btid
|
|
, _termParams = fromMaybe NoTerminalParams $ w ^? buttons . ix btid . btTerminalParams
|
|
}
|