Files
loop/src/Dodge/Machine/Draw.hs
T
2025-12-26 16:53:10 +00:00

104 lines
3.0 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.Room.Foreground
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
McTrigger{} -> 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{} -> green
McTrigger{} -> 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