{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TemplateHaskell #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Algorithms.Geometry.LineSegmentIntersection.Types
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--------------------------------------------------------------------------------
module Algorithms.Geometry.LineSegmentIntersection.Types where

-- import           Algorithms.DivideAndConquer
import           Control.DeepSeq
import           Control.Lens
import           Data.Ext
import           Data.Bifunctor
import           Data.Geometry.Interval
import           Data.Geometry.LineSegment
import           Data.Geometry.Point
import qualified Data.Map as Map
import qualified Data.Set as Set
import           Data.Ord (comparing, Down(..))
import           GHC.Generics
import           Data.Vinyl.CoRec
import           Data.Vinyl
import           Data.Intersection


----------------------------------------------------------------------------------


-- FIXME: What do we do when one segmnet lies *on* the other one. For
-- the short segment it should be an "around start", but then the
-- startpoints do not match.
--
-- for the long one it's an "on" segment, but they do not intersect


-- | Assumes that two segments have the same start point
newtype AroundStart a = AroundStart a deriving (Int -> AroundStart a -> ShowS
[AroundStart a] -> ShowS
AroundStart a -> String
(Int -> AroundStart a -> ShowS)
-> (AroundStart a -> String)
-> ([AroundStart a] -> ShowS)
-> Show (AroundStart a)
forall a. Show a => Int -> AroundStart a -> ShowS
forall a. Show a => [AroundStart a] -> ShowS
forall a. Show a => AroundStart a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AroundStart a] -> ShowS
$cshowList :: forall a. Show a => [AroundStart a] -> ShowS
show :: AroundStart a -> String
$cshow :: forall a. Show a => AroundStart a -> String
showsPrec :: Int -> AroundStart a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> AroundStart a -> ShowS
Show,ReadPrec [AroundStart a]
ReadPrec (AroundStart a)
Int -> ReadS (AroundStart a)
ReadS [AroundStart a]
(Int -> ReadS (AroundStart a))
-> ReadS [AroundStart a]
-> ReadPrec (AroundStart a)
-> ReadPrec [AroundStart a]
-> Read (AroundStart a)
forall a. Read a => ReadPrec [AroundStart a]
forall a. Read a => ReadPrec (AroundStart a)
forall a. Read a => Int -> ReadS (AroundStart a)
forall a. Read a => ReadS [AroundStart a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AroundStart a]
$creadListPrec :: forall a. Read a => ReadPrec [AroundStart a]
readPrec :: ReadPrec (AroundStart a)
$creadPrec :: forall a. Read a => ReadPrec (AroundStart a)
readList :: ReadS [AroundStart a]
$creadList :: forall a. Read a => ReadS [AroundStart a]
readsPrec :: Int -> ReadS (AroundStart a)
$creadsPrec :: forall a. Read a => Int -> ReadS (AroundStart a)
Read,AroundStart a -> ()
(AroundStart a -> ()) -> NFData (AroundStart a)
forall a. NFData a => AroundStart a -> ()
forall a. (a -> ()) -> NFData a
rnf :: AroundStart a -> ()
$crnf :: forall a. NFData a => AroundStart a -> ()
NFData,a -> AroundStart b -> AroundStart a
(a -> b) -> AroundStart a -> AroundStart b
(forall a b. (a -> b) -> AroundStart a -> AroundStart b)
-> (forall a b. a -> AroundStart b -> AroundStart a)
-> Functor AroundStart
forall a b. a -> AroundStart b -> AroundStart a
forall a b. (a -> b) -> AroundStart a -> AroundStart b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> AroundStart b -> AroundStart a
$c<$ :: forall a b. a -> AroundStart b -> AroundStart a
fmap :: (a -> b) -> AroundStart a -> AroundStart b
$cfmap :: forall a b. (a -> b) -> AroundStart a -> AroundStart b
Functor)

