Improve debris

src/Dodge/Placement/Instance/Wall.hs

@@ -55,7 +55,7 @@ midWall ps = ps0j (PutShape . colorSH col $ upperPrismPoly 50 ps)
 singleBlock :: Point2 -> [Placement]
 singleBlock a = 
     [sPS a 0 
-        $ PutBlock StoneBlock 5 [20,20] baseBlockPane
+        $ PutBlock StoneBlock 100 baseBlockPane
         $ reverse 
         $ square 10
     ]

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    bm  hp  hps wl  ps' 
-                            -> placeBlock (map doShift ps') hp wl hps bm w
+    PutBlock    bm  hp wl  ps' 
+                            -> placeBlock (map doShift ps') hp wl bm w
     PutLineBlock wl bm wdth dpth a b -> placeLineBlock wl bm 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

@@ -21,20 +21,16 @@ addBlock
     :: [Point2]     -- ^ Block polygon
     -> Wall         -- ^ Base Pane
     -> Int          -- ^ First layer of health
-    -> [Int]        -- ^ Extra layers of health
     -> BlockMaterial
     -> World 
     -> World
-addBlock (p:ps) wl hp hps bm w 
-    | hp <= 0 && null hps = w
-    | hp <= 0 = addBlock (p:ps) wl (head hps + hp) (tail hps) bm w
-    | otherwise = w
-        & wallsZone . znObjects %~ flip (IM.foldl' $ flip wallInZone) panes
-        & walls  %~ IM.union panes
-        & blocks %~ IM.insert blid Block 
-            {_blID = blid,_blWallIDs = IS.fromList is, _blHPs = hp:hps, _blShadows=[], _blMaterial = bm
-                , _blFootprint = p:ps, _blPos = centroid (p:ps), _blDraw = const mempty
-                , _blDeath = makeBlockDebris}
+addBlock (p:ps) wl hp bm w = w
+    & wallsZone . znObjects %~ flip (IM.foldl' $ flip wallInZone) panes
+    & walls  %~ IM.union panes
+    & blocks %~ IM.insert blid Block 
+        {_blID = blid,_blWallIDs = IS.fromList is, _blHP = hp, _blShadows=[], _blMaterial = bm
+            , _blFootprint = p:ps, _blPos = centroid (p:ps), _blDraw = const mempty
+            , _blDeath = makeBlockDebris}
   where 
     blid = IM.newKey $ _blocks w
     lns = zip (p:ps) (ps ++ [p])
@@ -55,14 +51,14 @@ addBlock (p:ps) wl hp hps bm w
         (x,y) = zoneOfPoint $ uncurry pHalf (_wlLine wl)
         wlid  = _wlID wl
         ips = map zoneOfPoint $ uncurry (divideLine (2*zoneSize)) (_wlLine wl)
-addBlock _ _ _ _ _ _ = error "Trying to add a block with incomplete polygon"
+addBlock _ _ _ _ _ = error "Trying to add a block with incomplete polygon"
         
-placeBlock :: [Point2] -> Int -> Wall -> [Int] -> BlockMaterial -> World -> (Int,World)
-placeBlock poly i wl is bm w 
+placeBlock :: [Point2] -> Int -> Wall -> BlockMaterial -> World -> (Int,World)
+placeBlock poly hp wl bm w 
     = (0, foldr (uncurry removePathsCrossing) wWithBlock pairs)
   where 
     pairs = loopPairs poly
-    wWithBlock = addBlock poly wl i is bm w
+    wWithBlock = addBlock poly wl hp bm w
 
 {- | Splits a line into many four cornered blocks. -}
 placeLineBlock 
@@ -90,7 +86,7 @@ placeLineBlock basePane bm blockWidth depth a b gw = ( 0
     blid = IM.newKey $ _blocks gw
     insertBlock (i,p) = over blocks $ IM.insert (i+blid) Block 
         { _blID = i + blid, _blWallIDs = IS.fromList $ ksAtI i
-        , _blHPs = [5,5], _blShadows = shadowsAt i, _blMaterial = bm
+        , _blHP = 1000, _blShadows = shadowsAt i, _blMaterial = bm
         , _blFootprint = cornersAt p -- TODO check winding (clockwise, anticlockwise)
         , _blPos = p, _blDraw = const mempty , _blDeath = makeBlockDebris}
     insertBlocks = flip (foldr insertBlock) $ zip is blockCenPs