Make "tanks" into Blocks

src/Dodge/Block.hs

@@ -1,6 +1,6 @@
 module Dodge.Block where
 import Dodge.Data
-import Dodge.Block.Debris
+--import Dodge.Block.Debris
 import Dodge.SoundLogic
 import Dodge.Zone
 import Dodge.WorldEvent.Sound

src/Dodge/Config/Data.hs

@@ -13,7 +13,7 @@ data Configuration = Configuration
     , _volume_music         :: Float
     , _graphics_wall_textured        :: Bool
     , _graphics_cloud_shadows        :: Bool
-    , _graphics_object_shadows      :: Bool
+    , _graphics_object_shadows       :: Bool
     , _graphics_resolution_factor    :: ResFactor
     , _windowX              :: Float
     , _windowY              :: Float

src/Dodge/Data.hs

@@ -924,6 +924,7 @@ data Block = Block
     , _blShadows    :: [Int]   -- a list of blocks/walls? that are not shown when this block exists
     , _blFootprint  :: [Point2]
     , _blPos        :: Point2
+    , _blRot        :: Float
     , _blDraw       :: Block -> SPic
     , _blDeath      :: Block -> World -> World
     }

src/Dodge/Default/Block.hs

@@ -11,8 +11,9 @@ defaultBlock = Block
     , _blShadows = []
     , _blFootprint = []
     , _blPos       = 0
+    , _blRot       = 0
     , _blDraw      = const mempty
-    , _blDeath      = makeBlockDebris
+    , _blDeath     = makeBlockDebris
     }
-
+defaultDirtBlock :: Block
 defaultDirtBlock = defaultBlock & blHP .~ 50

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
+tankShape baseshape facade col col' 
-    (PutShape $ colorSH col (upperPrismPoly 31 baseshape) <> facade col col')
+    = sps0 $ PutBlock bl wl $ reverse baseshape
-    $ sps0 $ PutWall baseshape defaultWall 
+  where
-        {_wlDraw = False, _wlColor = col, _wlRotateTo = False, _wlOpacity = SeeAbove}
+    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' 
+    PutBlock    bl wl  ps'  -> placeBlock (map doShift ps') (bl & blPos %~ doShift & blRot .~ rot)
-                            -> placeBlock (map doShift ps') bl wl w
+                                    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
+            , _blFootprint = p:ps
-            , _blDeath = makeBlockDebris}
+            }
   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

src/Dodge/Room/Pillar.hs

@@ -33,7 +33,7 @@ blockPillar w' h' = ps0jPushPS (aline tl tr)
     aline = PutLineBlock baseBlockPane 9 9
 
 smallPillar :: PSType
-smallPillar = PutBlock defaultBlock 500 baseBlockPane $ reverse $ square 5
+smallPillar = PutBlock defaultBlock baseBlockPane $ reverse $ square 5
 
 crossPillar :: Float -> Float -> Placement
 crossPillar w' h' = ps0jPushPS (aline (V2 (-w) 0) (V2 w 0))
@@ -41,7 +41,7 @@ crossPillar w' h' = ps0jPushPS (aline (V2 (-w) 0) (V2 w 0))
   where
     w = w' - 9
     h = h' - 9
-    aline = PutLineBlock baseBlockPane StoneBlock 9 9
+    aline = PutLineBlock baseBlockPane 9 9
 
 roomPillarsSquare :: RandomGen g => State g Room
 roomPillarsSquare = do

src/Dodge/Wall/DamageEffect.hs

@@ -41,13 +41,13 @@ windowWallDamage dm wl = wallDamageEffect dm wl . case _dmType dm of
     PIERCING    -> dosplint . colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
     BLUNT       -> dosplint . wlDustAt wl outTo
     SHATTERING  -> dosplint . muchWlDustAt wl outTo
-    CRUSHING    -> dosplint . id
+    CRUSHING    -> dosplint
-    EXPLOSIVE   -> dosplint . id
+    EXPLOSIVE   -> dosplint
-    CUTTING     -> dosplint . id
+    CUTTING     -> dosplint
     SPARKING    -> id
     FLAMING     -> id
     ELECTRICAL  -> id
-    CONCUSSIVE  -> dosplint . id
+    CONCUSSIVE  -> dosplint
     TORQUEDAM   -> id
     PUSHDAM     -> id
     POISONDAM   -> id