{-# LANGUAGE UndecidableInstances #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Triangle
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Data types to represent Triangles
--
--------------------------------------------------------------------------------
module HGeometry.Triangle
  ( Triangle(Triangle)
  , module HGeometry.Triangle.Class


  , LineTriangleIntersection(..)
  ) where

import Control.Lens
import Data.Foldable1
import GHC.Generics (Generic)
import HGeometry.Box.Boxable
import HGeometry.Ext
import HGeometry.HalfLine
import HGeometry.Intersection
import HGeometry.Line.PointAndVector
import HGeometry.LineSegment
import HGeometry.Point
import HGeometry.Properties
import HGeometry.Transformation
import HGeometry.Triangle.Class
import HGeometry.Vector
import Hiraffe.Graph
import Text.Read

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

-- | Triangles in d-dimensional space
newtype Triangle point = MkTriangle (Vector 3 point)
  deriving ((forall x. Triangle point -> Rep (Triangle point) x)
-> (forall x. Rep (Triangle point) x -> Triangle point)
-> Generic (Triangle point)
forall x. Rep (Triangle point) x -> Triangle point
forall x. Triangle point -> Rep (Triangle point) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall point x. Rep (Triangle point) x -> Triangle point
forall point x. Triangle point -> Rep (Triangle point) x
$cfrom :: forall point x. Triangle point -> Rep (Triangle point) x
from :: forall x. Triangle point -> Rep (Triangle point) x
$cto :: forall point x. Rep (Triangle point) x -> Triangle point
to :: forall x. Rep (Triangle point) x -> Triangle point
Generic)
  deriving newtype ((forall a b. (a -> b) -> Triangle a -> Triangle b)
-> (forall a b. a -> Triangle b -> Triangle a) -> Functor Triangle
forall a b. a -> Triangle b -> Triangle a
forall a b. (a -> b) -> Triangle a -> Triangle b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Triangle a -> Triangle b
fmap :: forall a b. (a -> b) -> Triangle a -> Triangle b
$c<$ :: forall a b. a -> Triangle b -> Triangle a
<$ :: forall a b. a -> Triangle b -> Triangle a
Functor,(forall m. Monoid m => Triangle m -> m)
-> (forall m a. Monoid m => (a -> m) -> Triangle a -> m)
-> (forall m a. Monoid m => (a -> m) -> Triangle a -> m)
-> (forall a b. (a -> b -> b) -> b -> Triangle a -> b)
-> (forall a b. (a -> b -> b) -> b -> Triangle a -> b)
-> (forall b a. (b -> a -> b) -> b -> Triangle a -> b)
-> (forall b a. (b -> a -> b) -> b -> Triangle a -> b)
-> (forall a. (a -> a -> a) -> Triangle a -> a)
-> (forall a. (a -> a -> a) -> Triangle a -> a)
-> (forall a. Triangle a -> [a])
-> (forall a. Triangle a -> Bool)
-> (forall a. Triangle a -> Int)
-> (forall a. Eq a => a -> Triangle a -> Bool)
-> (forall a. Ord a => Triangle a -> a)
-> (forall a. Ord a => Triangle a -> a)
-> (forall a. Num a => Triangle a -> a)
-> (forall a. Num a => Triangle a -> a)
-> Foldable Triangle
forall a. Eq a => a -> Triangle a -> Bool
forall a. Num a => Triangle a -> a
forall a. Ord a => Triangle a -> a
forall m. Monoid m => Triangle m -> m
forall a. Triangle a -> Bool
forall a. Triangle a -> Int
forall a. Triangle a -> [a]
forall a. (a -> a -> a) -> Triangle a -> a
forall m a. Monoid m => (a -> m) -> Triangle a -> m
forall b a. (b -> a -> b) -> b -> Triangle a -> b
forall a b. (a -> b -> b) -> b -> Triangle a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Triangle m -> m
fold :: forall m. Monoid m => Triangle m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Triangle a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Triangle a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Triangle a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Triangle a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Triangle a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Triangle a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Triangle a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Triangle a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Triangle a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Triangle a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Triangle a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Triangle a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Triangle a -> a
foldr1 :: forall a. (a -> a -> a) -> Triangle a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Triangle a -> a
foldl1 :: forall a. (a -> a -> a) -> Triangle a -> a
$ctoList :: forall a. Triangle a -> [a]
toList :: forall a. Triangle a -> [a]
$cnull :: forall a. Triangle a -> Bool
null :: forall a. Triangle a -> Bool
$clength :: forall a. Triangle a -> Int
length :: forall a. Triangle a -> Int
$celem :: forall a. Eq a => a -> Triangle a -> Bool
elem :: forall a. Eq a => a -> Triangle a -> Bool
$cmaximum :: forall a. Ord a => Triangle a -> a
maximum :: forall a. Ord a => Triangle a -> a
$cminimum :: forall a. Ord a => Triangle a -> a
minimum :: forall a. Ord a => Triangle a -> a
$csum :: forall a. Num a => Triangle a -> a
sum :: forall a. Num a => Triangle a -> a
$cproduct :: forall a. Num a => Triangle a -> a
product :: forall a. Num a => Triangle a -> a
Foldable,Triangle point -> Triangle point
(Triangle point -> Triangle point) -> Reversing (Triangle point)
forall point. Triangle point -> Triangle point
forall t. (t -> t) -> Reversing t
$creversing :: forall point. Triangle point -> Triangle point
reversing :: Triangle point -> Triangle point
Reversing)

-- | Construct a triangle from its three points
pattern Triangle       :: point -> point -> point -> Triangle point
pattern $bTriangle :: forall point. point -> point -> point -> Triangle point
$mTriangle :: forall {r} {point}.
Triangle point
-> (point -> point -> point -> r) -> ((# #) -> r) -> r
Triangle a b c = MkTriangle (Vector3 a b c)
{-# COMPLETE Triangle #-}

instance Traversable Triangle where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Triangle a -> f (Triangle b)
traverse a -> f b
f (MkTriangle Vector 3 a
v) = Vector 3 b -> Triangle b
forall point. Vector 3 point -> Triangle point
MkTriangle (Vector 3 b -> Triangle b) -> f (Vector 3 b) -> f (Triangle b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Vector 3 a -> f (Vector 3 b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Vector 3 a -> f (Vector 3 b)
traverse a -> f b
f Vector 3 a
v

instance Foldable1 Triangle where
  foldMap1 :: forall m a. Semigroup m => (a -> m) -> Triangle a -> m
foldMap1 a -> m
f (MkTriangle Vector 3 a
v) = (a -> m) -> Vector 3 a -> m
forall m a. Semigroup m => (a -> m) -> Vector 3 a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f Vector 3 a
v

instance Traversable1 Triangle where
  traverse1 :: forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> Triangle a -> f (Triangle b)
traverse1 a -> f b
f (MkTriangle Vector 3 a
v) = Vector 3 b -> Triangle b
forall point. Vector 3 point -> Triangle point
MkTriangle (Vector 3 b -> Triangle b) -> f (Vector 3 b) -> f (Triangle b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Vector 3 a -> f (Vector 3 b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> Vector 3 a -> f (Vector 3 b)
traverse1 a -> f b
f Vector 3 a
v


deriving instance Eq  (Vector 3 point) => Eq (Triangle point)
deriving instance Ord (Vector 3 point) => Ord (Triangle point)

type instance Dimension (Triangle point) = Dimension point
type instance NumType   (Triangle point) = NumType point

-- | Iso between a triangle and a vector of three points
_TriangleVector :: Iso (Triangle point) (Triangle point') (Vector 3 point) (Vector 3 point')
_TriangleVector :: forall point point' (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Vector 3 point) (f (Vector 3 point'))
-> p (Triangle point) (f (Triangle point'))
_TriangleVector = (Triangle point -> Vector 3 point)
-> (Vector 3 point' -> Triangle point')
-> Iso
     (Triangle point)
     (Triangle point')
     (Vector 3 point)
     (Vector 3 point')
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(MkTriangle Vector 3 point
v) -> Vector 3 point
v) Vector 3 point' -> Triangle point'
forall point. Vector 3 point -> Triangle point
MkTriangle

instance ( Point_ point (Dimension point) (NumType point)
         ) => Triangle_ (Triangle point) point where
  corners :: Lens' (Triangle point) (Vector 3 point)
corners = (Vector 3 point -> f (Vector 3 point))
-> Triangle point -> f (Triangle point)
forall point point' (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Vector 3 point) (f (Vector 3 point'))
-> p (Triangle point) (f (Triangle point'))
_TriangleVector

instance ( Point_ point (Dimension point) (NumType point)
         ) => ConstructableTriangle_ (Triangle point) point where
  mkTriangle :: point -> point -> point -> Triangle point
mkTriangle = point -> point -> point -> Triangle point
forall point. point -> point -> point -> Triangle point
Triangle

instance HasVertices' (Triangle point) where
  type Vertex   (Triangle point) = point
  type VertexIx (Triangle point) = Int -- make this an AtMostThree?
  vertexAt :: VertexIx (Triangle point)
-> IndexedTraversal'
     (VertexIx (Triangle point))
     (Triangle point)
     (Vertex (Triangle point))
vertexAt VertexIx (Triangle point)
i = (Vector 3 point -> f (Vector 3 point))
-> Triangle point -> f (Triangle point)
forall point point' (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Vector 3 point) (f (Vector 3 point'))
-> p (Triangle point) (f (Triangle point'))
_TriangleVector((Vector 3 point -> f (Vector 3 point))
 -> Triangle point -> f (Triangle point))
-> (p point (f point) -> Vector 3 point -> f (Vector 3 point))
-> p point (f point)
-> Triangle point
-> f (Triangle point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Index (Vector 3 point)
-> IndexedTraversal'
     (Index (Vector 3 point))
     (Vector 3 point)
     (IxValue (Vector 3 point))
forall m.
Ixed m =>
Index m -> IndexedTraversal' (Index m) m (IxValue m)
iix VertexIx (Triangle point)
Index (Vector 3 point)
i
  numVertices :: Triangle point -> Int
numVertices = Int -> Triangle point -> Int
forall a b. a -> b -> a
const Int
3

instance HasVertices (Triangle point) (Triangle point') where
  vertices :: IndexedTraversal1
  (VertexIx (Triangle point))
  (Triangle point)
  (Triangle point')
  (Vertex (Triangle point))
  (Vertex (Triangle point'))
vertices = AnIndexedTraversal1
  Int (Triangle point) (Triangle point') point point'
-> IndexedTraversal1
     Int (Triangle point) (Triangle point') point point'
forall i s t a b.
AnIndexedTraversal1 i s t a b -> IndexedTraversal1 i s t a b
cloneIndexedTraversal1 ((Vector 3 point
 -> Bazaar1 (Indexed Int) point point' (Vector 3 point'))
-> Triangle point
-> Bazaar1 (Indexed Int) point point' (Triangle point')
forall point point' (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Vector 3 point) (f (Vector 3 point'))
-> p (Triangle point) (f (Triangle point'))
_TriangleVector((Vector 3 point
  -> Bazaar1 (Indexed Int) point point' (Vector 3 point'))
 -> Triangle point
 -> Bazaar1 (Indexed Int) point point' (Triangle point'))
-> (Indexed Int point (Bazaar1 (Indexed Int) point point' point')
    -> Vector 3 point
    -> Bazaar1 (Indexed Int) point point' (Vector 3 point'))
-> AnIndexedTraversal1
     Int (Triangle point) (Triangle point') point point'
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Indexed Int point (Bazaar1 (Indexed Int) point point' point')
-> Vector 3 point
-> Bazaar1 (Indexed Int) point point' (Vector 3 point')
Indexed
  Int
  (IxValue (Vector 3 point))
  (Bazaar1 (Indexed Int) point point' (IxValue (Vector 3 point')))
-> Vector 3 point
-> Bazaar1 (Indexed Int) point point' (Vector 3 point')
forall vector vector'.
HasComponents vector vector' =>
IndexedTraversal1
  Int vector vector' (IxValue vector) (IxValue vector')
IndexedTraversal1
  Int
  (Vector 3 point)
  (Vector 3 point')
  (IxValue (Vector 3 point))
  (IxValue (Vector 3 point'))
components)



instance HasEdges' (Triangle point) where
  type Edge  (Triangle point)  = (point, point)
  -- ^ Indices are taken modulo 3, The edges of a Triangle a b c are ordered (a,b), (b,c),
  -- (c,a)
  type EdgeIx (Triangle point) = Int
-- (p :: Type -> Type -> Type) (f :: Type -> Type). (Indexable i p, Applicative f) => p a (f b) -> s -> f t
  edgeAt :: EdgeIx (Triangle point)
-> IndexedTraversal'
     (EdgeIx (Triangle point)) (Triangle point) (Edge (Triangle point))
edgeAt EdgeIx (Triangle point)
i = \p (Edge (Triangle point)) (f (Edge (Triangle point)))
pEdgeFEdge (Triangle point
a point
b point
c) -> case Int
EdgeIx (Triangle point)
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
3 of
      Int
0 -> (\(point
a',point
b') -> point -> point -> point -> Triangle point
forall point. point -> point -> point -> Triangle point
Triangle point
a' point
b' point
c ) ((point, point) -> Triangle point)
-> f (point, point) -> f (Triangle point)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p (point, point) (f (point, point))
-> Int -> (point, point) -> f (point, point)
forall a b. p a b -> Int -> a -> b
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p (point, point) (f (point, point))
p (Edge (Triangle point)) (f (Edge (Triangle point)))
pEdgeFEdge (Int
0 :: Int) (point
a,point
b)
      Int
1 -> (\(point
b',point
c') -> point -> point -> point -> Triangle point
forall point. point -> point -> point -> Triangle point
Triangle point
a  point
b' point
c') ((point, point) -> Triangle point)
-> f (point, point) -> f (Triangle point)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p (point, point) (f (point, point))
-> Int -> (point, point) -> f (point, point)
forall a b. p a b -> Int -> a -> b
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p (point, point) (f (point, point))
p (Edge (Triangle point)) (f (Edge (Triangle point)))
pEdgeFEdge (Int
1 :: Int) (point
b,point
c)
      Int
_ -> (\(point
c',point
a') -> point -> point -> point -> Triangle point
forall point. point -> point -> point -> Triangle point
Triangle point
a' point
b  point
c') ((point, point) -> Triangle point)
-> f (point, point) -> f (Triangle point)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p (point, point) (f (point, point))
-> Int -> (point, point) -> f (point, point)
forall a b. p a b -> Int -> a -> b
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p (point, point) (f (point, point))
p (Edge (Triangle point)) (f (Edge (Triangle point)))
pEdgeFEdge (Int
2 :: Int) (point
c,point
a)
  {-# INLINE edgeAt #-}
  numEdges :: Triangle point -> Int
numEdges = Int -> Triangle point -> Int
forall a b. a -> b -> a
const Int
3


-- instance HasEdges (Triangle point) (Triangle point) where
--   edges = conjoined trav (itrav.indexed)
--     where
--       trav  f (Triangle a b c) = Triangle <$> f   (a,b) <*> f   (b,c) <*> f   (c,a)
--       itrav f (Triangle a b c) = Triangle <$> f 0 (a,b) <*> f 1 (b,c) <*> f 2 (c,a)
--   {-# INLINE edges #-}

-- TODO: Hmm, the edges instance is weird; i.e. if we modify a in both (a,b) and in (c,a)
-- which a do we use !?


-- data AtMostThree = One | Two | Three
--   deriving (Show,Read,Eq,Ord,Enum,Bounded)

-- instance HasEdges' (Triangle point) where
--   type Edge  (Triangle point)  = (point, point)
--   type EdgeIx (Triangle point) = AtMostThree

-- -- p a (f b) -> s -> f t
--   edgeAt i =
--   (Triangle a b c) = case i of
--     One   ->
--     Two   ->
--     Three ->

--   numEdges = const 3


instance HasPoints (Triangle point) (Triangle point') point point' where
  allPoints :: forall (d :: Nat) r r'.
(Point_ point d r, Point_ point' d r',
 NumType (Triangle point) ~ r, NumType (Triangle point') ~ r',
 Dimension (Triangle point) ~ d, Dimension (Triangle point') ~ d) =>
Traversal1 (Triangle point) (Triangle point') point point'
allPoints = (Vector 3 point -> f (Vector 3 point'))
-> Triangle point -> f (Triangle point')
forall point point' (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Vector 3 point) (f (Vector 3 point'))
-> p (Triangle point) (f (Triangle point'))
_TriangleVector((Vector 3 point -> f (Vector 3 point'))
 -> Triangle point -> f (Triangle point'))
-> ((point -> f point') -> Vector 3 point -> f (Vector 3 point'))
-> (point -> f point')
-> Triangle point
-> f (Triangle point')
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(point -> f point') -> Vector 3 point -> f (Vector 3 point')
(IxValue (Vector 3 point) -> f (IxValue (Vector 3 point')))
-> Vector 3 point -> f (Vector 3 point')
forall vector vector'.
HasComponents vector vector' =>
IndexedTraversal1
  Int vector vector' (IxValue vector) (IxValue vector')
IndexedTraversal1
  Int
  (Vector 3 point)
  (Vector 3 point')
  (IxValue (Vector 3 point))
  (IxValue (Vector 3 point'))
components

instance ( DefaultTransformByConstraints (Triangle point) d r
         , Point_ point d r
         ) => IsTransformable (Triangle point)

instance (Show point) => Show (Triangle point) where
  showsPrec :: Int -> Triangle point -> ShowS
showsPrec Int
k (Triangle point
a point
b point
c ) = Bool -> ShowS -> ShowS
showParen (Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
                                    String -> ShowS
showString String
"Triangle "
                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> point -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
appPrecInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) point
a
                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> point -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
appPrecInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) point
b
                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> point -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
appPrecInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) point
c

appPrec :: Int
appPrec :: Int
appPrec = Int
10

instance (Read point) => Read (Triangle point) where
  readPrec :: ReadPrec (Triangle point)
readPrec = ReadPrec (Triangle point) -> ReadPrec (Triangle point)
forall a. ReadPrec a -> ReadPrec a
parens (Int -> ReadPrec (Triangle point) -> ReadPrec (Triangle point)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
appPrec (ReadPrec (Triangle point) -> ReadPrec (Triangle point))
-> ReadPrec (Triangle point) -> ReadPrec (Triangle point)
forall a b. (a -> b) -> a -> b
$ do
                          Ident "Triangle" <- ReadPrec Lexeme
lexP
                          b <- step readPrec
                          a <- step readPrec
                          c <- step readPrec
                          return (Triangle a b c))

instance ( Point_ point d r
         , Ord (Vector d r)
         ) => IsBoxable (Triangle point)

instance ( Point_ point 2 r
         , Num r, Ord r
         ) => HasIntersectionWith (Point 2 r) (Triangle point) where
  Point 2 r
q intersects :: Point 2 r -> Triangle point -> Bool
`intersects` Triangle point
t = Getting
  All (Vector 3 (HalfSpaceF (LinePV 2 r))) (HalfSpaceF (LinePV 2 r))
-> (HalfSpaceF (LinePV 2 r) -> Bool)
-> Vector 3 (HalfSpaceF (LinePV 2 r))
-> Bool
forall s a. Getting All s a -> (a -> Bool) -> s -> Bool
allOf (IxValue (Vector 3 (HalfSpaceF (LinePV 2 r)))
 -> Const All (IxValue (Vector 3 (HalfSpaceF (LinePV 2 r)))))
-> Vector 3 (HalfSpaceF (LinePV 2 r))
-> Const All (Vector 3 (HalfSpaceF (LinePV 2 r)))
Getting
  All (Vector 3 (HalfSpaceF (LinePV 2 r))) (HalfSpaceF (LinePV 2 r))
forall vector vector'.
HasComponents vector vector' =>
IndexedTraversal1
  Int vector vector' (IxValue vector) (IxValue vector')
IndexedTraversal1
  Int
  (Vector 3 (HalfSpaceF (LinePV 2 r)))
  (Vector 3 (HalfSpaceF (LinePV 2 r)))
  (IxValue (Vector 3 (HalfSpaceF (LinePV 2 r))))
  (IxValue (Vector 3 (HalfSpaceF (LinePV 2 r))))
components (Point 2 r
q Point 2 r -> HalfSpaceF (LinePV 2 r) -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects`) (Vector 3 (HalfSpaceF (LinePV 2 r)) -> Bool)
-> Vector 3 (HalfSpaceF (LinePV 2 r)) -> Bool
forall a b. (a -> b) -> a -> b
$ Triangle point -> Vector 3 (HalfSpaceF (LinePV 2 r))
forall triangle point r.
(Triangle_ triangle point, Point_ point 2 r, Num r, Ord r) =>
triangle -> Vector 3 (HalfSpaceF (LinePV 2 r))
intersectingHalfPlanes Triangle point
t


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


-- | Data type desciribn the intersection between an oriented line in R^3 and a triangle
data LineTriangleIntersection point seg =
    Line_x_Triangle_Point point
  | Line_x_Triangle_LineSegment seg
  deriving (Int -> LineTriangleIntersection point seg -> ShowS
[LineTriangleIntersection point seg] -> ShowS
LineTriangleIntersection point seg -> String
(Int -> LineTriangleIntersection point seg -> ShowS)
-> (LineTriangleIntersection point seg -> String)
-> ([LineTriangleIntersection point seg] -> ShowS)
-> Show (LineTriangleIntersection point seg)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall point seg.
(Show point, Show seg) =>
Int -> LineTriangleIntersection point seg -> ShowS
forall point seg.
(Show point, Show seg) =>
[LineTriangleIntersection point seg] -> ShowS
forall point seg.
(Show point, Show seg) =>
LineTriangleIntersection point seg -> String
$cshowsPrec :: forall point seg.
(Show point, Show seg) =>
Int -> LineTriangleIntersection point seg -> ShowS
showsPrec :: Int -> LineTriangleIntersection point seg -> ShowS
$cshow :: forall point seg.
(Show point, Show seg) =>
LineTriangleIntersection point seg -> String
show :: LineTriangleIntersection point seg -> String
$cshowList :: forall point seg.
(Show point, Show seg) =>
[LineTriangleIntersection point seg] -> ShowS
showList :: [LineTriangleIntersection point seg] -> ShowS
Show,LineTriangleIntersection point seg
-> LineTriangleIntersection point seg -> Bool
(LineTriangleIntersection point seg
 -> LineTriangleIntersection point seg -> Bool)
-> (LineTriangleIntersection point seg
    -> LineTriangleIntersection point seg -> Bool)
-> Eq (LineTriangleIntersection point seg)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall point seg.
(Eq point, Eq seg) =>
LineTriangleIntersection point seg
-> LineTriangleIntersection point seg -> Bool
$c== :: forall point seg.
(Eq point, Eq seg) =>
LineTriangleIntersection point seg
-> LineTriangleIntersection point seg -> Bool
== :: LineTriangleIntersection point seg
-> LineTriangleIntersection point seg -> Bool
$c/= :: forall point seg.
(Eq point, Eq seg) =>
LineTriangleIntersection point seg
-> LineTriangleIntersection point seg -> Bool
/= :: LineTriangleIntersection point seg
-> LineTriangleIntersection point seg -> Bool
Eq,Eq (LineTriangleIntersection point seg)
Eq (LineTriangleIntersection point seg) =>
(LineTriangleIntersection point seg
 -> LineTriangleIntersection point seg -> Ordering)
-> (LineTriangleIntersection point seg
    -> LineTriangleIntersection point seg -> Bool)
-> (LineTriangleIntersection point seg
    -> LineTriangleIntersection point seg -> Bool)
-> (LineTriangleIntersection point seg
    -> LineTriangleIntersection point seg -> Bool)
-> (LineTriangleIntersection point seg
    -> LineTriangleIntersection point seg -> Bool)
-> (LineTriangleIntersection point seg
    -> LineTriangleIntersection point seg
    -> LineTriangleIntersection point seg)
-> (LineTriangleIntersection point seg
    -> LineTriangleIntersection point seg
    -> LineTriangleIntersection point seg)
-> Ord (LineTriangleIntersection point seg)
LineTriangleIntersection point seg
-> LineTriangleIntersection point seg -> Bool
LineTriangleIntersection point seg
-> LineTriangleIntersection point seg -> Ordering
LineTriangleIntersection point seg
-> LineTriangleIntersection point seg
-> LineTriangleIntersection point seg
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall point seg.
(Ord point, Ord seg) =>
Eq (LineTriangleIntersection point seg)
forall point seg.
(Ord point, Ord seg) =>
LineTriangleIntersection point seg
-> LineTriangleIntersection point seg -> Bool
forall point seg.
(Ord point, Ord seg) =>
LineTriangleIntersection point seg
-> LineTriangleIntersection point seg -> Ordering
forall point seg.
(Ord point, Ord seg) =>
LineTriangleIntersection point seg
-> LineTriangleIntersection point seg
-> LineTriangleIntersection point seg
$ccompare :: forall point seg.
(Ord point, Ord seg) =>
LineTriangleIntersection point seg
-> LineTriangleIntersection point seg -> Ordering
compare :: LineTriangleIntersection point seg
-> LineTriangleIntersection point seg -> Ordering
$c< :: forall point seg.
(Ord point, Ord seg) =>
LineTriangleIntersection point seg
-> LineTriangleIntersection point seg -> Bool
< :: LineTriangleIntersection point seg
-> LineTriangleIntersection point seg -> Bool
$c<= :: forall point seg.
(Ord point, Ord seg) =>
LineTriangleIntersection point seg
-> LineTriangleIntersection point seg -> Bool
<= :: LineTriangleIntersection point seg
-> LineTriangleIntersection point seg -> Bool
$c> :: forall point seg.
(Ord point, Ord seg) =>
LineTriangleIntersection point seg
-> LineTriangleIntersection point seg -> Bool
> :: LineTriangleIntersection point seg
-> LineTriangleIntersection point seg -> Bool
$c>= :: forall point seg.
(Ord point, Ord seg) =>
LineTriangleIntersection point seg
-> LineTriangleIntersection point seg -> Bool
>= :: LineTriangleIntersection point seg
-> LineTriangleIntersection point seg -> Bool
$cmax :: forall point seg.
(Ord point, Ord seg) =>
LineTriangleIntersection point seg
-> LineTriangleIntersection point seg
-> LineTriangleIntersection point seg
max :: LineTriangleIntersection point seg
-> LineTriangleIntersection point seg
-> LineTriangleIntersection point seg
$cmin :: forall point seg.
(Ord point, Ord seg) =>
LineTriangleIntersection point seg
-> LineTriangleIntersection point seg
-> LineTriangleIntersection point seg
min :: LineTriangleIntersection point seg
-> LineTriangleIntersection point seg
-> LineTriangleIntersection point seg
Ord,(forall a b.
 (a -> b)
 -> LineTriangleIntersection point a
 -> LineTriangleIntersection point b)
-> (forall a b.
    a
    -> LineTriangleIntersection point b
    -> LineTriangleIntersection point a)
-> Functor (LineTriangleIntersection point)
forall a b.
a
-> LineTriangleIntersection point b
-> LineTriangleIntersection point a
forall a b.
(a -> b)
-> LineTriangleIntersection point a
-> LineTriangleIntersection point b
forall point a b.
a
-> LineTriangleIntersection point b
-> LineTriangleIntersection point a
forall point a b.
(a -> b)
-> LineTriangleIntersection point a
-> LineTriangleIntersection point b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall point a b.
(a -> b)
-> LineTriangleIntersection point a
-> LineTriangleIntersection point b
fmap :: forall a b.
(a -> b)
-> LineTriangleIntersection point a
-> LineTriangleIntersection point b
$c<$ :: forall point a b.
a
-> LineTriangleIntersection point b
-> LineTriangleIntersection point a
<$ :: forall a b.
a
-> LineTriangleIntersection point b
-> LineTriangleIntersection point a
Functor)

instance Bifunctor LineTriangleIntersection where
  bimap :: forall a b c d.
(a -> b)
-> (c -> d)
-> LineTriangleIntersection a c
-> LineTriangleIntersection b d
bimap a -> b
f c -> d
g = \case
    Line_x_Triangle_Point a
p       -> b -> LineTriangleIntersection b d
forall point seg. point -> LineTriangleIntersection point seg
Line_x_Triangle_Point (a -> b
f a
p)
    Line_x_Triangle_LineSegment c
s -> d -> LineTriangleIntersection b d
forall point seg. seg -> LineTriangleIntersection point seg
Line_x_Triangle_LineSegment (c -> d
g c
s)

-- | The extra value is the parameter t so that the intersection point
-- is line^.anchor + t*line^.direction
type instance Intersection (LinePV 3 r) (Triangle point') =
    Maybe (LineTriangleIntersection (Point 3 r :+ r) (ClosedLineSegment (Point 3 r :+ r)))

-- | Same here, we also return the parameter at which the ray intersects the point
type instance Intersection (HalfLine point) (Triangle point') =
    Maybe (LineTriangleIntersection
            (Point 3 (NumType point) :+ NumType point)
            (ClosedLineSegment (Point 3 (NumType point) :+ NumType point))
          )

instance ( Point_ point  3 r
         , Fractional r, Ord r
         ) => HasIntersectionWith (LinePV 3 r) (Triangle point)

instance ( Point_ point  3 r
         , Fractional r, Ord r
         ) => IsIntersectableWith (LinePV 3 r) (Triangle point) where
  LinePV 3 r
l intersect :: LinePV 3 r
-> Triangle point -> Intersection (LinePV 3 r) (Triangle point)
`intersect` Triangle point
tri = LinePV 3 r
-> Triangle (Point 3 r)
-> Maybe
     (LineTriangleIntersection
        (Point 3 r :+ r) (ClosedLineSegment (Point 3 r :+ r)))
forall r.
(Ord r, Fractional r) =>
LinePV 3 r
-> Triangle (Point 3 r)
-> Maybe
     (LineTriangleIntersection
        (Point 3 r :+ r) (ClosedLineSegment (Point 3 r :+ r)))
directedLineTriangleIntersect LinePV 3 r
l (Getting (Point 3 r) point (Point 3 r) -> point -> Point 3 r
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Point 3 r) point (Point 3 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 3 r)
asPoint (point -> Point 3 r) -> Triangle point -> Triangle (Point 3 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Triangle point
tri)

-- | Computes the intersection between an oriented line and a triangle.
-- If the result is an intersection point p; it also returns the parameter t
-- describing the intersection point along the line. I.e. so that p = o + t*v
-- where o is the anchorPoint of the line, and v is its direciton vector.
--
-- see https://en.wikipedia.org/wiki/M%C3%B6ller%E2%80%93Trumbore_intersection_algorithm
-- for the implementation details.
-- as well as
-- https://www.tandfonline.com/doi/abs/10.1080/10867651.1997.10487468
directedLineTriangleIntersect :: (Ord r, Fractional r)
                              => LinePV 3 r -> Triangle (Point 3 r)
                              -> Maybe (LineTriangleIntersection
                                            (Point 3 r :+ r)
                                            (ClosedLineSegment (Point 3 r :+ r))
                                       )
directedLineTriangleIntersect :: forall r.
(Ord r, Fractional r) =>
LinePV 3 r
-> Triangle (Point 3 r)
-> Maybe
     (LineTriangleIntersection
        (Point 3 r :+ r) (ClosedLineSegment (Point 3 r :+ r)))
directedLineTriangleIntersect (LinePV Point 3 r
o Vector 3 r
vec) (Triangle Point 3 r
a Point 3 r
b Point 3 r
c)
    | Bool
lineAndTriangleParallel = String
-> Maybe
     (LineTriangleIntersection
        (Point 3 r :+ r) (ClosedLineSegment (Point 3 r :+ r)))
forall a. HasCallStack => String -> a
error String
"(Half)Line x Triangle colinear not implemented yet"
        -- FIXME might we not intersect in a line segment here?
    | Bool
lineIntersectsTriangle  = LineTriangleIntersection
  (Point 3 r :+ r) (ClosedLineSegment (Point 3 r :+ r))
-> Maybe
     (LineTriangleIntersection
        (Point 3 r :+ r) (ClosedLineSegment (Point 3 r :+ r)))
forall a. a -> Maybe a
Just (LineTriangleIntersection
   (Point 3 r :+ r) (ClosedLineSegment (Point 3 r :+ r))
 -> Maybe
      (LineTriangleIntersection
         (Point 3 r :+ r) (ClosedLineSegment (Point 3 r :+ r))))
-> ((Point 3 r :+ r)
    -> LineTriangleIntersection
         (Point 3 r :+ r) (ClosedLineSegment (Point 3 r :+ r)))
-> (Point 3 r :+ r)
-> Maybe
     (LineTriangleIntersection
        (Point 3 r :+ r) (ClosedLineSegment (Point 3 r :+ r)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point 3 r :+ r)
-> LineTriangleIntersection
     (Point 3 r :+ r) (ClosedLineSegment (Point 3 r :+ r))
forall point seg. point -> LineTriangleIntersection point seg
Line_x_Triangle_Point ((Point 3 r :+ r)
 -> Maybe
      (LineTriangleIntersection
         (Point 3 r :+ r) (ClosedLineSegment (Point 3 r :+ r))))
-> (Point 3 r :+ r)
-> Maybe
     (LineTriangleIntersection
        (Point 3 r :+ r) (ClosedLineSegment (Point 3 r :+ r)))
forall a b. (a -> b) -> a -> b
$ (Point 3 r
o Point 3 r -> Vector 3 r -> Point 3 r
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> Vector d r -> point
.+^ (r
t r -> Vector 3 r -> Vector 3 r
forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
r -> vector -> vector
*^ Vector 3 r
vec)) Point 3 r -> r -> Point 3 r :+ r
forall core extra. core -> extra -> core :+ extra
:+ r
t
    | Bool
otherwise               = Maybe
  (LineTriangleIntersection
     (Point 3 r :+ r) (ClosedLineSegment (Point 3 r :+ r)))
forall a. Maybe a
Nothing
  where
    lineAndTriangleParallel :: Bool
lineAndTriangleParallel = r
det r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== r
0

    e1 :: Vector 3 r
e1 = Point 3 r
b Point 3 r -> Point 3 r -> Vector 3 r
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> point -> Vector d r
.-. Point 3 r
a
    e2 :: Vector 3 r
e2 = Point 3 r
c Point 3 r -> Point 3 r -> Vector 3 r
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> point -> Vector d r
.-. Point 3 r
a

    rayCrossE2 :: Vector 3 r
rayCrossE2 = Vector 3 r
vec Vector 3 r -> Vector 3 r -> Vector 3 r
forall r. Num r => Vector 3 r -> Vector 3 r -> Vector 3 r
`cross` Vector 3 r
e2

    det :: r
det = Vector 3 r
e1 Vector 3 r -> Vector 3 r -> r
forall vector (d :: Nat) r.
(Metric_ vector d r, Num r) =>
vector -> vector -> r
`dot` Vector 3 r
rayCrossE2
    invDet :: r
invDet = r
1 r -> r -> r
forall a. Fractional a => a -> a -> a
/ r
det

    s :: Vector 3 r
s = Point 3 r
o Point 3 r -> Point 3 r -> Vector 3 r
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> point -> Vector d r
.-. Point 3 r
a
    u :: r
u = r
invDet r -> r -> r
forall a. Num a => a -> a -> a
* (Vector 3 r
s Vector 3 r -> Vector 3 r -> r
forall vector (d :: Nat) r.
(Metric_ vector d r, Num r) =>
vector -> vector -> r
`dot` Vector 3 r
rayCrossE2)

    sCrossE1 :: Vector 3 r
sCrossE1 = Vector 3 r
s Vector 3 r -> Vector 3 r -> Vector 3 r
forall r. Num r => Vector 3 r -> Vector 3 r -> Vector 3 r
`cross` Vector 3 r
e1
    v :: r
v = r
invDet r -> r -> r
forall a. Num a => a -> a -> a
* (Vector 3 r
vec Vector 3 r -> Vector 3 r -> r
forall vector (d :: Nat) r.
(Metric_ vector d r, Num r) =>
vector -> vector -> r
`dot` Vector 3 r
sCrossE1)

    lineIntersectsTriangle :: Bool
lineIntersectsTriangle = r
0 r -> r -> Bool
forall a. Ord a => a -> a -> Bool
<= r
u Bool -> Bool -> Bool
&& r
u       r -> r -> Bool
forall a. Ord a => a -> a -> Bool
<= r
1
                          Bool -> Bool -> Bool
&& r
0 r -> r -> Bool
forall a. Ord a => a -> a -> Bool
<= r
v Bool -> Bool -> Bool
&& (r
u r -> r -> r
forall a. Num a => a -> a -> a
+ r
v) r -> r -> Bool
forall a. Ord a => a -> a -> Bool
<= r
1
    -- the u <= 1 is slightly suplurfous, but may speed up the equation.

    -- the parameter along the line at which the line intersects the triangle
    t :: r
t = r
invDet r -> r -> r
forall a. Num a => a -> a -> a
* (Vector 3 r
e2 Vector 3 r -> Vector 3 r -> r
forall vector (d :: Nat) r.
(Metric_ vector d r, Num r) =>
vector -> vector -> r
`dot` Vector 3 r
sCrossE1)


instance ( Point_ point  3 r
         , Point_ point' 3 r
         , Fractional r, Ord r
         ) => HasIntersectionWith (HalfLine point) (Triangle point')

instance ( Point_ point  3 r
         , Point_ point' 3 r
         , Fractional r, Ord r
         ) => IsIntersectableWith (HalfLine point) (Triangle point') where
  HalfLine point
ray intersect :: HalfLine point
-> Triangle point'
-> Intersection (HalfLine point) (Triangle point')
`intersect` Triangle point'
tri = case LinePV 3 r
-> Triangle (Point 3 r)
-> Maybe
     (LineTriangleIntersection
        (Point 3 r :+ r) (ClosedLineSegment (Point 3 r :+ r)))
forall r.
(Ord r, Fractional r) =>
LinePV 3 r
-> Triangle (Point 3 r)
-> Maybe
     (LineTriangleIntersection
        (Point 3 r :+ r) (ClosedLineSegment (Point 3 r :+ r)))
directedLineTriangleIntersect (HalfLine point -> LinePV (Dimension point) (NumType point)
forall {s}.
Point_ s (Dimension s) (NumType s) =>
HalfLine s -> LinePV (Dimension s) (NumType s)
toLine HalfLine point
ray) (Getting (Point 3 r) point' (Point 3 r) -> point' -> Point 3 r
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Point 3 r) point' (Point 3 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point' (Point 3 r)
asPoint (point' -> Point 3 r) -> Triangle point' -> Triangle (Point 3 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Triangle point'
tri) of
      Just (Line_x_Triangle_Point Point 3 r :+ r
p) | Point 3 r :+ r
p(Point 3 r :+ r) -> Getting r (Point 3 r :+ r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Point 3 r :+ r) r
forall core extra extra' (f :: * -> *).
Functor f =>
(extra -> f extra') -> (core :+ extra) -> f (core :+ extra')
extra r -> r -> Bool
forall a. Ord a => a -> a -> Bool
>= r
0 -> LineTriangleIntersection
  (Point 3 r :+ r) (ClosedLineSegment (Point 3 r :+ r))
-> Maybe
     (LineTriangleIntersection
        (Point 3 r :+ r) (ClosedLineSegment (Point 3 r :+ r)))
forall a. a -> Maybe a
Just (LineTriangleIntersection
   (Point 3 r :+ r) (ClosedLineSegment (Point 3 r :+ r))
 -> Maybe
      (LineTriangleIntersection
         (Point 3 r :+ r) (ClosedLineSegment (Point 3 r :+ r))))
-> LineTriangleIntersection
     (Point 3 r :+ r) (ClosedLineSegment (Point 3 r :+ r))
-> Maybe
     (LineTriangleIntersection
        (Point 3 r :+ r) (ClosedLineSegment (Point 3 r :+ r)))
forall a b. (a -> b) -> a -> b
$ (Point 3 r :+ r)
-> LineTriangleIntersection
     (Point 3 r :+ r) (ClosedLineSegment (Point 3 r :+ r))
forall point seg. point -> LineTriangleIntersection point seg
Line_x_Triangle_Point Point 3 r :+ r
p
      Just (Line_x_Triangle_LineSegment ClosedLineSegment (Point 3 r :+ r)
_)           ->
        String
-> Maybe
     (LineTriangleIntersection
        (Point 3 r :+ r) (ClosedLineSegment (Point 3 r :+ r)))
forall a. HasCallStack => String -> a
error String
"HalfLine x LineSegment not fully implmeneted yet"
        -- possibly clip the segment here!
      Maybe
  (LineTriangleIntersection
     (Point 3 r :+ r) (ClosedLineSegment (Point 3 r :+ r)))
_                                              -> Maybe
  (LineTriangleIntersection
     (Point 3 r :+ r) (ClosedLineSegment (Point 3 r :+ r)))
Intersection (HalfLine point) (Triangle point')
forall a. Maybe a
Nothing
    where
      toLine :: HalfLine s -> LinePV (Dimension s) (NumType s)
toLine (HalfLine s
o Vector (Dimension s) (NumType s)
v) = Point (Dimension s) (NumType s)
-> Vector (Dimension s) (NumType s)
-> LinePV (Dimension s) (NumType s)
forall (d :: Nat) r. Point d r -> Vector d r -> LinePV d r
LinePV (s
os
-> Getting
     (Point (Dimension s) (NumType s))
     s
     (Point (Dimension s) (NumType s))
-> Point (Dimension s) (NumType s)
forall s a. s -> Getting a s a -> a
^.Getting
  (Point (Dimension s) (NumType s))
  s
  (Point (Dimension s) (NumType s))
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' s (Point (Dimension s) (NumType s))
asPoint) Vector (Dimension s) (NumType s)
v

-- | Testing for intersections between closed line segments and triangles
instance (Point_ point 2 r, Point_ vertex 2 r, Num r, Ord r
         ) => HasIntersectionWith (ClosedLineSegment point) (Triangle vertex) where
  ClosedLineSegment point
seg0 intersects :: ClosedLineSegment point -> Triangle vertex -> Bool
`intersects` Triangle vertex
tri0 =
         (ClosedLineSegment (Point 2 r)
segClosedLineSegment (Point 2 r)
-> Getting (Point 2 r) (ClosedLineSegment (Point 2 r)) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (ClosedLineSegment (Point 2 r)) (Point 2 r)
forall seg p. HasStart seg p => Lens' seg p
Lens' (ClosedLineSegment (Point 2 r)) (Point 2 r)
start) Point 2 r -> Triangle (Point 2 r) -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` Triangle (Point 2 r)
tri Bool -> Bool -> Bool
|| (ClosedLineSegment (Point 2 r)
segClosedLineSegment (Point 2 r)
-> Getting (Point 2 r) (ClosedLineSegment (Point 2 r)) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (ClosedLineSegment (Point 2 r)) (Point 2 r)
forall seg p. HasEnd seg p => Lens' seg p
Lens' (ClosedLineSegment (Point 2 r)) (Point 2 r)
end) Point 2 r -> Triangle (Point 2 r) -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` Triangle (Point 2 r)
tri
      Bool -> Bool -> Bool
|| (ClosedLineSegment (Point 2 r) -> Bool)
-> [ClosedLineSegment (Point 2 r)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ClosedLineSegment (Point 2 r)
seg ClosedLineSegment (Point 2 r)
-> ClosedLineSegment (Point 2 r) -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects`) [ClosedLineSegment (Point 2 r)]
edges'
    where
      tri                  :: Triangle (Point 2 r)
      tri :: Triangle (Point 2 r)
tri@(Triangle Point 2 r
a Point 2 r
b Point 2 r
c) = Getting (Point 2 r) vertex (Point 2 r) -> vertex -> Point 2 r
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Point 2 r) vertex (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' vertex (Point 2 r)
asPoint (vertex -> Point 2 r) -> Triangle vertex -> Triangle (Point 2 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Triangle vertex
tri0
      seg  :: ClosedLineSegment (Point 2 r)
      seg :: ClosedLineSegment (Point 2 r)
seg  = ClosedLineSegment point
seg0ClosedLineSegment point
-> (ClosedLineSegment point -> ClosedLineSegment (Point 2 r))
-> ClosedLineSegment (Point 2 r)
forall a b. a -> (a -> b) -> b
&(point -> Identity (Point 2 r))
-> ClosedLineSegment point
-> Identity (ClosedLineSegment (Point 2 r))
forall (d :: Nat) r r'.
(Point_ point d r, Point_ (Point 2 r) d r',
 NumType (ClosedLineSegment point) ~ r,
 NumType (ClosedLineSegment (Point 2 r)) ~ r',
 Dimension (ClosedLineSegment point) ~ d,
 Dimension (ClosedLineSegment (Point 2 r)) ~ d) =>
Traversal1
  (ClosedLineSegment point)
  (ClosedLineSegment (Point 2 r))
  point
  (Point 2 r)
forall s t point point' (d :: Nat) r r'.
(HasPoints s t point point', Point_ point d r, Point_ point' d r',
 NumType s ~ r, NumType t ~ r', Dimension s ~ d, Dimension t ~ d) =>
Traversal1 s t point point'
Traversal1
  (ClosedLineSegment point)
  (ClosedLineSegment (Point 2 r))
  point
  (Point 2 r)
allPoints ((point -> Identity (Point 2 r))
 -> ClosedLineSegment point
 -> Identity (ClosedLineSegment (Point 2 r)))
-> (point -> Point 2 r)
-> ClosedLineSegment point
-> ClosedLineSegment (Point 2 r)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Getting (Point 2 r) point (Point 2 r) -> point -> Point 2 r
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Point 2 r) point (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint
      edges' :: [ClosedLineSegment (Point 2 r)]
edges' = [Point 2 r -> Point 2 r -> ClosedLineSegment (Point 2 r)
forall point. point -> point -> ClosedLineSegment point
ClosedLineSegment Point 2 r
a Point 2 r
b, Point 2 r -> Point 2 r -> ClosedLineSegment (Point 2 r)
forall point. point -> point -> ClosedLineSegment point
ClosedLineSegment Point 2 r
b Point 2 r
c, Point 2 r -> Point 2 r -> ClosedLineSegment (Point 2 r)
forall point. point -> point -> ClosedLineSegment point
ClosedLineSegment Point 2 r
c Point 2 r
a]


instance ( Point_ corner 2 r, Point_ vertex 2 r, Num r, Ord r
         ) => HasIntersectionWith (Triangle corner) (Triangle vertex) where
  Triangle corner
triA intersects :: Triangle corner -> Triangle vertex -> Bool
`intersects` Triangle vertex
triB = Getting Any (Triangle corner) (Point 2 r)
-> (Point 2 r -> Bool) -> Triangle corner -> Bool
forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf ((corner -> Const Any corner)
-> Triangle corner -> Const Any (Triangle corner)
(Vertex (Triangle corner) -> Const Any (Vertex (Triangle corner)))
-> Triangle corner -> Const Any (Triangle corner)
forall graph graph'.
HasVertices graph graph' =>
IndexedTraversal1
  (VertexIx graph) graph graph' (Vertex graph) (Vertex graph')
IndexedTraversal1
  (VertexIx (Triangle corner))
  (Triangle corner)
  (Triangle corner)
  (Vertex (Triangle corner))
  (Vertex (Triangle corner))
vertices((corner -> Const Any corner)
 -> Triangle corner -> Const Any (Triangle corner))
-> ((Point 2 r -> Const Any (Point 2 r))
    -> corner -> Const Any corner)
-> Getting Any (Triangle corner) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const Any (Point 2 r)) -> corner -> Const Any corner
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' corner (Point 2 r)
asPoint) (Point 2 r -> Triangle vertex -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` Triangle vertex
triB) Triangle corner
triA
                        Bool -> Bool -> Bool
|| Getting Any (Triangle vertex) (ClosedLineSegment vertex)
-> (ClosedLineSegment vertex -> Bool) -> Triangle vertex -> Bool
forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf Getting Any (Triangle vertex) (ClosedLineSegment vertex)
forall {point}.
(ClosedLineSegment point -> Const Any (ClosedLineSegment point))
-> Triangle point -> Const Any (Triangle point)
edgeSegments'      (ClosedLineSegment vertex -> Triangle corner -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` Triangle corner
triA) Triangle vertex
triB
    -- triangleA intersects triangleB if either:
    --  1) triangleA has a vertex inside triangleB, or
    --  2) the edges of triangle B intersect triangleA; this may include the case
           -- where the vertices of triangleB lie inside A (or when their boundaries intersect)
    where
      edgeSegments' :: (ClosedLineSegment point -> Const Any (ClosedLineSegment point))
-> Triangle point -> Const Any (Triangle point)
edgeSegments' = (Triangle point -> [ClosedLineSegment point])
-> Fold (Triangle point) (ClosedLineSegment point)
forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
folding (\(Triangle point
a point
b point
c) -> [ point -> point -> ClosedLineSegment point
forall point. point -> point -> ClosedLineSegment point
ClosedLineSegment point
a point
b
                                                    , point -> point -> ClosedLineSegment point
forall point. point -> point -> ClosedLineSegment point
ClosedLineSegment point
b point
c
                                                    , point -> point -> ClosedLineSegment point
forall point. point -> point -> ClosedLineSegment point
ClosedLineSegment point
c point
a
                                                    ]
                              )