Commit mid block refactor

src/Dodge/Placement/Instance/Wall.hs

@@ -1,6 +1,8 @@
 module Dodge.Placement.Instance.Wall
     where
 import Dodge.Data
+import Dodge.Default.Block
+import Dodge.Block.Debris
 import Dodge.LevelGen.Data
 import Dodge.Default.Wall
 --import Dodge.Wall.DamageEffect
@@ -56,7 +58,7 @@ midWall ps = ps0j (PutShape . colorSH col $ upperPrismPoly 50 ps)
 singleBlock :: Point2 -> [Placement]
 singleBlock a = 
     [sPS a 0 
-        $ PutBlock StoneBlock 100 baseBlockPane
+        $ PutBlock defaultBlock baseBlockPane
         $ reverse 
         $ square 10
     ]
@@ -65,20 +67,20 @@ Places a line of blocks between two points.
 Width 9, also extends out from each point by 9.
  -}
 blockLine :: Point2 -> Point2 -> Placement
-blockLine a b = sps0 $ PutLineBlock baseBlockPane StoneBlock 9 9 a b
+blockLine a b = sps0 $ PutLineBlock baseBlockPane 9 9 a b
 
 {-
 Places an breakable window between two points.
 Width 8, also extends out from each point by 8.
  -}
 windowLine :: Point2 -> Point2 -> Placement
-windowLine a b = sps0 $ PutLineBlock defaultWindow GlassBlock 8 8 a b
+windowLine a b = sps0 $ PutLineBlock defaultWindow 8 8 a b
 {-
 Places an unbreakable window between two points.
 Width 7, also extends out from each point by 7.
  -}
 crystalLine :: Point2 -> Point2 -> Placement
-crystalLine a b = sps0 $ PutLineBlock defaultCrystalWall CrystalBlock 7 7 a b
+crystalLine a b = sps0 $ PutLineBlock defaultCrystalWall 7 7 a b
 --crystalLine a b = sps0 $ PutWall ps defaultCrystalWall
 --  where
 --    ps = 
@@ -104,7 +106,7 @@ wallLine a b = sps0 $ PutWall ps defaultWall
     up   = vNormal left
 
 windowLineType :: Point2 -> Point2 -> PSType
-windowLineType = PutLineBlock defaultWindow GlassBlock 8 8
+windowLineType = PutLineBlock defaultWindow 8 8
 
 baseBlockPane :: Wall
 baseBlockPane = defaultWall
@@ -151,7 +153,7 @@ putBlockRect' w h = ps0jPushPS (aline tl tr)
     tr = V2 w h
     br = V2 w (-h)
     bl = V2 (-w) (-h)
-    aline = PutLineBlock baseBlockPane StoneBlock 9 9
+    aline = PutLineBlock baseBlockPane 9 9
 
 putBlockRect :: Float -> Float -> Float -> Float -> [Placement]
 putBlockRect a x b y =

src/Dodge/Placement/PlaceSpot.hs

@@ -103,9 +103,9 @@ 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 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
+    PutBlock    bl wl  ps' 
+                            -> placeBlock (map doShift ps') bl 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
     PutNothing              -> (0,w)

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