Make "tanks" into Blocks

src/Dodge/Placement/Instance/Tank.hs

@@ -4,6 +4,7 @@ module Dodge.Placement.Instance.Tank
     , roundTankCross
     ) where
 import Dodge.Data
+import Dodge.Default.Block
 --import Dodge.Placement.PlaceSpot
 import Dodge.LevelGen.Data
 import Dodge.Room.Foreground
@@ -11,7 +12,9 @@ import Dodge.Default.Wall
 --import Dodge.Placement.TopDecoration
 import Geometry
 import Shape
+import ShapePicture
 import Color
+import LensHelp
 --import Quaternion
 
 tankSquareDec :: (Float -> Float -> Float -> Color -> Color -> Shape) 
@@ -19,10 +22,23 @@ 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' = ps0jPushPS
-    (PutShape $ colorSH col (upperPrismPoly 31 baseshape) <> facade col col')
-    $ sps0 $ PutWall baseshape defaultWall 
-        {_wlDraw = False, _wlColor = col, _wlRotateTo = False, _wlOpacity = SeeAbove}
+tankShape baseshape facade col col' 
+    = sps0 $ PutBlock bl wl $ reverse baseshape
+  where
+    bl = defaultBlock
+        & blDraw .~ (\bl' -> (noPic $ uncurryV translateSHf (_blPos bl') $ rotateSH (_blRot bl') $ colorSH col (upperPrismPoly 31 $ reverse baseshape) <> facade col col'))
+        & blDeath .~ const id
+    wl = defaultWall 
+        & wlDraw .~ False 
+        & wlColor .~ col 
+        & wlRotateTo .~ False  
+        & wlOpacity .~ SeeAbove
+        & wlMaterial .~ Metal
+
+--    = ps0jPushPS
+--    (PutShape $ colorSH col (upperPrismPoly 31 baseshape) <> facade col col')
+--    $ sps0 $ PutWall baseshape defaultWall 
+--        {_wlDraw = False, _wlColor = col, _wlRotateTo = False, _wlOpacity = SeeAbove}
 
 roundTank :: Color -> Color -> Placement
 roundTank = tankShape (polyCirc 4 20) 

src/Dodge/Placement/Instance/Wall.hs

@@ -2,7 +2,7 @@ module Dodge.Placement.Instance.Wall
     where
 import Dodge.Data
 import Dodge.Default.Block
-import Dodge.Block.Debris
+--import Dodge.Block.Debris
 import Dodge.LevelGen.Data
 import Dodge.Default.Wall
 --import Dodge.Wall.DamageEffect

src/Dodge/Placement/PlaceSpot.hs

@@ -103,8 +103,8 @@ placeSpotID ps pt w = case pt of
     PutCoord    cp          -> plNewID   coordinates (doShift cp) w
     PutSlideDr  pth col f off  a   b spd 
                             -> plSlideDoor pth col f off (doShift a) (doShift b) spd w
-    PutBlock    bl wl  ps' 
-                            -> placeBlock (map doShift ps') bl wl w
+    PutBlock    bl wl  ps'  -> placeBlock (map doShift ps') (bl & blPos %~ doShift & blRot .~ rot)
+                                    wl w
     PutLineBlock wl wdth dpth a b -> placeLineBlock wl wdth dpth (doShift a) (doShift b) w
     PutWall     qs  wl      -> (0,placeWallPoly (map doShift qs) wl w)
     PutShape    sh          -> placeShape sh p rot w

src/Dodge/Placement/PlaceSpot/Block.hs

@@ -28,8 +28,8 @@ addBlock (p:ps) wl bl w = w
     & walls  %~ IM.union panes
     & blocks %~ IM.insert blid bl 
         {_blID = blid,_blWallIDs = IS.fromList is, _blShadows=[]
-            , _blFootprint = p:ps, _blPos = centroid (p:ps), _blDraw = const mempty
-            , _blDeath = makeBlockDebris}
+            , _blFootprint = p:ps
+            }
   where 
     blid = IM.newKey $ _blocks w
     lns = zip (p:ps) (ps ++ [p])
@@ -85,6 +85,7 @@ placeLineBlock basePane blockWidth depth a b gw = ( 0
     insertBlock (i,p) = over blocks $ IM.insert (i+blid) Block 
         { _blID = i + blid, _blWallIDs = IS.fromList $ ksAtI i
         , _blHP = 1000, _blShadows = shadowsAt i
+        , _blRot = 0    -- THIS IS NOT SENSIBLE. TODO rethink block positioning
         , _blFootprint = cornersAt p -- TODO check winding (clockwise, anticlockwise)
         , _blPos = p, _blDraw = const mempty , _blDeath = makeBlockDebris}
     insertBlocks = flip (foldr insertBlock) $ zip is blockCenPs