86 lines
2.5 KiB
Haskell
86 lines
2.5 KiB
Haskell
module Dodge.Machine.Draw (drawMachine) where
|
|
|
|
import Control.Lens
|
|
import qualified Data.Map.Strict as M
|
|
import Data.Maybe
|
|
import Dodge.Data.CWorld
|
|
import Dodge.Item.Draw.SPic
|
|
import Dodge.Item.HeldOffset
|
|
import Dodge.Placement.TopDecoration
|
|
import Dodge.Terminal.Color
|
|
import Geometry
|
|
import Picture
|
|
import Shape
|
|
import ShapePicture
|
|
|
|
drawMachine :: CWorld -> Machine -> SPic
|
|
drawMachine cw mc = case _mcType mc of
|
|
McStatic -> mempty
|
|
McTerminal -> terminalSPic lw mc
|
|
McTurret tu -> drawBaseMachine 20 mc <> drawTurret lw tu mc
|
|
McDamSensor se -> drawBaseMachine 25 mc <> drawDamSensor gp se mc
|
|
McProxSensor se -> drawBaseMachine 25 mc <> drawProxSensor se mc
|
|
where
|
|
lw = cw ^. lWorld
|
|
gp = cw ^. cwGen . cwgParams . sensorCoding
|
|
|
|
drawDamSensor ::
|
|
M.Map SensorType (PaletteColor, DecorationShape) ->
|
|
DamageSensor ->
|
|
Machine ->
|
|
SPic
|
|
drawDamSensor gp sens mc = fold $ do
|
|
let st = sens ^. sensType
|
|
x <- gp ^? ix st
|
|
return $ sensorSPic x mc
|
|
|
|
drawProxSensor :: ProximitySensor -> Machine -> SPic
|
|
drawProxSensor _ = 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 OTTerminal
|
|
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 :: LWorld -> Turret -> Machine -> SPic
|
|
drawTurret lw tu mc = fold $ do
|
|
itm <- lw ^? items . ix (tu ^. tuWeapon)
|
|
return $ overPosSP (turretItemOffset itm tu mc) (itemSPic itm)
|
|
|
|
sensorSPic :: (PaletteColor, DecorationShape) -> Machine -> SPic
|
|
sensorSPic (pc, ds) mc = noPic $ decorationToShape ds w w 25 col col
|
|
where
|
|
col = paletteToColor pc
|
|
w = _mcWidth mc
|