Commit before changing block type

src/Dodge/Data.hs

@@ -57,6 +57,7 @@ data World = World
     , _particles            :: ![Particle]
     , _walls                :: !(IM.IntMap Wall)
     , _doors                :: IM.IntMap Door
+    , _blocks               :: IM.IntMap Block'
     , _wallsZone            :: Zone (IM.IntMap Wall)
     , _forceFields          :: IM.IntMap ForceField
     , _floorItems           :: IM.IntMap FloorItem
@@ -535,6 +536,12 @@ data Prop
         , _pjTimer :: Int
         }
 data Either3 a b c = E3x1 a | E3x2 b | E3x3 c
+data Block' = Block'
+    { _blID      :: Int
+    , _blWallIDs :: [Int]
+    , _blHPs     :: [Int]
+    , _blShadows' :: [Int]
+    }
 data Door = Door
     { _drID :: Int
     , _drWallIDs :: [Int]
@@ -765,6 +772,7 @@ makeLenses ''CrGroupParams
 makeLenses ''CrMvType 
 makeLenses ''Intention
 makeLenses ''Door
+makeLenses ''Block'
 makeLenses ''Zone
 numColor :: Int -> Color
 numColor 0  = toV4 (1,0,0,1) 

src/Dodge/Default/World.hs

@@ -35,6 +35,7 @@ defaultWorld = World
     , _props = IM.empty
     , _particles = []
     , _walls = IM.empty
+    , _blocks = IM.empty
     , _doors = IM.empty
     , _wallsZone = Zone IM.empty
     , _forceFields = IM.empty

src/Dodge/LevelGen/Block.hs

@@ -100,13 +100,15 @@ addBlock
     -> [Int]        -- ^ Extra layers of health
     -> World 
     -> World
-addBlock (p:ps) hp col isSeeThrough degradability w 
-    | hp <= 0 && null degradability = w
-    | hp <= 0 = addBlock (p:ps) (head degradability + hp) col isSeeThrough (tail degradability) w
+addBlock (p:ps) hp col isSeeThrough hps w 
+    | hp <= 0 && null hps = w
+    | hp <= 0 = addBlock (p:ps) (head hps + hp) col isSeeThrough (tail hps) w
     | otherwise = w  
         & wallsZone . znObjects %~ flip (IM.foldl' $ flip wallInZone) panes
-        & walls     %~ IM.union panes
+        & walls  %~ IM.union panes
+        & blocks %~ IM.insert blid (Block' {_blID = blid,_blWallIDs = is, _blHPs = hp:hps, _blShadows'=[]})
   where 
+    blid = IM.newKey $ _blocks w
     lns = zip (p:ps) (ps ++ [p])
     i = IM.newKey $ _walls w
     is = [i.. i + length lns-1]
@@ -121,7 +123,7 @@ addBlock (p:ps) hp col isSeeThrough degradability w
             , _wlIsSeeThrough = isSeeThrough
             , _blVisible = True
             , _blShadows = []
-            , _blDegrades = degradability
+            , _blDegrades = hps
             , _wlDraw = True
             , _wlRotateTo = True
             }