76 lines
2.1 KiB
Haskell
76 lines
2.1 KiB
Haskell
module Dodge.Machine.Draw (
|
|
drawMachine,
|
|
) where
|
|
|
|
import Dodge.Terminal.Color
|
|
import Control.Lens
|
|
import Data.Maybe
|
|
import Dodge.Data.LWorld
|
|
import Dodge.Item.Draw.SPic
|
|
import Dodge.Item.HeldOffset
|
|
import Dodge.Placement.TopDecoration
|
|
import Geometry
|
|
import Picture
|
|
import Shape
|
|
import ShapePicture
|
|
|
|
drawMachine :: LWorld -> Machine -> SPic
|
|
drawMachine lw mc = case _mcType mc of
|
|
McStatic -> mempty
|
|
McTerminal -> terminalSPic lw mc
|
|
McTurret tu -> drawBaseMachine 20 mc <> drawTurret tu mc
|
|
McSensor se -> drawBaseMachine 25 mc <> drawSensor se mc
|
|
|
|
drawSensor :: Sensor -> Machine -> SPic
|
|
drawSensor sens = case sens of
|
|
DamageSensor{_sensDraw = pcds} -> sensorSPic pcds
|
|
ProximitySensor{} -> const mempty
|
|
|
|
terminalSPic :: LWorld -> Machine -> SPic
|
|
terminalSPic lw = noPic . terminalShape lw
|
|
|
|
terminalShape :: LWorld -> Machine -> Shape
|
|
terminalShape lw mc = fromMaybe mempty $ do
|
|
tid <- mc ^? mcMounts . ix ObTerminal
|
|
term <- lw ^? terminals . ix tid
|
|
return $
|
|
colorSH
|
|
(_tmExternalColor term)
|
|
( prismBox
|
|
Medium
|
|
Typical
|
|
[V3 10 10 20, V3 (-10) 10 20, V3 (-10) (-10) 10, V3 10 (-10) 10]
|
|
(addZ 0 `map` rectWH 10 10)
|
|
)
|
|
<> screenbackground (getcol term)
|
|
where
|
|
getcol term = fromMaybe black $ termScreenColor term
|
|
screenbackground col = colorSH
|
|
col
|
|
( prismBox
|
|
Small
|
|
Typical
|
|
[V3 8 8 20, V3 (-8) 8 20, V3 0 (-8) 10]
|
|
[V3 8 8 19, V3 (-8) 8 19, V3 0 (-8) 9]
|
|
)
|
|
|
|
drawBaseMachine :: Float -> Machine -> SPic
|
|
drawBaseMachine h mc =
|
|
noPic
|
|
. colorSH (_mcColor mc)
|
|
. upperBox Medium Typical h
|
|
. square
|
|
$ _mcWidth mc
|
|
|
|
drawTurret :: Turret -> Machine -> SPic
|
|
drawTurret tu mc = overPosSP (turretItemOffset itm tu mc) (itemSPic itm)
|
|
where
|
|
itm = _tuWeapon tu
|
|
|
|
sensorSPic :: (PaletteColor, DecorationShape) -> Machine -> SPic
|
|
sensorSPic (pc, ds) mc =
|
|
noPic $ decorationToShape ds w w 25 col col
|
|
where
|
|
col = paletteToColor pc
|
|
w = _mcWidth mc
|