130 lines
4.3 KiB
Haskell
130 lines
4.3 KiB
Haskell
--{-# LANGUAGE TupleSections #-}
|
|
module Dodge.Placement.Instance.Terminal
|
|
( putTerminal
|
|
, putTerminal'
|
|
, simpleTermMessage
|
|
, genTermMessage
|
|
, topFlushStrings
|
|
) 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'
|
|
:: Color
|
|
-> (Int -> Machine -> World -> World) -- | machine update, takes button id as input
|
|
-> Placement
|
|
putTerminal' col mcf = ps0PushPS (PutButton termButton)
|
|
$ \pl -> Just $ pt0 (PutMachine col (reverse $ square 10) defaultMachine
|
|
{ _mcDraw = noPic . terminalShape col
|
|
, _mcHP = 100
|
|
, _mcUpdate = mcf (fromJust $ _plMID pl)
|
|
, _mcSensor = SensorCloseToggle NotClose False
|
|
})
|
|
$ const Nothing
|
|
|
|
putTerminal :: (GenParams -> World -> TerminalParams) -> Placement
|
|
putTerminal f = ps0PushPSw PutNothing $ \w _ -> Just $
|
|
--plGenUpdate ?~ g $ ps0PushPS (PutButton $ termButton & btTerminalParams .~ f (_genParams w))
|
|
ps0PushPS (PutButton $ termButton & btTerminalParams .~ f (_genParams w))
|
|
$ \pl -> Just $ pt0 (PutMachine terminalColor (reverse $ square 10) defaultMachine
|
|
{ _mcDraw = noPic . terminalShape terminalColor
|
|
, _mcHP = 100
|
|
, _mcUpdate = machineAddSound fridgeHumS
|
|
$ machineUpdateDeathEff $ \mc -> (buttons . at (fromJust (_plMID pl)) .~ Nothing)
|
|
. makeExplosionAt (_mcPos mc)
|
|
})
|
|
$ const Nothing
|
|
termButton :: Button
|
|
termButton = Button
|
|
{ _btPict = const mempty
|
|
, _btPos = 0
|
|
, _btRot = 0
|
|
, _btEvent = displayTerminalMessage . _btID
|
|
, _btID = 0
|
|
, _btText = "TERMINAL"
|
|
, _btState = BtOff
|
|
, _btTerminalParams = const $ TerminalParams [] [] 10 "TERMINAL" Nothing Nothing [] []
|
|
, _btName = ""
|
|
}
|
|
|
|
|
|
terminalColor :: Color
|
|
terminalColor = dark magenta
|
|
|
|
terminalShape :: Color -> Machine -> Shape
|
|
--terminalShape _ = upperPrismPoly 15 $ square 10
|
|
terminalShape col _ = colorSH col (prismPoly
|
|
[V3 10 10 20, V3 (-10) 10 20, V3 (-10) (-10) 10, V3 10 (-10) 10]
|
|
[V3 10 10 0, V3 (-10) 10 0, V3 (-10) (-10) 0, V3 10 (-10) 0]
|
|
)
|
|
<> colorSH black (prismPoly
|
|
[V3 8 8 20, V3 (-8) 8 20, V3 0 (-8) 10]
|
|
[V3 8 8 19, V3 (-8) 8 19, V3 0 (-8) 9]
|
|
--[V3 8 8 20, V3 (-8) 8 20, V3 (-8) (-8) 10, V3 8 (-8) 10]
|
|
--[V3 8 8 19, V3 (-8) 8 19, V3 (-8) (-8) 9, V3 8 (-8) 9]
|
|
)
|
|
|
|
displayTerminalMessage :: Int -> World -> World
|
|
displayTerminalMessage btid w = w & hud . hudElement .~ DisplayInventory DisplayTerminal
|
|
{ _termID = btid
|
|
, _termParams = fromMaybe NoTerminalParams $ (w ^? buttons . ix btid . btTerminalParams) <&> ($ w)
|
|
}
|
|
|
|
simpleTermMessage :: [String] -> (GenParams -> World -> TerminalParams)
|
|
simpleTermMessage = genTermMessage . const
|
|
--simpleTermMessage ss = const $ TerminalParams
|
|
-- {_termDisplayedLines = []
|
|
-- ,_termFutureLines = TerminalLineEffect 0 termsound
|
|
-- : map totermline (topFlushStrings ss ++ ss)
|
|
-- ,_termMaxLines = 7
|
|
-- ,_termTitle = "TERMINAL"
|
|
-- ,_termSel = Nothing
|
|
-- ,_termMaxSel = Nothing
|
|
-- }
|
|
-- where
|
|
-- 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
|
|
|
|
topFlushStrings :: [String] -> [String]
|
|
topFlushStrings = topFlush . maximum . map length
|
|
|
|
topFlush :: Int -> [String]
|
|
topFlush twidth = [replicate i ' ' ++ "*" | i <- [0, max 1 $ twidth `div` 5 .. twidth]]
|
|
|
|
genTermMessage :: (GenParams -> [String]) -> (GenParams -> World -> TerminalParams)
|
|
genTermMessage f = \gp _ -> TerminalParams
|
|
{_termDisplayedLines = []
|
|
,_termFutureLines = termSoundLine computerBeepingS
|
|
: map totermline (topFlushStrings (f gp) ++ f gp)
|
|
,_termMaxLines = 7
|
|
,_termTitle = "TERMINAL"
|
|
,_termSel = Nothing
|
|
-- ,_termOptions = []
|
|
,_termInput = Nothing
|
|
,_termScrollCommands = []
|
|
,_termWriteCommands = []
|
|
}
|
|
where
|
|
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
|