furhter line segment intersection work

hgeometry/hgeometry.cabal

@@ -635,7 +635,7 @@ test-suite hgeometry-with-ipe-hspec
       Polygon.Convex.ConvexSpec
       Polygon.Convex.ConvexSpec
       VoronoiDiagram.VoronoiSpec
-      LineSegmentSpec_
+      LineSegmentSpec
       Polygon.Triangulation.TriangulateMonotoneSpec
       LineSegment.Intersection.BentleyOttmannSpec
 

hgeometry/kernel/src-quickcheck/HGeometry/Kernel/Instances.hs

@@ -21,6 +21,7 @@ import HGeometry.HalfSpace
 import HGeometry.HyperPlane (HyperPlane(..))
 import HGeometry.HyperPlane.NonVertical (NonVerticalHyperPlane(..))
 import HGeometry.Interval
+import HGeometry.Interval.EndPoint
 import HGeometry.Line.LineEQ
 import HGeometry.Line.PointAndVector
 import HGeometry.LineSegment
@@ -56,10 +57,12 @@ instance ( Arbitrary (endPoint r)
                  pure $ Interval p q
 
 instance ( Arbitrary (endPoint point)
-         , Eq (endPoint point)
+         , IsEndPoint (endPoint point) (endPoint point)
+         , IxValue (endPoint point) ~ point
+         , Eq point
          ) => Arbitrary (LineSegment endPoint point) where
   arbitrary = do p <- arbitrary
-                 q <- arbitrary `suchThat` (/= p)
+                 q <- arbitrary `suchThat` (\q' -> q'^._endPoint /= p^._endPoint)
                  pure $ LineSegment p q
 
 instance ( Arbitrary point

hgeometry/kernel/src/HGeometry/LineSegment/Class.hs

@@ -19,7 +19,7 @@ module HGeometry.LineSegment.Class
 
   , HasStart(..), HasEnd(..)
   , HasStartPoint(..), HasEndPoint(..)
-
+  , StartPointOf, EndPointOf
 
   , ordAtY, ordAtX
   , xCoordAt, yCoordAt

hgeometry/kernel/src/HGeometry/LineSegment/Intersection.hs

@@ -45,26 +45,55 @@ type instance Intersection (LineEQ r) (LineSegment AnEndPoint point) =
 -- * HasIntersectionWith
 
 instance ( Point_ point 2 r, Num r, Ord r
-         ) => LinePV 2 r `HasIntersectionWith` ClosedLineSegment point where
+         , IxValue (endPoint point) ~ point
+         , EndPoint_ (endPoint point)
+         ) => LinePV 2 r `HasIntersectionWith` LineSegment endPoint point where
   intersects = intersectsImpl
   {-# INLINE intersects #-}
 
 instance ( Point_ point 2 r, Num r, Ord r
-         ) => LineEQ r `HasIntersectionWith` ClosedLineSegment point where
+         , IxValue (endPoint point) ~ point
+         , EndPoint_ (endPoint point)
+         ) => LineEQ r `HasIntersectionWith` LineSegment endPoint point where
   --
   -- >>> LineEQ 1 2 `intersects` ClosedLineSegment origin (Point2 1 10)
   -- True
   intersects = intersectsImpl
   {-# INLINE intersects #-}
 
-instance ( Point_ point 2 r, Num r,  Ord r
-         ) => LineEQ r `HasIntersectionWith` LineSegment AnEndPoint point where
-  intersects = intersectsImpl
-  {-# INLINE intersects #-}
-instance ( Point_ point 2 r, Num r,  Ord r
-         ) => LinePV 2 r `HasIntersectionWith` LineSegment AnEndPoint point where
-  intersects = intersectsImpl
-  {-# INLINE intersects #-}
+
+-- instance ( Point_ point 2 r, Num r, Ord r
+--          ) => LinePV 2 r `HasIntersectionWith` ClosedLineSegment point where
+--   intersects = intersectsImpl
+--   {-# INLINE intersects #-}
+
+-- instance ( Point_ point 2 r, Num r, Ord r
+--          ) => LineEQ r `HasIntersectionWith` ClosedLineSegment point where
+--   --
+--   -- >>> LineEQ 1 2 `intersects` ClosedLineSegment origin (Point2 1 10)
+--   -- True
+--   intersects = intersectsImpl
+--   {-# INLINE intersects #-}
+
+-- instance ( Point_ point 2 r, Num r,  Ord r
+--          ) => LineEQ r `HasIntersectionWith` LineSegment AnEndPoint point where
+--   intersects = intersectsImpl
+--   {-# INLINE intersects #-}
+-- instance ( Point_ point 2 r, Num r,  Ord r
+--          ) => LinePV 2 r `HasIntersectionWith` LineSegment AnEndPoint point where
+--   intersects = intersectsImpl
+--   {-# INLINE intersects #-}
+
+-- instance ( Point_ point 2 r, Num r, Ord r
+--          ) => LinePV 2 r `HasIntersectionWith` OpenLineSegment point where
+--   intersects = intersectsImpl
+--   {-# INLINE intersects #-}
+
+-- instance ( Point_ point 2 r, Num r, Ord r
+--          ) => LineEQ r `HasIntersectionWith` OpenLineSegment point where
+--   intersects = intersectsImpl
+--   {-# INLINE intersects #-}
+
 
 
 -- | Test whether a line in R^2 intersects a closed linesegment
@@ -115,6 +144,19 @@ instance ( Point_ point 2 r
   intersect = intersectImpl
   {-# INLINE intersect #-}
 
+instance ( Point_ point 2 r
+         , Fractional r,  Ord r
+         ) => LinePV 2 r `IsIntersectableWith` OpenLineSegment point where
+  intersect = intersectImpl
+  {-# INLINE intersect #-}
+
+instance ( Point_ point 2 r
+         , Fractional r,  Ord r
+         ) => LineEQ r `IsIntersectableWith` OpenLineSegment point where
+  intersect = intersectImpl
+  {-# INLINE intersect #-}
+
+
 -- | Implementation for intersects between lines and line segments.
 --
 -- the type is is sufficiently general that for various line or closed line segment types
@@ -136,6 +178,7 @@ l `intersectImpl` s = l `intersect` supportingLine s >>= \case
     Line_x_Line_Line _  -> Just $ Line_x_LineSegment_LineSegment s
 {-# INLINE intersectImpl #-}
 
+
 --------------------------------------------------------------------------------
 -- * LineSegment x LineSegment
 
@@ -160,9 +203,49 @@ type instance Intersection (LineSegment AnEndPoint point)
 ----------------------------------------
 -- * HasIntersectionWith
 
+instance ( Point_ point 2 r, Num r,  Ord r
+         , IxValue (endPoint point) ~ point
+         , EndPoint_ (endPoint point)
+         ) =>
+         LineSegment endPoint point `HasIntersectionWith` LineSegment endPoint point where
+  s `intersects `s' = supportingLine s `intersects` s' && supportingLine s' `intersects` s
+  {-# INLINE intersects #-}
+
+-- TODO: specialize instance for ClosedLineSegment and AnLineSegment
+
+instance ( Point_ point 2 r, Num r,  Ord r
+         ) =>
+         LineSegment AnEndPoint point `HasIntersectionWith` ClosedLineSegment point where
+  s `intersects `s' = supportingLine s `intersects` s' && supportingLine s' `intersects` s
+  {-# INLINE intersects #-}
+
+instance ( Point_ point 2 r, Num r,  Ord r
+         ) =>
+         LineSegment AnEndPoint point `HasIntersectionWith` OpenLineSegment point where
+  s `intersects `s' = supportingLine s `intersects` s' && supportingLine s' `intersects` s
+  {-# INLINE intersects #-}
+
+instance ( Point_ point 2 r, Num r,  Ord r
+         ) =>
+         ClosedLineSegment point `HasIntersectionWith` LineSegment AnEndPoint point where
+  s `intersects `s' = supportingLine s `intersects` s' && supportingLine s' `intersects` s
+  {-# INLINE intersects #-}
+
+instance ( Point_ point 2 r, Num r,  Ord r
+         ) =>
+         ClosedLineSegment point `HasIntersectionWith` OpenLineSegment point where
+  s `intersects `s' = supportingLine s `intersects` s' && supportingLine s' `intersects` s
+  {-# INLINE intersects #-}
+
+instance ( Point_ point 2 r, Num r,  Ord r
+         ) =>
+         OpenLineSegment point `HasIntersectionWith` LineSegment AnEndPoint point where
+  s `intersects `s' = supportingLine s `intersects` s' && supportingLine s' `intersects` s
+  {-# INLINE intersects #-}
+
 instance ( Point_ point 2 r, Num r,  Ord r
          ) =>
-         LineSegment AnEndPoint point `HasIntersectionWith` LineSegment AnEndPoint point where
+         OpenLineSegment point `HasIntersectionWith` ClosedLineSegment point where
   s `intersects `s' = supportingLine s `intersects` s' && supportingLine s' `intersects` s
   {-# INLINE intersects #-}
 

hgeometry/kernel/test/HGeometry/LineSegmentSpec.hs

@@ -1,26 +1,27 @@
-{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE PartialTypeSignatures #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 module HGeometry.LineSegmentSpec where
 
 import Control.Lens ((^.), IxValue)
 import Data.Ord (comparing)
 import HGeometry.Ext
 import HGeometry.Intersection
 import HGeometry.Number.Real.Rational
--- import Data.Vinyl
 -- import HGeometry.Boundary
 -- import HGeometry.Box
 import HGeometry.LineSegment
--- import HGeometry.LineSegment.Internal (onSegment, onSegment2)
 import HGeometry.Point
 import HGeometry.Interval
-import HGeometry.Vector ((*^))
+import HGeometry.HyperPlane
+import HGeometry.Vector ((*^), Vector(..))
+import HGeometry.Line.PointAndVector
 import Test.Hspec.QuickCheck
 import Test.Hspec
 import Test.QuickCheck ((===), Arbitrary(..), suchThat, Property, counterexample)
 import Test.QuickCheck.Instances ()
 import HGeometry.Kernel.Instances ()
 
+import Debug.Trace
 --------------------------------------------------------------------------------
 -- main :: IO ()
 -- main = print $ testStartInt
@@ -91,15 +92,20 @@ spec =
           intersects3 = intersects
           intersects2 :: Point 2 R -> ClosedLineSegment (Point 2 R :+ ()) -> Bool
           intersects2 = intersects
+          intersects2' :: Point 2 R -> OpenLineSegment (Point 2 R :+ ()) -> Bool
+          intersects2' = intersects
 
       it "2d on segment tests" $ do
         let seg1 = ClosedLineSegment (origin :+ ()) (Point2 2 0 :+ ())
             seg2 = ClosedLineSegment (origin :+ ()) (Point2 3 3 :+ ())
+            seg3 = OpenLineSegment   (origin :+ ()) (Point2 3 3 :+ ())
         (Point2 1    0 `intersects2` seg1) `shouldBe`  True
         (Point2 1    1 `intersects2` seg1) `shouldBe` False
         (Point2 5    0 `intersects2` seg1) `shouldBe` False
         (Point2 (-1) 0 `intersects2` seg1) `shouldBe` False
         (Point2 1    1 `intersects2` seg2) `shouldBe`  True
+        (Point2 1    1 `intersects2'` seg3) `shouldBe`  True
+        (Point2 0    0 `intersects2'` seg3) `shouldBe`  False
 
       it "3d on segment tests" $ do
         let seg = ClosedLineSegment (origin :+ ()) (Point3 3 3 3 :+ ())
@@ -194,16 +200,24 @@ test3 = ClosedLineSegment (Point2 0 21) (Point2 0 5)
 test4 :: LineSegment AnEndPoint (Point 2 Int)
 test4 = LineSegment (AnEndPoint Open $ Point2 0 10) (AnEndPoint Closed $ Point2 0 9)
 
+test5 :: OpenLineSegment (Point 2 Int)
+test5 = OpenLineSegment (Point2 0 20) (Point2 200 20)
+
 -- -- test = withRank (Vector2 0 1) test1 test4
 
 testI :: Spec
 testI = describe "some manual intersection tests" $ do
-          pure ()
---           it "manual intersection" $ (test1 `intersects` test2 ) `shouldBe` True
---          it "manual intersection" $ (test1 `intersects` test3 ) `shouldBe` True
---           it "manual intersection" $ (test1 `intersects` test4 ) `shouldBe` False
---           it "manual intersection" $ (test2 `intersects` test4 ) `shouldBe` True
-
+          it "manual intersection" $ (test1 `intersects` test2 ) `shouldBe` True
+          it "manual intersection" $ (test1 `intersects` test3 ) `shouldBe` True
+          it "manual intersection" $ (test1 `intersects` test4 ) `shouldBe` False
+          it "manual intersection" $ (test2 `intersects` test4 ) `shouldBe` True
+          it "manual intersection" $ (test2 `intersects` test5 ) `shouldBe` False
+
+          describe "manual intersect with line" $ do
+            let l = LinePV origin (Vector2 0 (1 :: Int))
+            it "man" $ (l `intersects` test1) `shouldBe` True
+            it "sideTest" $ traceShow (hyperPlaneEquation l) $
+              (onSideTest (test1^.start) l) `shouldBe` EQ