Fix wall zoning bug

src/Dodge/Debug.hs

@@ -3,8 +3,10 @@ import Dodge.Data
 import Dodge.Picture
 import Dodge.Picture.Layer
 import Geometry.Data
+import Geometry
 import Picture
 import qualified IntMapHelp as IM
+import qualified Data.IntSet as IS
 
 import Control.Lens
 
@@ -49,3 +51,10 @@ pjTimerF :: Int -> Int -> World -> World
 pjTimerF 0    i = projectiles %~ IM.delete i
 pjTimerF time i = projectiles . ix i . pjUpdate .~ (\_ -> pjTimerF (time - 1) i)
 
+drawDDA :: IM.IntMap IS.IntSet -> Picture
+drawDDA = setLayer 1 . color (withAlpha 0.5 green) . IM.foldlWithKey' f []
+  where
+    f pic x' ys' = concatMap (\y -> polygon (rectNSEW (y+50) y (x+50) x)) ys ++ pic
+      where
+        x = 50 * fromIntegral x'
+        ys = map ((50 *) . fromIntegral) $ IS.toList ys'

src/Dodge/Layout.hs

@@ -95,7 +95,7 @@ updateWallZoning w = set wallsZone (foldl' (flip wallInZone) IM.empty (_walls w)
       where 
         (x,y) = zoneOfPoint $ uncurry pHalf (_wlLine wl)
         wlid  = _wlID wl
-        ips = map zoneOfPoint $ uncurry (divideLine (2*zoneSize)) (_wlLine wl)
+        ips = map zoneOfPoint $ uncurry (divideLine (zoneSize)) (_wlLine wl)
 
 
 makePath :: Tree Room -> [(Point2,Point2)]

src/Dodge/Render/Picture.hs

@@ -8,7 +8,9 @@ import Dodge.Picture
 import Dodge.Picture.Layer
 import Dodge.Render.HUD
 import Dodge.Render.MenuScreen
+import Dodge.Debug
 import Geometry
+import Geometry.Zone
 --import Geometry.Data
 import Picture
 import Polyhedra.Data
@@ -56,7 +58,16 @@ customMouseCursor w =
     $ pictures [ line [V2 (-5) 0,V2 5 0] , line [V2 0 (-5),V2 0 5] ]
 
 testPic :: World -> Picture
-testPic _ = blank
+testPic w = setLayer 1 $ zonesPic ++ wallsPic
+  where
+    wallsPic = setDepth 25 . color yellow . concatMap (drawTheWall . _wlLine) $ IM.elems theWalls
+    drawTheWall (a,b) = lineOfThickness 20 [a,b]
+    theWalls = wallsAlongLine sp ep w
+    zonesPic = setDepth 20 $ drawDDA zones
+    zones = ddaExt zoneSize sp ep
+    sp = _crPos $ you w
+    ep = mouseWorldPos w
+    
 --    [ setDepth (-1) . translate 0 0.8
 --        . scale 0.001 0.001 . text . show $ _crMvDir $ you w
 --    ]

src/Geometry/Zone.hs

@@ -9,15 +9,15 @@ import Data.Foldable
 import qualified Data.IntMap.Strict as IM
 import qualified Data.IntSet as IS
 
-foldl2'
-    :: (b -> a -> a -> b) 
-    -> b 
-    -> [a]
-    -> b
-foldl2' f s (t:ts) = fst $ foldl' g (s, t) ts
-  where
-    g (r,x) y = (f r x y,y)
-foldl2' _ s _ = s
+--foldl2'
+--    :: (b -> a -> a -> b) 
+--    -> b 
+--    -> [a]
+--    -> b
+--foldl2' f s (t:ts) = fst $ foldl' g (s, t) ts
+--  where
+--    g (r,x) y = (f r x y,y)
+--foldl2' _ s _ = s
 
 sortArguments 
     :: Ord a 
@@ -82,6 +82,35 @@ increasingInterval x y
 -- point.
 ddaExt :: Float -> V2 Float -> V2 Float -> IM.IntMap IS.IntSet
 ddaExt s sp@(V2 sx sy) ep@(V2 ex ey) 
+    | x1 <= x2 = addsp . addys . IM.fromDistinctAscList $ zip [x1 .. x2] 
+                    $ map (IS.singleton . divTo s) [x1y,x1y+ydx..]
+    | otherwise = addsp . addys . IM.fromDistinctAscList $ zip [x2-1 .. x1-1]
+                    $ map (IS.singleton . divTo s) [x2y,x2y+ydx..]
+  where
+    addsp im = let V2 x y = sizeZoneOfPoint' s sp
+            in insertXY im (x,y)
+    x1 = divTo s sx
+    x2 = divTo s ex
+    x1y = fx' sp ep $ s * (fromIntegral x1)
+    x2y = fx' sp ep $ s * (fromIntegral x2)
+    ydx = s * ydx' sp ep
+    addys m = add2s m ypairs 
+    y1 = divTo s sy
+    y2 = divTo s ey
+    y1x = fy' sp ep $ s * (fromIntegral y1)
+    y2x = fy' sp ep $ s * (fromIntegral y2)
+    xdy = s * xdy' sp ep
+    ypairs 
+        | y1 <= y2  = zip (map (divTo s) [y1x,y1x+xdy..])
+                         [y1 .. y2] 
+        | otherwise = zip (map (divTo s) [y2x,y2x+xdy..])
+                         [y2-1 .. y1-1] 
+-- | Determines which horizontal and vertical lines on a grid are crossed by a
+-- line. For each adds the x-y index of the square to the right or above the
+-- crossed grid line. Also adds the index of the square containing the start
+-- point.
+ddaExtExt :: Float -> V2 Float -> V2 Float -> IM.IntMap IS.IntSet
+ddaExtExt s sp@(V2 sx sy) ep@(V2 ex ey) 
     | x1 <= x2 = addys . IM.fromDistinctAscList $ zip [x1 .. x2] 
                     $ map (IS.singleton . divTo s) [x1y,x1y+ydx..]
     | otherwise = addys . IM.fromDistinctAscList $ zip [x2-1 .. x1-1]
@@ -137,6 +166,9 @@ add2s imis = foldl'
     (\m (k,x) -> IM.insertWith (\_ old -> IS.insert x old) k (IS.singleton x) m)
     imis
 
+insertXY :: IM.IntMap IS.IntSet -> (Int,Int) -> IM.IntMap IS.IntSet
+insertXY m (k,x) = IM.insertWith (\_ old -> IS.insert x old) k (IS.singleton x) m
+
 addV2s :: IM.IntMap IS.IntSet -> [V2 Int] -> IM.IntMap IS.IntSet
 {-# INLINE addV2s #-}
 addV2s imis = foldl'