{-# LANGUAGE TemplateHaskell  #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Geometry.Box.Corners
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--------------------------------------------------------------------------------
module Data.Geometry.Box.Corners( Corners(Corners), northWest, northEast, southEast, southWest
                                , corners, cornersInDirection
                                ) where

import Control.Lens (makeLenses,Ixed(..),Index, IxValue,(%~),(&),(^?!))
import Data.Ext
import Data.Functor.Apply
import Data.Geometry.Box.Internal
import Data.Geometry.Directions
import Data.Geometry.Point
import Data.Semigroup.Foldable.Class
import Data.Semigroup.Traversable.Class
import Data.Util
import GHC.Generics (Generic)

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

-- | A Quadrant data type
data Corners a = Corners { Corners a -> a
_northWest  :: !a
                         , Corners a -> a
_northEast  :: !a
                         , Corners a -> a
_southEast  :: !a
                         , Corners a -> a
_southWest  :: !a
                         } deriving (Int -> Corners a -> ShowS
[Corners a] -> ShowS
Corners a -> String
(Int -> Corners a -> ShowS)
-> (Corners a -> String)
-> ([Corners a] -> ShowS)
-> Show (Corners a)
forall a. Show a => Int -> Corners a -> ShowS
forall a. Show a => [Corners a] -> ShowS
forall a. Show a => Corners a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Corners a] -> ShowS
$cshowList :: forall a. Show a => [Corners a] -> ShowS
show :: Corners a -> String
$cshow :: forall a. Show a => Corners a -> String
showsPrec :: Int -> Corners a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Corners a -> ShowS
Show,Corners a -> Corners a -> Bool
(Corners a -> Corners a -> Bool)
-> (Corners a -> Corners a -> Bool) -> Eq (Corners a)
forall a. Eq a => Corners a -> Corners a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Corners a -> Corners a -> Bool
$c/= :: forall a. Eq a => Corners a -> Corners a -> Bool
== :: Corners a -> Corners a -> Bool
$c== :: forall a. Eq a => Corners a -> Corners a -> Bool
Eq,Eq (Corners a)
Eq (Corners a)
-> (Corners a -> Corners a -> Ordering)
-> (Corners a -> Corners a -> Bool)
-> (Corners a -> Corners a -> Bool)
-> (Corners a -> Corners a -> Bool)
-> (Corners a -> Corners a -> Bool)
-> (Corners a -> Corners a -> Corners a)
-> (Corners a -> Corners a -> Corners a)
-> Ord (Corners a)
Corners a -> Corners a -> Bool
Corners a -> Corners a -> Ordering
Corners a -> Corners a -> Corners a
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 a. Ord a => Eq (Corners a)
forall a. Ord a => Corners a -> Corners a -> Bool
forall a. Ord a => Corners a -> Corners a -> Ordering
forall a. Ord a => Corners a -> Corners a -> Corners a
min :: Corners a -> Corners a -> Corners a
$cmin :: forall a. Ord a => Corners a -> Corners a -> Corners a
max :: Corners a -> Corners a -> Corners a
$cmax :: forall a. Ord a => Corners a -> Corners a -> Corners a
>= :: Corners a -> Corners a -> Bool
$c>= :: forall a. Ord a => Corners a -> Corners a -> Bool
> :: Corners a -> Corners a -> Bool
$c> :: forall a. Ord a => Corners a -> Corners a -> Bool
<= :: Corners a -> Corners a -> Bool
$c<= :: forall a. Ord a => Corners a -> Corners a -> Bool
< :: Corners a -> Corners a -> Bool
$c< :: forall a. Ord a => Corners a -> Corners a -> Bool
compare :: Corners a -> Corners a -> Ordering
$ccompare :: forall a. Ord a => Corners a -> Corners a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Corners a)
Ord,(forall x. Corners a -> Rep (Corners a) x)
-> (forall x. Rep (Corners a) x -> Corners a)
-> Generic (Corners a)
forall x. Rep (Corners a) x -> Corners a
forall x. Corners a -> Rep (Corners a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Corners a) x -> Corners a
forall a x. Corners a -> Rep (Corners a) x
$cto :: forall a x. Rep (Corners a) x -> Corners a
$cfrom :: forall a x. Corners a -> Rep (Corners a) x
Generic,a -> Corners b -> Corners a
(a -> b) -> Corners a -> Corners b
(forall a b. (a -> b) -> Corners a -> Corners b)
-> (forall a b. a -> Corners b -> Corners a) -> Functor Corners
forall a b. a -> Corners b -> Corners a
forall a b. (a -> b) -> Corners a -> Corners b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Corners b -> Corners a
$c<$ :: forall a b. a -> Corners b -> Corners a
fmap :: (a -> b) -> Corners a -> Corners b
$cfmap :: forall a b. (a -> b) -> Corners a -> Corners b
Functor,Corners a -> Bool
(a -> m) -> Corners a -> m
(a -> b -> b) -> b -> Corners a -> b
(forall m. Monoid m => Corners m -> m)
-> (forall m a. Monoid m => (a -> m) -> Corners a -> m)
-> (forall m a. Monoid m => (a -> m) -> Corners a -> m)
-> (forall a b. (a -> b -> b) -> b -> Corners a -> b)
-> (forall a b. (a -> b -> b) -> b -> Corners a -> b)
-> (forall b a. (b -> a -> b) -> b -> Corners a -> b)
-> (forall b a. (b -> a -> b) -> b -> Corners a -> b)
-> (forall a. (a -> a -> a) -> Corners a -> a)
-> (forall a. (a -> a -> a) -> Corners a -> a)
-> (forall a. Corners a -> [a])
-> (forall a. Corners a -> Bool)
-> (forall a. Corners a -> Int)
-> (forall a. Eq a => a -> Corners a -> Bool)
-> (forall a. Ord a => Corners a -> a)
-> (forall a. Ord a => Corners a -> a)
-> (forall a. Num a => Corners a -> a)
-> (forall a. Num a => Corners a -> a)
-> Foldable Corners
forall a. Eq a => a -> Corners a -> Bool
forall a. Num a => Corners a -> a
forall a. Ord a => Corners a -> a
forall m. Monoid m => Corners m -> m
forall a. Corners a -> Bool
forall a. Corners a -> Int
forall a. Corners a -> [a]
forall a. (a -> a -> a) -> Corners a -> a
forall m a. Monoid m => (a -> m) -> Corners a -> m
forall b a. (b -> a -> b) -> b -> Corners a -> b
forall a b. (a -> b -> b) -> b -> Corners a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Corners a -> a
$cproduct :: forall a. Num a => Corners a -> a
sum :: Corners a -> a
$csum :: forall a. Num a => Corners a -> a
minimum :: Corners a -> a
$cminimum :: forall a. Ord a => Corners a -> a
maximum :: Corners a -> a
$cmaximum :: forall a. Ord a => Corners a -> a
elem :: a -> Corners a -> Bool
$celem :: forall a. Eq a => a -> Corners a -> Bool
length :: Corners a -> Int
$clength :: forall a. Corners a -> Int
null :: Corners a -> Bool
$cnull :: forall a. Corners a -> Bool
toList :: Corners a -> [a]
$ctoList :: forall a. Corners a -> [a]
foldl1 :: (a -> a -> a) -> Corners a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Corners a -> a
foldr1 :: (a -> a -> a) -> Corners a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Corners a -> a
foldl' :: (b -> a -> b) -> b -> Corners a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Corners a -> b
foldl :: (b -> a -> b) -> b -> Corners a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Corners a -> b
foldr' :: (a -> b -> b) -> b -> Corners a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Corners a -> b
foldr :: (a -> b -> b) -> b -> Corners a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Corners a -> b
foldMap' :: (a -> m) -> Corners a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Corners a -> m
foldMap :: (a -> m) -> Corners a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Corners a -> m
fold :: Corners m -> m
$cfold :: forall m. Monoid m => Corners m -> m
Foldable,Functor Corners
Foldable Corners
Functor Corners
-> Foldable Corners
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Corners a -> f (Corners b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Corners (f a) -> f (Corners a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Corners a -> m (Corners b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Corners (m a) -> m (Corners a))
-> Traversable Corners
(a -> f b) -> Corners a -> f (Corners b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Corners (m a) -> m (Corners a)
forall (f :: * -> *) a.
Applicative f =>
Corners (f a) -> f (Corners a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Corners a -> m (Corners b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Corners a -> f (Corners b)
sequence :: Corners (m a) -> m (Corners a)
$csequence :: forall (m :: * -> *) a. Monad m => Corners (m a) -> m (Corners a)
mapM :: (a -> m b) -> Corners a -> m (Corners b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Corners a -> m (Corners b)
sequenceA :: Corners (f a) -> f (Corners a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Corners (f a) -> f (Corners a)
traverse :: (a -> f b) -> Corners a -> f (Corners b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Corners a -> f (Corners b)
$cp2Traversable :: Foldable Corners
$cp1Traversable :: Functor Corners
Traversable)
makeLenses ''Corners


type instance Index   (Corners a) = InterCardinalDirection
type instance IxValue (Corners a) = a

instance Ixed (Corners a) where
  ix :: Index (Corners a) -> Traversal' (Corners a) (IxValue (Corners a))
ix = \case
    Index (Corners a)
NorthWest -> (IxValue (Corners a) -> f (IxValue (Corners a)))
-> Corners a -> f (Corners a)
forall a. Lens' (Corners a) a
northWest
    Index (Corners a)
NorthEast -> (IxValue (Corners a) -> f (IxValue (Corners a)))
-> Corners a -> f (Corners a)
forall a. Lens' (Corners a) a
northEast
    Index (Corners a)
SouthEast -> (IxValue (Corners a) -> f (IxValue (Corners a)))
-> Corners a -> f (Corners a)
forall a. Lens' (Corners a) a
southEast
    Index (Corners a)
SouthWest -> (IxValue (Corners a) -> f (IxValue (Corners a)))
-> Corners a -> f (Corners a)
forall a. Lens' (Corners a) a
southWest

instance Foldable1 Corners
instance Traversable1 Corners where
  traverse1 :: (a -> f b) -> Corners a -> f (Corners b)
traverse1 a -> f b
f (Corners a
a a
b a
c a
d) = b -> b -> b -> b -> Corners b
forall a. a -> a -> a -> a -> Corners a
Corners (b -> b -> b -> b -> Corners b)
-> f b -> f (b -> b -> b -> Corners b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a f (b -> b -> b -> Corners b) -> f b -> f (b -> b -> Corners b)
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> a -> f b
f a
b f (b -> b -> Corners b) -> f b -> f (b -> Corners b)
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> a -> f b
f a
c f (b -> Corners b) -> f b -> f (Corners b)
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> a -> f b
f a
d

instance Applicative Corners where
  pure :: a -> Corners a
pure a
x = a -> a -> a -> a -> Corners a
forall a. a -> a -> a -> a -> Corners a
Corners a
x a
x a
x a
x
  (Corners a -> b
f a -> b
g a -> b
h a -> b
i) <*> :: Corners (a -> b) -> Corners a -> Corners b
<*> (Corners a
a a
b a
c a
d) = b -> b -> b -> b -> Corners b
forall a. a -> a -> a -> a -> Corners a
Corners (a -> b
f a
a) (a -> b
g a
b) (a -> b
h a
c) (a -> b
i a
d)

instance Semigroup a => Semigroup (Corners a) where
  Corners a
s <> :: Corners a -> Corners a -> Corners a
<> Corners a
s' = a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) (a -> a -> a) -> Corners a -> Corners (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Corners a
s Corners (a -> a) -> Corners a -> Corners a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Corners a
s'
instance Monoid a => Monoid (Corners a) where
  mempty :: Corners a
mempty = a -> Corners a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty


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

{- HLINT ignore corners -}
-- | Get the corners of a rectangle, the order is:
-- (TopLeft, TopRight, BottomRight, BottomLeft).
-- The extra values in the Top points are taken from the Top point,
-- the extra values in the Bottom points are taken from the Bottom point
corners :: Num r => Rectangle p r -> Corners (Point 2 r :+ p)
corners :: Rectangle p r -> Corners (Point 2 r :+ p)
corners Rectangle p r
r     = let w :: r
w = Rectangle p r -> r
forall r p. Num r => Rectangle p r -> r
width Rectangle p r
r
                    p :: Point 2 r :+ p
p = (Rectangle p r -> CWMax (Point 2 r) :+ p
forall (d :: Nat) p r. Box d p r -> CWMax (Point d r) :+ p
_maxP Rectangle p r
r)(CWMax (Point 2 r) :+ p)
-> ((CWMax (Point 2 r) :+ p) -> Point 2 r :+ p) -> Point 2 r :+ p
forall a b. a -> (a -> b) -> b
&(CWMax (Point 2 r) -> Identity (Point 2 r))
-> (CWMax (Point 2 r) :+ p) -> Identity (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core ((CWMax (Point 2 r) -> Identity (Point 2 r))
 -> (CWMax (Point 2 r) :+ p) -> Identity (Point 2 r :+ p))
-> (CWMax (Point 2 r) -> Point 2 r)
-> (CWMax (Point 2 r) :+ p)
-> Point 2 r :+ p
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ CWMax (Point 2 r) -> Point 2 r
forall a. CWMax a -> a
_cwMax
                    q :: Point 2 r :+ p
q = (Rectangle p r -> CWMin (Point 2 r) :+ p
forall (d :: Nat) p r. Box d p r -> CWMin (Point d r) :+ p
_minP Rectangle p r
r)(CWMin (Point 2 r) :+ p)
-> ((CWMin (Point 2 r) :+ p) -> Point 2 r :+ p) -> Point 2 r :+ p
forall a b. a -> (a -> b) -> b
&(CWMin (Point 2 r) -> Identity (Point 2 r))
-> (CWMin (Point 2 r) :+ p) -> Identity (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core ((CWMin (Point 2 r) -> Identity (Point 2 r))
 -> (CWMin (Point 2 r) :+ p) -> Identity (Point 2 r :+ p))
-> (CWMin (Point 2 r) -> Point 2 r)
-> (CWMin (Point 2 r) :+ p)
-> Point 2 r :+ p
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ CWMin (Point 2 r) -> Point 2 r
forall a. CWMin a -> a
_cwMin
                in (Point 2 r :+ p)
-> (Point 2 r :+ p)
-> (Point 2 r :+ p)
-> (Point 2 r :+ p)
-> Corners (Point 2 r :+ p)
forall a. a -> a -> a -> a -> Corners a
Corners (Point 2 r :+ p
p(Point 2 r :+ p)
-> ((Point 2 r :+ p) -> Point 2 r :+ p) -> Point 2 r :+ p
forall a b. a -> (a -> b) -> b
&(Point 2 r -> Identity (Point 2 r))
-> (Point 2 r :+ p) -> Identity (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core((Point 2 r -> Identity (Point 2 r))
 -> (Point 2 r :+ p) -> Identity (Point 2 r :+ p))
-> ((r -> Identity r) -> Point 2 r -> Identity (Point 2 r))
-> (r -> Identity r)
-> (Point 2 r :+ p)
-> Identity (Point 2 r :+ p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Identity r) -> Point 2 r -> Identity (Point 2 r)
forall (d :: Nat) (point :: Nat -> * -> *) r.
(1 <= d, Arity d, AsAPoint point) =>
Lens' (point d r) r
xCoord ((r -> Identity r)
 -> (Point 2 r :+ p) -> Identity (Point 2 r :+ p))
-> (r -> r) -> (Point 2 r :+ p) -> Point 2 r :+ p
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ r -> r -> r
forall a. Num a => a -> a -> a
subtract r
w) Point 2 r :+ p
p
                           (Point 2 r :+ p
q(Point 2 r :+ p)
-> ((Point 2 r :+ p) -> Point 2 r :+ p) -> Point 2 r :+ p
forall a b. a -> (a -> b) -> b
&(Point 2 r -> Identity (Point 2 r))
-> (Point 2 r :+ p) -> Identity (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core((Point 2 r -> Identity (Point 2 r))
 -> (Point 2 r :+ p) -> Identity (Point 2 r :+ p))
-> ((r -> Identity r) -> Point 2 r -> Identity (Point 2 r))
-> (r -> Identity r)
-> (Point 2 r :+ p)
-> Identity (Point 2 r :+ p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Identity r) -> Point 2 r -> Identity (Point 2 r)
forall (d :: Nat) (point :: Nat -> * -> *) r.
(1 <= d, Arity d, AsAPoint point) =>
Lens' (point d r) r
xCoord ((r -> Identity r)
 -> (Point 2 r :+ p) -> Identity (Point 2 r :+ p))
-> (r -> r) -> (Point 2 r :+ p) -> Point 2 r :+ p
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (r -> r -> r
forall a. Num a => a -> a -> a
+ r
w))      Point 2 r :+ p
q


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

-- | Gets the corners in a particular direction
cornersInDirection     :: CardinalDirection -> Corners p -> Two p
cornersInDirection :: CardinalDirection -> Corners p -> Two p
cornersInDirection CardinalDirection
d Corners p
c = (\InterCardinalDirection
icd -> Corners p
cCorners p -> Getting (Endo p) (Corners p) p -> p
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?!Index (Corners p) -> Traversal' (Corners p) (IxValue (Corners p))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Corners p)
InterCardinalDirection
icd) (InterCardinalDirection -> p) -> V2 InterCardinalDirection -> Two p
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CardinalDirection -> V2 InterCardinalDirection
interCardinalsOf CardinalDirection
d