Improve line zoning

src/Dodge/Base/Zone.hs

@@ -5,6 +5,7 @@ module Dodge.Base.Zone
 import Dodge.Data
 import Dodge.Base.Window
 import Geometry
+import Geometry.Zone
 
 import Data.Maybe
 import Data.List
@@ -73,14 +74,16 @@ zoneOfLine (V2 aa ab) (V2 ba bb)
     f (x,y) = [(p,r) | p <-[x-1,x,x+1] , r<-[y-1,y,y+1]]
 
 zoneOfLineIntMap :: Point2 -> Point2 -> IM.IntMap IS.IntSet
-{-# INLINE zoneOfLineIntMap #-}
-zoneOfLineIntMap a b = expandLine $ digitalLine (x-1,y-1) (x'-1,y'-1)
-  where 
-    (x,y) = zoneOfPoint a
-    (x',y') = zoneOfPoint b
+--{-# INLINE zoneOfLineIntMap #-}
+zoneOfLineIntMap = ddaExt zoneSize
+--zoneOfLineIntMap a b = expandLine $ digitalLine (x-1,y-1) (x'-1,y'-1)
+--  where 
+--    (x,y) = zoneOfPoint a
+--    (x',y') = zoneOfPoint b
+
 
 expandLine :: [(Int,Int)] -> IM.IntMap IS.IntSet
-{-# INLINE expandLine #-}
+--{-# INLINE expandLine #-}
 expandLine xs = IM.map expandSet 
     $ IM.unionsWith IS.union [im, IM.mapKeysMonotonic (+1) im, IM.mapKeysMonotonic (+2) im]
   where 
@@ -172,10 +175,10 @@ lookLookups xs z = mapMaybe (flip (uncurry lookLookup) z) xs
 -- there is certainly a problem somewhere here: it may be in the zoning, or
 -- within this function
 wallsAlongLine :: Point2 -> Point2 -> World -> IM.IntMap Wall
-{-# INLINE wallsAlongLine #-}
-wallsAlongLine a b w = IM.foldrWithKey' g IM.empty kps
+--{-# INLINE wallsAlongLine #-}
+wallsAlongLine a b w = IM.foldlWithKey' g IM.empty kps
   where 
-    g x s = IM.union (IM.unions (IM.restrictKeys (f x $ _wallsZone w) s))
+    g m x s = IM.union (IM.unions (IM.restrictKeys (f x $ _wallsZone w) s)) m
     kps = zoneOfLineIntMap a b
     f i m = case IM.lookup i m of 
         Just val -> val