justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Reify block drawing

Browse Source
This commit is contained in:
justin
2022-07-25 01:27:39 +01:00
parent 486c203fa2
commit c3a5b9d5be
15 changed files with 85 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Placement/Instance/Block.hs
+5 -3
View File
@@ -8,11 +8,13 @@ import Shape
import Dodge.Default.Wall
import Dodge.Default.Block
decoratedBlock :: (Block -> Shape) -> Material -> Color -> Float -> [Point2] -> PSType
--decoratedBlock :: (Block -> Shape) -> Material -> Color -> Float -> [Point2] -> PSType
decoratedBlock :: BlSh -> Material -> Color -> Float -> [Point2] -> PSType
decoratedBlock decf mat col h ps = PutBlock bl wl $ reverse ps
where
bl = defaultBlock
& blDraw .~ (\bl' -> noPic (colorSH col (upperPrismPoly h $ reverse ps) <> decf bl'))
& blDraw .~ BlockDraws [BlockDrawColHeightPoss col h (reverse ps),BlockDrawBlSh decf]
--(\bl' -> noPic (colorSH col (upperPrismPoly h $ reverse ps) <> decf bl'))
& blHeight .~ h
& blMaterial .~ mat
wl = defaultWall
@@ -23,4 +25,4 @@ decoratedBlock decf mat col h ps = PutBlock bl wl $ reverse ps
& wlHeight .~ h
lowBlock :: Material -> Color -> Float -> [Point2] -> PSType
lowBlock = decoratedBlock (const mempty)
lowBlock = decoratedBlock BlShMempty
src/Dodge/Placement/Instance/Tank.hs
+1 -1
View File
@@ -18,7 +18,7 @@ tankSquareDec :: (Float -> Float -> Float -> Color -> Color -> Shape)
tankSquareDec dec = tankShape (square 20) (dec 20 20 31)
tankShape :: [Point2] -> (Color -> Color -> Shape) -> Color -> Color -> Placement
tankShape baseshape facade col col' = sps0 $ decoratedBlock (const $ facade col col') Metal col 31 baseshape
tankShape baseshape facade col col' = sps0 $ decoratedBlock (BlShConst $ facade col col') Metal col 31 baseshape
-- = sps0 $ PutBlock bl wl $ reverse baseshape
-- where
-- bl = defaultBlock