{-# LANGUAGE UndecidableInstances #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Box.Internal
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Axis alligned boxes in d-dimensional space.
--
--------------------------------------------------------------------------------
module HGeometry.Box.Internal
  ( Box(Box,Rectangle,Rect)
  , type Rectangle
  , fromExtent
  ) where

import Control.Lens
import Data.Zip
import GHC.Generics (Generic)
import HGeometry.Box.Class
import HGeometry.Interval
import HGeometry.Point
import HGeometry.Properties (NumType,Dimension)
import HGeometry.Vector
import Prelude hiding (zipWith)
import Text.Read

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

-- | D-dimensional boxes.
--
-- A box is represented by two points; a point with lexicographically minimal coordinates,
-- and a point with lexicographically maximal coordinates.
newtype Box point = MkBox (Vector 2 point)
  deriving stock ((forall x. Box point -> Rep (Box point) x)
-> (forall x. Rep (Box point) x -> Box point)
-> Generic (Box point)
forall x. Rep (Box point) x -> Box point
forall x. Box point -> Rep (Box point) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall point x. Rep (Box point) x -> Box point
forall point x. Box point -> Rep (Box point) x
$cfrom :: forall point x. Box point -> Rep (Box point) x
from :: forall x. Box point -> Rep (Box point) x
$cto :: forall point x. Rep (Box point) x -> Box point
to :: forall x. Rep (Box point) x -> Box point
Generic)
  deriving newtype (Box point -> Box point -> Bool
(Box point -> Box point -> Bool)
-> (Box point -> Box point -> Bool) -> Eq (Box point)
forall point. Eq point => Box point -> Box point -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall point. Eq point => Box point -> Box point -> Bool
== :: Box point -> Box point -> Bool
$c/= :: forall point. Eq point => Box point -> Box point -> Bool
/= :: Box point -> Box point -> Bool
Eq,Eq (Box point)
Eq (Box point) =>
(Box point -> Box point -> Ordering)
-> (Box point -> Box point -> Bool)
-> (Box point -> Box point -> Bool)
-> (Box point -> Box point -> Bool)
-> (Box point -> Box point -> Bool)
-> (Box point -> Box point -> Box point)
-> (Box point -> Box point -> Box point)
-> Ord (Box point)
Box point -> Box point -> Bool
Box point -> Box point -> Ordering
Box point -> Box point -> Box point
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall point. Ord point => Eq (Box point)
forall point. Ord point => Box point -> Box point -> Bool
forall point. Ord point => Box point -> Box point -> Ordering
forall point. Ord point => Box point -> Box point -> Box point
$ccompare :: forall point. Ord point => Box point -> Box point -> Ordering
compare :: Box point -> Box point -> Ordering
$c< :: forall point. Ord point => Box point -> Box point -> Bool
< :: Box point -> Box point -> Bool
$c<= :: forall point. Ord point => Box point -> Box point -> Bool
<= :: Box point -> Box point -> Bool
$c> :: forall point. Ord point => Box point -> Box point -> Bool
> :: Box point -> Box point -> Bool
$c>= :: forall point. Ord point => Box point -> Box point -> Bool
>= :: Box point -> Box point -> Bool
$cmax :: forall point. Ord point => Box point -> Box point -> Box point
max :: Box point -> Box point -> Box point
$cmin :: forall point. Ord point => Box point -> Box point -> Box point
min :: Box point -> Box point -> Box point
Ord)

-- | Construct a box
pattern Box           :: point -> point -> Box point
pattern $bBox :: forall point. point -> point -> Box point
$mBox :: forall {r} {point}.
Box point -> (point -> point -> r) -> ((# #) -> r) -> r
Box minP maxP = MkBox (Vector2 minP maxP)
{-# COMPLETE Box #-}

-- | Defines a rectangle
type Rectangle = Box
-- TODO this type is slightly misleading

-- | Construct a Rectangle
--
--
pattern Rectangle           :: Dimension point ~ 2
                            => point -> point -> Box point
pattern $bRectangle :: forall point. (Dimension point ~ 2) => point -> point -> Box point
$mRectangle :: forall {r} {point}.
(Dimension point ~ 2) =>
Box point -> (point -> point -> r) -> ((# #) -> r) -> r
Rectangle minP maxP = Box minP maxP
{-# COMPLETE Rectangle #-}
{-# INLINE Rectangle #-}

-- | Given x y w h construct the rectangle with bottom left corner (x,y), width w, and
-- hegith h.
pattern Rect :: Num r => r -> r -> r -> r -> Rectangle (Point 2 r)
pattern $bRect :: forall r. Num r => r -> r -> r -> r -> Rectangle (Point 2 r)
$mRect :: forall {r} {r}.
Num r =>
Rectangle (Point 2 r)
-> (r -> r -> r -> r -> r) -> ((# #) -> r) -> r
Rect x y w h <- (rectXYWH -> (x,y,w,h))
  where
    Rect r
x r
y r
w r
h = Point 2 r -> Point 2 r -> Box (Point 2 r)
forall point. (Dimension point ~ 2) => point -> point -> Box point
Rectangle (r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 r
x r
y) (r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 (r
xr -> r -> r
forall a. Num a => a -> a -> a
+r
w) (r
yr -> r -> r
forall a. Num a => a -> a -> a
+r
h))

-- | Extract the x,y of the lower left corner, and width and height of the rectangle.
rectXYWH      :: Num r => Rectangle (Point 2 r) -> (r,r,r,r)
rectXYWH :: forall r. Num r => Rectangle (Point 2 r) -> (r, r, r, r)
rectXYWH Rectangle (Point 2 r)
rect = let Vector2 r
w r
h = Rectangle (Point 2 r) -> Vector 2 r
forall box (d :: Nat) point r.
(Box_ box point, Point_ point d r, Num r, Functor (Vector d)) =>
box -> Vector d r
size Rectangle (Point 2 r)
rect
                    Point2 r
x r
y  = Rectangle (Point 2 r)
rectRectangle (Point 2 r)
-> Getting (Point 2 r) (Rectangle (Point 2 r)) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Rectangle (Point 2 r)) (Point 2 r)
forall box point. HasMinPoint box point => Lens' box point
Lens' (Rectangle (Point 2 r)) (Point 2 r)
minPoint
                in (r
x,r
y,r
w,r
h)

-- type instance PointFor  (Box point) = point
type instance Dimension (Box point) = Dimension point
type instance NumType   (Box point) = NumType point

-- instance Constrained Box where
--   type Dom Box point = OptCVector_ 2 point
instance Functor Box where
  fmap :: forall a b. (a -> b) -> Box a -> Box b
fmap a -> b
f (Box a
p a
q) = b -> b -> Box b
forall point. point -> point -> Box point
Box (a -> b
f a
p) (a -> b
f a
q)
--   -- cmap f (MkBox v) = MkBox $ v&components %~ f
instance Foldable Box where
  foldMap :: forall m a. Monoid m => (a -> m) -> Box a -> m
foldMap a -> m
f (Box a
p a
q) = a -> m
f a
p m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
f a
q
instance Traversable Box where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Box a -> f (Box b)
traverse a -> f b
f (Box a
p a
q) = b -> b -> Box b
forall point. point -> point -> Box point
Box (b -> b -> Box b) -> f b -> f (b -> Box b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
p f (b -> Box b) -> f b -> f (Box b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
q

instance HasMinPoint (Box point) point where
  minPoint :: Lens' (Box point) point
minPoint = (Box point -> point)
-> (Box point -> point -> Box point) -> Lens' (Box point) point
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(Box point
p point
_) -> point
p) (\(Box point
_ point
q) point
p -> point -> point -> Box point
forall point. point -> point -> Box point
Box point
p point
q)

instance HasMaxPoint (Box point) point where
  maxPoint :: Lens' (Box point) point
maxPoint = (Box point -> point)
-> (Box point -> point -> Box point) -> Lens' (Box point) point
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(Box point
_ point
q) -> point
q) (\(Box point
p point
_) point
q -> point -> point -> Box point
forall point. point -> point -> Box point
Box point
p point
q)

instance HasPoints (Box point) (Box point') point point' where
  allPoints :: 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'
allPoints point -> f point'
f (MkBox Vector 2 point
v) = Vector 2 point' -> Box point'
forall point. Vector 2 point -> Box point
MkBox (Vector 2 point' -> Box point')
-> f (Vector 2 point') -> f (Box point')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IxValue (Vector 2 point) -> f (IxValue (Vector 2 point')))
-> Vector 2 point -> f (Vector 2 point')
forall vector vector'.
HasComponents vector vector' =>
IndexedTraversal1
  Int vector vector' (IxValue vector) (IxValue vector')
IndexedTraversal1
  Int
  (Vector 2 point)
  (Vector 2 point')
  (IxValue (Vector 2 point))
  (IxValue (Vector 2 point'))
components point -> f point'
IxValue (Vector 2 point) -> f (IxValue (Vector 2 point'))
f Vector 2 point
v

instance ( Point_ point d r
         , Zip (Vector d)
         ) => Box_ (Box point) point where
  extent :: forall r (d :: Nat).
(r ~ NumType (Box point), d ~ Dimension (Box point), Num r) =>
Box point -> Vector d (ClosedInterval r)
extent (Box point
p point
q) = (r -> r -> ClosedInterval r)
-> Vector d r -> Vector d r -> Vector d (ClosedInterval r)
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 -> r -> ClosedInterval r
forall r. r -> r -> ClosedInterval r
ClosedInterval (point
ppoint -> Getting (Vector d r) point (Vector d r) -> Vector d r
forall s a. s -> Getting a s a -> a
^.Getting (Vector d r) point (Vector d r)
forall (d :: Nat) r s.
(Dimension point ~ d, NumType point ~ r, Dimension point ~ d,
 NumType point ~ s) =>
Lens point point (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 point (Vector d r) (Vector d r)
vector) (point
qpoint -> Getting (Vector d r) point (Vector d r) -> Vector d r
forall s a. s -> Getting a s a -> a
^.Getting (Vector d r) point (Vector d r)
forall (d :: Nat) r s.
(Dimension point ~ d, NumType point ~ r, Dimension point ~ d,
 NumType point ~ s) =>
Lens point point (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 point (Vector d r) (Vector d r)
vector)


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

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

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

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

-- | Given a vector of intervals, construct a box.
--
-- >>> fromExtent (Vector2 (ClosedInterval 1 2) (ClosedInterval 10 20))
-- Box (Point2 1 10) (Point2 2 20)
fromExtent                     :: ( 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 :: 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 (Getting
  (Vector (Dimension vector) (IxValue vector))
  vector
  (Vector (Dimension vector) (IxValue vector))
-> vector -> Vector (Dimension vector) (IxValue vector)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Vector (Dimension vector) (IxValue vector))
  vector
  (Vector (Dimension vector) (IxValue vector))
forall vector vector' (d :: Nat) r s.
AsVector_ vector vector' d r s =>
Iso vector vector' (Vector d r) (Vector d s)
Iso
  vector
  vector
  (Vector (Dimension vector) (IxValue vector))
  (Vector (Dimension vector) (IxValue vector))
_Vector -> Vector (Dimension vector) (IxValue vector)
v) = Point d r -> Point d r -> Box (Point d r)
forall point. point -> point -> Box point
Box Point d r
minP Point d r
maxP
  where
    minP :: Point d r
minP = Vector d r -> Point d r
forall point (d :: Nat) r.
ConstructablePoint_ point d r =>
Vector d r -> point
fromVector (Vector d r -> Point d r)
-> (Vector (Dimension vector) (IxValue vector) -> Vector d r)
-> Vector (Dimension vector) (IxValue vector)
-> Point d r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter
  (Vector (Dimension vector) (IxValue vector))
  (Vector d r)
  (IxValue vector)
  r
-> (IxValue vector -> r)
-> Vector (Dimension vector) (IxValue vector)
-> Vector d r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Vector (Dimension vector) (IxValue vector))
  (Vector d r)
  (IxValue vector)
  r
(IxValue (Vector (Dimension vector) (IxValue vector))
 -> Identity (IxValue (Vector d r)))
-> Vector (Dimension vector) (IxValue vector)
-> Identity (Vector d r)
forall vector vector'.
HasComponents vector vector' =>
IndexedTraversal1
  Int vector vector' (IxValue vector) (IxValue vector')
IndexedTraversal1
  Int
  (Vector (Dimension vector) (IxValue vector))
  (Vector d r)
  (IxValue (Vector (Dimension vector) (IxValue vector)))
  (IxValue (Vector d r))
components (Getting r (IxValue vector) r -> IxValue vector -> r
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting r (IxValue vector) r
forall seg p. HasStart seg p => Lens' seg p
Lens' (IxValue vector) r
start) (Vector (Dimension vector) (IxValue vector) -> Point d r)
-> Vector (Dimension vector) (IxValue vector) -> Point d r
forall a b. (a -> b) -> a -> b
$ Vector (Dimension vector) (IxValue vector)
v
    maxP :: Point d r
maxP = Vector d r -> Point d r
forall point (d :: Nat) r.
ConstructablePoint_ point d r =>
Vector d r -> point
fromVector (Vector d r -> Point d r)
-> (Vector (Dimension vector) (IxValue vector) -> Vector d r)
-> Vector (Dimension vector) (IxValue vector)
-> Point d r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter
  (Vector (Dimension vector) (IxValue vector))
  (Vector d r)
  (IxValue vector)
  r
-> (IxValue vector -> r)
-> Vector (Dimension vector) (IxValue vector)
-> Vector d r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Vector (Dimension vector) (IxValue vector))
  (Vector d r)
  (IxValue vector)
  r
(IxValue (Vector (Dimension vector) (IxValue vector))
 -> Identity (IxValue (Vector d r)))
-> Vector (Dimension vector) (IxValue vector)
-> Identity (Vector d r)
forall vector vector'.
HasComponents vector vector' =>
IndexedTraversal1
  Int vector vector' (IxValue vector) (IxValue vector')
IndexedTraversal1
  Int
  (Vector (Dimension vector) (IxValue vector))
  (Vector d r)
  (IxValue (Vector (Dimension vector) (IxValue vector)))
  (IxValue (Vector d r))
components (Getting r (IxValue vector) r -> IxValue vector -> r
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting r (IxValue vector) r
forall seg p. HasEnd seg p => Lens' seg p
Lens' (IxValue vector) r
end)   (Vector (Dimension vector) (IxValue vector) -> Point d r)
-> Vector (Dimension vector) (IxValue vector) -> Point d r
forall a b. (a -> b) -> a -> b
$ Vector (Dimension vector) (IxValue vector)
v