102 lines
2.9 KiB
Haskell
102 lines
2.9 KiB
Haskell
module Dodge.Machine.Draw (drawMachine) where
|
|
|
|
import Dodge.Room.Foreground
|
|
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
|
|
McProxSensor {} -> drawBaseMachine 25 mc
|
|
McStorage {} -> noPic $ colorSH (mcColor mc) storageShape
|
|
McDistributer {} -> drawBaseMachine 25 mc
|
|
where
|
|
lw = cw ^. lWorld
|
|
gp = cw ^. cwGen . cwgParams . sensorCoding
|
|
|
|
storageShape :: Shape
|
|
storageShape = upperBox Large Typical 31 (polyCirc 4 20) <>
|
|
foldMap toprail (take 8 [0, pi / 4 ..])
|
|
where
|
|
toprail a = rotateSH a $ thinHighBar 31 (V2 0 20) (rotateV (pi / 4) $ V2 0 20)
|
|
|
|
drawDamSensor ::
|
|
M.Map SensorType (PaletteColor, DecorationShape) ->
|
|
DamageSensor ->
|
|
SPic
|
|
drawDamSensor gp sens = fold $ do
|
|
let st = sens ^. sensType
|
|
x <- gp ^? ix st
|
|
return $ sensorSPic x
|
|
|
|
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
|
|
(mcColor mc)
|
|
( 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
|
|
$ 10
|
|
|
|
mcColor :: Machine -> Color
|
|
mcColor mc = case mc ^. mcType of
|
|
McStatic -> blue
|
|
McTerminal -> dark magenta
|
|
McDamSensor {} -> yellow
|
|
McProxSensor {} -> aquamarine
|
|
McTurret {} -> blue
|
|
McStorage {} -> orange
|
|
McDistributer {} -> red
|
|
|
|
|
|
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) -> SPic
|
|
sensorSPic (pc, ds) = noPic $ colorSH col $ decorationToShape ds w w 25
|
|
where
|
|
col = paletteToColor pc
|
|
w = 10
|