From 4949d987898d414e3d4efdb8d543607787608d1d Mon Sep 17 00:00:00 2001
From: justin <justin.g.kruger@gmail.com>
Date: Sat, 11 Oct 2025 11:13:35 +0100
Subject: [PATCH] Clarify circle segment intersection

---
 src/Dodge/Base/Collide.hs         | 10 +++++-----
 src/Dodge/RadarSweep.hs           |  4 ++--
 src/Dodge/WorldEvent/ThingsHit.hs |  2 +-
 src/Geometry/Intersect.hs         | 33 +++++++++++++++++++------------
 4 files changed, 28 insertions(+), 21 deletions(-)

diff --git a/src/Dodge/Base/Collide.hs b/src/Dodge/Base/Collide.hs
index afc0905d5..38e2240ee 100644
--- a/src/Dodge/Base/Collide.hs
+++ b/src/Dodge/Base/Collide.hs
@@ -53,15 +53,16 @@ import Geometry
 
 collidePoint :: Point2 -> Point2 -> [Wall] -> (Point2, Maybe Wall)
 {-# INLINE collidePoint #-}
-collidePoint sp ep = foldl' findPoint (ep, Nothing)
+collidePoint sp ep = foldl' f (ep, Nothing)
   where
-    findPoint (p, mwl) wl = maybe (p, mwl) (,Just wl) . uncurry (intersectSegSeg sp p) . _wlLine $ wl
+    f (p, mwl) wl 
+        = maybe (p, mwl) (,Just wl) . uncurry (intersectSegSeg sp p) . _wlLine $ wl
 
 overlapSegCrs :: Point2 -> Point2 -> [Creature] -> [(Point2, Creature)]
 {-# INLINE overlapSegCrs #-}
 overlapSegCrs sp ep =
     mapMaybe
-        (\cr -> (,cr) <$> listToMaybe (intersectCircSeg (cr ^. crPos . _xy) (crRad $ cr ^. crType) sp ep))
+        (\cr -> (,cr) <$> fst (intersectCircSeg (cr ^. crPos . _xy) (crRad $ cr ^. crType) sp ep))
 
 doBounce :: Float -> Point2 -> Point2 -> (Point2, Maybe Wall) -> Maybe (Point2, Point2)
 {-# INLINE doBounce #-}
@@ -126,10 +127,9 @@ collide3 sp ep w =
 
 -- Just (hitpoint,normaltosurface)
 collide3Walls :: Point3 -> World -> (Point3, MPO) -> (Point3, MPO)
-collide3Walls sp w e@(ep, _) = foldl' f e wls
+collide3Walls sp w e@(ep, _) = foldl' f e $ wlsNearSeg (xyV3 sp) (xyV3 ep) w
   where
     f x wl = collide3Wall sp wl x
-    wls = wlsNearSeg (xyV3 sp) (xyV3 ep) w
 
 collide3Floors ::
     Point3 ->
diff --git a/src/Dodge/RadarSweep.hs b/src/Dodge/RadarSweep.hs
index 51dd0f8cf..31c99815f 100644
--- a/src/Dodge/RadarSweep.hs
+++ b/src/Dodge/RadarSweep.hs
@@ -100,5 +100,5 @@ wallBlips :: Point2 -> Float -> World -> ([Point2], S.Set (Point2, Point2))
 wallBlips p r = foldMap f . wlsNearCirc p r
   where
     f wl = case uncurry (intersectCircSeg p r) $ _wlLine wl of
-        [] -> mempty
-        xs -> (xs, S.singleton (wl ^. wlLine))
+        (Nothing,Nothing) -> mempty
+        (a,b) -> (maybeToList a <> maybeToList b, S.singleton (wl ^. wlLine))
diff --git a/src/Dodge/WorldEvent/ThingsHit.hs b/src/Dodge/WorldEvent/ThingsHit.hs
index b5c67b33f..ed8c0c3ad 100644
--- a/src/Dodge/WorldEvent/ThingsHit.hs
+++ b/src/Dodge/WorldEvent/ThingsHit.hs
@@ -91,7 +91,7 @@ pbsHit sp ep w
     | sp == ep = mempty
     | otherwise =
         sortOn (dist sp . fst)
-            . mapMaybe (\pb -> (,pb) <$> listToMaybe (intersectCircSeg (_pbPos pb) 8 sp ep))
+            . mapMaybe (\pb -> (,pb) <$> fst (intersectCircSeg (_pbPos pb) 8 sp ep))
             . IM.elems
             $ w ^. cWorld . lWorld . pulseBalls
 
diff --git a/src/Geometry/Intersect.hs b/src/Geometry/Intersect.hs
index 8b13cd257..f775178d8 100644
--- a/src/Geometry/Intersect.hs
+++ b/src/Geometry/Intersect.hs
@@ -7,7 +7,6 @@ module Geometry.Intersect where
 import Control.Applicative
 import Control.Lens
 import Control.Monad
-import Data.List
 import Data.Maybe
 import Geometry.Data
 import Geometry.LHS
@@ -348,18 +347,26 @@ inSegArea a b c = param >= 0 && param <= dotV (b -.- a) (b -.- a)
   where
     param = dotV (b -.- a) (c -.- a)
 
--- I suspect that this may not be correct...
--- it should probably use closestPointOnSeg
-intersectCircSeg :: Point2 -> Float -> Point2 -> Point2 -> [Point2]
-intersectCircSeg c r a b
-    | y < 0 = []
-    | otherwise = nub $ filter (inSegArea a b) [d -.- v, d +.+ v]
+intersectCircSeg :: Point2 -> Float -> Point2 -> Point2 -> (Maybe Point2,Maybe Point2)
+intersectCircSeg c r s e = intersectCircLineAlong c r s e
+    & g
+    & each %~ f
   where
-    d = closestPointOnLine a b c
-    x = dist d c
-    y = r ^ (2 :: Int) - x ^ (2 :: Int)
-    z = sqrt y
-    v = z *.* normalizeV (b -.- a)
+    f (Just x) | x >= 0 && x < 1 = Just $ s + x *^ (e - s)
+    f _ = Nothing
+    g Nothing = (Nothing,Nothing)
+    g (Just (x,y)) = (Just x,Just y)
+        
+--intersectCircSeg :: Point2 -> Float -> Point2 -> Point2 -> [Point2]
+--intersectCircSeg c r a b
+--    | y < 0 = []
+--    | otherwise = nub $ filter (inSegArea a b) [d -.- v, d +.+ v]
+--  where
+--    d = closestPointOnLine a b c
+--    x = dist d c
+--    y = r ^ (2 :: Int) - x ^ (2 :: Int)
+--    z = sqrt y
+--    v = z *.* normalizeV (b -.- a)
 
 intersectCircLineAlong :: Point2 -> Float -> Point2 -> Point2 -> Maybe (Float, Float)
 intersectCircLineAlong p r x y = do
@@ -415,4 +422,4 @@ intersectCircSegTest c r x y =
     z = r *.* vNormal (normalizeV x - y)
 
 intersectCircSegFirst :: Point2 -> Float -> Point2 -> Point2 -> Maybe Point2
-intersectCircSegFirst c r a = listToMaybe . intersectCircSeg c r a
+intersectCircSegFirst c r a = fst . intersectCircSeg c r a