{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Box.Intersection
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- d-dimensional Boxes
--
--------------------------------------------------------------------------------
module HGeometry.Box.Intersection
  (
  ) where

import Control.Lens
import Data.Maybe (isJust)
import Data.Semialign
import HGeometry.Box.Class
import HGeometry.Box.Internal
import HGeometry.Intersection
import HGeometry.Interval
import HGeometry.Point
import HGeometry.Properties
import HGeometry.Vector

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

type instance Intersection (Box point) (Box point) =
  Maybe (Box (Point (Dimension point) (NumType point)))

-- TODO, maybe make this more precise:

-- data instance IntersectionOf (Box point) (Box point) =
--     Box_x_Box_Point point
--   | Box_x_Box_Segment (ClosedLineSegment point)
--   | Box_x_Box_Box (Box point)

instance (Ord r, Num r, Point_ point d r
         , HasComponents (Vector d (Interval_x_IntervalIntersection r (ClosedInterval r)))
                         (Vector d (ClosedInterval r))
         , HasComponents (Vector d (ClosedInterval r)) (Vector d r)
         , Has_ Vector_ d (ClosedInterval r)
         , Has_ Additive_ d r
         , Traversable (Vector d), Applicative (Vector d), Zip (Vector d)
         ) => Box point `HasIntersectionWith` Box point where
  Box point
a intersects :: Box point -> Box point -> Bool
`intersects` Box point
b = Maybe (Box (Point d r)) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Box (Point d r)) -> Bool)
-> Maybe (Box (Point d r)) -> Bool
forall a b. (a -> b) -> a -> b
$ Box point
a Box point -> Box point -> Intersection (Box point) (Box point)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` Box point
b

instance  ( Point_ point d r, Ord r, Num r
          , HasComponents (Vector d (Interval_x_IntervalIntersection r (ClosedInterval r)))
                          (Vector d (ClosedInterval r))
          , HasComponents (Vector d (ClosedInterval r)) (Vector d r)
          , Has_ Vector_ d (ClosedInterval r)
          , Has_ Additive_ d r
          , Traversable (Vector d), Applicative (Vector d), Zip (Vector d)
          ) => Box point `IsIntersectableWith` Box point where
  Box point
bx intersect :: Box point -> Box point -> Intersection (Box point) (Box point)
`intersect` Box point
bx' = (Vector d (Interval_x_IntervalIntersection r (ClosedInterval r))
 -> Box (Point d r))
-> Maybe
     (Vector d (Interval_x_IntervalIntersection r (ClosedInterval r)))
-> Maybe (Box (Point d r))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector d (Interval_x_IntervalIntersection r (ClosedInterval r))
-> Box (Point d r)
fromExtent' (Maybe
   (Vector d (Interval_x_IntervalIntersection r (ClosedInterval r)))
 -> Intersection (Box point) (Box point))
-> (Vector
      d (Maybe (Interval_x_IntervalIntersection r (ClosedInterval r)))
    -> Maybe
         (Vector d (Interval_x_IntervalIntersection r (ClosedInterval r))))
-> Vector
     d (Maybe (Interval_x_IntervalIntersection r (ClosedInterval r)))
-> Intersection (Box point) (Box point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector
  d (Maybe (Interval_x_IntervalIntersection r (ClosedInterval r)))
-> Maybe
     (Vector d (Interval_x_IntervalIntersection r (ClosedInterval r)))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => Vector d (m a) -> m (Vector d a)
sequence (Vector
   d (Maybe (Interval_x_IntervalIntersection r (ClosedInterval r)))
 -> Intersection (Box point) (Box point))
-> Vector
     d (Maybe (Interval_x_IntervalIntersection r (ClosedInterval r)))
-> Intersection (Box point) (Box point)
forall a b. (a -> b) -> a -> b
$ (ClosedInterval r
 -> ClosedInterval r
 -> Maybe (Interval_x_IntervalIntersection r (ClosedInterval r)))
-> Vector d (ClosedInterval r)
-> Vector d (ClosedInterval r)
-> Vector
     d (Maybe (Interval_x_IntervalIntersection r (ClosedInterval r)))
forall a b c.
(a -> b -> c) -> Vector d a -> Vector d b -> Vector d c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ClosedInterval r
-> ClosedInterval r
-> Maybe (Interval_x_IntervalIntersection r (ClosedInterval r))
ClosedInterval r
-> ClosedInterval r
-> Intersection (ClosedInterval r) (ClosedInterval r)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
intersect (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
bx) (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
bx')
    where
      fromExtent' :: Vector d (Interval_x_IntervalIntersection r (ClosedInterval r))
-> Box (Point d r)
fromExtent' = Vector d (ClosedInterval r) -> Box (Point d r)
forall vector (d :: Nat) interval r.
(Vector_ vector d interval, ClosedInterval_ interval r,
 Has_ Additive_ d r, Has_ Vector_ d interval,
 HasComponents (Vector d interval) (Vector d r)) =>
vector -> Box (Point d r)
fromExtent (Vector d (ClosedInterval r) -> Box (Point d r))
-> (Vector d (Interval_x_IntervalIntersection r (ClosedInterval r))
    -> Vector d (ClosedInterval r))
-> Vector d (Interval_x_IntervalIntersection r (ClosedInterval r))
-> Box (Point d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter
  (Vector d (Interval_x_IntervalIntersection r (ClosedInterval r)))
  (Vector d (ClosedInterval r))
  (Interval_x_IntervalIntersection r (ClosedInterval r))
  (ClosedInterval r)
-> (Interval_x_IntervalIntersection r (ClosedInterval r)
    -> ClosedInterval r)
-> Vector d (Interval_x_IntervalIntersection r (ClosedInterval r))
-> Vector d (ClosedInterval r)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (forall vector vector'.
HasComponents vector vector' =>
IndexedTraversal1
  Int vector vector' (IxValue vector) (IxValue vector')
components @_ @(Vector d (ClosedInterval r))) Interval_x_IntervalIntersection r (ClosedInterval r)
-> ClosedInterval r
forall {r}.
Interval_x_IntervalIntersection r (ClosedInterval r)
-> ClosedInterval r
f
      f :: Interval_x_IntervalIntersection r (ClosedInterval r)
-> ClosedInterval r
f = \case
        Interval_x_Interval_Point r
x     -> r -> r -> ClosedInterval r
forall r. r -> r -> ClosedInterval r
ClosedInterval r
x r
x
        Interval_x_Interval_Contained ClosedInterval r
i -> ClosedInterval r
i
        Interval_x_Interval_Partial ClosedInterval r
i   -> ClosedInterval r
i
  {-# INLINE intersect #-}