Unshadow window blocks when neighbour destroyed

src/Dodge/Base.hs

@@ -29,6 +29,12 @@ import Data.Maybe
 takeUntil :: Foldable t => (a -> Bool) -> t a -> [a]
 takeUntil p = foldr (\x xs -> x : if p x then [] else xs) []
 
+
+safeHead :: [a] -> Maybe a
+safeHead (x:_) = Just x
+safeHead _ = Nothing
+
+
 you :: World -> Creature
 you w = _creatures w IM.! _yourID w
 

src/Dodge/Item/Weapon/Booster.hs

@@ -110,10 +110,6 @@ drawBoostShockwave pj = (,) mempty $ setLayer 1 $ onLayer UPtLayer $ pictures $
     f (p,v) x = p  +.+ x *.* vNormal v
     g (p,v) x = p  -.- x *.* vNormal v
 
-safeHead :: [a] -> Maybe a
-safeHead (x:_) = Just x
-safeHead _ = Nothing
-
 maxT :: Int
 maxT = 20
 

src/Dodge/LevelGen/LineBlock.hs

@@ -39,7 +39,7 @@ putLineBlock basePane blockWidth depth a b w
     linesAt p = makeLoopPairs $ cornersAt p
     k = IM.newKey $ _walls w
     blid = IM.newKey $ _blocks w
-    insertBlock' i = over blocks $ IM.insert (i+blid) Block' {_blID = i + blid, _blWallIDs = ksAtI i, _blHPs = [5,5], _blShadows' = []}
+    insertBlock' i = over blocks $ IM.insert (i+blid) Block' {_blID = i + blid, _blWallIDs = ksAtI i, _blHPs = [5,5], _blShadows' = shadowsAt i}
     insertBlocks' = flip (foldr insertBlock') is
     ksAtI i = map ( + (k + i*4) ) [0,1,2,3]
     visibilityAt i 

src/Dodge/Room.hs

@@ -53,8 +53,7 @@ roomC x y = defaultRoom
     { _rmPolys = [rectNSWE y 0 0 x]
     , _rmLinks = lnks
     , _rmPath  = pth
-    --, _rmPS    = [windowLine (V2 (x/2) 0) (V2 (x/2) (y-60))
-    , _rmPS    = [windowLine (V2 (x/2) 10) (V2 (x/2) (20))
+    , _rmPS    = [windowLine (V2 (x/2) 0) (V2 (x/2) (y-60))
                  ]
     , _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)]
     }

src/Dodge/Update.hs

@@ -16,6 +16,7 @@ import Dodge.Update.Camera
 import Dodge.SoundLogic
 import Dodge.Inventory
 import Geometry
+import Geometry.ConvexPoly
 import Geometry.Vector3D
 
 import SDL (MouseButton (..))
@@ -80,22 +81,40 @@ functionalUpdate w = case _menuLayers w of
       where 
         (x,y) = cloudZoneOfPoint $ stripZ $ _clPos cl
 
+splinterBlock :: Block' -> World -> World
+splinterBlock bl w = foldr unshadowBlock w (_blShadows' bl) -- foldr shiftTowardCen w (_blWallIDs bl)
+    & blocks . ix (_blID bl) . blHPs %~ tail
+  where
+    wls = map (_walls w IM.!) (_blWallIDs bl)
+    ps = map (fst . _wlLine) wls
+    cen = centroid ps
+    shiftTowardCen wlid = walls . ix wlid . wlLine %~ bimap f f
+    f x = 0.5 *.* (x +.+ cen)
+
+unshadowBlock :: Int -> World -> World
+unshadowBlock wlid w = case w ^? walls . ix wlid of
+    Just wl -> w
+        & walls . ix wlid . blVisible .~ True
+        & wallsZone . znObjects . ix x . ix y . ix wlid . blVisible .~ True
+      where
+        (x,y) = zoneOfPoint $ uncurry pHalf (_wlLine wl)
+    Nothing -> w
+
 updateBlocks :: World -> World
 updateBlocks w = foldr f w $ _blocks w
   where
-    f bl w' 
-        | head (_blHPs bl) < 1 = w'
+    f bl w' = case safeHead $ _blHPs bl of
+        Just x  | x < 1     -> splinterBlock bl w'
+                | otherwise -> w'
+        Nothing -> w'
             & walls  %~ removeIDs (_blWallIDs bl)
             & flip (foldr removeFromZone) (_blWallIDs bl)
             & blocks %~ IM.delete (_blID bl)
-        | otherwise = w'
     removeIDs is wls = foldr IM.delete wls is
     removeFromZone wlid w' = over (wallsZone . znObjects . ix x . ix y) (IM.delete (_wlID wl)) w'
-    --removeFromZone wlid w' = set (wallsZone . znObjects) IM.empty w'
-    --removeFromZone wlid w' = over (wallsZone . znObjects . ix x . ix y . ix (_wlID wl)) setCol w'
       where
         (x,y) = zoneOfPoint $ uncurry pHalf (_wlLine wl)
-        wl = _walls w IM.! wlid
+        wl = _walls w IM.! wlid -- note the use of w not w'
         setCol = wlColor .~ V4 1 1 0 1
 
 -- | Note the explict use of record syntax. Using lens creates a space leak.