Simplify tank decorations

src/Dodge/Placement/Instance/Block.hs

@@ -1,12 +1,15 @@
-module Dodge.Placement.Instance.Block where
+module Dodge.Placement.Instance.Block (
+    decoratedBlock,
+    lowBlock,
+) where
 
-import Shape
 import Color
 import Dodge.Data.GenWorld
 import Dodge.Default.Block
 import Dodge.Default.Wall
 import Geometry
 import LensHelp
+import Shape
 
 decoratedBlock :: Shape -> Material -> Color -> Float -> [Point2] -> PSType
 decoratedBlock decf mat col h ps = PutBlock bl wl $ reverse ps

src/Dodge/Placement/Instance/Tank.hs

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

src/Dodge/Placement/TopDecoration.hs

@@ -1,4 +1,12 @@
-module Dodge.Placement.TopDecoration where
+{-# LANGUAGE LambdaCase #-}
+
+module Dodge.Placement.TopDecoration (
+    decorationToShape,
+    fourEmbossDecoration,
+    midBarDecoration,
+    squareDecoration,
+    plusDecoration,
+) where
 
 import Color
 import Dodge.Data.GenParams
@@ -6,15 +14,15 @@ import Dodge.Room.Foreground
 import Geometry
 import Shape
 
-decorationToShape :: DecorationShape -> Float -> Float -> Float -> Color -> Color -> Shape
-decorationToShape dec = case dec of
+decorationToShape :: DecorationShape -> Float -> Float -> Float -> Color -> Shape
+decorationToShape = \case
     PLUS -> plusDecoration
     SQUARE -> squareDecoration
     CIRCLE -> circleDecoration
     THREELINES -> threeLineDecoration
 
-midBarDecoration :: Float -> Float -> Float -> Color -> Color -> Shape
-midBarDecoration w h z _ c =
+midBarDecoration :: Float -> Float -> Float -> Color -> Shape
+midBarDecoration w h z c =
     embossingR
         <> rotateSH pi embossingR
         <> colorSH c (thinHighBar (z + 7) (V2 (-0.3 * w) 0) (V2 (0.3 * w) 0))
@@ -22,24 +30,26 @@ midBarDecoration w h z _ c =
     w' = 0.3 * w
     embossingR =
         colorSH c $
-            prismPoly Medium Typical
+            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 -> Color -> Shape
-fourEmbossDecoration w h z _ c = colorSH c $ foldMap f [(w, h), (- w, h), (w, - h), (- w, - h)]
+fourEmbossDecoration :: Float -> Float -> Float -> Color -> Shape
+fourEmbossDecoration w h z c = colorSH c $ 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 -> Color -> Shape
-plusDecoration w h z _ c =
+plusDecoration :: Float -> Float -> Float -> Color -> Shape
+plusDecoration w h z c =
     colorSH c $
         thinHighBar z (V2 w 0) (V2 (- w) 0)
             <> thinHighBar z (V2 0 h) (V2 0 (- h))
 
-squareDecoration :: Float -> Float -> Float -> Color -> Color -> Shape
-squareDecoration w h z _ col =
+squareDecoration :: Float -> Float -> Float -> Color -> Shape
+squareDecoration w h z col =
     colorSH col $
         foldMap
             f
@@ -53,13 +63,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 -> Color -> Shape
-circleDecoration w _ z _ c = colorSH c $ foldMap toprail (take 8 [0, pi / 4 ..])
+circleDecoration :: Float -> Float -> Float -> Color -> Shape
+circleDecoration w _ z c = colorSH c $ 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 -> Color -> Shape
-threeLineDecoration w h z _ col =
+threeLineDecoration :: Float -> Float -> Float -> Color -> Shape
+threeLineDecoration w h z col =
     colorSH col $
         foldMap
             f