{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Geometry.Triangle where
import Control.DeepSeq (NFData)
import Control.Lens
import Data.Bifoldable (Bifoldable (bifoldMap))
import Data.Bifunctor (Bifunctor (first))
import Data.Bitraversable
import Data.Either (partitionEithers)
import Data.Ext
import Data.Geometry.Ball (Disk, disk)
import Data.Geometry.Boundary (PointLocationResult (..))
import Data.Geometry.Box (IsBoxable (..))
import Data.Geometry.HyperPlane
import Data.Geometry.Line (Line (Line))
import Data.Geometry.LineSegment
import Data.Geometry.Point
import Data.Geometry.Properties
import Data.Geometry.Transformation
import Data.Geometry.Vector
import qualified Data.Geometry.Vector as V
import qualified Data.List as List
import Data.Maybe (mapMaybe)
import Data.Util (Three, pattern Three)
import Data.Vinyl (Rec (RNil, (:&)))
import Data.Vinyl.CoRec (Handler (H), match)
import GHC.Generics (Generic)
import GHC.TypeLits (type (+))
data Triangle d p r = Triangle !(Point d r :+ p)
!(Point d r :+ p)
!(Point d r :+ p)
deriving ((forall x. Triangle d p r -> Rep (Triangle d p r) x)
-> (forall x. Rep (Triangle d p r) x -> Triangle d p r)
-> Generic (Triangle d p r)
forall x. Rep (Triangle d p r) x -> Triangle d p r
forall x. Triangle d p r -> Rep (Triangle d p r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (d :: Nat) p r x. Rep (Triangle d p r) x -> Triangle d p r
forall (d :: Nat) p r x. Triangle d p r -> Rep (Triangle d p r) x
$cto :: forall (d :: Nat) p r x. Rep (Triangle d p r) x -> Triangle d p r
$cfrom :: forall (d :: Nat) p r x. Triangle d p r -> Rep (Triangle d p r) x
Generic)
deriving instance (Arity d, Show r, Show p) => Show (Triangle d p r)
deriving instance (Arity d, Read r, Read p) => Read (Triangle d p r)
deriving instance (Arity d, Eq r, Eq p) => Eq (Triangle d p r)
instance (Arity d, NFData r, NFData p) => NFData (Triangle d p r)
instance Arity d => Bifunctor (Triangle d) where bimap :: (a -> b) -> (c -> d) -> Triangle d a c -> Triangle d b d
bimap = (a -> b) -> (c -> d) -> Triangle d a c -> Triangle d b d
forall (t :: * -> * -> *) a b c d.
Bitraversable t =>
(a -> b) -> (c -> d) -> t a c -> t b d
bimapDefault
instance Arity d => Bifoldable (Triangle d) where bifoldMap :: (a -> m) -> (b -> m) -> Triangle d a b -> m
bifoldMap = (a -> m) -> (b -> m) -> Triangle d a b -> m
forall (t :: * -> * -> *) m a b.
(Bitraversable t, Monoid m) =>
(a -> m) -> (b -> m) -> t a b -> m
bifoldMapDefault
instance Arity d => Bitraversable (Triangle d) where
bitraverse :: (a -> f c) -> (b -> f d) -> Triangle d a b -> f (Triangle d c d)
bitraverse a -> f c
f b -> f d
g (Triangle Point d b :+ a
p Point d b :+ a
q Point d b :+ a
r) = let tr :: (Point d b :+ a) -> f (Point d d :+ c)
tr = (Point d b -> f (Point d d))
-> (a -> f c) -> (Point d b :+ a) -> f (Point d d :+ c)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse ((b -> f d) -> Point d b -> f (Point d d)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse b -> f d
g) a -> f c
f in
(Point d d :+ c)
-> (Point d d :+ c) -> (Point d d :+ c) -> Triangle d c d
forall (d :: Nat) p r.
(Point d r :+ p)
-> (Point d r :+ p) -> (Point d r :+ p) -> Triangle d p r
Triangle ((Point d d :+ c)
-> (Point d d :+ c) -> (Point d d :+ c) -> Triangle d c d)
-> f (Point d d :+ c)
-> f ((Point d d :+ c) -> (Point d d :+ c) -> Triangle d c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Point d b :+ a) -> f (Point d d :+ c)
tr Point d b :+ a
p f ((Point d d :+ c) -> (Point d d :+ c) -> Triangle d c d)
-> f (Point d d :+ c) -> f ((Point d d :+ c) -> Triangle d c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Point d b :+ a) -> f (Point d d :+ c)
tr Point d b :+ a
q f ((Point d d :+ c) -> Triangle d c d)
-> f (Point d d :+ c) -> f (Triangle d c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Point d b :+ a) -> f (Point d d :+ c)
tr Point d b :+ a
r
instance Field1 (Triangle d p r) (Triangle d p r) (Point d r :+ p) (Point d r :+ p) where
_1 :: ((Point d r :+ p) -> f (Point d r :+ p))
-> Triangle d p r -> f (Triangle d p r)
_1 = (Triangle d p r -> Point d r :+ p)
-> (Triangle d p r -> (Point d r :+ p) -> Triangle d p r)
-> Lens
(Triangle d p r) (Triangle d p r) (Point d r :+ p) (Point d r :+ p)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(Triangle Point d r :+ p
p Point d r :+ p
_ Point d r :+ p
_) -> Point d r :+ p
p) (\(Triangle Point d r :+ p
_ Point d r :+ p
q Point d r :+ p
r) Point d r :+ p
p -> (Point d r :+ p)
-> (Point d r :+ p) -> (Point d r :+ p) -> Triangle d p r
forall (d :: Nat) p r.
(Point d r :+ p)
-> (Point d r :+ p) -> (Point d r :+ p) -> Triangle d p r
Triangle Point d r :+ p
p Point d r :+ p
q Point d r :+ p
r)
instance Field2 (Triangle d p r) (Triangle d p r) (Point d r :+ p) (Point d r :+ p) where
_2 :: ((Point d r :+ p) -> f (Point d r :+ p))
-> Triangle d p r -> f (Triangle d p r)
_2 = (Triangle d p r -> Point d r :+ p)
-> (Triangle d p r -> (Point d r :+ p) -> Triangle d p r)
-> Lens
(Triangle d p r) (Triangle d p r) (Point d r :+ p) (Point d r :+ p)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(Triangle Point d r :+ p
_ Point d r :+ p
q Point d r :+ p
_) -> Point d r :+ p
q) (\(Triangle Point d r :+ p
p Point d r :+ p
_ Point d r :+ p
r) Point d r :+ p
q -> (Point d r :+ p)
-> (Point d r :+ p) -> (Point d r :+ p) -> Triangle d p r
forall (d :: Nat) p r.
(Point d r :+ p)
-> (Point d r :+ p) -> (Point d r :+ p) -> Triangle d p r
Triangle Point d r :+ p
p Point d r :+ p
q Point d r :+ p
r)
instance Field3 (Triangle d p r) (Triangle d p r) (Point d r :+ p) (Point d r :+ p) where
_3 :: ((Point d r :+ p) -> f (Point d r :+ p))
-> Triangle d p r -> f (Triangle d p r)
_3 = (Triangle d p r -> Point d r :+ p)
-> (Triangle d p r -> (Point d r :+ p) -> Triangle d p r)
-> Lens
(Triangle d p r) (Triangle d p r) (Point d r :+ p) (Point d r :+ p)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(Triangle Point d r :+ p
_ Point d r :+ p
_ Point d r :+ p
r) -> Point d r :+ p
r) (\(Triangle Point d r :+ p
p Point d r :+ p
q Point d r :+ p
_) Point d r :+ p
r -> (Point d r :+ p)
-> (Point d r :+ p) -> (Point d r :+ p) -> Triangle d p r
forall (d :: Nat) p r.
(Point d r :+ p)
-> (Point d r :+ p) -> (Point d r :+ p) -> Triangle d p r
Triangle Point d r :+ p
p Point d r :+ p
q Point d r :+ p
r)
type instance NumType (Triangle d p r) = r
type instance Dimension (Triangle d p r) = d
_TriangleThreePoints :: Iso' (Triangle d p r) (Three (Point d r :+ p))
_TriangleThreePoints :: p (Three (Point d r :+ p)) (f (Three (Point d r :+ p)))
-> p (Triangle d p r) (f (Triangle d p r))
_TriangleThreePoints = (Triangle d p r -> Three (Point d r :+ p))
-> (Three (Point d r :+ p) -> Triangle d p r)
-> Iso
(Triangle d p r)
(Triangle d p r)
(Three (Point d r :+ p))
(Three (Point d r :+ p))
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(Triangle Point d r :+ p
p Point d r :+ p
q Point d r :+ p
r) -> (Point d r :+ p)
-> (Point d r :+ p) -> (Point d r :+ p) -> Three (Point d r :+ p)
forall a. a -> a -> a -> Three a
Three Point d r :+ p
p Point d r :+ p
q Point d r :+ p
r) (\(Three Point d r :+ p
p Point d r :+ p
q Point d r :+ p
r) -> (Point d r :+ p)
-> (Point d r :+ p) -> (Point d r :+ p) -> Triangle d p r
forall (d :: Nat) p r.
(Point d r :+ p)
-> (Point d r :+ p) -> (Point d r :+ p) -> Triangle d p r
Triangle Point d r :+ p
p Point d r :+ p
q Point d r :+ p
r)
instance PointFunctor (Triangle d p) where
pmap :: (Point (Dimension (Triangle d p r)) r
-> Point (Dimension (Triangle d p s)) s)
-> Triangle d p r -> Triangle d p s
pmap Point (Dimension (Triangle d p r)) r
-> Point (Dimension (Triangle d p s)) s
f (Triangle Point d r :+ p
p Point d r :+ p
q Point d r :+ p
r) = (Point d s :+ p)
-> (Point d s :+ p) -> (Point d s :+ p) -> Triangle d p s
forall (d :: Nat) p r.
(Point d r :+ p)
-> (Point d r :+ p) -> (Point d r :+ p) -> Triangle d p r
Triangle (Point d r :+ p
p(Point d r :+ p)
-> ((Point d r :+ p) -> Point d s :+ p) -> Point d s :+ p
forall a b. a -> (a -> b) -> b
&(Point d r -> Identity (Point d s))
-> (Point d r :+ p) -> Identity (Point d s :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core ((Point d r -> Identity (Point d s))
-> (Point d r :+ p) -> Identity (Point d s :+ p))
-> (Point d r -> Point d s) -> (Point d r :+ p) -> Point d s :+ p
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Point d r -> Point d s
Point (Dimension (Triangle d p r)) r
-> Point (Dimension (Triangle d p s)) s
f) (Point d r :+ p
q(Point d r :+ p)
-> ((Point d r :+ p) -> Point d s :+ p) -> Point d s :+ p
forall a b. a -> (a -> b) -> b
&(Point d r -> Identity (Point d s))
-> (Point d r :+ p) -> Identity (Point d s :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core ((Point d r -> Identity (Point d s))
-> (Point d r :+ p) -> Identity (Point d s :+ p))
-> (Point d r -> Point d s) -> (Point d r :+ p) -> Point d s :+ p
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Point d r -> Point d s
Point (Dimension (Triangle d p r)) r
-> Point (Dimension (Triangle d p s)) s
f) (Point d r :+ p
r(Point d r :+ p)
-> ((Point d r :+ p) -> Point d s :+ p) -> Point d s :+ p
forall a b. a -> (a -> b) -> b
&(Point d r -> Identity (Point d s))
-> (Point d r :+ p) -> Identity (Point d s :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core ((Point d r -> Identity (Point d s))
-> (Point d r :+ p) -> Identity (Point d s :+ p))
-> (Point d r -> Point d s) -> (Point d r :+ p) -> Point d s :+ p
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Point d r -> Point d s
Point (Dimension (Triangle d p r)) r
-> Point (Dimension (Triangle d p s)) s
f)
instance (Fractional r, Arity d, Arity (d + 1)) => IsTransformable (Triangle d p r) where
transformBy :: Transformation
(Dimension (Triangle d p r)) (NumType (Triangle d p r))
-> Triangle d p r -> Triangle d p r
transformBy = Transformation
(Dimension (Triangle d p r)) (NumType (Triangle d p r))
-> Triangle d p r -> Triangle d p r
forall (g :: * -> *) r (d :: Nat).
(PointFunctor g, Fractional r, d ~ Dimension (g r), Arity d,
Arity (d + 1)) =>
Transformation d r -> g r -> g r
transformPointFunctor
pattern Triangle' :: Point d r -> Point d r -> Point d r -> Triangle d () r
pattern $bTriangle' :: Point d r -> Point d r -> Point d r -> Triangle d () r
$mTriangle' :: forall r (d :: Nat) r.
Triangle d () r
-> (Point d r -> Point d r -> Point d r -> r) -> (Void# -> r) -> r
Triangle' p q r <- Triangle (p :+ ()) (q :+ ()) (r :+ ())
where
Triangle' Point d r
p Point d r
q Point d r
r = (Point d r :+ ())
-> (Point d r :+ ()) -> (Point d r :+ ()) -> Triangle d () r
forall (d :: Nat) p r.
(Point d r :+ p)
-> (Point d r :+ p) -> (Point d r :+ p) -> Triangle d p r
Triangle (Point d r -> Point d r :+ ()
forall a. a -> a :+ ()
ext Point d r
p) (Point d r -> Point d r :+ ()
forall a. a -> a :+ ()
ext Point d r
q) (Point d r -> Point d r :+ ()
forall a. a -> a :+ ()
ext Point d r
r)
sideSegments :: Triangle d p r -> [LineSegment d p r]
sideSegments :: Triangle d p r -> [LineSegment d p r]
sideSegments (Triangle Point d r :+ p
p Point d r :+ p
q Point d r :+ p
r) =
[(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment Point d r :+ p
p Point d r :+ p
q, (Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment Point d r :+ p
q Point d r :+ p
r, (Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment Point d r :+ p
r Point d r :+ p
p]
area :: Fractional r => Triangle 2 p r -> r
area :: Triangle 2 p r -> r
area Triangle 2 p r
t = Triangle 2 p r -> r
forall r p. Num r => Triangle 2 p r -> r
doubleArea Triangle 2 p r
t r -> r -> r
forall a. Fractional a => a -> a -> a
/ r
2
doubleArea :: Num r => Triangle 2 p r -> r
doubleArea :: Triangle 2 p r -> r
doubleArea (Triangle Point 2 r :+ p
a Point 2 r :+ p
b Point 2 r :+ p
c) = r -> r
forall a. Num a => a -> a
abs (r -> r) -> r -> r
forall a b. (a -> b) -> a -> b
$ r
axr -> r -> r
forall a. Num a => a -> a -> a
*r
by r -> r -> r
forall a. Num a => a -> a -> a
- r
axr -> r -> r
forall a. Num a => a -> a -> a
*r
cy
r -> r -> r
forall a. Num a => a -> a -> a
+ r
bxr -> r -> r
forall a. Num a => a -> a -> a
*r
cy r -> r -> r
forall a. Num a => a -> a -> a
- r
bxr -> r -> r
forall a. Num a => a -> a -> a
*r
ay
r -> r -> r
forall a. Num a => a -> a -> a
+ r
cxr -> r -> r
forall a. Num a => a -> a -> a
*r
ay r -> r -> r
forall a. Num a => a -> a -> a
- r
cxr -> r -> r
forall a. Num a => a -> a -> a
*r
by
where
Point2 r
ax r
ay = Point 2 r :+ p
a(Point 2 r :+ p)
-> Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core
Point2 r
bx r
by = Point 2 r :+ p
b(Point 2 r :+ p)
-> Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core
Point2 r
cx r
cy = Point 2 r :+ p
c(Point 2 r :+ p)
-> Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core
isDegenerateTriangle :: (Num r, Eq r) => Triangle 2 p r -> Bool
isDegenerateTriangle :: Triangle 2 p r -> Bool
isDegenerateTriangle = (r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== r
0) (r -> Bool) -> (Triangle 2 p r -> r) -> Triangle 2 p r -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Triangle 2 p r -> r
forall r p. Num r => Triangle 2 p r -> r
doubleArea
inscribedDisk :: (Eq r, Fractional r)
=> Triangle 2 p r -> Maybe (Disk () r)
inscribedDisk :: Triangle 2 p r -> Maybe (Disk () r)
inscribedDisk (Triangle Point 2 r :+ p
p Point 2 r :+ p
q Point 2 r :+ p
r) = Point 2 r -> Point 2 r -> Point 2 r -> Maybe (Disk () r)
forall r.
(Eq r, Fractional r) =>
Point 2 r -> Point 2 r -> Point 2 r -> Maybe (Disk () r)
disk (Point 2 r :+ p
p(Point 2 r :+ p)
-> Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) (Point 2 r :+ p
q(Point 2 r :+ p)
-> Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) (Point 2 r :+ p
r(Point 2 r :+ p)
-> Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core)
instance Num r => HasSupportingPlane (Triangle 3 p r) where
supportingPlane :: Triangle 3 p r
-> HyperPlane
(Dimension (Triangle 3 p r)) (NumType (Triangle 3 p r))
supportingPlane (Triangle Point 3 r :+ p
p Point 3 r :+ p
q Point 3 r :+ p
r) = Point 3 r -> Point 3 r -> Point 3 r -> HyperPlane 3 r
forall r.
Num r =>
Point 3 r -> Point 3 r -> Point 3 r -> HyperPlane 3 r
from3Points (Point 3 r :+ p
p(Point 3 r :+ p)
-> Getting (Point 3 r) (Point 3 r :+ p) (Point 3 r) -> Point 3 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 3 r) (Point 3 r :+ p) (Point 3 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) (Point 3 r :+ p
q(Point 3 r :+ p)
-> Getting (Point 3 r) (Point 3 r :+ p) (Point 3 r) -> Point 3 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 3 r) (Point 3 r :+ p) (Point 3 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) (Point 3 r :+ p
r(Point 3 r :+ p)
-> Getting (Point 3 r) (Point 3 r :+ p) (Point 3 r) -> Point 3 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 3 r) (Point 3 r :+ p) (Point 3 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core)
toBarricentric :: Fractional r
=> Point 2 r -> Triangle 2 p r
-> Vector 3 r
toBarricentric :: Point 2 r -> Triangle 2 p r -> Vector 3 r
toBarricentric (Point2 r
qx r
qy) (Triangle Point 2 r :+ p
a Point 2 r :+ p
b Point 2 r :+ p
c) = r -> r -> r -> Vector 3 r
forall r. r -> r -> r -> Vector 3 r
Vector3 r
alpha r
beta r
gamma
where
Point2 r
ax r
ay = Point 2 r :+ p
a(Point 2 r :+ p)
-> Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core
Point2 r
bx r
by = Point 2 r :+ p
b(Point 2 r :+ p)
-> Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core
Point2 r
cx r
cy = Point 2 r :+ p
c(Point 2 r :+ p)
-> Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core
dett :: r
dett = (r
by r -> r -> r
forall a. Num a => a -> a -> a
- r
cy)r -> r -> r
forall a. Num a => a -> a -> a
*(r
ax r -> r -> r
forall a. Num a => a -> a -> a
- r
cx) r -> r -> r
forall a. Num a => a -> a -> a
+ (r
cx r -> r -> r
forall a. Num a => a -> a -> a
- r
bx)r -> r -> r
forall a. Num a => a -> a -> a
*(r
ay r -> r -> r
forall a. Num a => a -> a -> a
- r
cy)
alpha :: r
alpha = ((r
by r -> r -> r
forall a. Num a => a -> a -> a
- r
cy)r -> r -> r
forall a. Num a => a -> a -> a
*(r
qx r -> r -> r
forall a. Num a => a -> a -> a
- r
cx) r -> r -> r
forall a. Num a => a -> a -> a
+ (r
cx r -> r -> r
forall a. Num a => a -> a -> a
- r
bx)r -> r -> r
forall a. Num a => a -> a -> a
*(r
qy r -> r -> r
forall a. Num a => a -> a -> a
- r
cy)) r -> r -> r
forall a. Fractional a => a -> a -> a
/ r
dett
beta :: r
beta = ((r
cy r -> r -> r
forall a. Num a => a -> a -> a
- r
ay)r -> r -> r
forall a. Num a => a -> a -> a
*(r
qx r -> r -> r
forall a. Num a => a -> a -> a
- r
cx) r -> r -> r
forall a. Num a => a -> a -> a
+ (r
ax r -> r -> r
forall a. Num a => a -> a -> a
- r
cx)r -> r -> r
forall a. Num a => a -> a -> a
*(r
qy r -> r -> r
forall a. Num a => a -> a -> a
- r
cy)) r -> r -> r
forall a. Fractional a => a -> a -> a
/ r
dett
gamma :: r
gamma = r
1 r -> r -> r
forall a. Num a => a -> a -> a
- r
alpha r -> r -> r
forall a. Num a => a -> a -> a
- r
beta
fromBarricentric :: (Arity d, Num r)
=> Vector 3 r -> Triangle d p r
-> Point d r
fromBarricentric :: Vector 3 r -> Triangle d p r -> Point d r
fromBarricentric (Vector3 r
a r
b r
c) (Triangle Point d r :+ p
p Point d r :+ p
q Point d r :+ p
r) = let f :: (Point d r :+ p) -> Vector d r
f = Getting (Vector d r) (Point d r :+ p) (Vector d r)
-> (Point d r :+ p) -> Vector d r
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Point d r -> Const (Vector d r) (Point d r))
-> (Point d r :+ p) -> Const (Vector d r) (Point d r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core((Point d r -> Const (Vector d r) (Point d r))
-> (Point d r :+ p) -> Const (Vector d r) (Point d r :+ p))
-> ((Vector d r -> Const (Vector d r) (Vector d r))
-> Point d r -> Const (Vector d r) (Point d r))
-> Getting (Vector d r) (Point d r :+ p) (Vector d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Vector d r -> Const (Vector d r) (Vector d r))
-> Point d r -> Const (Vector d r) (Point d r)
forall (d :: Nat) r r'.
Lens (Point d r) (Point d r') (Vector d r) (Vector d r')
vector) in
Vector d r -> Point d r
forall (d :: Nat) r. Vector d r -> Point d r
Point (Vector d r -> Point d r) -> Vector d r -> Point d r
forall a b. (a -> b) -> a -> b
$ r
a r -> Vector d r -> Vector d r
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ (Point d r :+ p) -> Vector d r
f Point d r :+ p
p Vector d r -> Vector d r -> Vector d r
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ r
b r -> Vector d r -> Vector d r
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ (Point d r :+ p) -> Vector d r
f Point d r :+ p
q Vector d r -> Vector d r -> Vector d r
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ r
c r -> Vector d r -> Vector d r
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ (Point d r :+ p) -> Vector d r
f Point d r :+ p
r
inTriangle :: (Ord r, Fractional r)
=> Point 2 r -> Triangle 2 p r -> PointLocationResult
inTriangle :: Point 2 r -> Triangle 2 p r -> PointLocationResult
inTriangle Point 2 r
q Triangle 2 p r
t
| (r -> Bool) -> [r] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (r -> Range r -> Bool
forall a. Ord a => a -> Range a -> Bool
`inRange` r -> r -> Range r
forall a. a -> a -> Range a
OpenRange r
0 r
1) [r
a,r
b,r
c] = PointLocationResult
Inside
| (r -> Bool) -> [r] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (r -> Range r -> Bool
forall a. Ord a => a -> Range a -> Bool
`inRange` r -> r -> Range r
forall a. a -> a -> Range a
ClosedRange r
0 r
1) [r
a,r
b,r
c] = PointLocationResult
OnBoundary
| Bool
otherwise = PointLocationResult
Outside
where
Vector3 r
a r
b r
c = Point 2 r -> Triangle 2 p r -> Vector 3 r
forall r p.
Fractional r =>
Point 2 r -> Triangle 2 p r -> Vector 3 r
toBarricentric Point 2 r
q Triangle 2 p r
t
inTriangleRelaxed :: (Ord r, Num r)
=> Point 2 r -> Triangle 2 p r -> PointLocationResult
inTriangleRelaxed :: Point 2 r -> Triangle 2 p r -> PointLocationResult
inTriangleRelaxed Point 2 r
q (Triangle Point 2 r :+ p
a Point 2 r :+ p
b Point 2 r :+ p
c)
| CCW
ab CCW -> CCW -> Bool
forall a. Eq a => a -> a -> Bool
== CCW
CoLinear Bool -> Bool -> Bool
&& CCW
bc CCW -> CCW -> Bool
forall a. Eq a => a -> a -> Bool
== CCW
ca = PointLocationResult
OnBoundary
| CCW
bc CCW -> CCW -> Bool
forall a. Eq a => a -> a -> Bool
== CCW
CoLinear Bool -> Bool -> Bool
&& CCW
ca CCW -> CCW -> Bool
forall a. Eq a => a -> a -> Bool
== CCW
ab = PointLocationResult
OnBoundary
| CCW
ca CCW -> CCW -> Bool
forall a. Eq a => a -> a -> Bool
== CCW
CoLinear Bool -> Bool -> Bool
&& CCW
bc CCW -> CCW -> Bool
forall a. Eq a => a -> a -> Bool
== CCW
ab = PointLocationResult
OnBoundary
| CCW
ab CCW -> CCW -> Bool
forall a. Eq a => a -> a -> Bool
== CCW
bc Bool -> Bool -> Bool
&& CCW
bc CCW -> CCW -> Bool
forall a. Eq a => a -> a -> Bool
== CCW
ca = PointLocationResult
Inside
| Bool
otherwise = PointLocationResult
Outside
where
ab :: CCW
ab = Point 2 r -> Point 2 r -> Point 2 r -> CCW
forall r.
(Ord r, Num r) =>
Point 2 r -> Point 2 r -> Point 2 r -> CCW
ccw (Point 2 r :+ p
a(Point 2 r :+ p)
-> Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) (Point 2 r :+ p
b(Point 2 r :+ p)
-> Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) Point 2 r
q
bc :: CCW
bc = Point 2 r -> Point 2 r -> Point 2 r -> CCW
forall r.
(Ord r, Num r) =>
Point 2 r -> Point 2 r -> Point 2 r -> CCW
ccw (Point 2 r :+ p
b(Point 2 r :+ p)
-> Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) (Point 2 r :+ p
c(Point 2 r :+ p)
-> Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) Point 2 r
q
ca :: CCW
ca = Point 2 r -> Point 2 r -> Point 2 r -> CCW
forall r.
(Ord r, Num r) =>
Point 2 r -> Point 2 r -> Point 2 r -> CCW
ccw (Point 2 r :+ p
c(Point 2 r :+ p)
-> Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) (Point 2 r :+ p
a(Point 2 r :+ p)
-> Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) Point 2 r
q
onTriangle :: (Ord r, Fractional r)
=> Point 2 r -> Triangle 2 p r -> Bool
Point 2 r
q onTriangle :: Point 2 r -> Triangle 2 p r -> Bool
`onTriangle` Triangle 2 p r
t = let Vector3 r
a r
b r
c = Point 2 r -> Triangle 2 p r -> Vector 3 r
forall r p.
Fractional r =>
Point 2 r -> Triangle 2 p r -> Vector 3 r
toBarricentric Point 2 r
q Triangle 2 p r
t
in (r -> Bool) -> [r] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (r -> Range r -> Bool
forall a. Ord a => a -> Range a -> Bool
`inRange` r -> r -> Range r
forall a. a -> a -> Range a
ClosedRange r
0 r
1) [r
a,r
b,r
c]
onTriangleRelaxed :: (Ord r, Num r) => Point 2 r -> Triangle 2 p r -> Bool
Point 2 r
q onTriangleRelaxed :: Point 2 r -> Triangle 2 p r -> Bool
`onTriangleRelaxed` Triangle 2 p r
t = Point 2 r -> Triangle 2 p r -> PointLocationResult
forall r p.
(Ord r, Num r) =>
Point 2 r -> Triangle 2 p r -> PointLocationResult
inTriangleRelaxed Point 2 r
q Triangle 2 p r
t PointLocationResult -> PointLocationResult -> Bool
forall a. Eq a => a -> a -> Bool
/= PointLocationResult
Outside
type instance IntersectionOf (Line 2 r) (Triangle 2 p r) =
[ NoIntersection, Point 2 r, LineSegment 2 () r ]
instance (Fractional r, Ord r) => Line 2 r `IsIntersectableWith` Triangle 2 p r where
nonEmptyIntersection :: proxy (Line 2 r)
-> proxy (Triangle 2 p r)
-> Intersection (Line 2 r) (Triangle 2 p r)
-> Bool
nonEmptyIntersection = proxy (Line 2 r)
-> proxy (Triangle 2 p r)
-> Intersection (Line 2 r) (Triangle 2 p r)
-> Bool
forall g h (proxy :: * -> *).
(NoIntersection ∈ IntersectionOf g h,
RecApplicative (IntersectionOf g h)) =>
proxy g -> proxy h -> Intersection g h -> Bool
defaultNonEmptyIntersection
Line 2 r
l intersect :: Line 2 r
-> Triangle 2 p r -> Intersection (Line 2 r) (Triangle 2 p r)
`intersect` (Triangle Point 2 r :+ p
p Point 2 r :+ p
q Point 2 r :+ p
r) =
case ([Point 2 r] -> [Point 2 r])
-> ([Point 2 r], [LineSegment 2 p r])
-> ([Point 2 r], [LineSegment 2 p r])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [Point 2 r] -> [Point 2 r]
forall a. Eq a => [a] -> [a]
List.nub (([Point 2 r], [LineSegment 2 p r])
-> ([Point 2 r], [LineSegment 2 p r]))
-> ([LineSegment 2 p r] -> ([Point 2 r], [LineSegment 2 p r]))
-> [LineSegment 2 p r]
-> ([Point 2 r], [LineSegment 2 p r])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either (Point 2 r) (LineSegment 2 p r)]
-> ([Point 2 r], [LineSegment 2 p r])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either (Point 2 r) (LineSegment 2 p r)]
-> ([Point 2 r], [LineSegment 2 p r]))
-> ([LineSegment 2 p r]
-> [Either (Point 2 r) (LineSegment 2 p r)])
-> [LineSegment 2 p r]
-> ([Point 2 r], [LineSegment 2 p r])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LineSegment 2 p r
-> Maybe (Either (Point 2 r) (LineSegment 2 p r)))
-> [LineSegment 2 p r] -> [Either (Point 2 r) (LineSegment 2 p r)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe LineSegment 2 p r -> Maybe (Either (Point 2 r) (LineSegment 2 p r))
collect ([LineSegment 2 p r] -> ([Point 2 r], [LineSegment 2 p r]))
-> [LineSegment 2 p r] -> ([Point 2 r], [LineSegment 2 p r])
forall a b. (a -> b) -> a -> b
$ [LineSegment 2 p r]
sides of
([],[]) -> NoIntersection
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection
([Point 2 r]
_, [LineSegment 2 p r
s]) -> LineSegment 2 () r
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec (LineSegment 2 () r
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
-> LineSegment 2 () r
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]
forall a b. (a -> b) -> a -> b
$ (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
([Point 2 r
a],[LineSegment 2 p r]
_) -> Point 2 r
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec Point 2 r
a
([Point 2 r
a,Point 2 r
b],[LineSegment 2 p r]
_) -> LineSegment 2 () r
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec (LineSegment 2 () r
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
-> LineSegment 2 () r
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]
forall a b. (a -> b) -> a -> b
$ (Point 2 r :+ ()) -> (Point 2 r :+ ()) -> LineSegment 2 () r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment (Point 2 r -> Point 2 r :+ ()
forall a. a -> a :+ ()
ext Point 2 r
a) (Point 2 r -> Point 2 r :+ ()
forall a. a -> a :+ ()
ext Point 2 r
b)
([Point 2 r]
_,[LineSegment 2 p r]
_) -> String
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]
forall a. HasCallStack => String -> a
error String
"intersecting a line with a triangle. Triangle is degenerate"
where
sides :: [LineSegment 2 p r]
sides = [(Point 2 r :+ p) -> (Point 2 r :+ p) -> LineSegment 2 p r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment Point 2 r :+ p
p Point 2 r :+ p
q, (Point 2 r :+ p) -> (Point 2 r :+ p) -> LineSegment 2 p r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment Point 2 r :+ p
q Point 2 r :+ p
r, (Point 2 r :+ p) -> (Point 2 r :+ p) -> LineSegment 2 p r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment Point 2 r :+ p
r Point 2 r :+ p
p]
collect :: LineSegment 2 p r -> Maybe (Either (Point 2 r) (LineSegment 2 p r))
collect :: LineSegment 2 p r -> Maybe (Either (Point 2 r) (LineSegment 2 p r))
collect LineSegment 2 p r
s = CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r]
-> Handlers
'[NoIntersection, Point 2 r, LineSegment 2 p r]
(Maybe (Either (Point 2 r) (LineSegment 2 p r)))
-> Maybe (Either (Point 2 r) (LineSegment 2 p r))
forall (ts :: [*]) b. CoRec Identity ts -> Handlers ts b -> b
match (LineSegment 2 p r
s LineSegment 2 p r
-> Line 2 r -> Intersection (LineSegment 2 p r) (Line 2 r)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` Line 2 r
l) (Handlers
'[NoIntersection, Point 2 r, LineSegment 2 p r]
(Maybe (Either (Point 2 r) (LineSegment 2 p r)))
-> Maybe (Either (Point 2 r) (LineSegment 2 p r)))
-> Handlers
'[NoIntersection, Point 2 r, LineSegment 2 p r]
(Maybe (Either (Point 2 r) (LineSegment 2 p r)))
-> Maybe (Either (Point 2 r) (LineSegment 2 p r))
forall a b. (a -> b) -> a -> b
$
(NoIntersection -> Maybe (Either (Point 2 r) (LineSegment 2 p r)))
-> Handler
(Maybe (Either (Point 2 r) (LineSegment 2 p r))) NoIntersection
forall b a. (a -> b) -> Handler b a
H (\NoIntersection
NoIntersection -> Maybe (Either (Point 2 r) (LineSegment 2 p r))
forall a. Maybe a
Nothing)
Handler
(Maybe (Either (Point 2 r) (LineSegment 2 p r))) NoIntersection
-> Rec
(Handler (Maybe (Either (Point 2 r) (LineSegment 2 p r))))
'[Point 2 r, LineSegment 2 p r]
-> Handlers
'[NoIntersection, Point 2 r, LineSegment 2 p r]
(Maybe (Either (Point 2 r) (LineSegment 2 p r)))
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (Point 2 r -> Maybe (Either (Point 2 r) (LineSegment 2 p r)))
-> Handler
(Maybe (Either (Point 2 r) (LineSegment 2 p r))) (Point 2 r)
forall b a. (a -> b) -> Handler b a
H (\(Point 2 r
a :: Point 2 r) -> Either (Point 2 r) (LineSegment 2 p r)
-> Maybe (Either (Point 2 r) (LineSegment 2 p r))
forall a. a -> Maybe a
Just (Either (Point 2 r) (LineSegment 2 p r)
-> Maybe (Either (Point 2 r) (LineSegment 2 p r)))
-> Either (Point 2 r) (LineSegment 2 p r)
-> Maybe (Either (Point 2 r) (LineSegment 2 p r))
forall a b. (a -> b) -> a -> b
$ Point 2 r -> Either (Point 2 r) (LineSegment 2 p r)
forall a b. a -> Either a b
Left Point 2 r
a)
Handler
(Maybe (Either (Point 2 r) (LineSegment 2 p r))) (Point 2 r)
-> Rec
(Handler (Maybe (Either (Point 2 r) (LineSegment 2 p r))))
'[LineSegment 2 p r]
-> Rec
(Handler (Maybe (Either (Point 2 r) (LineSegment 2 p r))))
'[Point 2 r, LineSegment 2 p r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (LineSegment 2 p r
-> Maybe (Either (Point 2 r) (LineSegment 2 p r)))
-> Handler
(Maybe (Either (Point 2 r) (LineSegment 2 p r)))
(LineSegment 2 p r)
forall b a. (a -> b) -> Handler b a
H (\(LineSegment 2 p r
e :: LineSegment 2 p r) -> Either (Point 2 r) (LineSegment 2 p r)
-> Maybe (Either (Point 2 r) (LineSegment 2 p r))
forall a. a -> Maybe a
Just (Either (Point 2 r) (LineSegment 2 p r)
-> Maybe (Either (Point 2 r) (LineSegment 2 p r)))
-> Either (Point 2 r) (LineSegment 2 p r)
-> Maybe (Either (Point 2 r) (LineSegment 2 p r))
forall a b. (a -> b) -> a -> b
$ LineSegment 2 p r -> Either (Point 2 r) (LineSegment 2 p r)
forall a b. b -> Either a b
Right LineSegment 2 p r
e)
Handler
(Maybe (Either (Point 2 r) (LineSegment 2 p r)))
(LineSegment 2 p r)
-> Rec
(Handler (Maybe (Either (Point 2 r) (LineSegment 2 p r)))) '[]
-> Rec
(Handler (Maybe (Either (Point 2 r) (LineSegment 2 p r))))
'[LineSegment 2 p r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (Handler (Maybe (Either (Point 2 r) (LineSegment 2 p r)))) '[]
forall u (a :: u -> *). Rec a '[]
RNil
type instance IntersectionOf (Line 3 r) (Triangle 3 p r) =
[ NoIntersection, Point 3 r, LineSegment 3 () r ]
instance (Fractional r, Ord r) => Line 3 r `IsIntersectableWith` Triangle 3 p r where
nonEmptyIntersection :: proxy (Line 3 r)
-> proxy (Triangle 3 p r)
-> Intersection (Line 3 r) (Triangle 3 p r)
-> Bool
nonEmptyIntersection = proxy (Line 3 r)
-> proxy (Triangle 3 p r)
-> Intersection (Line 3 r) (Triangle 3 p r)
-> Bool
forall g h (proxy :: * -> *).
(NoIntersection ∈ IntersectionOf g h,
RecApplicative (IntersectionOf g h)) =>
proxy g -> proxy h -> Intersection g h -> Bool
defaultNonEmptyIntersection
l :: Line 3 r
l@(Line Point 3 r
a Vector 3 r
v) intersect :: Line 3 r
-> Triangle 3 p r -> Intersection (Line 3 r) (Triangle 3 p r)
`intersect` t :: Triangle 3 p r
t@(Triangle (Point 3 r
p :+ p
_) (Point 3 r
q :+ p
_) (Point 3 r
r :+ p
_)) =
CoRec Identity '[NoIntersection, Point 3 r, Line 3 r]
-> Handlers
'[NoIntersection, Point 3 r, Line 3 r]
(CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r])
-> CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r]
forall (ts :: [*]) b. CoRec Identity ts -> Handlers ts b -> b
match (Line 3 r
l Line 3 r -> Plane r -> Intersection (Line 3 r) (Plane r)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` Plane r
h) (Handlers
'[NoIntersection, Point 3 r, Line 3 r]
(CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r])
-> CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r])
-> Handlers
'[NoIntersection, Point 3 r, Line 3 r]
(CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r])
-> CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r]
forall a b. (a -> b) -> a -> b
$
(NoIntersection
-> CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r])
-> Handler
(CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r])
NoIntersection
forall b a. (a -> b) -> Handler b a
H (\NoIntersection
NoIntersection -> NoIntersection
-> CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection)
Handler
(CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r])
NoIntersection
-> Rec
(Handler
(CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r]))
'[Point 3 r, Line 3 r]
-> Handlers
'[NoIntersection, Point 3 r, Line 3 r]
(CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r])
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (Point 3 r
-> CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r])
-> Handler
(CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r])
(Point 3 r)
forall b a. (a -> b) -> Handler b a
H (\i :: Point 3 r
i@Point3{} -> if Point 3 r -> Bool
onTriangle' Point 3 r
i then Point 3 r
-> CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec Point 3 r
i else NoIntersection
-> CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection)
Handler
(CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r])
(Point 3 r)
-> Rec
(Handler
(CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r]))
'[Line 3 r]
-> Rec
(Handler
(CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r]))
'[Point 3 r, Line 3 r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (Line 3 r
-> CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r])
-> Handler
(CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r])
(Line 3 r)
forall b a. (a -> b) -> Handler b a
H (\Line 3 r
_ -> CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r]
Intersection (Line 3 r) (Triangle 3 p r)
intersect2d)
Handler
(CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r])
(Line 3 r)
-> Rec
(Handler
(CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r]))
'[]
-> Rec
(Handler
(CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r]))
'[Line 3 r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec
(Handler
(CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r]))
'[]
forall u (a :: u -> *). Rec a '[]
RNil
where
h :: Plane r
h@(Plane Point 3 r
_ Vector 3 r
n) = Triangle 3 p r
-> HyperPlane
(Dimension (Triangle 3 p r)) (NumType (Triangle 3 p r))
forall t.
HasSupportingPlane t =>
t -> HyperPlane (Dimension t) (NumType t)
supportingPlane Triangle 3 p r
t
t' :: Triangle 2 () r
t' = (Point 2 r :+ ())
-> (Point 2 r :+ ()) -> (Point 2 r :+ ()) -> Triangle 2 () r
forall (d :: Nat) p r.
(Point d r :+ p)
-> (Point d r :+ p) -> (Point d r :+ p) -> Triangle d p r
Triangle (Point 2 r -> Point 2 r :+ ()
forall a. a -> a :+ ()
ext (Point 2 r -> Point 2 r :+ ()) -> Point 2 r -> Point 2 r :+ ()
forall a b. (a -> b) -> a -> b
$ Point 3 r -> Point 2 r
project Point 3 r
p) (Point 2 r -> Point 2 r :+ ()
forall a. a -> a :+ ()
ext Point 2 r
forall (d :: Nat) r. (Arity d, Num r) => Point d r
origin) (Point 2 r -> Point 2 r :+ ()
forall a. a -> a :+ ()
ext (Point 2 r -> Point 2 r :+ ()) -> Point 2 r -> Point 2 r :+ ()
forall a b. (a -> b) -> a -> b
$ Point 3 r -> Point 2 r
project Point 3 r
r)
l' :: Line 2 r
l' = Point 2 r -> Vector 2 r -> Line 2 r
forall (d :: Nat) r. Point d r -> Vector d r -> Line d r
Line (Point 3 r -> Point 2 r
project Point 3 r
a) (Vector 3 r -> Vector 2 r
project' Vector 3 r
v)
onTriangle' :: Point 3 r -> Bool
onTriangle' :: Point 3 r -> Bool
onTriangle' Point 3 r
i = Point 3 r -> Point 2 r
project Point 3 r
i Point 2 r -> Triangle 2 () r -> Bool
forall r p.
(Ord r, Fractional r) =>
Point 2 r -> Triangle 2 p r -> Bool
`onTriangle` Triangle 2 () r
t'
transf :: Transformation 3 r
transf :: Transformation 3 r
transf = let u :: Diff (Point 3) r
u = Point 3 r
p Point 3 r -> Point 3 r -> Diff (Point 3) r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point 3 r
q
in Vector 3 (Vector 3 r) -> Transformation 3 r
forall r. Num r => Vector 3 (Vector 3 r) -> Transformation 3 r
rotateTo (Vector 3 r -> Vector 3 r -> Vector 3 r -> Vector 3 (Vector 3 r)
forall r. r -> r -> r -> Vector 3 r
Vector3 Diff (Point 3) r
Vector 3 r
u (Vector 3 r
n Vector 3 r -> Vector 3 r -> Vector 3 r
forall r. Num r => Vector 3 r -> Vector 3 r -> Vector 3 r
`cross` Diff (Point 3) r
Vector 3 r
u) Vector 3 r
n) Transformation 3 r -> Transformation 3 r -> Transformation 3 r
forall r (d :: Nat).
(Num r, Arity (d + 1)) =>
Transformation d r -> Transformation d r -> Transformation d r
|.| Vector 3 r -> Transformation 3 r
forall r (d :: Nat).
(Num r, Arity d, Arity (d + 1)) =>
Vector d r -> Transformation d r
translation ((-r
1) r -> Vector 3 r -> Vector 3 r
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ Point 3 r -> Vector 3 r
forall (d :: Nat) r. Point d r -> Vector d r
toVec Point 3 r
q)
invTrans :: Transformation 3 r
invTrans :: Transformation 3 r
invTrans = Transformation 3 r -> Transformation 3 r
forall r (d :: Nat).
(Fractional r, Invertible (d + 1) r) =>
Transformation d r -> Transformation d r
inverseOf Transformation 3 r
transf
project :: Point 3 r -> Point 2 r
project :: Point 3 r -> Point 2 r
project = Point 3 r -> Point 2 r
forall (i :: Nat) (d :: Nat) r.
(Arity i, Arity d, i <= d) =>
Point d r -> Point i r
projectPoint (Point 3 r -> Point 2 r)
-> (Point 3 r -> Point 3 r) -> Point 3 r -> Point 2 r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transformation (Dimension (Point 3 r)) (NumType (Point 3 r))
-> Point 3 r -> Point 3 r
forall g.
IsTransformable g =>
Transformation (Dimension g) (NumType g) -> g -> g
transformBy Transformation 3 r
Transformation (Dimension (Point 3 r)) (NumType (Point 3 r))
transf
project' :: Vector 3 r -> Vector 2 r
project' :: Vector 3 r -> Vector 2 r
project' = Point 2 r -> Vector 2 r
forall (d :: Nat) r. Point d r -> Vector d r
toVec (Point 2 r -> Vector 2 r)
-> (Vector 3 r -> Point 2 r) -> Vector 3 r -> Vector 2 r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point 3 r -> Point 2 r
project (Point 3 r -> Point 2 r)
-> (Vector 3 r -> Point 3 r) -> Vector 3 r -> Point 2 r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector 3 r -> Point 3 r
forall (d :: Nat) r. Vector d r -> Point d r
Point
lift :: Point 2 r -> Point 3 r
lift :: Point 2 r -> Point 3 r
lift = Vector 3 r -> Point 3 r
forall (d :: Nat) r. Vector d r -> Point d r
Point (Vector 3 r -> Point 3 r)
-> (Point 2 r -> Vector 3 r) -> Point 2 r -> Point 3 r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transformation (Dimension (Vector 3 r)) (NumType (Vector 3 r))
-> Vector 3 r -> Vector 3 r
forall g.
IsTransformable g =>
Transformation (Dimension g) (NumType g) -> g -> g
transformBy Transformation 3 r
Transformation (Dimension (Vector 3 r)) (NumType (Vector 3 r))
invTrans (Vector 3 r -> Vector 3 r)
-> (Point 2 r -> Vector 3 r) -> Point 2 r -> Vector 3 r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector 2 r -> r -> Vector 3 r) -> r -> Vector 2 r -> Vector 3 r
forall a b c. (a -> b -> c) -> b -> a -> c
flip Vector 2 r -> r -> Vector 3 r
forall (d :: Nat) r.
(Arity (d + 1), Arity d) =>
Vector d r -> r -> Vector (d + 1) r
V.snoc r
0 (Vector 2 r -> Vector 3 r)
-> (Point 2 r -> Vector 2 r) -> Point 2 r -> Vector 3 r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point 2 r -> Vector 2 r
forall (d :: Nat) r. Point d r -> Vector d r
toVec
intersect2d :: Intersection (Line 3 r) (Triangle 3 p r)
intersect2d :: Intersection (Line 3 r) (Triangle 3 p r)
intersect2d = CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]
-> Handlers
'[NoIntersection, Point 2 r, LineSegment 2 () r]
(CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r])
-> CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r]
forall (ts :: [*]) b. CoRec Identity ts -> Handlers ts b -> b
match (Line 2 r
l' Line 2 r
-> Triangle 2 () r -> Intersection (Line 2 r) (Triangle 2 () r)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` Triangle 2 () r
t') (Handlers
'[NoIntersection, Point 2 r, LineSegment 2 () r]
(CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r])
-> CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r])
-> Handlers
'[NoIntersection, Point 2 r, LineSegment 2 () r]
(CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r])
-> CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r]
forall a b. (a -> b) -> a -> b
$
(NoIntersection
-> CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r])
-> Handler
(CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r])
NoIntersection
forall b a. (a -> b) -> Handler b a
H (\NoIntersection
NoIntersection -> NoIntersection
-> CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection)
Handler
(CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r])
NoIntersection
-> Rec
(Handler
(CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r]))
'[Point 2 r, LineSegment 2 () r]
-> Handlers
'[NoIntersection, Point 2 r, LineSegment 2 () r]
(CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r])
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (Point 2 r
-> CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r])
-> Handler
(CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r])
(Point 2 r)
forall b a. (a -> b) -> Handler b a
H (\i :: Point 2 r
i@(Point2 r
_ r
_) -> Point 3 r
-> CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec (Point 3 r
-> CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r])
-> Point 3 r
-> CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r]
forall a b. (a -> b) -> a -> b
$ Point 2 r -> Point 3 r
lift Point 2 r
i)
Handler
(CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r])
(Point 2 r)
-> Rec
(Handler
(CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r]))
'[LineSegment 2 () r]
-> Rec
(Handler
(CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r]))
'[Point 2 r, LineSegment 2 () r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (LineSegment 2 () r
-> CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r])
-> Handler
(CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r])
(LineSegment 2 () r)
forall b a. (a -> b) -> Handler b a
H (\(LineSegment EndPoint (Point 2 r :+ ())
s EndPoint (Point 2 r :+ ())
e) -> LineSegment 3 () r
-> CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec (LineSegment 3 () r
-> CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r])
-> LineSegment 3 () r
-> CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r]
forall a b. (a -> b) -> a -> b
$ EndPoint (Point 3 r :+ ())
-> EndPoint (Point 3 r :+ ()) -> LineSegment 3 () r
forall (d :: Nat) r p.
EndPoint (Point d r :+ p)
-> EndPoint (Point d r :+ p) -> LineSegment d p r
LineSegment (EndPoint (Point 2 r :+ ())
sEndPoint (Point 2 r :+ ())
-> (EndPoint (Point 2 r :+ ()) -> EndPoint (Point 3 r :+ ()))
-> EndPoint (Point 3 r :+ ())
forall a b. a -> (a -> b) -> b
&((Point 2 r :+ ()) -> Identity (Point 3 r :+ ()))
-> EndPoint (Point 2 r :+ ())
-> Identity (EndPoint (Point 3 r :+ ()))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((Point 2 r :+ ()) -> Identity (Point 3 r :+ ()))
-> EndPoint (Point 2 r :+ ())
-> Identity (EndPoint (Point 3 r :+ ())))
-> ((Point 2 r -> Identity (Point 3 r))
-> (Point 2 r :+ ()) -> Identity (Point 3 r :+ ()))
-> (Point 2 r -> Identity (Point 3 r))
-> EndPoint (Point 2 r :+ ())
-> Identity (EndPoint (Point 3 r :+ ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Identity (Point 3 r))
-> (Point 2 r :+ ()) -> Identity (Point 3 r :+ ())
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core ((Point 2 r -> Identity (Point 3 r))
-> EndPoint (Point 2 r :+ ())
-> Identity (EndPoint (Point 3 r :+ ())))
-> (Point 2 r -> Point 3 r)
-> EndPoint (Point 2 r :+ ())
-> EndPoint (Point 3 r :+ ())
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Point 2 r -> Point 3 r
lift)
(EndPoint (Point 2 r :+ ())
eEndPoint (Point 2 r :+ ())
-> (EndPoint (Point 2 r :+ ()) -> EndPoint (Point 3 r :+ ()))
-> EndPoint (Point 3 r :+ ())
forall a b. a -> (a -> b) -> b
&((Point 2 r :+ ()) -> Identity (Point 3 r :+ ()))
-> EndPoint (Point 2 r :+ ())
-> Identity (EndPoint (Point 3 r :+ ()))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((Point 2 r :+ ()) -> Identity (Point 3 r :+ ()))
-> EndPoint (Point 2 r :+ ())
-> Identity (EndPoint (Point 3 r :+ ())))
-> ((Point 2 r -> Identity (Point 3 r))
-> (Point 2 r :+ ()) -> Identity (Point 3 r :+ ()))
-> (Point 2 r -> Identity (Point 3 r))
-> EndPoint (Point 2 r :+ ())
-> Identity (EndPoint (Point 3 r :+ ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Identity (Point 3 r))
-> (Point 2 r :+ ()) -> Identity (Point 3 r :+ ())
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core ((Point 2 r -> Identity (Point 3 r))
-> EndPoint (Point 2 r :+ ())
-> Identity (EndPoint (Point 3 r :+ ())))
-> (Point 2 r -> Point 3 r)
-> EndPoint (Point 2 r :+ ())
-> EndPoint (Point 3 r :+ ())
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Point 2 r -> Point 3 r
lift))
Handler
(CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r])
(LineSegment 2 () r)
-> Rec
(Handler
(CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r]))
'[]
-> Rec
(Handler
(CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r]))
'[LineSegment 2 () r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec
(Handler
(CoRec Identity '[NoIntersection, Point 3 r, LineSegment 3 () r]))
'[]
forall u (a :: u -> *). Rec a '[]
RNil
instance (Arity d, Ord r) => IsBoxable (Triangle d p r) where
boundingBox :: Triangle d p r
-> Box (Dimension (Triangle d p r)) () (NumType (Triangle d p r))
boundingBox (Triangle Point d r :+ p
a Point d r :+ p
b Point d r :+ p
c) = (Point d r :+ p)
-> Box (Dimension (Point d r :+ p)) () (NumType (Point d r :+ p))
forall g.
(IsBoxable g, Ord (NumType g)) =>
g -> Box (Dimension g) () (NumType g)
boundingBox Point d r :+ p
a Box d () r -> Box d () r -> Box d () r
forall a. Semigroup a => a -> a -> a
<> (Point d r :+ p)
-> Box (Dimension (Point d r :+ p)) () (NumType (Point d r :+ p))
forall g.
(IsBoxable g, Ord (NumType g)) =>
g -> Box (Dimension g) () (NumType g)
boundingBox Point d r :+ p
b Box d () r -> Box d () r -> Box d () r
forall a. Semigroup a => a -> a -> a
<> (Point d r :+ p)
-> Box (Dimension (Point d r :+ p)) () (NumType (Point d r :+ p))
forall g.
(IsBoxable g, Ord (NumType g)) =>
g -> Box (Dimension g) () (NumType g)
boundingBox Point d r :+ p
c