Commit mid block refactor

src/Dodge/Placement/PlaceSpot/Block.hs

@@ -20,15 +20,14 @@ import qualified Data.IntSet as IS
 addBlock 
     :: [Point2]     -- ^ Block polygon
     -> Wall         -- ^ Base Pane
-    -> Int          -- ^ First layer of health
-    -> BlockMaterial
+    -> Block
     -> World 
     -> World
-addBlock (p:ps) wl hp bm w = w
+addBlock (p:ps) wl bl 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
+    & blocks %~ IM.insert blid bl 
+        {_blID = blid,_blWallIDs = IS.fromList is, _blShadows=[]
             , _blFootprint = p:ps, _blPos = centroid (p:ps), _blDraw = const mempty
             , _blDeath = makeBlockDebris}
   where 
@@ -51,26 +50,25 @@ addBlock (p:ps) wl hp bm w = 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 -> BlockMaterial -> World -> (Int,World)
-placeBlock poly hp wl bm w 
+placeBlock :: [Point2] -> Block -> Wall -> World -> (Int,World)
+placeBlock poly bl wl w 
     = (0, foldr (uncurry removePathsCrossing) wWithBlock pairs)
   where 
     pairs = loopPairs poly
-    wWithBlock = addBlock poly wl hp bm w
+    wWithBlock = addBlock poly wl bl w
 
 {- | Splits a line into many four cornered blocks. -}
 placeLineBlock 
     :: Wall     -- ^ Base pane
-    -> BlockMaterial
     -> Float    -- ^ Block width
     -> Float    -- ^ Block depth
     -> Point2   -- ^ Start point (symmetric)
     -> Point2   -- ^ End point (symmetric)
     -> World 
     -> (Int, World)
-placeLineBlock basePane bm blockWidth depth a b gw = ( 0 
+placeLineBlock basePane blockWidth depth a b gw = ( 0 
     , removePathsCrossing a b (foldr insertWall (insertBlocks gw) listWalls)
     )
   where 
@@ -86,7 +84,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
-        , _blHP = 1000, _blShadows = shadowsAt i, _blMaterial = bm
+        , _blHP = 1000, _blShadows = shadowsAt i
         , _blFootprint = cornersAt p -- TODO check winding (clockwise, anticlockwise)
         , _blPos = p, _blDraw = const mempty , _blDeath = makeBlockDebris}
     insertBlocks = flip (foldr insertBlock) $ zip is blockCenPs