Reorganise wall placements

src/Dodge/Placement/Instance/LightSource.hs

@@ -1,6 +1,6 @@
 module Dodge.Placement.Instance.LightSource where
 import Dodge.Data
-import Dodge.LightSources.Lamp
+import Dodge.LightSource
 import Dodge.LevelGen.Data
 import Dodge.Room.Foreground
 import Geometry

src/Dodge/Placement/Instance/Tank.hs

@@ -0,0 +1,97 @@
+module Dodge.Placement.Instance.Tank where
+import Dodge.Data
+import Dodge.Placement.PlaceSpot
+import Dodge.LevelGen.Data
+import Dodge.Room.Foreground
+import Dodge.Default.Wall
+import Geometry
+import Shape
+import Color
+--import Quaternion
+
+roundTank :: Color -> Float -> Float -> Placement
+roundTank col x y = shiftPlacement (V2 x y,0) $ ps0j 
+    (PutForeground $ colorSH col $ 
+        upperPrismPoly 31 thecircle
+        <> foldMap toprail ( take 8 [0,pi/4..]) 
+    )
+    $ sps0 $ PutWall thecircle defaultWall {_wlDraw = False, _wlColor = col, _wlRotateTo = False}
+  where
+    toprail a = rotateSH a $ thinHighBar 31 (V2 0 20) (rotateV (pi/4) $ V2 0 20)
+    thecircle = polyCirc 4 20
+
+roundTankCross :: Color -> Float -> Float -> Placement
+roundTankCross col x y = shiftPlacement (V2 x y,0) $ ps0j 
+    (PutForeground $ colorSH col $ 
+        upperPrismPoly 31 thecircle
+        <> thinHighBar 31 (V2 20 0) (V2 (-20) 0)
+        <> thinHighBar 31 (V2 0 20) (V2 0 (-20))
+    )
+    $ sps0 $ PutWall thecircle defaultWall {_wlDraw = False, _wlColor = col, _wlRotateTo = False}
+  where
+    thecircle = polyCirc 4 20
+
+tankRectCross :: Float -> Float -> Color -> Float -> Float -> Placement
+tankRectCross w h col x y = shiftPlacement (V2 x y,0) $ ps0j
+    (PutForeground $ colorSH col $
+        upperPrismPoly 31 therect
+        <> thinHighBar 31 (V2 w 0) (V2 (-w) 0)
+        <> thinHighBar 31 (V2 0 h) (V2 0 (-h))
+    )
+    $ sps0 $ PutWall therect defaultWall {_wlDraw = False, _wlColor = col, _wlRotateTo = False}
+  where
+    therect = rectWH w h
+
+tankSquareCross :: Color -> Float -> Float -> Placement
+tankSquareCross = tankRectCross 20 20
+
+
+tankRect :: Float -> Float -> Color -> Float -> Float -> Placement
+tankRect w h col x y = shiftPlacement (V2 x y,0) $ ps0j
+    (PutForeground $ colorSH col
+        $ upperPrismPoly 31 therect
+        <> foldMap f [(w',-w',h',h'),(w',-w',-h',-h'),(w',w',h',-h'),(-w',-w',h',-h')]
+    )
+    $ sps0 $ PutWall therect defaultWall {_wlDraw = False, _wlColor = col, _wlRotateTo = False}
+  where
+    therect = rectWH w h
+    w' = w - 1.5
+    h' = h - 1.5
+    f (a,b,c,d) = thinHighBar 31 (V2 a b) (V2 c d)
+
+tankSquare :: Color -> Float -> Float -> Placement
+tankSquare = tankRect 20 20
+
+tankRectEmboss :: Float -> Float -> Color -> Float -> Float -> Placement
+tankRectEmboss w h col x y = shiftPlacement (V2 x y,0) $ ps0j
+    (PutForeground $ colorSH col $
+        upperPrismPoly 31 therect
+        <> embossingR
+        <> rotateSH pi embossingR
+        <> thinHighBar 38 (V2 (-0.3*w) 0) (V2 (0.3*w) 0)
+    )
+    $ sps0 $ PutWall therect defaultWall {_wlDraw = False, _wlColor = col, _wlRotateTo = False}
+  where
+    w' = 0.3 * w
+    therect = rectWH w h
+    embossingR = prismPoly 
+        [V3 w h 31,V3 w (0.3*h) 41,V3 w (-0.3*h) 41,V3 w (-h) 31]
+        [V3 w' h 31,V3 w' (0.3*h) 41,V3 w' (-0.3*h) 41,V3 w' (-h) 31]
+
+tankSquareEmboss :: Color -> Float -> Float -> Placement
+tankSquareEmboss = tankRectEmboss 20 20
+
+tankRectEmboss4 :: Float -> Float -> Color -> Float -> Float -> Placement
+tankRectEmboss4 w h col x y = shiftPlacement (V2 x y,0) $ ps0j
+    (PutForeground $ colorSH col $
+        upperPrismPoly 31 therect
+        <> foldMap f [(w,h),(-w,h),(w,-h),(-w,-h)]
+    )
+    $ sps0 $ PutWall therect defaultWall {_wlDraw = False, _wlColor = col, _wlRotateTo = False}
+  where
+    therect = rectWH w h
+    f (a,b) = translateSH (V3 (a/2) (b/2) 31) embossing
+    embossing = upperPrismPolyHalf 10 $ rectNSEW (h/2) (-h/2) (w/2) (-w/2)
+
+tankSquareEmboss4 :: Color -> Float -> Float -> Placement
+tankSquareEmboss4 = tankRectEmboss4 20 20

src/Dodge/Placement/Instance/Wall.hs

@@ -1,13 +1,25 @@
 module Dodge.Placement.Instance.Wall
     where
 import Dodge.Data
-import Color
-import Geometry
 import Dodge.LevelGen.Data
 import Dodge.Default.Wall
+import Geometry
+import Shape
+import Color
 
 import Data.List
 import Control.Lens
+lowWall :: [Point2] -> Placement
+lowWall ps = ps0j (PutForeground . colorSH col $ upperPrismPoly 30 ps)
+    $ sps0 $ PutWall ps theWall
+  where
+    col = _wlColor defaultWall
+    theWall = defaultWall
+        { _wlOpacity = SeeAbove
+        , _wlDraw = False
+        }
+
+
 singleBlock :: Point2 -> [Placement]
 singleBlock a = 
     [sPS a 0