{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Box
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- d-dimensional Boxes
--
--------------------------------------------------------------------------------
module HGeometry.Box
  ( module HGeometry.Box.Class
  , module HGeometry.Box.Internal
  , module HGeometry.Box.Corners
  , module HGeometry.Box.Sides
  , IsBoxable(..)
  , LineBoxIntersection(..)
  , HalfLineBoxIntersection(..)
  ) where

import Control.Lens
import Data.Foldable1
import Data.Semialign
import Data.Semigroup (All(..))
import GHC.Generics (Generic)
import HGeometry.Boundary
import HGeometry.Box.Boxable
import HGeometry.Box.Class
import HGeometry.Box.Corners
import HGeometry.Box.Internal
import HGeometry.Box.Intersection ()
import HGeometry.Box.Sides
import HGeometry.Direction
import HGeometry.HalfLine
import HGeometry.HyperPlane.Class
import HGeometry.Intersection
import HGeometry.Interval
import HGeometry.Line.General
import HGeometry.Line.LineEQ
import HGeometry.Line.PointAndVector
import HGeometry.LineSegment
import HGeometry.LineSegment.Intersection
import HGeometry.Point
import HGeometry.Properties
import HGeometry.Transformation
import HGeometry.Vector
import Prelude hiding (zipWith)

-- import Debug.Trace

--------------------------------------------------------------------------------
-- $setup
-- >>> myRect = Rectangle origin (Point2 10 20.0) :: Rectangle (Point 2 Rational)
--
--

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

instance ( Point_ point d r, Num r, Ord r
         , Foldable1 (Vector d), Zip (Vector d)
         ) => HasIntersectionWith (Point d r) (Box point) where
  Point d r
q intersects :: Point d r -> Box point -> Bool
`intersects` Box point
box = All -> Bool
getAll (All -> Bool) -> (Vector d All -> All) -> Vector d All -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector d All -> All
forall m. Semigroup m => Vector d m -> m
forall (t :: * -> *) m. (Foldable1 t, Semigroup m) => t m -> m
fold1 (Vector d All -> Bool) -> Vector d All -> Bool
forall a b. (a -> b) -> a -> b
$
    (r -> ClosedInterval r -> All)
-> Vector d r -> Vector d (ClosedInterval r) -> Vector d All
forall a b c.
(a -> b -> c) -> Vector d a -> Vector d b -> Vector d c
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith (\r
x ClosedInterval r
i -> Bool -> All
All (Bool -> All) -> Bool -> All
forall a b. (a -> b) -> a -> b
$ r -> Point 1 r
forall r. r -> Point 1 r
Point1 r
x Point 1 r -> ClosedInterval r -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` ClosedInterval r
i) (Point d r
qPoint d r
-> Getting (Vector d r) (Point d r) (Vector d r) -> Vector d r
forall s a. s -> Getting a s a -> a
^.Getting (Vector d r) (Point d r) (Vector d r)
forall (d :: Nat) r s.
(Dimension (Point d r) ~ d, NumType (Point d r) ~ r,
 Dimension (Point d r) ~ d, NumType (Point d r) ~ s) =>
Lens (Point d r) (Point d r) (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens (Point d r) (Point d r) (Vector d r) (Vector d r)
vector) (Box point -> Vector d (ClosedInterval r)
forall r (d :: Nat).
(r ~ NumType (Box point), d ~ Dimension (Box point), Num r) =>
Box point -> Vector d (ClosedInterval r)
forall box point r (d :: Nat).
(Box_ box point, r ~ NumType box, d ~ Dimension box, Num r) =>
box -> Vector d (ClosedInterval r)
extent Box point
box)
  {-# INLINE intersects #-}

type instance Intersection (Point d r) (Box point) = Maybe (Point d r)

instance ( Point_ point d r, Num r, Ord r
         , Foldable1 (Vector d), Zip (Vector d)
         ) => IsIntersectableWith (Point d r) (Box point) where
  Point d r
q intersect :: Point d r -> Box point -> Intersection (Point d r) (Box point)
`intersect` Box point
box
    | Point d r
q Point d r -> Box point -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` Box point
box = Point d r -> Maybe (Point d r)
forall a. a -> Maybe a
Just Point d r
q
    | Bool
otherwise          = Maybe (Point d r)
Intersection (Point d r) (Box point)
forall a. Maybe a
Nothing
  {-# INLINE intersect #-}


--------------------------------------------------------------------------------
-- * Intersection with a line

-- | Data type representing the intersection of a Box and a line
data LineBoxIntersection d r = Line_x_Box_Point (Point d r)
                             | Line_x_Box_LineSegment (ClosedLineSegment (Point d r))

deriving instance (Show (Point d r), Show (ClosedLineSegment (Point d r))) =>
                  Show (LineBoxIntersection d r)
deriving instance (Eq (Point d r), Eq (ClosedLineSegment (Point d r))) =>
                  Eq (LineBoxIntersection d r)

type instance Intersection (LineEQ r) (Rectangle point) = Maybe (LineBoxIntersection 2 r)


instance (Num r, Ord r
         , Point_ point 2 r
         ) =>  HasIntersectionWith (LineEQ r) (Rectangle point) where
  l :: LineEQ r
l@(LineEQ r
a r
b) intersects :: LineEQ r -> Rectangle point -> Bool
`intersects` (Rectangle point
p point
q) = case r
a r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` r
0 of
      Ordering
LT -> r
ly r -> r -> Bool
forall a. Ord a => a -> a -> Bool
>= point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord Bool -> Bool -> Bool
&& r
ry r -> r -> Bool
forall a. Ord a => a -> a -> Bool
<= point
qpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord
      Ordering
EQ -> r -> Point 1 r
forall r. r -> Point 1 r
Point1 r
b Point 1 r -> ClosedInterval r -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` r -> r -> ClosedInterval r
forall r. r -> r -> ClosedInterval r
ClosedInterval (point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord) (point
qpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord)
      Ordering
GT -> r
ly r -> r -> Bool
forall a. Ord a => a -> a -> Bool
<= point
qpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord Bool -> Bool -> Bool
&& r
ry r -> r -> Bool
forall a. Ord a => a -> a -> Bool
>= point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord
    where
      ly :: r
ly = r -> LineEQ r -> r
forall r. Num r => r -> LineEQ r -> r
evalAt' (point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord) LineEQ r
l
      ry :: r
ry = r -> LineEQ r -> r
forall r. Num r => r -> LineEQ r -> r
evalAt' (point
qpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord) LineEQ r
l
  {-# INLINE intersects #-}

instance (Fractional r, Ord r
         , Point_ point 2 r
         ) =>  IsIntersectableWith (LineEQ r) (Rectangle point) where
  l :: LineEQ r
l@(LineEQ r
a r
b) intersect :: LineEQ r
-> Rectangle point -> Intersection (LineEQ r) (Rectangle point)
`intersect` (Rectangle point
p point
q) = case r
a r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` r
0 of
      Ordering
LT -> case r
ly r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord) of
              Ordering
LT -> Maybe (LineBoxIntersection 2 r)
Intersection (LineEQ r) (Rectangle point)
forall a. Maybe a
Nothing
              Ordering
EQ -> LineBoxIntersection 2 r -> Maybe (LineBoxIntersection 2 r)
LineBoxIntersection 2 r
-> Intersection (LineEQ r) (Rectangle point)
forall a. a -> Maybe a
Just (LineBoxIntersection 2 r
 -> Intersection (LineEQ r) (Rectangle point))
-> (Point 2 r -> LineBoxIntersection 2 r)
-> Point 2 r
-> Intersection (LineEQ r) (Rectangle point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point 2 r -> LineBoxIntersection 2 r
forall (d :: Nat) r. Point d r -> LineBoxIntersection d r
Line_x_Box_Point (Point 2 r -> Intersection (LineEQ r) (Rectangle point))
-> Point 2 r -> Intersection (LineEQ r) (Rectangle point)
forall a b. (a -> b) -> a -> b
$ r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 (point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord) (point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord)
              Ordering
GT -> case r
ry r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (point
qpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord) of
                      Ordering
LT -> let s :: Point 2 r
s = if point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord r -> r -> Bool
forall a. Ord a => a -> a -> Bool
<= r
tx then r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 r
tx (point
qpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord)
                                                       else r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 (point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord) r
ly
                                t :: Point 2 r
t = if r
bx r -> r -> Bool
forall a. Ord a => a -> a -> Bool
<= point
qpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord then r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 r
bx (point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord)
                                                       else r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 (point
qpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord) r
ry
                            in LineBoxIntersection 2 r -> Maybe (LineBoxIntersection 2 r)
LineBoxIntersection 2 r
-> Intersection (LineEQ r) (Rectangle point)
forall a. a -> Maybe a
Just (LineBoxIntersection 2 r
 -> Intersection (LineEQ r) (Rectangle point))
-> (ClosedLineSegment (Point 2 r) -> LineBoxIntersection 2 r)
-> ClosedLineSegment (Point 2 r)
-> Intersection (LineEQ r) (Rectangle point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClosedLineSegment (Point 2 r) -> LineBoxIntersection 2 r
forall (d :: Nat) r.
ClosedLineSegment (Point d r) -> LineBoxIntersection d r
Line_x_Box_LineSegment (ClosedLineSegment (Point 2 r)
 -> Intersection (LineEQ r) (Rectangle point))
-> ClosedLineSegment (Point 2 r)
-> Intersection (LineEQ r) (Rectangle point)
forall a b. (a -> b) -> a -> b
$ Point 2 r -> Point 2 r -> ClosedLineSegment (Point 2 r)
forall point. point -> point -> ClosedLineSegment point
ClosedLineSegment Point 2 r
s Point 2 r
t
                      Ordering
EQ -> LineBoxIntersection 2 r -> Maybe (LineBoxIntersection 2 r)
LineBoxIntersection 2 r
-> Intersection (LineEQ r) (Rectangle point)
forall a. a -> Maybe a
Just (LineBoxIntersection 2 r
 -> Intersection (LineEQ r) (Rectangle point))
-> (Point 2 r -> LineBoxIntersection 2 r)
-> Point 2 r
-> Intersection (LineEQ r) (Rectangle point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point 2 r -> LineBoxIntersection 2 r
forall (d :: Nat) r. Point d r -> LineBoxIntersection d r
Line_x_Box_Point (Point 2 r -> Intersection (LineEQ r) (Rectangle point))
-> Point 2 r -> Intersection (LineEQ r) (Rectangle point)
forall a b. (a -> b) -> a -> b
$ r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 (point
qpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord) (point
qpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord)
                      Ordering
GT -> Maybe (LineBoxIntersection 2 r)
Intersection (LineEQ r) (Rectangle point)
forall a. Maybe a
Nothing
      Ordering
EQ | Bool
inRange   -> LineBoxIntersection 2 r -> Maybe (LineBoxIntersection 2 r)
LineBoxIntersection 2 r
-> Intersection (LineEQ r) (Rectangle point)
forall a. a -> Maybe a
Just (LineBoxIntersection 2 r
 -> Intersection (LineEQ r) (Rectangle point))
-> (ClosedLineSegment (Point 2 r) -> LineBoxIntersection 2 r)
-> ClosedLineSegment (Point 2 r)
-> Intersection (LineEQ r) (Rectangle point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClosedLineSegment (Point 2 r) -> LineBoxIntersection 2 r
forall (d :: Nat) r.
ClosedLineSegment (Point d r) -> LineBoxIntersection d r
Line_x_Box_LineSegment
                      (ClosedLineSegment (Point 2 r)
 -> Intersection (LineEQ r) (Rectangle point))
-> ClosedLineSegment (Point 2 r)
-> Intersection (LineEQ r) (Rectangle point)
forall a b. (a -> b) -> a -> b
$ Point 2 r -> Point 2 r -> ClosedLineSegment (Point 2 r)
forall point. point -> point -> ClosedLineSegment point
ClosedLineSegment (r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 (point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord) r
b) (r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 (point
qpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord) r
b)
         | Bool
otherwise -> Maybe (LineBoxIntersection 2 r)
Intersection (LineEQ r) (Rectangle point)
forall a. Maybe a
Nothing
      Ordering
GT -> case r
ly r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (point
qpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord) of
              Ordering
LT -> case r
ry r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord) of
                      Ordering
LT -> Maybe (LineBoxIntersection 2 r)
Intersection (LineEQ r) (Rectangle point)
forall a. Maybe a
Nothing
                      Ordering
EQ -> LineBoxIntersection 2 r -> Maybe (LineBoxIntersection 2 r)
LineBoxIntersection 2 r
-> Intersection (LineEQ r) (Rectangle point)
forall a. a -> Maybe a
Just (LineBoxIntersection 2 r
 -> Intersection (LineEQ r) (Rectangle point))
-> (Point 2 r -> LineBoxIntersection 2 r)
-> Point 2 r
-> Intersection (LineEQ r) (Rectangle point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point 2 r -> LineBoxIntersection 2 r
forall (d :: Nat) r. Point d r -> LineBoxIntersection d r
Line_x_Box_Point (Point 2 r -> Intersection (LineEQ r) (Rectangle point))
-> Point 2 r -> Intersection (LineEQ r) (Rectangle point)
forall a b. (a -> b) -> a -> b
$ r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 (point
qpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord) (point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord)
                      Ordering
GT -> let
                                s :: Point 2 r
s = if point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord r -> r -> Bool
forall a. Ord a => a -> a -> Bool
<= r
bx then r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 r
bx (point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord)
                                                       else r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 (point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord) r
ly
                                t :: Point 2 r
t = if r
tx r -> r -> Bool
forall a. Ord a => a -> a -> Bool
<= point
qpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord then r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 r
tx (point
qpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord)
                                                       else r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 (point
qpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord) r
ry
                            in LineBoxIntersection 2 r -> Maybe (LineBoxIntersection 2 r)
LineBoxIntersection 2 r
-> Intersection (LineEQ r) (Rectangle point)
forall a. a -> Maybe a
Just (LineBoxIntersection 2 r
 -> Intersection (LineEQ r) (Rectangle point))
-> (ClosedLineSegment (Point 2 r) -> LineBoxIntersection 2 r)
-> ClosedLineSegment (Point 2 r)
-> Intersection (LineEQ r) (Rectangle point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClosedLineSegment (Point 2 r) -> LineBoxIntersection 2 r
forall (d :: Nat) r.
ClosedLineSegment (Point d r) -> LineBoxIntersection d r
Line_x_Box_LineSegment (ClosedLineSegment (Point 2 r)
 -> Intersection (LineEQ r) (Rectangle point))
-> ClosedLineSegment (Point 2 r)
-> Intersection (LineEQ r) (Rectangle point)
forall a b. (a -> b) -> a -> b
$ Point 2 r -> Point 2 r -> ClosedLineSegment (Point 2 r)
forall point. point -> point -> ClosedLineSegment point
ClosedLineSegment Point 2 r
s Point 2 r
t
              Ordering
EQ -> LineBoxIntersection 2 r -> Maybe (LineBoxIntersection 2 r)
LineBoxIntersection 2 r
-> Intersection (LineEQ r) (Rectangle point)
forall a. a -> Maybe a
Just (LineBoxIntersection 2 r
 -> Intersection (LineEQ r) (Rectangle point))
-> (Point 2 r -> LineBoxIntersection 2 r)
-> Point 2 r
-> Intersection (LineEQ r) (Rectangle point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point 2 r -> LineBoxIntersection 2 r
forall (d :: Nat) r. Point d r -> LineBoxIntersection d r
Line_x_Box_Point (Point 2 r -> Intersection (LineEQ r) (Rectangle point))
-> Point 2 r -> Intersection (LineEQ r) (Rectangle point)
forall a b. (a -> b) -> a -> b
$ r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 (point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord) (point
qpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord)
              Ordering
GT -> Maybe (LineBoxIntersection 2 r)
Intersection (LineEQ r) (Rectangle point)
forall a. Maybe a
Nothing
    where
      ly :: r
ly = r -> LineEQ r -> r
forall r. Num r => r -> LineEQ r -> r
evalAt' (point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord) LineEQ r
l
      ry :: r
ry = r -> LineEQ r -> r
forall r. Num r => r -> LineEQ r -> r
evalAt' (point
qpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord) LineEQ r
l

      bx :: r
bx = r -> r
horX (point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord)
      tx :: r
tx = r -> r
horX (point
qpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord)

      inRange :: Bool
inRange = r -> Point 1 r
forall r. r -> Point 1 r
Point1 r
b Point 1 r -> ClosedInterval r -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` r -> r -> ClosedInterval r
forall r. r -> r -> ClosedInterval r
ClosedInterval (point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord) (point
qpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord)

      -- x-coordinate of the intersection with a horizontal line at height h
      horX :: r -> r
horX r
h = (r
hr -> r -> r
forall a. Num a => a -> a -> a
-r
b) r -> r -> r
forall a. Fractional a => a -> a -> a
/ r
a
  {-# INLINE intersect #-}

----------------------------------------
-- with general line

type instance Intersection (VerticalOrLineEQ r) (Rectangle point) =
  Maybe (LineBoxIntersection 2 r)

instance (Num r, Ord r
         , Point_ point 2 r
         ) =>  HasIntersectionWith (VerticalOrLineEQ r) (Rectangle point) where
  VerticalOrLineEQ r
l intersects :: VerticalOrLineEQ r -> Rectangle point -> Bool
`intersects` rect :: Rectangle point
rect@(Rectangle point
p point
q) = case VerticalOrLineEQ r
l of
    VerticalLineThrough r
x -> (point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord) r -> r -> Bool
forall a. Ord a => a -> a -> Bool
<= r
x Bool -> Bool -> Bool
&& r
x r -> r -> Bool
forall a. Ord a => a -> a -> Bool
<= (point
qpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord)
    NonVertical LineEQ r
l'        -> LineEQ r
l' LineEQ r -> Rectangle point -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` Rectangle point
rect
  {-# INLINE intersects #-}

instance (Fractional r, Ord r
         , Point_ point 2 r
         ) =>  IsIntersectableWith (VerticalOrLineEQ r) (Rectangle point) where
  VerticalOrLineEQ r
l intersect :: VerticalOrLineEQ r
-> Rectangle point
-> Intersection (VerticalOrLineEQ r) (Rectangle point)
`intersect` rect :: Rectangle point
rect@(Rectangle point
p point
q) = case VerticalOrLineEQ r
l of
    VerticalLineThrough r
x
      | (point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord) r -> r -> Bool
forall a. Ord a => a -> a -> Bool
<= r
x Bool -> Bool -> Bool
&& r
x r -> r -> Bool
forall a. Ord a => a -> a -> Bool
<= (point
qpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord) -> LineBoxIntersection 2 r -> Maybe (LineBoxIntersection 2 r)
LineBoxIntersection 2 r
-> Intersection (VerticalOrLineEQ r) (Rectangle point)
forall a. a -> Maybe a
Just (LineBoxIntersection 2 r
 -> Intersection (VerticalOrLineEQ r) (Rectangle point))
-> (ClosedLineSegment (Point 2 r) -> LineBoxIntersection 2 r)
-> ClosedLineSegment (Point 2 r)
-> Intersection (VerticalOrLineEQ r) (Rectangle point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClosedLineSegment (Point 2 r) -> LineBoxIntersection 2 r
forall (d :: Nat) r.
ClosedLineSegment (Point d r) -> LineBoxIntersection d r
Line_x_Box_LineSegment
                                              (ClosedLineSegment (Point 2 r)
 -> Intersection (VerticalOrLineEQ r) (Rectangle point))
-> ClosedLineSegment (Point 2 r)
-> Intersection (VerticalOrLineEQ r) (Rectangle point)
forall a b. (a -> b) -> a -> b
$ Point 2 r -> Point 2 r -> ClosedLineSegment (Point 2 r)
forall point. point -> point -> ClosedLineSegment point
ClosedLineSegment (r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 r
x (r -> Point 2 r) -> r -> Point 2 r
forall a b. (a -> b) -> a -> b
$ point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord)
                                                                  (r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 r
x (r -> Point 2 r) -> r -> Point 2 r
forall a b. (a -> b) -> a -> b
$ point
qpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord)
      | Bool
otherwise                            -> Maybe (LineBoxIntersection 2 r)
Intersection (VerticalOrLineEQ r) (Rectangle point)
forall a. Maybe a
Nothing
    NonVertical LineEQ r
l'        -> LineEQ r
l' LineEQ r
-> Rectangle point -> Intersection (LineEQ r) (Rectangle point)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` Rectangle point
rect
  {-# INLINE intersect #-}





instance (Point_ point d r, IsTransformable point) => IsTransformable (Box point) where
  -- ^ this instance is slighly misleading, as for arbitrary affine
  -- transformations (e.g. rotations) the result may no longer be an
  -- axis aligned box. So use with care!
  transformBy :: Transformation (Dimension (Box point)) (NumType (Box point))
-> Box point -> Box point
transformBy Transformation (Dimension (Box point)) (NumType (Box point))
t = ASetter (Box point) (Box point) point point
-> (point -> point) -> Box point -> Box point
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Box point) (Box point) point point
forall (d :: Nat) r r'.
(Point_ point d r, Point_ point d r', NumType (Box point) ~ r,
 NumType (Box point) ~ r', Dimension (Box point) ~ d,
 Dimension (Box point) ~ d) =>
Traversal1 (Box point) (Box point) point point
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 (Box point) (Box point) point point
allPoints (Transformation (Dimension point) (NumType point) -> point -> point
forall g.
IsTransformable g =>
Transformation (Dimension g) (NumType g) -> g -> g
transformBy Transformation (Dimension point) (NumType point)
Transformation (Dimension (Box point)) (NumType (Box point))
t)


type instance Intersection (LinePV 2 r) (Rectangle point) = Maybe (LineBoxIntersection 2 r)

instance ( Num r, Ord r
         , Point_ point 2 r
         ) =>  HasIntersectionWith (LinePV 2 r) (Rectangle point) where
  LinePV 2 r
l intersects :: LinePV 2 r -> Rectangle point -> Bool
`intersects` (Rectangle point -> Corners point
forall r rectangle point.
(Num r, Rectangle_ rectangle point, Point_ point 2 r) =>
rectangle -> Corners point
corners -> Corners point
tl point
tr point
br point
bl) =
      point -> point -> Bool
onOppositeSides point
tl point
br Bool -> Bool -> Bool
|| point -> point -> Bool
onOppositeSides point
tr point
bl
    where
      onOppositeSides :: point -> point -> Bool
onOppositeSides point
p point
q = point -> LinePV 2 r -> Ordering
forall point.
(Point_ point 2 r, Ord r, Num r) =>
point -> LinePV 2 r -> Ordering
forall hyperPlane (d :: Nat) r point.
(HyperPlane_ hyperPlane d r, Point_ point d r, Ord r, Num r) =>
point -> hyperPlane -> Ordering
onSideTest point
p LinePV 2 r
l Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= point -> LinePV 2 r -> Ordering
forall point.
(Point_ point 2 r, Ord r, Num r) =>
point -> LinePV 2 r -> Ordering
forall hyperPlane (d :: Nat) r point.
(HyperPlane_ hyperPlane d r, Point_ point d r, Ord r, Num r) =>
point -> hyperPlane -> Ordering
onSideTest point
q LinePV 2 r
l
  {-# INLINE intersects #-}

instance ( Fractional r, Ord r
         , Point_ point 2 r
         ) =>  IsIntersectableWith (LinePV 2 r) (Rectangle point) where
  l :: LinePV 2 r
l@(LinePV Point 2 r
p Vector 2 r
_) intersect :: LinePV 2 r
-> Rectangle point -> Intersection (LinePV 2 r) (Rectangle point)
`intersect` Rectangle point
r = case LinePV 2 r -> Maybe (LineEQ r)
forall r. (Fractional r, Ord r) => LinePV 2 r -> Maybe (LineEQ r)
toLinearFunction LinePV 2 r
l of
      Maybe (LineEQ r)
Nothing
        | (Point 2 r
pPoint 2 r -> Getting r (Point 2 r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Point 2 r) r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int (Point 2 r) r
xCoord) r -> ClosedInterval r -> Bool
forall interval r.
(Ord r, Interval_ interval r) =>
r -> interval -> Bool
`stabsInterval` ClosedInterval r
xRange -> LineBoxIntersection 2 r -> Maybe (LineBoxIntersection 2 r)
LineBoxIntersection 2 r
-> Intersection (LinePV 2 r) (Rectangle point)
forall a. a -> Maybe a
Just (LineBoxIntersection 2 r
 -> Intersection (LinePV 2 r) (Rectangle point))
-> (ClosedLineSegment (Point 2 r) -> LineBoxIntersection 2 r)
-> ClosedLineSegment (Point 2 r)
-> Intersection (LinePV 2 r) (Rectangle point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClosedLineSegment (Point 2 r) -> LineBoxIntersection 2 r
forall (d :: Nat) r.
ClosedLineSegment (Point d r) -> LineBoxIntersection d r
Line_x_Box_LineSegment
                                              (ClosedLineSegment (Point 2 r)
 -> Intersection (LinePV 2 r) (Rectangle point))
-> ClosedLineSegment (Point 2 r)
-> Intersection (LinePV 2 r) (Rectangle point)
forall a b. (a -> b) -> a -> b
$ Point 2 r -> Point 2 r -> ClosedLineSegment (Point 2 r)
forall point. point -> point -> ClosedLineSegment point
ClosedLineSegment (r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 (Point 2 r
pPoint 2 r -> Getting r (Point 2 r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Point 2 r) r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int (Point 2 r) r
xCoord) r
minY)
                                                                  (r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 (Point 2 r
pPoint 2 r -> Getting r (Point 2 r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Point 2 r) r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int (Point 2 r) r
xCoord) r
maxY)
        | Bool
otherwise                          -> Maybe (LineBoxIntersection 2 r)
Intersection (LinePV 2 r) (Rectangle point)
forall a. Maybe a
Nothing
      Just LineEQ r
l'                                -> LineEQ r
l' LineEQ r
-> Rectangle point -> Intersection (LineEQ r) (Rectangle point)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` Rectangle point
r
    where
      Vector2 ClosedInterval r
xRange (ClosedInterval r
minY r
maxY) = Rectangle point -> Vector 2 (ClosedInterval r)
forall r (d :: Nat).
(r ~ NumType (Rectangle point), d ~ Dimension (Rectangle point),
 Num r) =>
Rectangle point -> Vector d (ClosedInterval r)
forall box point r (d :: Nat).
(Box_ box point, r ~ NumType box, d ~ Dimension box, Num r) =>
box -> Vector d (ClosedInterval r)
extent Rectangle point
r
  {-# INLINE intersect #-}

--------------------------------------------------------------------------------
-- Box x Box intersection






--------------------------------------------------------------------------------
-- * Intersection with a linesegment

-- | Figure out where a query point is with respect to a rectangle
inBox          :: ( Point_ point 2 r, Point_ queryPoint 2 r, Rectangle_ rectangle point
                  , Ord r, Num r
                  ) => queryPoint -> rectangle -> PointLocationResultWith CardinalDirection
queryPoint
q inBox :: forall point r queryPoint rectangle.
(Point_ point 2 r, Point_ queryPoint 2 r,
 Rectangle_ rectangle point, Ord r, Num r) =>
queryPoint
-> rectangle -> PointLocationResultWith CardinalDirection
`inBox` rectangle
rect = case r -> ClosedInterval r -> CompareInterval
forall r interval.
(Ord r, Interval_ interval r) =>
r -> interval -> CompareInterval
compareIntervalExact (queryPoint
qqueryPoint -> Getting r queryPoint r -> r
forall s a. s -> Getting a s a -> a
^.Getting r queryPoint r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int queryPoint r
xCoord) ClosedInterval r
xRange of
    CompareInterval
Before   -> PointLocationResultWith CardinalDirection
forall edge. PointLocationResultWith edge
StrictlyOutside
    CompareInterval
OnStart  -> case r -> ClosedInterval r -> CompareInterval
forall r interval.
(Ord r, Interval_ interval r) =>
r -> interval -> CompareInterval
compareIntervalExact (queryPoint
qqueryPoint -> Getting r queryPoint r -> r
forall s a. s -> Getting a s a -> a
^.Getting r queryPoint r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int queryPoint r
yCoord) ClosedInterval r
yRange of
                  CompareInterval
Before   -> PointLocationResultWith CardinalDirection
forall edge. PointLocationResultWith edge
StrictlyOutside
                  CompareInterval
OnStart  -> CardinalDirection -> PointLocationResultWith CardinalDirection
forall edge. edge -> PointLocationResultWith edge
OnBoundaryEdge CardinalDirection
South -- on both south and west even
                  CompareInterval
Interior -> CardinalDirection -> PointLocationResultWith CardinalDirection
forall edge. edge -> PointLocationResultWith edge
OnBoundaryEdge CardinalDirection
West
                  CompareInterval
OnEnd    -> CardinalDirection -> PointLocationResultWith CardinalDirection
forall edge. edge -> PointLocationResultWith edge
OnBoundaryEdge CardinalDirection
North -- on both north and west
                  CompareInterval
After    -> PointLocationResultWith CardinalDirection
forall edge. PointLocationResultWith edge
StrictlyOutside
    CompareInterval
Interior -> case r -> ClosedInterval r -> CompareInterval
forall r interval.
(Ord r, Interval_ interval r) =>
r -> interval -> CompareInterval
compareIntervalExact (queryPoint
qqueryPoint -> Getting r queryPoint r -> r
forall s a. s -> Getting a s a -> a
^.Getting r queryPoint r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int queryPoint r
yCoord) ClosedInterval r
yRange of
                  CompareInterval
Before   -> PointLocationResultWith CardinalDirection
forall edge. PointLocationResultWith edge
StrictlyOutside
                  CompareInterval
OnStart  -> CardinalDirection -> PointLocationResultWith CardinalDirection
forall edge. edge -> PointLocationResultWith edge
OnBoundaryEdge CardinalDirection
South
                  CompareInterval
Interior -> PointLocationResultWith CardinalDirection
forall edge. PointLocationResultWith edge
StrictlyInside
                  CompareInterval
OnEnd    -> CardinalDirection -> PointLocationResultWith CardinalDirection
forall edge. edge -> PointLocationResultWith edge
OnBoundaryEdge CardinalDirection
North
                  CompareInterval
After    -> PointLocationResultWith CardinalDirection
forall edge. PointLocationResultWith edge
StrictlyOutside
    CompareInterval
OnEnd    -> case r -> ClosedInterval r -> CompareInterval
forall r interval.
(Ord r, Interval_ interval r) =>
r -> interval -> CompareInterval
compareIntervalExact (queryPoint
qqueryPoint -> Getting r queryPoint r -> r
forall s a. s -> Getting a s a -> a
^.Getting r queryPoint r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int queryPoint r
yCoord) ClosedInterval r
yRange of
                  CompareInterval
Before   -> PointLocationResultWith CardinalDirection
forall edge. PointLocationResultWith edge
StrictlyOutside
                  CompareInterval
OnStart  -> CardinalDirection -> PointLocationResultWith CardinalDirection
forall edge. edge -> PointLocationResultWith edge
OnBoundaryEdge CardinalDirection
East -- on both south and east even
                  CompareInterval
Interior -> CardinalDirection -> PointLocationResultWith CardinalDirection
forall edge. edge -> PointLocationResultWith edge
OnBoundaryEdge CardinalDirection
East
                  CompareInterval
OnEnd    -> CardinalDirection -> PointLocationResultWith CardinalDirection
forall edge. edge -> PointLocationResultWith edge
OnBoundaryEdge CardinalDirection
North -- on both north and east
                  CompareInterval
After    -> PointLocationResultWith CardinalDirection
forall edge. PointLocationResultWith edge
StrictlyOutside
    CompareInterval
After    -> PointLocationResultWith CardinalDirection
forall edge. PointLocationResultWith edge
StrictlyOutside
  where
    Vector2 ClosedInterval r
xRange ClosedInterval r
yRange = rectangle -> Vector 2 (ClosedInterval r)
forall r (d :: Nat).
(r ~ NumType rectangle, d ~ Dimension rectangle, Num r) =>
rectangle -> Vector d (ClosedInterval r)
forall box point r (d :: Nat).
(Box_ box point, r ~ NumType box, d ~ Dimension box, Num r) =>
box -> Vector d (ClosedInterval r)
extent rectangle
rect


instance ( Ord r, Num r, Point_ point 2 r, Point_ point' 2 r
         , IxValue (endPoint point) ~ point
         , EndPoint_ (endPoint point)
         , HasIntersectionWith  (LineSegment endPoint point) (ClosedLineSegment point')
         ) => HasIntersectionWith (LineSegment endPoint point) (Rectangle point') where
  LineSegment endPoint point
seg intersects :: LineSegment endPoint point -> Rectangle point' -> Bool
`intersects` Rectangle point'
rect = Bool
intersects'
    where
      intersects' :: Bool
intersects' = case (LineSegment endPoint point
segLineSegment endPoint point
-> Getting point (LineSegment endPoint point) point -> point
forall s a. s -> Getting a s a -> a
^.Getting point (LineSegment endPoint point) point
forall seg p. HasStart seg p => Lens' seg p
Lens' (LineSegment endPoint point) point
start) point
-> Rectangle point' -> PointLocationResultWith CardinalDirection
forall point r queryPoint rectangle.
(Point_ point 2 r, Point_ queryPoint 2 r,
 Rectangle_ rectangle point, Ord r, Num r) =>
queryPoint
-> rectangle -> PointLocationResultWith CardinalDirection
`inBox` Rectangle point'
rect of
        PointLocationResultWith CardinalDirection
StrictlyInside   -> Bool
True
        OnBoundaryEdge CardinalDirection
_ -> endPoint point -> Bool
isClosed (LineSegment endPoint point
segLineSegment endPoint point
-> Getting
     (endPoint point) (LineSegment endPoint point) (endPoint point)
-> endPoint point
forall s a. s -> Getting a s a -> a
^.Getting
  (endPoint point) (LineSegment endPoint point) (endPoint point)
forall seg p. HasStartPoint seg p => Lens' seg p
Lens' (LineSegment endPoint point) (endPoint point)
startPoint)
                            Bool -> Bool -> Bool
|| case (LineSegment endPoint point
segLineSegment endPoint point
-> Getting point (LineSegment endPoint point) point -> point
forall s a. s -> Getting a s a -> a
^.Getting point (LineSegment endPoint point) point
forall seg p. HasEnd seg p => Lens' seg p
Lens' (LineSegment endPoint point) point
end) point
-> Rectangle point' -> PointLocationResultWith CardinalDirection
forall point r queryPoint rectangle.
(Point_ point 2 r, Point_ queryPoint 2 r,
 Rectangle_ rectangle point, Ord r, Num r) =>
queryPoint
-> rectangle -> PointLocationResultWith CardinalDirection
`inBox` Rectangle point'
rect of
                                 PointLocationResultWith CardinalDirection
StrictlyInside   -> Bool
True
                                 OnBoundaryEdge CardinalDirection
_ -> Bool
True
                                 PointLocationResultWith CardinalDirection
StrictlyOutside  -> Bool
intersectsBoundary
        PointLocationResultWith CardinalDirection
StrictlyOutside  -> case (LineSegment endPoint point
segLineSegment endPoint point
-> Getting point (LineSegment endPoint point) point -> point
forall s a. s -> Getting a s a -> a
^.Getting point (LineSegment endPoint point) point
forall seg p. HasEnd seg p => Lens' seg p
Lens' (LineSegment endPoint point) point
end) point
-> Rectangle point' -> PointLocationResultWith CardinalDirection
forall point r queryPoint rectangle.
(Point_ point 2 r, Point_ queryPoint 2 r,
 Rectangle_ rectangle point, Ord r, Num r) =>
queryPoint
-> rectangle -> PointLocationResultWith CardinalDirection
`inBox` Rectangle point'
rect of
                              PointLocationResultWith CardinalDirection
StrictlyInside   -> Bool
True
                              OnBoundaryEdge CardinalDirection
_ -> endPoint point -> Bool
isClosed (LineSegment endPoint point
segLineSegment endPoint point
-> Getting
     (endPoint point) (LineSegment endPoint point) (endPoint point)
-> endPoint point
forall s a. s -> Getting a s a -> a
^.Getting
  (endPoint point) (LineSegment endPoint point) (endPoint point)
forall seg p. HasEndPoint seg p => Lens' seg p
Lens' (LineSegment endPoint point) (endPoint point)
endPoint) Bool -> Bool -> Bool
|| Bool
intersectsBoundary
                              PointLocationResultWith CardinalDirection
StrictlyOutside  -> Bool
intersectsBoundary
      intersectsBoundary :: Bool
intersectsBoundary = LineSegment endPoint point
seg LineSegment endPoint point -> Boundary (Rectangle point') -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` Rectangle point' -> Boundary (Rectangle point')
forall g. g -> Boundary g
Boundary Rectangle point'
rect
      isClosed :: endPoint point -> Bool
isClosed = (EndPointType -> EndPointType -> Bool
forall a. Eq a => a -> a -> Bool
== EndPointType
Closed) (EndPointType -> Bool)
-> (endPoint point -> EndPointType) -> endPoint point -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. endPoint point -> EndPointType
forall endPoint. EndPoint_ endPoint => endPoint -> EndPointType
endPointType

-- isOpenSegment     :: ( IxValue (endPoint point) ~ point
--                      , EndPoint_ (endPoint point)
--                      ) => LineSegment endPoint point -> Bool
-- isOpenSegment seg = let isOpen = (== Open) . endPointType
--                     in isOpen (seg^.startPoint) && isOpen (seg^.endPoint)

-- diagonals (corners -> Corners a b c d) = Vector2 (ClosedLineSegment a c) (ClosedLineSegment b d)


instance ( Ord r, Num r, Point_ point 2 r, Point_ point' 2 r
         -- , IxValue (endPoint point) ~ point
         -- , EndPoint_ (endPoint point)
         , HasIntersectionWith  (LineSegment endPoint point) (ClosedLineSegment point')
         ) => HasIntersectionWith (LineSegment endPoint point) (Boundary (Rectangle point')) where
  LineSegment endPoint point
seg intersects :: LineSegment endPoint point -> Boundary (Rectangle point') -> Bool
`intersects` (Boundary Rectangle point'
rect) = (ClosedLineSegment point' -> Bool)
-> Sides (ClosedLineSegment point') -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (LineSegment endPoint point
seg `intersects`) (Rectangle point' -> Sides (ClosedLineSegment point')
forall r rectangle point.
(Num r, Rectangle_ rectangle point, Point_ point 2 r) =>
rectangle -> Sides (ClosedLineSegment point)
sides Rectangle point'
rect)
  -- TODO: I guess we should be able to speed up this implmeentation, since the various
  -- intersection tests against the sidees are probably doing double work.


-- data LineSegmentRectangleIntersection seg point =
--     LineSegment_x_Box_Point (Point d r)
--   | LineSegment_x_Box_Segment_Contained seg
--   | LineSegment_x_Box_Segment_Partial (ClosedLineSegment (Point d r))



-- instance (Ord r, Num r, Point_ point 2 r
--          ) => LinePV 2 p `HasIntersectionWith` Boundary (Rectangle point) where
--   l `intersects` br = l `intersects` (coerce br :: Rectangle point)
--   {-# INLINE intersects #-}

-- instance (Ord r, Num r, Point_ point 2 r
--          ) => LineEQ r `HasIntersectionWith` Boundary (Rectangle point) where
--   l `intersects` br = l `intersects` (coerce br :: Rectangle point)
--   {-# INLINE intersects #-}



-- type instance Intersection (LinePV 2 r) (Rectangle point) =
--   Maybe (ClosedLineSegment (Point 2 r))

-- type instance Intersection (LineEQ r) (Rectangle point) =
--   Maybe (ClosedLineSegment (Point 2 r))


-- instance (Ord r, Fractional r, Point_ point 2 r) => LinePV 2 p `IsIntersectableWith` Rectangle point where
--   l `intersect` r = undefined

-- instance (Ord r, Fractional r, Point_ point 2 r) => LineEQ r `IsIntersectableWith` Rectangle point where
--   l `intersect` r = undefined



--------------------------------------------------------------------------------
-- * Intersection with a HalfLine


instance ( Point_ point 2 r, Ord r, Num r
         ) => HasIntersectionWith (HalfLine point) (Rectangle point) where
  HalfLine point
hl intersects :: HalfLine point -> Rectangle point -> Bool
`intersects` Rectangle point
box =
    (HalfLine point
hlHalfLine point
-> Getting (Point 2 r) (HalfLine point) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.(point -> Const (Point 2 r) point)
-> HalfLine point -> Const (Point 2 r) (HalfLine point)
forall seg p. HasStart seg p => Lens' seg p
Lens' (HalfLine point) point
start((point -> Const (Point 2 r) point)
 -> HalfLine point -> Const (Point 2 r) (HalfLine point))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> point -> Const (Point 2 r) point)
-> Getting (Point 2 r) (HalfLine point) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> point -> Const (Point 2 r) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint) Point 2 r -> Rectangle point -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` Rectangle point
box Bool -> Bool -> Bool
|| (ClosedLineSegment point -> Bool)
-> Sides (ClosedLineSegment point) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (HalfLine point
hl `intersects`) (Rectangle point -> Sides (ClosedLineSegment point)
forall r rectangle point.
(Num r, Rectangle_ rectangle point, Point_ point 2 r) =>
rectangle -> Sides (ClosedLineSegment point)
sides Rectangle point
box)
  -- the first condition is redundant, but probably sufficiently cheap that it may
  -- actually help/be faster when the starting point lies inside the box.
  {-# INLINE intersects #-}

type instance Intersection (HalfLine point) (Rectangle point) =
  Maybe (HalfLineBoxIntersection (Point 2 (NumType point)))

data HalfLineBoxIntersection point =
    HalfLine_x_Box_Point       point
  | HalfLine_x_Box_LineSegment (ClosedLineSegment point)
  deriving (Int -> HalfLineBoxIntersection point -> ShowS
[HalfLineBoxIntersection point] -> ShowS
HalfLineBoxIntersection point -> String
(Int -> HalfLineBoxIntersection point -> ShowS)
-> (HalfLineBoxIntersection point -> String)
-> ([HalfLineBoxIntersection point] -> ShowS)
-> Show (HalfLineBoxIntersection point)
forall point.
Show point =>
Int -> HalfLineBoxIntersection point -> ShowS
forall point.
Show point =>
[HalfLineBoxIntersection point] -> ShowS
forall point. Show point => HalfLineBoxIntersection point -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall point.
Show point =>
Int -> HalfLineBoxIntersection point -> ShowS
showsPrec :: Int -> HalfLineBoxIntersection point -> ShowS
$cshow :: forall point. Show point => HalfLineBoxIntersection point -> String
show :: HalfLineBoxIntersection point -> String
$cshowList :: forall point.
Show point =>
[HalfLineBoxIntersection point] -> ShowS
showList :: [HalfLineBoxIntersection point] -> ShowS
Show,HalfLineBoxIntersection point
-> HalfLineBoxIntersection point -> Bool
(HalfLineBoxIntersection point
 -> HalfLineBoxIntersection point -> Bool)
-> (HalfLineBoxIntersection point
    -> HalfLineBoxIntersection point -> Bool)
-> Eq (HalfLineBoxIntersection point)
forall point.
Eq point =>
HalfLineBoxIntersection point
-> HalfLineBoxIntersection point -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall point.
Eq point =>
HalfLineBoxIntersection point
-> HalfLineBoxIntersection point -> Bool
== :: HalfLineBoxIntersection point
-> HalfLineBoxIntersection point -> Bool
$c/= :: forall point.
Eq point =>
HalfLineBoxIntersection point
-> HalfLineBoxIntersection point -> Bool
/= :: HalfLineBoxIntersection point
-> HalfLineBoxIntersection point -> Bool
Eq,ReadPrec [HalfLineBoxIntersection point]
ReadPrec (HalfLineBoxIntersection point)
Int -> ReadS (HalfLineBoxIntersection point)
ReadS [HalfLineBoxIntersection point]
(Int -> ReadS (HalfLineBoxIntersection point))
-> ReadS [HalfLineBoxIntersection point]
-> ReadPrec (HalfLineBoxIntersection point)
-> ReadPrec [HalfLineBoxIntersection point]
-> Read (HalfLineBoxIntersection point)
forall point.
Read point =>
ReadPrec [HalfLineBoxIntersection point]
forall point.
Read point =>
ReadPrec (HalfLineBoxIntersection point)
forall point.
Read point =>
Int -> ReadS (HalfLineBoxIntersection point)
forall point. Read point => ReadS [HalfLineBoxIntersection point]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall point.
Read point =>
Int -> ReadS (HalfLineBoxIntersection point)
readsPrec :: Int -> ReadS (HalfLineBoxIntersection point)
$creadList :: forall point. Read point => ReadS [HalfLineBoxIntersection point]
readList :: ReadS [HalfLineBoxIntersection point]
$creadPrec :: forall point.
Read point =>
ReadPrec (HalfLineBoxIntersection point)
readPrec :: ReadPrec (HalfLineBoxIntersection point)
$creadListPrec :: forall point.
Read point =>
ReadPrec [HalfLineBoxIntersection point]
readListPrec :: ReadPrec [HalfLineBoxIntersection point]
Read,(forall x.
 HalfLineBoxIntersection point
 -> Rep (HalfLineBoxIntersection point) x)
-> (forall x.
    Rep (HalfLineBoxIntersection point) x
    -> HalfLineBoxIntersection point)
-> Generic (HalfLineBoxIntersection point)
forall x.
Rep (HalfLineBoxIntersection point) x
-> HalfLineBoxIntersection point
forall x.
HalfLineBoxIntersection point
-> Rep (HalfLineBoxIntersection point) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall point x.
Rep (HalfLineBoxIntersection point) x
-> HalfLineBoxIntersection point
forall point x.
HalfLineBoxIntersection point
-> Rep (HalfLineBoxIntersection point) x
$cfrom :: forall point x.
HalfLineBoxIntersection point
-> Rep (HalfLineBoxIntersection point) x
from :: forall x.
HalfLineBoxIntersection point
-> Rep (HalfLineBoxIntersection point) x
$cto :: forall point x.
Rep (HalfLineBoxIntersection point) x
-> HalfLineBoxIntersection point
to :: forall x.
Rep (HalfLineBoxIntersection point) x
-> HalfLineBoxIntersection point
Generic,(forall a b.
 (a -> b) -> HalfLineBoxIntersection a -> HalfLineBoxIntersection b)
-> (forall a b.
    a -> HalfLineBoxIntersection b -> HalfLineBoxIntersection a)
-> Functor HalfLineBoxIntersection
forall a b.
a -> HalfLineBoxIntersection b -> HalfLineBoxIntersection a
forall a b.
(a -> b) -> HalfLineBoxIntersection a -> HalfLineBoxIntersection 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) -> HalfLineBoxIntersection a -> HalfLineBoxIntersection b
fmap :: forall a b.
(a -> b) -> HalfLineBoxIntersection a -> HalfLineBoxIntersection b
$c<$ :: forall a b.
a -> HalfLineBoxIntersection b -> HalfLineBoxIntersection a
<$ :: forall a b.
a -> HalfLineBoxIntersection b -> HalfLineBoxIntersection a
Functor)

instance ( Point_ point 2 r, Ord r, Fractional r
         ) => IsIntersectableWith (HalfLine point) (Rectangle point) where
  HalfLine point
hl intersect :: HalfLine point
-> Rectangle point
-> Intersection (HalfLine point) (Rectangle point)
`intersect` Rectangle point
box = LinePV 2 r
LinePV (Dimension (HalfLine point)) (NumType (HalfLine point))
m LinePV 2 r
-> Rectangle point -> Intersection (LinePV 2 r) (Rectangle point)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` Rectangle point
box Maybe (LineBoxIntersection 2 r)
-> (LineBoxIntersection 2 r
    -> Maybe (HalfLineBoxIntersection (Point 2 r)))
-> Maybe (HalfLineBoxIntersection (Point 2 r))
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Line_x_Box_Point Point 2 r
p
        | Point 2 r
p Point 2 r -> LinePV 2 r -> SideTest
forall r point.
(Ord r, Num r, Point_ point 2 r) =>
point -> LinePV 2 r -> SideTest
`onSide` LinePV 2 r -> LinePV 2 r
forall r. Num r => LinePV 2 r -> LinePV 2 r
perpendicularTo LinePV 2 r
LinePV (Dimension (HalfLine point)) (NumType (HalfLine point))
m SideTest -> SideTest -> Bool
forall a. Eq a => a -> a -> Bool
== SideTest
LeftSide -> HalfLineBoxIntersection (Point 2 r)
-> Maybe (HalfLineBoxIntersection (Point 2 r))
forall a. a -> Maybe a
Just (HalfLineBoxIntersection (Point 2 r)
 -> Maybe (HalfLineBoxIntersection (Point 2 r)))
-> HalfLineBoxIntersection (Point 2 r)
-> Maybe (HalfLineBoxIntersection (Point 2 r))
forall a b. (a -> b) -> a -> b
$ Point 2 r -> HalfLineBoxIntersection (Point 2 r)
forall point. point -> HalfLineBoxIntersection point
HalfLine_x_Box_Point Point 2 r
p
        | Bool
otherwise                                -> Maybe (HalfLineBoxIntersection (Point 2 r))
forall a. Maybe a
Nothing
      Line_x_Box_LineSegment LineSegment (EndPoint 'Closed) (Point 2 r)
seg                   -> let seg' :: LineSegment (EndPoint 'Closed) (Point 2 r)
seg' = Vector 2 r
-> LineSegment (EndPoint 'Closed) (Point 2 r)
-> LineSegment (EndPoint 'Closed) (Point 2 r)
forall point r (endPoint :: * -> *).
(Point_ point 2 r, Ord r, Num r, IxValue (endPoint point) ~ point,
 EndPoint_ (endPoint point)) =>
Vector 2 r
-> LineSegment endPoint point -> LineSegment endPoint point
reorientTo (HalfLine point
hlHalfLine point
-> Getting (Vector 2 r) (HalfLine point) (Vector 2 r) -> Vector 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Vector 2 r) (HalfLine point) (Vector 2 r)
forall (d :: Nat) r.
(Dimension (HalfLine point) ~ d, NumType (HalfLine point) ~ r) =>
Lens' (HalfLine point) (Vector d r)
forall t (d :: Nat) r.
(HasDirection t, Dimension t ~ d, NumType t ~ r) =>
Lens' t (Vector d r)
Lens' (HalfLine point) (Vector 2 r)
direction) LineSegment (EndPoint 'Closed) (Point 2 r)
seg
                                                      in case LinePV 2 r
-> LineSegment (EndPoint 'Closed) (Point 2 r) -> CompareInterval
forall r point (endPoint :: * -> *).
(Ord r, Num r, Point_ point 2 r, IxValue (endPoint point) ~ point,
 EndPoint_ (endPoint point)) =>
LinePV 2 r -> LineSegment endPoint point -> CompareInterval
compareColinearInterval LinePV 2 r
LinePV (Dimension (HalfLine point)) (NumType (HalfLine point))
m LineSegment (EndPoint 'Closed) (Point 2 r)
seg' of
        CompareInterval
Before   -> HalfLineBoxIntersection (Point 2 r)
-> Maybe (HalfLineBoxIntersection (Point 2 r))
forall a. a -> Maybe a
Just (HalfLineBoxIntersection (Point 2 r)
 -> Maybe (HalfLineBoxIntersection (Point 2 r)))
-> HalfLineBoxIntersection (Point 2 r)
-> Maybe (HalfLineBoxIntersection (Point 2 r))
forall a b. (a -> b) -> a -> b
$ LineSegment (EndPoint 'Closed) (Point 2 r)
-> HalfLineBoxIntersection (Point 2 r)
forall point.
ClosedLineSegment point -> HalfLineBoxIntersection point
HalfLine_x_Box_LineSegment LineSegment (EndPoint 'Closed) (Point 2 r)
seg'
        CompareInterval
OnStart  -> HalfLineBoxIntersection (Point 2 r)
-> Maybe (HalfLineBoxIntersection (Point 2 r))
forall a. a -> Maybe a
Just (HalfLineBoxIntersection (Point 2 r)
 -> Maybe (HalfLineBoxIntersection (Point 2 r)))
-> HalfLineBoxIntersection (Point 2 r)
-> Maybe (HalfLineBoxIntersection (Point 2 r))
forall a b. (a -> b) -> a -> b
$ LineSegment (EndPoint 'Closed) (Point 2 r)
-> HalfLineBoxIntersection (Point 2 r)
forall point.
ClosedLineSegment point -> HalfLineBoxIntersection point
HalfLine_x_Box_LineSegment LineSegment (EndPoint 'Closed) (Point 2 r)
seg'
        CompareInterval
Interior -> HalfLineBoxIntersection (Point 2 r)
-> Maybe (HalfLineBoxIntersection (Point 2 r))
forall a. a -> Maybe a
Just (HalfLineBoxIntersection (Point 2 r)
 -> Maybe (HalfLineBoxIntersection (Point 2 r)))
-> HalfLineBoxIntersection (Point 2 r)
-> Maybe (HalfLineBoxIntersection (Point 2 r))
forall a b. (a -> b) -> a -> b
$ LineSegment (EndPoint 'Closed) (Point 2 r)
-> HalfLineBoxIntersection (Point 2 r)
forall point.
ClosedLineSegment point -> HalfLineBoxIntersection point
HalfLine_x_Box_LineSegment (LineSegment (EndPoint 'Closed) (Point 2 r)
 -> HalfLineBoxIntersection (Point 2 r))
-> LineSegment (EndPoint 'Closed) (Point 2 r)
-> HalfLineBoxIntersection (Point 2 r)
forall a b. (a -> b) -> a -> b
$ LineSegment (EndPoint 'Closed) (Point 2 r)
seg'LineSegment (EndPoint 'Closed) (Point 2 r)
-> (LineSegment (EndPoint 'Closed) (Point 2 r)
    -> LineSegment (EndPoint 'Closed) (Point 2 r))
-> LineSegment (EndPoint 'Closed) (Point 2 r)
forall a b. a -> (a -> b) -> b
&(Point 2 r -> Identity (Point 2 r))
-> LineSegment (EndPoint 'Closed) (Point 2 r)
-> Identity (LineSegment (EndPoint 'Closed) (Point 2 r))
forall seg p. HasStart seg p => Lens' seg p
Lens' (LineSegment (EndPoint 'Closed) (Point 2 r)) (Point 2 r)
start ((Point 2 r -> Identity (Point 2 r))
 -> LineSegment (EndPoint 'Closed) (Point 2 r)
 -> Identity (LineSegment (EndPoint 'Closed) (Point 2 r)))
-> Point 2 r
-> LineSegment (EndPoint 'Closed) (Point 2 r)
-> LineSegment (EndPoint 'Closed) (Point 2 r)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (HalfLine point
hlHalfLine point
-> Getting (Point 2 r) (HalfLine point) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.(point -> Const (Point 2 r) point)
-> HalfLine point -> Const (Point 2 r) (HalfLine point)
forall seg p. HasStart seg p => Lens' seg p
Lens' (HalfLine point) point
start((point -> Const (Point 2 r) point)
 -> HalfLine point -> Const (Point 2 r) (HalfLine point))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> point -> Const (Point 2 r) point)
-> Getting (Point 2 r) (HalfLine point) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> point -> Const (Point 2 r) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint)
        CompareInterval
OnEnd    -> HalfLineBoxIntersection (Point 2 r)
-> Maybe (HalfLineBoxIntersection (Point 2 r))
forall a. a -> Maybe a
Just (HalfLineBoxIntersection (Point 2 r)
 -> Maybe (HalfLineBoxIntersection (Point 2 r)))
-> HalfLineBoxIntersection (Point 2 r)
-> Maybe (HalfLineBoxIntersection (Point 2 r))
forall a b. (a -> b) -> a -> b
$ Point 2 r -> HalfLineBoxIntersection (Point 2 r)
forall point. point -> HalfLineBoxIntersection point
HalfLine_x_Box_Point (LineSegment (EndPoint 'Closed) (Point 2 r)
seg'LineSegment (EndPoint 'Closed) (Point 2 r)
-> Getting
     (Point 2 r)
     (LineSegment (EndPoint 'Closed) (Point 2 r))
     (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting
  (Point 2 r)
  (LineSegment (EndPoint 'Closed) (Point 2 r))
  (Point 2 r)
forall seg p. HasEnd seg p => Lens' seg p
Lens' (LineSegment (EndPoint 'Closed) (Point 2 r)) (Point 2 r)
end)
        CompareInterval
After    -> Maybe (HalfLineBoxIntersection (Point 2 r))
forall a. Maybe a
Nothing -- no intersection
    where
      m :: LinePV (Dimension (HalfLine point)) (NumType (HalfLine point))
m = HalfLine point
-> LinePV (Dimension (HalfLine point)) (NumType (HalfLine point))
forall t.
HasSupportingLine t =>
t -> LinePV (Dimension t) (NumType t)
supportingLine HalfLine point
hl

-- | Given some vector v, and a line segment (that suposedly either has direction v or
-- -v), flip the seg so that it has direction v.
reorientTo       :: ( Point_ point 2 r, Ord r, Num r
                    , IxValue (endPoint point) ~ point, EndPoint_ (endPoint point)
                    )
                 => Vector 2 r -> LineSegment endPoint point -> LineSegment endPoint point
reorientTo :: forall point r (endPoint :: * -> *).
(Point_ point 2 r, Ord r, Num r, IxValue (endPoint point) ~ point,
 EndPoint_ (endPoint point)) =>
Vector 2 r
-> LineSegment endPoint point -> LineSegment endPoint point
reorientTo Vector 2 r
v LineSegment endPoint point
seg = case (LineSegment endPoint point
segLineSegment endPoint point
-> Getting point (LineSegment endPoint point) point -> point
forall s a. s -> Getting a s a -> a
^.Getting point (LineSegment endPoint point) point
forall seg p. HasEnd seg p => Lens' seg p
Lens' (LineSegment endPoint point) point
end) point -> LinePV 2 r -> SideTest
forall r point.
(Ord r, Num r, Point_ point 2 r) =>
point -> LinePV 2 r -> SideTest
`onSide` LinePV 2 r
m of
                     SideTest
RightSide -> LineSegment endPoint point -> LineSegment endPoint point
forall {endPoint :: * -> *} {point}.
LineSegment endPoint point -> LineSegment endPoint point
flipSegment LineSegment endPoint point
seg
                     SideTest
_         -> LineSegment endPoint point
seg
  where
    m :: LinePV 2 r
m = LinePV 2 r -> LinePV 2 r
forall r. Num r => LinePV 2 r -> LinePV 2 r
perpendicularTo (LinePV 2 r -> LinePV 2 r) -> LinePV 2 r -> LinePV 2 r
forall a b. (a -> b) -> a -> b
$ Point 2 r -> Vector 2 r -> LinePV 2 r
forall (d :: Nat) r. Point d r -> Vector d r -> LinePV d r
LinePV (LineSegment endPoint point
segLineSegment endPoint point
-> Getting (Point 2 r) (LineSegment endPoint point) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.(point -> Const (Point 2 r) point)
-> LineSegment endPoint point
-> Const (Point 2 r) (LineSegment endPoint point)
forall seg p. HasStart seg p => Lens' seg p
Lens' (LineSegment endPoint point) point
start((point -> Const (Point 2 r) point)
 -> LineSegment endPoint point
 -> Const (Point 2 r) (LineSegment endPoint point))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> point -> Const (Point 2 r) point)
-> Getting (Point 2 r) (LineSegment endPoint point) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> point -> Const (Point 2 r) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint) Vector 2 r
v
    -- v points into the left halfplane of m
    flipSegment :: LineSegment endPoint point -> LineSegment endPoint point
flipSegment (LineSegment endPoint point
s endPoint point
t) = endPoint point -> endPoint point -> LineSegment endPoint point
forall (endPoint :: * -> *) point.
endPoint point -> endPoint point -> LineSegment endPoint point
LineSegment endPoint point
t endPoint point
s