Fix bugs in zones near segments

src/Dodge/Debug/Picture.hs

@@ -1,7 +1,7 @@
 {-# OPTIONS -Wno-incomplete-uni-patterns #-}
 module Dodge.Debug.Picture where
 
-import Linear (_xy)
+import Linear (_xy, (*^))
 import Control.Lens
 import Data.Foldable
 --import qualified Data.Graph.Inductive as FGL
@@ -147,11 +147,12 @@ drawWallsNearSegment w = concat $ do
 
 -- # OPTIONS -Wno-incomplete-uni-patterns #-}
 drawZoneCol :: Color -> Float -> V2 Int -> Picture
-drawZoneCol col s (V2 x y) = setLayer DebugLayer . color col $ thickLine 2 (p : ps ++ [p])
+drawZoneCol col = drawZone (\ps -> color col $ thickLine 2 (ps ++ [head ps]))
+
+drawZone :: ([Point2] -> Picture) -> Float -> V2 Int -> Picture
+drawZone f s (V2 x y) = setLayer DebugLayer $ f ps
   where
-    (p : ps) =
-        zipWith (+.+) (square 1) $
-            map ((s *.*) . (each %~ fromIntegral)) [V2 x y, V2 (x + 1) y, V2 (x + 1) (y + 1), V2 x (y + 1)]
+    ps = rectNSWE s 0 0 s <&> (+ s *^ (V2 x y & each %~ fromIntegral))
 
 --showEnabledDebugs :: Config -> Picture
 --{-# INLINE showEnabledDebugs #-}
@@ -310,11 +311,21 @@ drawZoneCirc w = concat $ do
 drawDDATest :: World -> Picture
 drawDDATest w =
     foldMap (drawZoneCol orange 50) ps
-        <> setLayer DebugLayer (color yellow (line [cvf, mwp]))
+        <> foldMap (drawZone f 50) qs
+        <> foldMap (drawZone g 50) rs
+        <> foldMap (drawCrossCol yellow) xs
+--        <> foldMap (drawCrossCol cyan) xs'
+        <> setLayer DebugLayer (color yellow (line [x, y]))
   where
-    cvf = w ^. wCam . camViewFrom
-    mwp = mouseWorldPos (w ^. input) (w ^. wCam)
-    ps = zoneOfSeg 50 cvf mwp
+    x = w ^. wCam . camViewFrom
+    y = mouseWorldPos (w ^. input) (w ^. wCam)
+    f [a,b,c,d] = color red $ thickLine 2 [a,c]
+    g [a,b,c,d] = color blue $ thickLine 2 [b,d]
+    ps = zoneOfSeg 50 x y
+    qs = map (zoneOfPoint 50) $ xIntercepts' 50 x y
+    rs = map (zoneOfPoint 50) $ yIntercepts' 50 x y
+    xs = xIntercepts' 50 x y
+--    xs' = xIntercepts' 50 x y
 
 drawWallSearchRays :: World -> Picture
 drawWallSearchRays w = foldMap (f . fst) $ allVisibleWalls w