{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise #-}
{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Box.Class
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- d dimensional boxes
--
--------------------------------------------------------------------------------
module HGeometry.Box.Class
  ( Box_(..)
  , HasMinPoint(..)
  , HasMaxPoint(..)
  , centerPoint

  , Rectangle_
  , width
  , height


  , size
  ) where

import Control.Lens
-- import Control.Subcategory.Functor
import HGeometry.Ext
import Data.Type.Ord
import GHC.TypeLits
import HGeometry.Interval
import HGeometry.Point
import HGeometry.Properties
import HGeometry.Vector

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

-- $setup
-- >>> import HGeometry.Box
-- >>> let myRect = Rectangle (Point2 1 1) (Point2 10 20.0) :: Rectangle (Point 2 Double)

-- | Types that have a 'minPoint' field lens
class HasMinPoint box point | box -> point where
  -- | Lens to access the lexicographically smallest point
  minPoint :: Lens' box point

-- | Types that have a 'maxPoint' field lens
class HasMaxPoint box point | box -> point where
  -- | Lens to access the lexicographically largest point
  maxPoint :: Lens' box point

-- | d-dimensional Boxes
class ( HasMinPoint box point
      , HasMaxPoint box point
      , Point_ point (Dimension box) (NumType box)
      -- , PointFor box ~ point
      -- , NumType box ~ NumType point
      ) => Box_ box point | box -> point where

  -- | Get a vector with the extent of the box in each dimension. Note
  -- that the resulting vector is 0 indexed whereas one would normally
  -- count dimensions starting at zero.
  extent :: ( r ~ NumType box
            , d ~ Dimension box
            , Num r
            ) => box -> Vector d (ClosedInterval r)

-- | Rectangles are two dimensional boxes.
type Rectangle_ rectangle point = (Box_ rectangle point, Dimension rectangle ~ 2)

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

-- | Get the size of the box (in all dimensions). Note that the
-- resulting vector is 0 indexed whereas one would normally count
-- dimensions starting at zero.
--
-- >>> size myRect
-- Vector2 9.0 19.0
size :: forall box d point r.
        ( Box_ box point, Point_ point d r
        , Num r
        , Functor (Vector d)
        ) => box -> Vector d r
size :: forall box (d :: Nat) point r.
(Box_ box point, Point_ point d r, Num r, Functor (Vector d)) =>
box -> Vector d r
size = (ClosedInterval r -> r)
-> Vector d (ClosedInterval r) -> Vector d r
forall a b. (a -> b) -> Vector d a -> Vector d b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ClosedInterval r -> r
forall interval r. (Interval_ interval r, Num r) => interval -> r
duration (Vector d (ClosedInterval r) -> Vector d r)
-> (box -> Vector d (ClosedInterval r)) -> box -> Vector d r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. box -> Vector d (ClosedInterval r)
forall r (d :: Nat).
(r ~ NumType box, d ~ Dimension box, Num r) =>
box -> 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


-- | Given a dimension, get the width of the box in that dimension.
-- Dimensions are 0 indexed.
widthIn :: forall i box d point r. ( Box_ box point, Point_ point d r
                                   , i <= d - 1
                                   , KnownNat i
                                   , Functor (Vector d)
                                   , Num r
                                   ) => box -> r
widthIn :: forall (i :: Nat) box (d :: Nat) point r.
(Box_ box point, Point_ point d r, i <= (d - 1), KnownNat i,
 Functor (Vector d), Num r) =>
box -> r
widthIn = Getting r (Vector d r) r -> Vector d r -> r
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (forall (i :: Nat) vector r (d :: Nat).
(i <= (d - 1), KnownNat i, Vector_ vector d r) =>
IndexedLens' Int vector r
component @i) (Vector d r -> r) -> (box -> Vector d r) -> box -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. box -> Vector d r
forall box (d :: Nat) point r.
(Box_ box point, Point_ point d r, Num r, Functor (Vector d)) =>
box -> Vector d r
size


-- | Get the width of a rectangle.
width :: ( Box_ box point, Point_ point d r
         , 1 <= d
         , Functor (Vector d)
         , Num r
         ) => box -> r
width :: forall box point (d :: Nat) r.
(Box_ box point, Point_ point d r, 1 <= d, Functor (Vector d),
 Num r) =>
box -> r
width  = forall (i :: Nat) box (d :: Nat) point r.
(Box_ box point, Point_ point d r, i <= (d - 1), KnownNat i,
 Functor (Vector d), Num r) =>
box -> r
widthIn @0

-- | get the height of a rectangle
height :: ( Box_ box point, Point_ point d r
         , 2 <= d
         , Functor (Vector d)
         , Num r
         ) => box -> r
height :: forall box point (d :: Nat) r.
(Box_ box point, Point_ point d r, 2 <= d, Functor (Vector d),
 Num r) =>
box -> r
height = forall (i :: Nat) box (d :: Nat) point r.
(Box_ box point, Point_ point d r, i <= (d - 1), KnownNat i,
 Functor (Vector d), Num r) =>
box -> r
widthIn @1

-- | Get the center point of a box
--
-- >>> centerPoint myRect
-- Point2 5.5 10.5
centerPoint   :: (Box_ box point, Point_ point d r, Fractional r)
              => box -> point
centerPoint :: forall box point (d :: Nat) r.
(Box_ box point, Point_ point d r, Fractional r) =>
box -> point
centerPoint box
r = let v :: Vector d r
v = (box
rbox -> Getting point box point -> point
forall s a. s -> Getting a s a -> a
^.Getting point box point
forall box point. HasMaxPoint box point => Lens' box point
Lens' box point
maxPoint) point -> point -> Vector d r
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> point -> Vector d r
.-. (box
rbox -> Getting point box point -> point
forall s a. s -> Getting a s a -> a
^.Getting point box point
forall box point. HasMinPoint box point => Lens' box point
Lens' box point
minPoint)
                in (box
rbox -> Getting point box point -> point
forall s a. s -> Getting a s a -> a
^.Getting point box point
forall box point. HasMinPoint box point => Lens' box point
Lens' box point
minPoint) point -> Vector d r -> point
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> Vector d r -> point
.+^ ((r
1r -> r -> r
forall a. Fractional a => a -> a -> a
/r
2) r -> Vector d r -> Vector d r
forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
r -> vector -> vector
*^ Vector d r
v)

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

instance HasMinPoint box point => HasMinPoint (box :+ extra) point where
  minPoint :: Lens' (box :+ extra) point
minPoint = (box -> f box) -> (box :+ extra) -> f (box :+ extra)
forall core extra core' (f :: * -> *).
Functor f =>
(core -> f core') -> (core :+ extra) -> f (core' :+ extra)
core((box -> f box) -> (box :+ extra) -> f (box :+ extra))
-> ((point -> f point) -> box -> f box)
-> (point -> f point)
-> (box :+ extra)
-> f (box :+ extra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(point -> f point) -> box -> f box
forall box point. HasMinPoint box point => Lens' box point
Lens' box point
minPoint
  {-# INLINE minPoint #-}
instance HasMaxPoint box point => HasMaxPoint (box :+ extra) point where
  maxPoint :: Lens' (box :+ extra) point
maxPoint = (box -> f box) -> (box :+ extra) -> f (box :+ extra)
forall core extra core' (f :: * -> *).
Functor f =>
(core -> f core') -> (core :+ extra) -> f (core' :+ extra)
core((box -> f box) -> (box :+ extra) -> f (box :+ extra))
-> ((point -> f point) -> box -> f box)
-> (point -> f point)
-> (box :+ extra)
-> f (box :+ extra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(point -> f point) -> box -> f box
forall box point. HasMaxPoint box point => Lens' box point
Lens' box point
maxPoint
  {-# INLINE maxPoint #-}
instance Box_ box point => Box_ (box :+ extra) point where
  extent :: forall r (d :: Nat).
(r ~ NumType (box :+ extra), d ~ Dimension (box :+ extra),
 Num r) =>
(box :+ extra) -> Vector d (ClosedInterval r)
extent = box -> Vector d (ClosedInterval r)
forall r (d :: Nat).
(r ~ NumType box, d ~ Dimension box, Num r) =>
box -> 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 -> Vector d (ClosedInterval r))
-> ((box :+ extra) -> box)
-> (box :+ extra)
-> Vector d (ClosedInterval r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting box (box :+ extra) box -> (box :+ extra) -> box
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting box (box :+ extra) box
forall core extra core' (f :: * -> *).
Functor f =>
(core -> f core') -> (core :+ extra) -> f (core' :+ extra)
core
  {-# INLINE extent #-}