Improve line zoning

src/Dodge/Base/Collide.hs

@@ -24,7 +24,7 @@ hitPointLines
 hitPointLines p1 p2
     = safeMinimumOn (dist p1 . fst)
     . mapMaybe
-    (\(x,y) -> (, (x,y)) <$> intersectSegSeg' p1 p2 x y)
+    (\(x,y) -> (, (x,y)) <$> intersectSegSeg p1 p2 x y)
 
 -- | looks for first collision of a point with walls
 -- if found, gives point and reflection velocity
@@ -36,7 +36,7 @@ reflectPointWalls p1 p2 ws
             fmap ( (, reflectIn (x -.- y) (p2 -.- p1)) 
                  . (+.+ errorNormalizeV 39 (vNormal (x -.- y)))
                  ) 
-                 (intersectSegSeg' p1 p2 x y)
+                 (intersectSegSeg p1 p2 x y)
          ) 
         . _wlLine) ws
 -- | Looks for first collision of a point with walls.
@@ -52,43 +52,43 @@ reflectPointWallsDamped dfact p1 p2 ws
     $ IM.mapMaybe 
         (( \(x,y) -> fmap ((, reflectInParam dfact (x -.- y) (p2 -.- p1)) 
                             . (+.+ errorNormalizeV 40 (vNormal (x -.- y)))) 
-                                (intersectSegSeg' p1 p2 x y)) 
+                                (intersectSegSeg p1 p2 x y)) 
          . _wlLine
         ) ws
 -- | Test if a point collides with walls
 pointHitsWalls :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
 pointHitsWalls p1 p2 
-    = any $ isJust . uncurry (intersectSegSeg' p1 p2) . _wlLine
+    = any $ isJust . uncurry (intersectSegSeg p1 p2) . _wlLine
 -- | Test if there something blocking a walk
 collidePointWalkable :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
 collidePointWalkable p1 p2 ws 
-    = any (isJust . uncurry (intersectSegSeg' p1 p2) . _wlLine) 
+    = any (isJust . uncurry (intersectSegSeg p1 p2) . _wlLine) 
     $ IM.filter (fromMaybe True . (^? doorPathable)) ws
 
 furthestPointWalkable :: Point2 -> Point2 -> IM.IntMap Wall -> Point2
 furthestPointWalkable p1 p2 ws 
     = fromMaybe p2
     . safeMinimumOn (dist p1) 
-    $ IM.mapMaybe ( uncurry (intersectSegSeg' p1 p2) . _wlLine) ws
+    $ IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine) ws
 
 collidePointIndirect :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
 {-# INLINE collidePointIndirect #-}
 collidePointIndirect p1 p2 ws 
     = safeMinimumOn (dist p1) 
-    . IM.mapMaybe ( uncurry (intersectSegSeg' p1 p2) . _wlLine) 
+    . IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine) 
     $ IM.filter (not . _wlIsSeeThrough) ws
 {- | Checks to see whether someone can fire bullets effectively between two points. 
  - Not sure if this needs vision as well, need to make this uniform. -}
 collidePointFire :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
 collidePointFire p1 p2 ws 
     = safeMinimumOn (dist p1) 
-    . IM.mapMaybe ( uncurry (intersectSegSeg' p1 p2) . _wlLine ) 
+    . IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine ) 
     $ IM.filter (\wl -> not (_wlIsSeeThrough wl && isJust (wl ^? blHP))) ws
 {- | Checks to see whether someone can fire bullets effectively between two points. 
  - Not sure if this needs vision as well, need to make this uniform. -}
 collidePointFireVision :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
 collidePointFireVision p1 p2 ws 
-    = any ( isJust . uncurry (intersectSegSeg' p1 p2) . _wlLine) 
+    = any ( isJust . uncurry (intersectSegSeg p1 p2) . _wlLine) 
     $ IM.filter notBlockWindow ws
   where 
     notBlockWindow wl = case wl ^? blHP of

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