91 lines
2.9 KiB
Haskell
91 lines
2.9 KiB
Haskell
--{-# LANGUAGE TupleSections #-}
|
|
module Dodge.Placement.Instance.Terminal
|
|
( putTerminal
|
|
, simpleTermMessage
|
|
, genTermMessage
|
|
) 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 Sound.Data
|
|
|
|
import Data.Maybe
|
|
|
|
putTerminal :: (GenParams -> TerminalParams) -> Placement
|
|
putTerminal f = plGenUpdate ?~ 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
|
|
& plGenUpdate .~ Nothing
|
|
)
|
|
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
|
|
}
|
|
|
|
simpleTermMessage :: [String] -> (GenParams -> TerminalParams)
|
|
simpleTermMessage ss = const $ TerminalParams
|
|
{_termDisplayedLines = []
|
|
,_termFutureLines = TerminalLineEffect 0 termsound
|
|
: map totermline (topflush ++ ss)
|
|
,_termMaxLines = 7
|
|
}
|
|
where
|
|
topflush = [replicate i ' ' ++ "*" | i <- [0,2 .. maximum (map length ss)]]
|
|
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
|
|
|
|
genTermMessage :: (GenParams -> [String]) -> (GenParams -> TerminalParams)
|
|
genTermMessage f = \gp -> TerminalParams
|
|
{_termDisplayedLines = []
|
|
,_termFutureLines = termSoundLine computerBeepingS
|
|
: map totermline (topflush (f gp) ++ f gp)
|
|
,_termMaxLines = 7
|
|
}
|
|
where
|
|
topflush ss = [replicate i ' ' ++ "*" | i <- [0,2 .. maximum (map length ss)]]
|
|
totermline s = TerminalLineDisplay 0 (const (s,white))
|
|
|
|
termSoundLine :: SoundID -> TerminalLine
|
|
termSoundLine sid = TerminalLineEffect 0 termsound
|
|
where
|
|
termsound subinv w = soundStart TerminalSound tpos sid Nothing w
|
|
where
|
|
tpos = fromMaybe 0 $ w ^? buttons . ix (_termID subinv) . btPos
|