instance Eq r => Eq (AroundStart (LineSegment 2 p r :+ e)) where
  -- | equality on endpoint
  (AroundStart LineSegment 2 p r :+ e
s) == :: AroundStart (LineSegment 2 p r :+ e)
-> AroundStart (LineSegment 2 p r :+ e) -> Bool
== (AroundStart LineSegment 2 p r :+ e
s') = LineSegment 2 p r :+ e
s(LineSegment 2 p r :+ e)
-> Getting (Point 2 r) (LineSegment 2 p r :+ e) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.(LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> (LineSegment 2 p r :+ e)
-> Const (Point 2 r) (LineSegment 2 p r :+ e)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core((LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
 -> (LineSegment 2 p r :+ e)
 -> Const (Point 2 r) (LineSegment 2 p r :+ e))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> Getting (Point 2 r) (LineSegment 2 p r :+ e) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> (Point 2 r -> Const (Point 2 r) (Point 2 r))
-> LineSegment 2 p r
-> Const (Point 2 r) (LineSegment 2 p r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core Point 2 r -> Point 2 r -> Bool
forall a. Eq a => a -> a -> Bool
== LineSegment 2 p r :+ e
s'(LineSegment 2 p r :+ e)
-> Getting (Point 2 r) (LineSegment 2 p r :+ e) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.(LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> (LineSegment 2 p r :+ e)
-> Const (Point 2 r) (LineSegment 2 p r :+ e)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core((LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
 -> (LineSegment 2 p r :+ e)
 -> Const (Point 2 r) (LineSegment 2 p r :+ e))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> Getting (Point 2 r) (LineSegment 2 p r :+ e) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> (Point 2 r -> Const (Point 2 r) (Point 2 r))
-> LineSegment 2 p r
-> Const (Point 2 r) (LineSegment 2 p r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core

instance (Ord r, Num r) => Ord (AroundStart (LineSegment 2 p r :+ e)) where
  -- | ccw ordered around their suposed common startpoint
  (AroundStart LineSegment 2 p r :+ e
s) compare :: AroundStart (LineSegment 2 p r :+ e)
-> AroundStart (LineSegment 2 p r :+ e) -> Ordering
`compare` (AroundStart LineSegment 2 p r :+ e
s') =
    Point 2 r -> Point 2 r -> Point 2 r -> Ordering
forall r.
(Num r, Ord r) =>
Point 2 r -> Point 2 r -> Point 2 r -> Ordering
ccwCmpAround (LineSegment 2 p r :+ e
s(LineSegment 2 p r :+ e)
-> Getting (Point 2 r) (LineSegment 2 p r :+ e) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.(LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> (LineSegment 2 p r :+ e)
-> Const (Point 2 r) (LineSegment 2 p r :+ e)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core((LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
 -> (LineSegment 2 p r :+ e)
 -> Const (Point 2 r) (LineSegment 2 p r :+ e))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> Getting (Point 2 r) (LineSegment 2 p r :+ e) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> (Point 2 r -> Const (Point 2 r) (Point 2 r))
-> LineSegment 2 p r
-> Const (Point 2 r) (LineSegment 2 p r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) (LineSegment 2 p r :+ e
s(LineSegment 2 p r :+ e)
-> Getting (Point 2 r) (LineSegment 2 p r :+ e) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.(LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> (LineSegment 2 p r :+ e)
-> Const (Point 2 r) (LineSegment 2 p r :+ e)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core((LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
 -> (LineSegment 2 p r :+ e)
 -> Const (Point 2 r) (LineSegment 2 p r :+ e))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> Getting (Point 2 r) (LineSegment 2 p r :+ e) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> (Point 2 r -> Const (Point 2 r) (Point 2 r))
-> LineSegment 2 p r
-> Const (Point 2 r) (LineSegment 2 p r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core)  (LineSegment 2 p r :+ e
s'(LineSegment 2 p r :+ e)
-> Getting (Point 2 r) (LineSegment 2 p r :+ e) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.(LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> (LineSegment 2 p r :+ e)
-> Const (Point 2 r) (LineSegment 2 p r :+ e)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core((LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
 -> (LineSegment 2 p r :+ e)
 -> Const (Point 2 r) (LineSegment 2 p r :+ e))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> Getting (Point 2 r) (LineSegment 2 p r :+ e) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> (Point 2 r -> Const (Point 2 r) (Point 2 r))
-> LineSegment 2 p r
-> Const (Point 2 r) (LineSegment 2 p r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core)

----------------------------------------

-- | Assumes that two segments have the same end point
newtype AroundEnd a = AroundEnd a deriving (Int -> AroundEnd a -> ShowS
[AroundEnd a] -> ShowS
AroundEnd a -> String
(Int -> AroundEnd a -> ShowS)
-> (AroundEnd a -> String)
-> ([AroundEnd a] -> ShowS)
-> Show (AroundEnd a)
forall a. Show a => Int -> AroundEnd a -> ShowS
forall a. Show a => [AroundEnd a] -> ShowS
forall a. Show a => AroundEnd a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AroundEnd a] -> ShowS
$cshowList :: forall a. Show a => [AroundEnd a] -> ShowS
show :: AroundEnd a -> String
$cshow :: forall a. Show a => AroundEnd a -> String
showsPrec :: Int -> AroundEnd a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> AroundEnd a -> ShowS
Show,ReadPrec [AroundEnd a]
ReadPrec (AroundEnd a)
Int -> ReadS (AroundEnd a)
ReadS [AroundEnd a]
(Int -> ReadS (AroundEnd a))
-> ReadS [AroundEnd a]
-> ReadPrec (AroundEnd a)
-> ReadPrec [AroundEnd a]
-> Read (AroundEnd a)
forall a. Read a => ReadPrec [AroundEnd a]
forall a. Read a => ReadPrec (AroundEnd a)
forall a. Read a => Int -> ReadS (AroundEnd a)
forall a. Read a => ReadS [AroundEnd a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AroundEnd a]
$creadListPrec :: forall a. Read a => ReadPrec [AroundEnd a]
readPrec :: ReadPrec (AroundEnd a)
$creadPrec :: forall a. Read a => ReadPrec (AroundEnd a)
readList :: ReadS [AroundEnd a]
$creadList :: forall a. Read a => ReadS [AroundEnd a]
readsPrec :: Int -> ReadS (AroundEnd a)
$creadsPrec :: forall a. Read a => Int -> ReadS (AroundEnd a)
Read,AroundEnd a -> ()
(AroundEnd a -> ()) -> NFData (AroundEnd a)
forall a. NFData a => AroundEnd a -> ()
forall a. (a -> ()) -> NFData a
rnf :: AroundEnd a -> ()
$crnf :: forall a. NFData a => AroundEnd a -> ()
NFData,a -> AroundEnd b -> AroundEnd a
(a -> b) -> AroundEnd a -> AroundEnd b
(forall a b. (a -> b) -> AroundEnd a -> AroundEnd b)
-> (forall a b. a -> AroundEnd b -> AroundEnd a)
-> Functor AroundEnd
forall a b. a -> AroundEnd b -> AroundEnd a
forall a b. (a -> b) -> AroundEnd a -> AroundEnd b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> AroundEnd b -> AroundEnd a
$c<$ :: forall a b. a -> AroundEnd b -> AroundEnd a
fmap :: (a -> b) -> AroundEnd a -> AroundEnd b
$cfmap :: forall a b. (a -> b) -> AroundEnd a -> AroundEnd b
Functor)

instance Eq r => Eq (AroundEnd (LineSegment 2 p r :+ e)) where
  -- | equality on endpoint
  (AroundEnd LineSegment 2 p r :+ e
s) == :: AroundEnd (LineSegment 2 p r :+ e)
-> AroundEnd (LineSegment 2 p r :+ e) -> Bool
== (AroundEnd LineSegment 2 p r :+ e
s') = LineSegment 2 p r :+ e
s(LineSegment 2 p r :+ e)
-> Getting (Point 2 r) (LineSegment 2 p r :+ e) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.(LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> (LineSegment 2 p r :+ e)
-> Const (Point 2 r) (LineSegment 2 p r :+ e)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core((LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
 -> (LineSegment 2 p r :+ e)
 -> Const (Point 2 r) (LineSegment 2 p r :+ e))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> Getting (Point 2 r) (LineSegment 2 p r :+ e) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> (Point 2 r -> Const (Point 2 r) (Point 2 r))
-> LineSegment 2 p r
-> Const (Point 2 r) (LineSegment 2 p r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core Point 2 r -> Point 2 r -> Bool
forall a. Eq a => a -> a -> Bool
== LineSegment 2 p r :+ e
s'(LineSegment 2 p r :+ e)
-> Getting (Point 2 r) (LineSegment 2 p r :+ e) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.(LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> (LineSegment 2 p r :+ e)
-> Const (Point 2 r) (LineSegment 2 p r :+ e)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core((LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
 -> (LineSegment 2 p r :+ e)
 -> Const (Point 2 r) (LineSegment 2 p r :+ e))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> Getting (Point 2 r) (LineSegment 2 p r :+ e) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> (Point 2 r -> Const (Point 2 r) (Point 2 r))
-> LineSegment 2 p r
-> Const (Point 2 r) (LineSegment 2 p r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core

instance (Ord r, Num r) => Ord (AroundEnd (LineSegment 2 p r :+ e)) where
  -- | ccw ordered around their suposed common end point
  (AroundEnd LineSegment 2 p r :+ e
s) compare :: AroundEnd (LineSegment 2 p r :+ e)
-> AroundEnd (LineSegment 2 p r :+ e) -> Ordering
`compare` (AroundEnd LineSegment 2 p r :+ e
s') =
    Point 2 r -> Point 2 r -> Point 2 r -> Ordering
forall r.
(Num r, Ord r) =>
Point 2 r -> Point 2 r -> Point 2 r -> Ordering
ccwCmpAround (LineSegment 2 p r :+ e
s(LineSegment 2 p r :+ e)
-> Getting (Point 2 r) (LineSegment 2 p r :+ e) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.(LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> (LineSegment 2 p r :+ e)
-> Const (Point 2 r) (LineSegment 2 p r :+ e)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core((LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
 -> (LineSegment 2 p r :+ e)
 -> Const (Point 2 r) (LineSegment 2 p r :+ e))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> Getting (Point 2 r) (LineSegment 2 p r :+ e) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> (Point 2 r -> Const (Point 2 r) (Point 2 r))
-> LineSegment 2 p r
-> Const (Point 2 r) (LineSegment 2 p r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) (LineSegment 2 p r :+ e
s(LineSegment 2 p r :+ e)
-> Getting (Point 2 r) (LineSegment 2 p r :+ e) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.(LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> (LineSegment 2 p r :+ e)
-> Const (Point 2 r) (LineSegment 2 p r :+ e)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core((LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
 -> (LineSegment 2 p r :+ e)
 -> Const (Point 2 r) (LineSegment 2 p r :+ e))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> Getting (Point 2 r) (LineSegment 2 p r :+ e) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> (Point 2 r -> Const (Point 2 r) (Point 2 r))
-> LineSegment 2 p r
-> Const (Point 2 r) (LineSegment 2 p r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core)  (LineSegment 2 p r :+ e
s'(LineSegment 2 p r :+ e)
-> Getting (Point 2 r) (LineSegment 2 p r :+ e) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.(LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> (LineSegment 2 p r :+ e)
-> Const (Point 2 r) (LineSegment 2 p r :+ e)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core((LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
 -> (LineSegment 2 p r :+ e)
 -> Const (Point 2 r) (LineSegment 2 p r :+ e))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> Getting (Point 2 r) (LineSegment 2 p r :+ e) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> (Point 2 r -> Const (Point 2 r) (Point 2 r))
-> LineSegment 2 p r
-> Const (Point 2 r) (LineSegment 2 p r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core)

--------------------------------------------------------------------------------

-- | Assumes that two segments intersect in a single point.
newtype AroundIntersection a = AroundIntersection a deriving (Int -> AroundIntersection a -> ShowS
[AroundIntersection a] -> ShowS
AroundIntersection a -> String
(Int -> AroundIntersection a -> ShowS)
-> (AroundIntersection a -> String)
-> ([AroundIntersection a] -> ShowS)
-> Show (AroundIntersection a)
forall a. Show a => Int -> AroundIntersection a -> ShowS
forall a. Show a => [AroundIntersection a] -> ShowS
forall a. Show a => AroundIntersection a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AroundIntersection a] -> ShowS
$cshowList :: forall a. Show a => [AroundIntersection a] -> ShowS
show :: AroundIntersection a -> String
$cshow :: forall a. Show a => AroundIntersection a -> String
showsPrec :: Int -> AroundIntersection a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> AroundIntersection a -> ShowS
Show,ReadPrec [AroundIntersection a]
ReadPrec (AroundIntersection a)
Int -> ReadS (AroundIntersection a)
ReadS [AroundIntersection a]
(Int -> ReadS (AroundIntersection a))
-> ReadS [AroundIntersection a]
-> ReadPrec (AroundIntersection a)
-> ReadPrec [AroundIntersection a]
-> Read (AroundIntersection a)
forall a. Read a => ReadPrec [AroundIntersection a]
forall a. Read a => ReadPrec (AroundIntersection a)
forall a. Read a => Int -> ReadS (AroundIntersection a)
forall a. Read a => ReadS [AroundIntersection a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AroundIntersection a]
$creadListPrec :: forall a. Read a => ReadPrec [AroundIntersection a]
readPrec :: ReadPrec (AroundIntersection a)
$creadPrec :: forall a. Read a => ReadPrec (AroundIntersection a)
readList :: ReadS [AroundIntersection a]
$creadList :: forall a. Read a => ReadS [AroundIntersection a]
readsPrec :: Int -> ReadS (AroundIntersection a)
$creadsPrec :: forall a. Read a => Int -> ReadS (AroundIntersection a)
Read,AroundIntersection a -> ()
(AroundIntersection a -> ()) -> NFData (AroundIntersection a)
forall a. NFData a => AroundIntersection a -> ()
forall a. (a -> ()) -> NFData a
rnf :: AroundIntersection a -> ()
$crnf :: forall a. NFData a => AroundIntersection a -> ()
NFData,a -> AroundIntersection b -> AroundIntersection a
(a -> b) -> AroundIntersection a -> AroundIntersection b
(forall a b.
 (a -> b) -> AroundIntersection a -> AroundIntersection b)
-> (forall a b. a -> AroundIntersection b -> AroundIntersection a)
-> Functor AroundIntersection
forall a b. a -> AroundIntersection b -> AroundIntersection a
forall a b.
(a -> b) -> AroundIntersection a -> AroundIntersection b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> AroundIntersection b -> AroundIntersection a
$c<$ :: forall a b. a -> AroundIntersection b -> AroundIntersection a
fmap :: (a -> b) -> AroundIntersection a -> AroundIntersection b
$cfmap :: forall a b.
(a -> b) -> AroundIntersection a -> AroundIntersection b
Functor)

instance Eq r => Eq (AroundIntersection (LineSegment 2 p r :+ e)) where
  -- | equality ignores the p and the e types
  (AroundIntersection (LineSegment 2 p r
s :+ e
_)) == :: AroundIntersection (LineSegment 2 p r :+ e)
-> AroundIntersection (LineSegment 2 p r :+ e) -> Bool
== (AroundIntersection (LineSegment 2 p r
s' :+ e
_))
    = (p -> ()) -> LineSegment 2 p r -> LineSegment 2 () r
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (() -> p -> ()
forall a b. a -> b -> a
const ()) LineSegment 2 p r
s LineSegment 2 () r -> LineSegment 2 () r -> Bool
forall a. Eq a => a -> a -> Bool
== (p -> ()) -> LineSegment 2 p r -> LineSegment 2 () r
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (() -> p -> ()
forall a b. a -> b -> a
const ()) LineSegment 2 p r
s'

instance (Ord r, Fractional r) => Ord (AroundIntersection (LineSegment 2 p r :+ e)) where
  -- | ccw ordered around their common intersection point.
  (AroundIntersection (LineSegment 2 p r
s :+ e
_)) compare :: AroundIntersection (LineSegment 2 p r :+ e)
-> AroundIntersection (LineSegment 2 p r :+ e) -> Ordering
`compare` (AroundIntersection (LineSegment 2 p r
s' :+ e
_)) =
    CoRec
  Identity '[NoIntersection, Point 2 r, LineSegment 2 (Either p p) r]
-> Handlers
     '[NoIntersection, Point 2 r, LineSegment 2 (Either p p) r] Ordering
-> Ordering
forall (ts :: [*]) b. CoRec Identity ts -> Handlers ts b -> b
match (LineSegment 2 p r
s LineSegment 2 p r
-> LineSegment 2 p r
-> Intersection (LineSegment 2 p r) (LineSegment 2 p r)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` LineSegment 2 p r
s') (Handlers
   '[NoIntersection, Point 2 r, LineSegment 2 (Either p p) r] Ordering
 -> Ordering)
-> Handlers
     '[NoIntersection, Point 2 r, LineSegment 2 (Either p p) r] Ordering
-> Ordering
forall a b. (a -> b) -> a -> b
$
        (NoIntersection -> Ordering) -> Handler Ordering NoIntersection
forall b a. (a -> b) -> Handler b a
H (\NoIntersection
NoIntersection     -> String -> Ordering
forall a. HasCallStack => String -> a
error String
"AroundIntersection: segments do not intersect!")
     Handler Ordering NoIntersection
-> Rec
     (Handler Ordering) '[Point 2 r, LineSegment 2 (Either p p) r]
-> Handlers
     '[NoIntersection, Point 2 r, LineSegment 2 (Either p p) r] Ordering
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (Point 2 r -> Ordering) -> Handler Ordering (Point 2 r)
forall b a. (a -> b) -> Handler b a
H (\Point 2 r
p                  -> Point 2 r -> LineSegment 2 p r -> LineSegment 2 p r -> Ordering
forall r p.
(Ord r, Num r) =>
Point 2 r -> LineSegment 2 p r -> LineSegment 2 p r -> Ordering
cmpAroundP Point 2 r
p LineSegment 2 p r
s LineSegment 2 p r
s')
     Handler Ordering (Point 2 r)
-> Rec (Handler Ordering) '[LineSegment 2 (Either p p) r]
-> Rec
     (Handler Ordering) '[Point 2 r, LineSegment 2 (Either p p) r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (LineSegment 2 (Either p p) r -> Ordering)
-> Handler Ordering (LineSegment 2 (Either p p) r)
forall b a. (a -> b) -> Handler b a
H (\LineSegment 2 (Either p p) r
_                  -> (LineSegment 2 p r -> r
forall (d :: Nat) r p.
(ImplicitPeano (Peano d), Num r,
 ArityPeano (Peano (FromPeano (Peano d))),
 KnownNat (FromPeano (Peano d)), KnownNat d,
 Peano (FromPeano (Peano d) + 1)
 ~ 'S (Peano (FromPeano (Peano d)))) =>
LineSegment d p r -> r
squaredLength LineSegment 2 p r
s) r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (LineSegment 2 p r -> r
forall (d :: Nat) r p.
(ImplicitPeano (Peano d), Num r,
 ArityPeano (Peano (FromPeano (Peano d))),
 KnownNat (FromPeano (Peano d)), KnownNat d,
 Peano (FromPeano (Peano d) + 1)
 ~ 'S (Peano (FromPeano (Peano d)))) =>
LineSegment d p r -> r
squaredLength LineSegment 2 p r
s'))
                                 -- if s and s' just happen to be the same length but
                                 -- intersect in different behaviour from using (==).
                                 -- but that situation doese not satisfy the precondition
                                 -- of aroundIntersection anyway.
     Handler Ordering (LineSegment 2 (Either p p) r)
-> Rec (Handler Ordering) '[]
-> Rec (Handler Ordering) '[LineSegment 2 (Either p p) r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (Handler Ordering) '[]
forall u (a :: u -> *). Rec a '[]
RNil
    where
      squaredLength :: LineSegment d p r -> r
squaredLength (LineSegment' Point d r :+ p
a Point d r :+ p
b) = Point d r -> Point d r -> r
forall r (d :: Nat).
(Num r, Arity d) =>
Point d r -> Point d r -> r
squaredEuclideanDist (Point d r :+ p
a(Point d r :+ p)
-> Getting (Point d r) (Point d r :+ p) (Point d r) -> Point d r
forall s a. s -> Getting a s a -> a
^.Getting (Point d r) (Point d r :+ p) (Point d r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) (Point d r :+ p
b(Point d r :+ p)
-> Getting (Point d r) (Point d r :+ p) (Point d r) -> Point d r
forall s a. s -> Getting a s a -> a
^.Getting (Point d r) (Point d r :+ p) (Point d r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core)

-- | compare around p
cmpAroundP        :: (Ord r, Num r) => Point 2 r -> LineSegment 2 p r -> LineSegment 2 p r -> Ordering
cmpAroundP :: Point 2 r -> LineSegment 2 p r -> LineSegment 2 p r -> Ordering
cmpAroundP Point 2 r
p LineSegment 2 p r
s LineSegment 2 p r
s' = Point 2 r -> Point 2 r -> Point 2 r -> Ordering
forall r.
(Num r, Ord r) =>
Point 2 r -> Point 2 r -> Point 2 r -> Ordering
ccwCmpAround Point 2 r
p (LineSegment 2 p r
sLineSegment 2 p r
-> Getting (Point 2 r) (LineSegment 2 p r) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> Getting (Point 2 r) (LineSegment 2 p r) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core)  (LineSegment 2 p r
s'LineSegment 2 p r
-> Getting (Point 2 r) (LineSegment 2 p r) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> LineSegment 2 p r -> Const (Point 2 r) (LineSegment 2 p r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> Getting (Point 2 r) (LineSegment 2 p r) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core)


-- seg1 = ClosedLineSegment (ext $ Point2 0 0) (ext $ Point2 0 10)
-- seg2 = ClosedLineSegment (ext $ Point2 0 0) (ext $ Point2 0 10)


--------------------------------------------------------------------------------



-- | The line segments that contain a given point p may either have p
-- as the endpoint or have p in their interior.
--
-- if somehow the segment is degenerate, and p is both the start and
-- end it is reported only as the start point.
data Associated p r e =
  Associated { Associated p r e -> Set (AroundEnd (LineSegment 2 p r :+ e))
_startPointOf :: Set.Set (AroundEnd (LineSegment 2 p r :+ e))
             -- ^ segments for which the intersection point is the
             -- start point (i.e. s^.start.core == p)
             , Associated p r e -> Set (AroundStart (LineSegment 2 p r :+ e))
_endPointOf   :: Set.Set (AroundStart (LineSegment 2 p r :+ e))
             -- ^ segments for which the intersection point is the end
             -- point (i.e. s^.end.core == p)
             , Associated p r e
-> Set (AroundIntersection (LineSegment 2 p r :+ e))
_interiorTo   :: Set.Set (AroundIntersection (LineSegment 2 p r :+ e))
             } deriving stock (Int -> Associated p r e -> ShowS
[Associated p r e] -> ShowS
Associated p r e -> String
(Int -> Associated p r e -> ShowS)
-> (Associated p r e -> String)
-> ([Associated p r e] -> ShowS)
-> Show (Associated p r e)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall p r e.
(Show r, Show p, Show e) =>
Int -> Associated p r e -> ShowS
forall p r e.
(Show r, Show p, Show e) =>
[Associated p r e] -> ShowS
forall p r e.
(Show r, Show p, Show e) =>
Associated p r e -> String
showList :: [Associated p r e] -> ShowS
$cshowList :: forall p r e.
(Show r, Show p, Show e) =>
[Associated p r e] -> ShowS
show :: Associated p r e -> String
$cshow :: forall p r e.
(Show r, Show p, Show e) =>
Associated p r e -> String
showsPrec :: Int -> Associated p r e -> ShowS
$cshowsPrec :: forall p r e.
(Show r, Show p, Show e) =>
Int -> Associated p r e -> ShowS
Show, ReadPrec [Associated p r e]
ReadPrec (Associated p r e)
Int -> ReadS (Associated p r e)
ReadS [Associated p r e]
(Int -> ReadS (Associated p r e))
-> ReadS [Associated p r e]
-> ReadPrec (Associated p r e)
-> ReadPrec [Associated p r e]
-> Read (Associated p r e)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall p r e.
(Read r, Read p, Read e, Ord r, Fractional r) =>
ReadPrec [Associated p r e]
forall p r e.
(Read r, Read p, Read e, Ord r, Fractional r) =>
ReadPrec (Associated p r e)
forall p r e.
(Read r, Read p, Read e, Ord r, Fractional r) =>
Int -> ReadS (Associated p r e)
forall p r e.
(Read r, Read p, Read e, Ord r, Fractional r) =>
ReadS [Associated p r e]
readListPrec :: ReadPrec [Associated p r e]
$creadListPrec :: forall p r e.
(Read r, Read p, Read e, Ord r, Fractional r) =>
ReadPrec [Associated p r e]
readPrec :: ReadPrec (Associated p r e)
$creadPrec :: forall p r e.
(Read r, Read p, Read e, Ord r, Fractional r) =>
ReadPrec (Associated p r e)
readList :: ReadS [Associated p r e]
$creadList :: forall p r e.
(Read r, Read p, Read e, Ord r, Fractional r) =>
ReadS [Associated p r e]
readsPrec :: Int -> ReadS (Associated p r e)
$creadsPrec :: forall p r e.
(Read r, Read p, Read e, Ord r, Fractional r) =>
Int -> ReadS (Associated p r e)
Read, (forall x. Associated p r e -> Rep (Associated p r e) x)
-> (forall x. Rep (Associated p r e) x -> Associated p r e)
-> Generic (Associated p r e)
forall x. Rep (Associated p r e) x -> Associated p r e
forall x. Associated p r e -> Rep (Associated p r e) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall p r e x. Rep (Associated p r e) x -> Associated p r e
forall p r e x. Associated p r e -> Rep (Associated p r e) x
$cto :: forall p r e x. Rep (Associated p r e) x -> Associated p r e
$cfrom :: forall p r e x. Associated p r e -> Rep (Associated p r e) x
Generic, Associated p r e -> Associated p r e -> Bool
(Associated p r e -> Associated p r e -> Bool)
-> (Associated p r e -> Associated p r e -> Bool)
-> Eq (Associated p r e)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall p r e. Eq r => Associated p r e -> Associated p r e -> Bool
/= :: Associated p r e -> Associated p r e -> Bool
$c/= :: forall p r e. Eq r => Associated p r e -> Associated p r e -> Bool
== :: Associated p r e -> Associated p r e -> Bool
$c== :: forall p r e. Eq r => Associated p r e -> Associated p r e -> Bool
Eq)

makeLenses ''Associated

instance Functor (Associated p r) where
  fmap :: (a -> b) -> Associated p r a -> Associated p r b
fmap a -> b
f (Associated Set (AroundEnd (LineSegment 2 p r :+ a))
ss Set (AroundStart (LineSegment 2 p r :+ a))
es Set (AroundIntersection (LineSegment 2 p r :+ a))
is) = Set (AroundEnd (LineSegment 2 p r :+ b))
-> Set (AroundStart (LineSegment 2 p r :+ b))
-> Set (AroundIntersection (LineSegment 2 p r :+ b))
-> Associated p r b
forall p r e.
Set (AroundEnd (LineSegment 2 p r :+ e))
-> Set (AroundStart (LineSegment 2 p r :+ e))
-> Set (AroundIntersection (LineSegment 2 p r :+ e))
-> Associated p r e
Associated ((AroundEnd (LineSegment 2 p r :+ a)
 -> AroundEnd (LineSegment 2 p r :+ b))
-> Set (AroundEnd (LineSegment 2 p r :+ a))
-> Set (AroundEnd (LineSegment 2 p r :+ b))
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic ((a -> b)
-> AroundEnd (LineSegment 2 p r :+ a)
-> AroundEnd (LineSegment 2 p r :+ b)
forall (f :: * -> *) c e b.
Functor f =>
(e -> b) -> f (c :+ e) -> f (c :+ b)
g a -> b
f) Set (AroundEnd (LineSegment 2 p r :+ a))
ss)
                                            ((AroundStart (LineSegment 2 p r :+ a)
 -> AroundStart (LineSegment 2 p r :+ b))
-> Set (AroundStart (LineSegment 2 p r :+ a))
-> Set (AroundStart (LineSegment 2 p r :+ b))
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic ((a -> b)
-> AroundStart (LineSegment 2 p r :+ a)
-> AroundStart (LineSegment 2 p r :+ b)
forall (f :: * -> *) c e b.
Functor f =>
(e -> b) -> f (c :+ e) -> f (c :+ b)
g a -> b
f) Set (AroundStart (LineSegment 2 p r :+ a))
es)
                                            ((AroundIntersection (LineSegment 2 p r :+ a)
 -> AroundIntersection (LineSegment 2 p r :+ b))
-> Set (AroundIntersection (LineSegment 2 p r :+ a))
-> Set (AroundIntersection (LineSegment 2 p r :+ b))
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic ((a -> b)
-> AroundIntersection (LineSegment 2 p r :+ a)
-> AroundIntersection (LineSegment 2 p r :+ b)
forall (f :: * -> *) c e b.
Functor f =>
(e -> b) -> f (c :+ e) -> f (c :+ b)
g a -> b
f) Set (AroundIntersection (LineSegment 2 p r :+ a))
is)
    where
      g   :: forall f c e b. Functor f => (e -> b) -> f (c :+ e) -> f (c :+ b)
      g :: (e -> b) -> f (c :+ e) -> f (c :+ b)
g e -> b
f' = ((c :+ e) -> c :+ b) -> f (c :+ e) -> f (c :+ b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((c :+ e) -> ((c :+ e) -> c :+ b) -> c :+ b
forall a b. a -> (a -> b) -> b
&(e -> Identity b) -> (c :+ e) -> Identity (c :+ b)
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra ((e -> Identity b) -> (c :+ e) -> Identity (c :+ b))
-> (e -> b) -> (c :+ e) -> c :+ b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ e -> b
f')


-- | Reports whether this associated has any interior intersections
--
-- \(O(1)\)
isInteriorIntersection :: Associated p r e -> Bool
isInteriorIntersection :: Associated p r e -> Bool
isInteriorIntersection = Bool -> Bool
not (Bool -> Bool)
-> (Associated p r e -> Bool) -> Associated p r e -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (AroundIntersection (LineSegment 2 p r :+ e)) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Set (AroundIntersection (LineSegment 2 p r :+ e)) -> Bool)
-> (Associated p r e
    -> Set (AroundIntersection (LineSegment 2 p r :+ e)))
-> Associated p r e
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Associated p r e
-> Set (AroundIntersection (LineSegment 2 p r :+ e))
forall p r e.
Associated p r e
-> Set (AroundIntersection (LineSegment 2 p r :+ e))
_interiorTo


-- | test if the given segment has p as its endpoint, an construct the
-- appropriate associated representing that.
--
-- pre: p intersects the segment
mkAssociated                :: (Ord r, Fractional r)
                            => Point 2 r -> LineSegment 2 p r :+ e-> Associated p r e
mkAssociated :: Point 2 r -> (LineSegment 2 p r :+ e) -> Associated p r e
mkAssociated Point 2 r
p s :: LineSegment 2 p r :+ e
s@(LineSegment EndPoint (Point 2 r :+ p)
a EndPoint (Point 2 r :+ p)
b :+ e
_)
  | Point 2 r
p Point 2 r -> Point 2 r -> Bool
forall a. Eq a => a -> a -> Bool
== EndPoint (Point 2 r :+ p)
aEndPoint (Point 2 r :+ p)
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ p)) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> EndPoint (Point 2 r :+ p)
-> Const (Point 2 r) (EndPoint (Point 2 r :+ p))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> EndPoint (Point 2 r :+ p)
 -> Const (Point 2 r) (EndPoint (Point 2 r :+ p)))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ p)) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core = Associated p r e
forall a. Monoid a => a
memptyAssociated p r e
-> (Associated p r e -> Associated p r e) -> Associated p r e
forall a b. a -> (a -> b) -> b
&(Set (AroundEnd (LineSegment 2 p r :+ e))
 -> Identity (Set (AroundEnd (LineSegment 2 p r :+ e))))
-> Associated p r e -> Identity (Associated p r e)
forall p r e.
Lens' (Associated p r e) (Set (AroundEnd (LineSegment 2 p r :+ e)))
startPointOf ((Set (AroundEnd (LineSegment 2 p r :+ e))
  -> Identity (Set (AroundEnd (LineSegment 2 p r :+ e))))
 -> Associated p r e -> Identity (Associated p r e))
-> Set (AroundEnd (LineSegment 2 p r :+ e))
-> Associated p r e
-> Associated p r e
forall s t a b. ASetter s t a b -> b -> s -> t
.~  AroundEnd (LineSegment 2 p r :+ e)
-> Set (AroundEnd (LineSegment 2 p r :+ e))
forall a. a -> Set a
Set.singleton ((LineSegment 2 p r :+ e) -> AroundEnd (LineSegment 2 p r :+ e)
forall a. a -> AroundEnd a
AroundEnd LineSegment 2 p r :+ e
s)
  | Point 2 r
p Point 2 r -> Point 2 r -> Bool
forall a. Eq a => a -> a -> Bool
== EndPoint (Point 2 r :+ p)
bEndPoint (Point 2 r :+ p)
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ p)) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> EndPoint (Point 2 r :+ p)
-> Const (Point 2 r) (EndPoint (Point 2 r :+ p))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> EndPoint (Point 2 r :+ p)
 -> Const (Point 2 r) (EndPoint (Point 2 r :+ p)))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ p)) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core = Associated p r e
forall a. Monoid a => a
memptyAssociated p r e
-> (Associated p r e -> Associated p r e) -> Associated p r e
forall a b. a -> (a -> b) -> b
&(Set (AroundStart (LineSegment 2 p r :+ e))
 -> Identity (Set (AroundStart (LineSegment 2 p r :+ e))))
-> Associated p r e -> Identity (Associated p r e)
forall p r e.
Lens'
  (Associated p r e) (Set (AroundStart (LineSegment 2 p r :+ e)))
endPointOf   ((Set (AroundStart (LineSegment 2 p r :+ e))
  -> Identity (Set (AroundStart (LineSegment 2 p r :+ e))))
 -> Associated p r e -> Identity (Associated p r e))
-> Set (AroundStart (LineSegment 2 p r :+ e))
-> Associated p r e
-> Associated p r e
forall s t a b. ASetter s t a b -> b -> s -> t
.~  AroundStart (LineSegment 2 p r :+ e)
-> Set (AroundStart (LineSegment 2 p r :+ e))
forall a. a -> Set a
Set.singleton ((LineSegment 2 p r :+ e) -> AroundStart (LineSegment 2 p r :+ e)
forall a. a -> AroundStart a
AroundStart LineSegment 2 p r :+ e
s)
  | Bool
otherwise               = Associated p r e
forall a. Monoid a => a
memptyAssociated p r e
-> (Associated p r e -> Associated p r e) -> Associated p r e
forall a b. a -> (a -> b) -> b
&(Set (AroundIntersection (LineSegment 2 p r :+ e))
 -> Identity (Set (AroundIntersection (LineSegment 2 p r :+ e))))
-> Associated p r e -> Identity (Associated p r e)
forall p r e.
Lens'
  (Associated p r e)
  (Set (AroundIntersection (LineSegment 2 p r :+ e)))
interiorTo   ((Set (AroundIntersection (LineSegment 2 p r :+ e))
  -> Identity (Set (AroundIntersection (LineSegment 2 p r :+ e))))
 -> Associated p r e -> Identity (Associated p r e))
-> Set (AroundIntersection (LineSegment 2 p r :+ e))
-> Associated p r e
-> Associated p r e
forall s t a b. ASetter s t a b -> b -> s -> t
.~  AroundIntersection (LineSegment 2 p r :+ e)
-> Set (AroundIntersection (LineSegment 2 p r :+ e))
forall a. a -> Set a
Set.singleton ((LineSegment 2 p r :+ e)
-> AroundIntersection (LineSegment 2 p r :+ e)
forall a. a -> AroundIntersection a
AroundIntersection LineSegment 2 p r :+ e
s)


-- | test if the given segment has p as its endpoint, an construct the
-- appropriate associated representing that.
--
-- If p is not one of the endpoints we concstruct an empty Associated!
--
mkAssociated'     :: (Ord r, Fractional r)
                  => Point 2 r -> LineSegment 2 p r :+ e -> Associated p r e
mkAssociated' :: Point 2 r -> (LineSegment 2 p r :+ e) -> Associated p r e
mkAssociated' Point 2 r
p LineSegment 2 p r :+ e
s = (Point 2 r -> (LineSegment 2 p r :+ e) -> Associated p r e
forall r p e.
(Ord r, Fractional r) =>
Point 2 r -> (LineSegment 2 p r :+ e) -> Associated p r e
mkAssociated Point 2 r
p LineSegment 2 p r :+ e
s)Associated p r e
-> (Associated p r e -> Associated p r e) -> Associated p r e
forall a b. a -> (a -> b) -> b
&(Set (AroundIntersection (LineSegment 2 p r :+ e))
 -> Identity (Set (AroundIntersection (LineSegment 2 p r :+ e))))
-> Associated p r e -> Identity (Associated p r e)
forall p r e.
Lens'
  (Associated p r e)
  (Set (AroundIntersection (LineSegment 2 p r :+ e)))
interiorTo ((Set (AroundIntersection (LineSegment 2 p r :+ e))
  -> Identity (Set (AroundIntersection (LineSegment 2 p r :+ e))))
 -> Associated p r e -> Identity (Associated p r e))
-> Set (AroundIntersection (LineSegment 2 p r :+ e))
-> Associated p r e
-> Associated p r e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (AroundIntersection (LineSegment 2 p r :+ e))
forall a. Monoid a => a
mempty

instance (Ord r, Fractional r) => Semigroup (Associated p r e) where
  (Associated Set (AroundEnd (LineSegment 2 p r :+ e))
ss Set (AroundStart (LineSegment 2 p r :+ e))
es Set (AroundIntersection (LineSegment 2 p r :+ e))
is) <> :: Associated p r e -> Associated p r e -> Associated p r e
<> (Associated Set (AroundEnd (LineSegment 2 p r :+ e))
ss' Set (AroundStart (LineSegment 2 p r :+ e))
es' Set (AroundIntersection (LineSegment 2 p r :+ e))
is') =
    Set (AroundEnd (LineSegment 2 p r :+ e))
-> Set (AroundStart (LineSegment 2 p r :+ e))
-> Set (AroundIntersection (LineSegment 2 p r :+ e))
-> Associated p r e
forall p r e.
Set (AroundEnd (LineSegment 2 p r :+ e))
-> Set (AroundStart (LineSegment 2 p r :+ e))
-> Set (AroundIntersection (LineSegment 2 p r :+ e))
-> Associated p r e
Associated (Set (AroundEnd (LineSegment 2 p r :+ e))
ss Set (AroundEnd (LineSegment 2 p r :+ e))
-> Set (AroundEnd (LineSegment 2 p r :+ e))
-> Set (AroundEnd (LineSegment 2 p r :+ e))
forall a. Semigroup a => a -> a -> a
<> Set (AroundEnd (LineSegment 2 p r :+ e))
ss') (Set (AroundStart (LineSegment 2 p r :+ e))
es Set (AroundStart (LineSegment 2 p r :+ e))
-> Set (AroundStart (LineSegment 2 p r :+ e))
-> Set (AroundStart (LineSegment 2 p r :+ e))
forall a. Semigroup a => a -> a -> a
<> Set (AroundStart (LineSegment 2 p r :+ e))
es') (Set (AroundIntersection (LineSegment 2 p r :+ e))
is Set (AroundIntersection (LineSegment 2 p r :+ e))
-> Set (AroundIntersection (LineSegment 2 p r :+ e))
-> Set (AroundIntersection (LineSegment 2 p r :+ e))
forall a. Semigroup a => a -> a -> a
<> Set (AroundIntersection (LineSegment 2 p r :+ e))
is')

instance (Ord r, Fractional r) => Monoid (Associated p r e) where
  mempty :: Associated p r e
mempty = Set (AroundEnd (LineSegment 2 p r :+ e))
-> Set (AroundStart (LineSegment 2 p r :+ e))
-> Set (AroundIntersection (LineSegment 2 p r :+ e))
-> Associated p r e
forall p r e.
Set (AroundEnd (LineSegment 2 p r :+ e))
-> Set (AroundStart (LineSegment 2 p r :+ e))
-> Set (AroundIntersection (LineSegment 2 p r :+ e))
-> Associated p r e
Associated Set (AroundEnd (LineSegment 2 p r :+ e))
forall a. Monoid a => a
mempty Set (AroundStart (LineSegment 2 p r :+ e))
forall a. Monoid a => a
mempty Set (AroundIntersection (LineSegment 2 p r :+ e))
forall a. Monoid a => a
mempty

instance (NFData p, NFData r, NFData e) => NFData (Associated p r e)

-- | For each intersection point the segments intersecting there.
type Intersections p r e = Map.Map (Point 2 r) (Associated p r e)

-- | An intersection point together with all segments intersecting at
-- this point.
data IntersectionPoint p r e =
  IntersectionPoint { IntersectionPoint p r e -> Point 2 r
_intersectionPoint :: !(Point 2 r)
                    , IntersectionPoint p r e -> Associated p r e
_associatedSegs    :: !(Associated p r e)
                    } deriving (Int -> IntersectionPoint p r e -> ShowS
[IntersectionPoint p r e] -> ShowS
IntersectionPoint p r e -> String
(Int -> IntersectionPoint p r e -> ShowS)
-> (IntersectionPoint p r e -> String)
-> ([IntersectionPoint p r e] -> ShowS)
-> Show (IntersectionPoint p r e)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall p r e.
(Show r, Show p, Show e) =>
Int -> IntersectionPoint p r e -> ShowS
forall p r e.
(Show r, Show p, Show e) =>
[IntersectionPoint p r e] -> ShowS
forall p r e.
(Show r, Show p, Show e) =>
IntersectionPoint p r e -> String
showList :: [IntersectionPoint p r e] -> ShowS
$cshowList :: forall p r e.
(Show r, Show p, Show e) =>
[IntersectionPoint p r e] -> ShowS
show :: IntersectionPoint p r e -> String
$cshow :: forall p r e.
(Show r, Show p, Show e) =>
IntersectionPoint p r e -> String
showsPrec :: Int -> IntersectionPoint p r e -> ShowS
$cshowsPrec :: forall p r e.
(Show r, Show p, Show e) =>
Int -> IntersectionPoint p r e -> ShowS
Show,ReadPrec [IntersectionPoint p r e]
ReadPrec (IntersectionPoint p r e)
Int -> ReadS (IntersectionPoint p r e)
ReadS [IntersectionPoint p r e]
(Int -> ReadS (IntersectionPoint p r e))
-> ReadS [IntersectionPoint p r e]
-> ReadPrec (IntersectionPoint p r e)
-> ReadPrec [IntersectionPoint p r e]
-> Read (IntersectionPoint p r e)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall p r e.
(Read r, Read p, Read e, Ord r, Fractional r) =>
ReadPrec [IntersectionPoint p r e]
forall p r e.
(Read r, Read p, Read e, Ord r, Fractional r) =>
ReadPrec (IntersectionPoint p r e)
forall p r e.
(Read r, Read p, Read e, Ord r, Fractional r) =>
Int -> ReadS (IntersectionPoint p r e)
forall p r e.
(Read r, Read p, Read e, Ord r, Fractional r) =>
ReadS [IntersectionPoint p r e]
readListPrec :: ReadPrec [IntersectionPoint p r e]
$creadListPrec :: forall p r e.
(Read r, Read p, Read e, Ord r, Fractional r) =>
ReadPrec [IntersectionPoint p r e]
readPrec :: ReadPrec (IntersectionPoint p r e)
$creadPrec :: forall p r e.
(Read r, Read p, Read e, Ord r, Fractional r) =>
ReadPrec (IntersectionPoint p r e)
readList :: ReadS [IntersectionPoint p r e]
$creadList :: forall p r e.
(Read r, Read p, Read e, Ord r, Fractional r) =>
ReadS [IntersectionPoint p r e]
readsPrec :: Int -> ReadS (IntersectionPoint p r e)
$creadsPrec :: forall p r e.
(Read r, Read p, Read e, Ord r, Fractional r) =>
Int -> ReadS (IntersectionPoint p r e)
Read,IntersectionPoint p r e -> IntersectionPoint p r e -> Bool
(IntersectionPoint p r e -> IntersectionPoint p r e -> Bool)
-> (IntersectionPoint p r e -> IntersectionPoint p r e -> Bool)
-> Eq (IntersectionPoint p r e)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall p r e.
Eq r =>
IntersectionPoint p r e -> IntersectionPoint p r e -> Bool
/= :: IntersectionPoint p r e -> IntersectionPoint p r e -> Bool
$c/= :: forall p r e.
Eq r =>
IntersectionPoint p r e -> IntersectionPoint p r e -> Bool
== :: IntersectionPoint p r e -> IntersectionPoint p r e -> Bool
$c== :: forall p r e.
Eq r =>
IntersectionPoint p r e -> IntersectionPoint p r e -> Bool
Eq,(forall x.
 IntersectionPoint p r e -> Rep (IntersectionPoint p r e) x)
-> (forall x.
    Rep (IntersectionPoint p r e) x -> IntersectionPoint p r e)
-> Generic (IntersectionPoint p r e)
forall x.
Rep (IntersectionPoint p r e) x -> IntersectionPoint p r e
forall x.
IntersectionPoint p r e -> Rep (IntersectionPoint p r e) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall p r e x.
Rep (IntersectionPoint p r e) x -> IntersectionPoint p r e
forall p r e x.
IntersectionPoint p r e -> Rep (IntersectionPoint p r e) x
$cto :: forall p r e x.
Rep (IntersectionPoint p r e) x -> IntersectionPoint p r e
$cfrom :: forall p r e x.
IntersectionPoint p r e -> Rep (IntersectionPoint p r e) x
Generic,a -> IntersectionPoint p r b -> IntersectionPoint p r a
(a -> b) -> IntersectionPoint p r a -> IntersectionPoint p r b
(forall a b.
 (a -> b) -> IntersectionPoint p r a -> IntersectionPoint p r b)
-> (forall a b.
    a -> IntersectionPoint p r b -> IntersectionPoint p r a)
-> Functor (IntersectionPoint p r)
forall a b. a -> IntersectionPoint p r b -> IntersectionPoint p r a
forall a b.
(a -> b) -> IntersectionPoint p r a -> IntersectionPoint p r b
forall p r a b.
a -> IntersectionPoint p r b -> IntersectionPoint p r a
forall p r a b.
(a -> b) -> IntersectionPoint p r a -> IntersectionPoint p r b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> IntersectionPoint p r b -> IntersectionPoint p r a
$c<$ :: forall p r a b.
a -> IntersectionPoint p r b -> IntersectionPoint p r a
fmap :: (a -> b) -> IntersectionPoint p r a -> IntersectionPoint p r b
$cfmap :: forall p r a b.
(a -> b) -> IntersectionPoint p r a -> IntersectionPoint p r b
Functor)
makeLenses ''IntersectionPoint

instance (NFData p, NFData r, NFData e) => NFData (IntersectionPoint p r e)


-- sameOrder           :: (Ord r, Num r, Eq p) => Point 2 r
--                     -> [LineSegment 2 p r] -> [LineSegment 2 p r] -> Bool
-- sameOrder c ss ss' = f ss == f ss'
--   where
--     f = map (^.extra) . sortAround' (ext c) . map (\s -> s^.end.core :+ s)




-- | Given a point p, and a bunch of segments that suposedly intersect
-- at p, correctly categorize them.
mkIntersectionPoint         :: (Ord r, Fractional r)
                            => Point 2 r
                            -> [LineSegment 2 p r :+ e] -- ^ uncategorized
                            -> [LineSegment 2 p r :+ e] -- ^ segments we know contain p,
                            -> IntersectionPoint p r e
mkIntersectionPoint :: Point 2 r
-> [LineSegment 2 p r :+ e]
-> [LineSegment 2 p r :+ e]
-> IntersectionPoint p r e
mkIntersectionPoint Point 2 r
p [LineSegment 2 p r :+ e]
as [LineSegment 2 p r :+ e]
cs = Point 2 r -> Associated p r e -> IntersectionPoint p r e
forall p r e.
Point 2 r -> Associated p r e -> IntersectionPoint p r e
IntersectionPoint Point 2 r
p (Associated p r e -> IntersectionPoint p r e)
-> Associated p r e -> IntersectionPoint p r e
forall a b. (a -> b) -> a -> b
$ ((LineSegment 2 p r :+ e) -> Associated p r e)
-> [LineSegment 2 p r :+ e] -> Associated p r e
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Point 2 r -> (LineSegment 2 p r :+ e) -> Associated p r e
forall r p e.
(Ord r, Fractional r) =>
Point 2 r -> (LineSegment 2 p r :+ e) -> Associated p r e
mkAssociated Point 2 r
p) ([LineSegment 2 p r :+ e] -> Associated p r e)
-> [LineSegment 2 p r :+ e] -> Associated p r e
forall a b. (a -> b) -> a -> b
$ [LineSegment 2 p r :+ e]
as [LineSegment 2 p r :+ e]
-> [LineSegment 2 p r :+ e] -> [LineSegment 2 p r :+ e]
forall a. Semigroup a => a -> a -> a
<> [LineSegment 2 p r :+ e]
cs

  -- IntersectionPoint p
  --                           $ Associated mempty mempty (Set.fromAscList cs')
  --                           <> foldMap (mkAssociated p) as
  -- where
  --   cs' = map AroundIntersection . List.sortBy (cmpAroundP p) $ cs
  -- -- TODO: In the bentley ottman algo we already know the sorted order of the segments
  -- -- so we can likely save the additional sort



-- | An ordering that is decreasing on y, increasing on x
ordPoints     :: Ord r => Point 2 r -> Point 2 r -> Ordering
ordPoints :: Point 2 r -> Point 2 r -> Ordering
ordPoints Point 2 r
a Point 2 r
b = let f :: point d b -> (Down b, b)
f point d b
p = (b -> Down b
forall a. a -> Down a
Down (b -> Down b) -> b -> Down b
forall a b. (a -> b) -> a -> b
$ point d b
ppoint d b -> Getting b (point d b) b -> b
forall s a. s -> Getting a s a -> a
^.Getting b (point d b) b
forall (d :: Nat) (point :: Nat -> * -> *) r.
(2 <= d, Arity d, AsAPoint point) =>
Lens' (point d r) r
yCoord, point d b
ppoint d b -> Getting b (point d b) b -> b
forall s a. s -> Getting a s a -> a
^.Getting b (point d b) b
forall (d :: Nat) (point :: Nat -> * -> *) r.
(1 <= d, Arity d, AsAPoint point) =>
Lens' (point d r) r
xCoord) in (Point 2 r -> (Down r, r)) -> Point 2 r -> Point 2 r -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Point 2 r -> (Down r, r)
forall (d :: Nat) (point :: Nat -> * -> *) b.
(ImplicitPeano (Peano d), ArityPeano (Peano (FromPeano (Peano d))),
 KnownNat (FromPeano (Peano d)), KnownNat d, AsAPoint point,
 (1 <=? d) ~ 'True, (2 <=? d) ~ 'True,
 Peano (FromPeano (Peano d) + 1)
 ~ 'S (Peano (FromPeano (Peano d)))) =>
point d b -> (Down b, b)
f Point 2 r
a Point 2 r
b