Reify block drawing

src/Dodge/Placement/Instance/Block.hs

@@ -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

@@ -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

src/Dodge/Placement/PlaceSpot/Block.hs

@@ -74,7 +74,7 @@ plLineBlock basePane blwidth a b gw = ( 0
         , _blObstructs = []
         , _blMaterial = _wlMaterial basePane
         , _blHeight   = 100
-        , _blPos = p, _blDraw = const mempty }
+        , _blPos = p, _blDraw = BlockDrawMempty }
         )
     insertBlocks = flip (foldr insertBlock) $ zip is blockCenPs
     ksAtI i = map ( + (wlid + i*4) ) [0,1,2,3]