Fix some shapes

This commit is contained in:
2023-03-25 17:56:20 +00:00
parent 3dd386e908
commit 7d96616b91
3 changed files with 18 additions and 13 deletions
+1 -1
View File
@@ -4,7 +4,7 @@ layout (triangle_strip, max_vertices = 3) out;
layout (std140, binding = 0) uniform TheMat { mat4 theMat; } ;
layout(location=0)uniform vec3 lightPos;
in float drawbit[];
// this code is duplicated in lineShadow.geom, should not be changed on its own
// the following code is duplicated in lineShadow.geom, should not be changed on its own
vec4 projNear (vec4 pos)
{
// note we project to a specific height
+4 -6
View File
@@ -1,13 +1,13 @@
module Dodge.Block.Draw
where
import Shape
module Dodge.Block.Draw (drawBlock) where
import Dodge.Data.Block
import Shape
import ShapePicture
drawBlock :: BlockDraw -> Block -> SPic
drawBlock bd = case bd of
BlockDrawMempty -> const mempty
BlockDraws bds -> \bl -> foldMap (`drawBlock` bl) bds
BlockDraws bds -> \bl -> foldMap (`drawBlock` bl) bds
BlockDrawColHeightPoss col h ps -> const $ noPic $ colorSH col (upperBox Medium Typical h ps)
BlockDrawBlSh x -> noPic . doBlSh x
@@ -15,5 +15,3 @@ doBlSh :: BlSh -> Block -> Shape
doBlSh bs = case bs of
BlShMempty -> const mempty
BlShConst sh -> const sh
+13 -6
View File
@@ -28,13 +28,17 @@ terminalShape :: Machine -> Shape
terminalShape mc =
colorSH
col
( prismBox Medium Typical
( prismBox
Medium
Typical
[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]
(addZ 0 `map` rectWH 10 10)
)
<> colorSH
black
( prismBox Small Superfluous
( prismBox
Small
Superfluous
[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]
@@ -45,9 +49,12 @@ terminalShape mc =
drawBaseMachine :: Float -> Machine -> SPic
drawBaseMachine h mc =
( colorSH (_mcColor mc) $ upperBox Medium Typical h (reverse $ square (_mcWidth mc))
, mempty
)
noPic
. colorSH (_mcColor mc)
. upperBox Medium Typical h
. square
$ _mcWidth mc
drawTurret :: Turret -> Machine -> SPic
drawTurret tu mc = overPosSP (turretItemOffset it tu mc) (itemSPic it)
where