Work on windows

src/Dodge/Wall/Damage.hs

@@ -33,18 +33,32 @@ damageWall wlid dt w = fromMaybe (mempty,w) $ do
         MachinePart mcid -> (,) mempty 
             $ w' & cWorld . lWorld . machines . ix mcid . mcDamage .:~ dt
         BlockPart blid ->
-            w' & cWorld . lWorld . blocks . ix blid . blHP -~ dmam
-                & maybeDestroyBlock blid
+            w' & damageBlock (wl ^. wlMaterial) dmam blid -- cWorld . lWorld . blocks . ix blid . blHP -~ dmam
+--                & maybeDestroyBlock blid
         DoorPart drid _ ->
             w' & cWorld . lWorld . doors . ix drid . drHP -~ dmam
                 & maybeDestroyDoor drid
         _ -> (mempty, w')
 
 -- block destruction is convoluted...
-maybeDestroyBlock :: Int -> World -> (S.Set Int2, World)
-maybeDestroyBlock blid w = case w ^? cWorld . lWorld . blocks . ix blid of
-    Just bl | _blHP bl < 1 -> destroyBlock bl w
-    _ -> (mempty, w)
+damageBlock :: Material -> Int -> Int -> World -> (S.Set Int2, World)
+damageBlock = \case
+    Glass -> damageGlassBlock
+    _ -> maybeDestroyBlock
+
+damageGlassBlock :: Int -> Int -> World -> (S.Set Int2, World)
+damageGlassBlock x i w = fromMaybe (mempty,w) $ do
+    bl <- w ^? cWorld . lWorld . blocks . ix i
+    return $ case bl ^. blHP - x of
+        y | y > 0 -> (mempty, w
+            & flip (foldl' unshadowBlock) (_blShadows bl)
+            & cWorld . lWorld . blocks . ix i . blHP .~ 1)
+        _ -> destroyBlock bl w
+
+maybeDestroyBlock :: Int ->  Int -> World -> (S.Set Int2, World)
+maybeDestroyBlock x blid w = case w ^? cWorld . lWorld . blocks . ix blid of
+    Just bl | _blHP bl < x -> destroyBlock bl w
+    _ -> (mempty, w & cWorld . lWorld . blocks . ix blid . blHP -~ x)
 
 maybeDestroyDoor :: Int -> World -> (S.Set Int2, World)
 maybeDestroyDoor drid w = case w ^? cWorld . lWorld . doors . ix drid of