Simplify facade shape coloring

src/Dodge/Machine/Draw.hs

@@ -84,7 +84,7 @@ drawTurret lw tu mc = fold $ do
     return $ overPosSP (turretItemOffset itm tu mc) (itemSPic itm)
 
 sensorSPic :: (PaletteColor, DecorationShape) -> SPic
-sensorSPic (pc, ds) = noPic $ decorationToShape ds w w 25 col
+sensorSPic (pc, ds) = noPic $ colorSH col $ decorationToShape ds w w 25
   where
     col = paletteToColor pc
     w = 10

src/Dodge/Placement/Instance/Tank.hs

@@ -13,25 +13,24 @@ import Geometry
 import Shape
 
 tankSquareDec ::
-    (Float -> Float -> Float -> Color -> Shape) ->
+    (Float -> Float -> Float -> Shape) ->
     Color ->
     Color ->
     Placement
 --tankSquareDec dec = tankShape (reverse . orderPolygon $ square 20) (dec 20 20 31)
 tankSquareDec dec = tankShape (orderPolygon $ square 20) (dec 20 20 31)
 
-tankShape :: [Point2] -> (Color -> Shape) -> Color -> Color -> Placement
+tankShape :: [Point2] -> Shape -> Color -> Color -> Placement
-tankShape baseshape facade col col' = sps0 $ decoratedBlock (facade col') Metal col 31 baseshape
+tankShape baseshape facade col col' = sps0 $ decoratedBlock (colorSH col' facade) Metal col 31 baseshape
 
 roundTank :: Color -> Color -> Placement
-roundTank = tankShape (polyCirc 4 20) $
+roundTank c c' = tankShape (polyCirc 4 20)
-    \c' -> colorSH c' $ foldMap toprail (take 8 [0, pi / 4 ..])
+    (colorSH c' $ foldMap toprail (take 8 [0, pi / 4 ..])) c c'
   where
     toprail a = rotateSH a $ thinHighBar 31 (V2 0 20) (rotateV (pi / 4) $ V2 0 20)
 
 roundTankCross :: Color -> Color -> Placement
-roundTankCross = tankShape (polyCirc 4 20) $
+roundTankCross c' c = tankShape (polyCirc 4 20)
-    \c ->
+        (colorSH c $
-        colorSH c $
             thinHighBar 31 (V2 20 0) (V2 (-20) 0)
-                <> thinHighBar 31 (V2 0 20) (V2 0 (-20))
+                <> thinHighBar 31 (V2 0 20) (V2 0 (-20))) c' c

src/Dodge/Placement/TopDecoration.hs

@@ -8,49 +8,45 @@ module Dodge.Placement.TopDecoration (
     plusDecoration,
 ) where
 
-import Color
 import Dodge.Data.GenParams
 import Dodge.Room.Foreground
 import Geometry
 import Shape
 
-decorationToShape :: DecorationShape -> Float -> Float -> Float -> Color -> Shape
+decorationToShape :: DecorationShape -> Float -> Float -> Float -> Shape
 decorationToShape = \case
     PLUS -> plusDecoration
     SQUARE -> squareDecoration
     CIRCLE -> circleDecoration
     THREELINES -> threeLineDecoration
 
-midBarDecoration :: Float -> Float -> Float -> Color -> Shape
+midBarDecoration :: Float -> Float -> Float -> Shape
-midBarDecoration w h z c =
+midBarDecoration w h z =
     embossingR
         <> rotateSH pi embossingR
-        <> colorSH c (thinHighBar (z + 7) (V2 (-0.3 * w) 0) (V2 (0.3 * w) 0))
+        <> thinHighBar (z + 7) (V2 (-0.3 * w) 0) (V2 (0.3 * w) 0)
   where
     w' = 0.3 * w
     embossingR =
-        colorSH c $
             prismPoly
                 Medium
                 Typical
                 [V3 w h z, V3 w (0.3 * h) 41, V3 w (-0.3 * h) 41, V3 w (- h) z]
                 [V3 w' h z, V3 w' (0.3 * h) 41, V3 w' (-0.3 * h) 41, V3 w' (- h) z]
 
-fourEmbossDecoration :: Float -> Float -> Float -> Color -> Shape
+fourEmbossDecoration :: Float -> Float -> Float -> Shape
-fourEmbossDecoration w h z c = colorSH c $ foldMap f [(w, h), (- w, h), (w, - h), (- w, - h)]
+fourEmbossDecoration w h z = foldMap f [(w, h), (- w, h), (w, - h), (- w, - h)]
   where
     f (a, b) = translateSH (V3 (a / 2) (b / 2) z) embossing
     embossing = upperBoxHalf Large Typical 10 $ rectNSWE (h / 2) (- h / 2) (- w / 2) (w / 2)
 
-plusDecoration :: Float -> Float -> Float -> Color -> Shape
+plusDecoration :: Float -> Float -> Float -> Shape
-plusDecoration w h z c =
+plusDecoration w h z =
-    colorSH c $
         thinHighBar z (V2 w 0) (V2 (- w) 0)
             <> thinHighBar z (V2 0 h) (V2 0 (- h))
 
-squareDecoration :: Float -> Float -> Float -> Color -> Shape
+squareDecoration :: Float -> Float -> Float -> Shape
-squareDecoration w h z col =
+squareDecoration w h z =
-    colorSH col $
         foldMap
             f
             [ (w', - w', h', h')
@@ -63,14 +59,13 @@ squareDecoration w h z col =
     h' = h - 1.5
     f (a, c, b, d) = thinHighBar z (V2 a b) (V2 c d)
 
-circleDecoration :: Float -> Float -> Float -> Color -> Shape
+circleDecoration :: Float -> Float -> Float -> Shape
-circleDecoration w _ z c = colorSH c $ foldMap toprail (take 8 [0, pi / 4 ..])
+circleDecoration w _ z = foldMap toprail (take 8 [0, pi / 4 ..])
   where
     toprail a = rotateSH a $ thinHighBar z (V2 0 w) (rotateV (pi / 4) $ V2 0 w)
 
-threeLineDecoration :: Float -> Float -> Float -> Color -> Shape
+threeLineDecoration :: Float -> Float -> Float -> Shape
-threeLineDecoration w h z col =
+threeLineDecoration w h z =
-    colorSH col $
         foldMap
             f
             [ (w', - w', h', h')