{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- | A (finite) two-dimensional plane, implemented as a composite of a 'Point' of 'Range's.
module NumHask.Space.Rect
  ( Rect (..),
    pattern Rect,
    pattern Ranges,
    rx,
    rz,
    ry,
    rw,
    flipAxes,
    corners,
    corners4,
    projectRect,
    foldRect,
    foldRectUnsafe,
    addPoint,
    rotationBound,
    gridR,
    gridF,
    aspect,
    ratio,
    projectOnR,
    projectOnP,
  )
where

import Data.Distributive as D
import Data.Functor.Compose
import Data.Functor.Rep
import Data.List.NonEmpty
import NumHask.Prelude hiding (Distributive)
import NumHask.Space.Point
import NumHask.Space.Range
import NumHask.Space.Types

-- $setup
--
-- >>> :m -Prelude
-- >>> :set -XRebindableSyntax
-- >>> import NumHask.Prelude
-- >>> import NumHask.Space

-- | a rectangular space often representing a finite 2-dimensional or XY plane.
--
-- >>> one :: Rect Double
-- Rect (-0.5) 0.5 (-0.5) 0.5
--
-- >>> zero :: Rect Double
-- Rect 0.0 0.0 0.0 0.0
--
-- >>> one + one :: Rect Double
-- Rect (-1.0) 1.0 (-1.0) 1.0
--
-- >>> let a = Rect (-1.0) 1.0 (-2.0) 4.0
-- >>> a
-- Rect (-1.0) 1.0 (-2.0) 4.0
--
-- >>> a * one
-- Rect (-1.0) 1.0 (-2.0) 4.0
--
-- >>> let (Ranges x y) = a
-- >>> x
-- Range -1.0 1.0
-- >>> y
-- Range -2.0 4.0
-- >>> fmap (+1) (Rect 1 2 3 4)
-- Rect 2 3 4 5
--
-- as a Space instance with Points as Elements
--
-- >>> project (Rect 0.0 1.0 (-1.0) 0.0) (Rect 1.0 4.0 10.0 0.0) (Point 0.5 1.0)
-- Point 2.5 (-10.0)
-- >>> gridSpace (Rect 0.0 10.0 0.0 1.0) (Point (2::Int) (2::Int))
-- [Rect 0.0 5.0 0.0 0.5,Rect 0.0 5.0 0.5 1.0,Rect 5.0 10.0 0.0 0.5,Rect 5.0 10.0 0.5 1.0]
-- >>> grid MidPos (Rect 0.0 10.0 0.0 1.0) (Point (2::Int) (2::Int))
-- [Point 2.5 0.25,Point 2.5 0.75,Point 7.5 0.25,Point 7.5 0.75]
newtype Rect a
  = Rect' (Compose Point Range a)
  deriving
    ( Rect a -> Rect a -> Bool
(Rect a -> Rect a -> Bool)
-> (Rect a -> Rect a -> Bool) -> Eq (Rect a)
forall a. Eq a => Rect a -> Rect a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Rect a -> Rect a -> Bool
== :: Rect a -> Rect a -> Bool
$c/= :: forall a. Eq a => Rect a -> Rect a -> Bool
/= :: Rect a -> Rect a -> Bool
Eq,
      (forall a b. (a -> b) -> Rect a -> Rect b)
-> (forall a b. a -> Rect b -> Rect a) -> Functor Rect
forall a b. a -> Rect b -> Rect a
forall a b. (a -> b) -> Rect a -> Rect 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) -> Rect a -> Rect b
fmap :: forall a b. (a -> b) -> Rect a -> Rect b
$c<$ :: forall a b. a -> Rect b -> Rect a
<$ :: forall a b. a -> Rect b -> Rect a
Functor,
      Functor Rect
Functor Rect =>
(forall a. a -> Rect a)
-> (forall a b. Rect (a -> b) -> Rect a -> Rect b)
-> (forall a b c. (a -> b -> c) -> Rect a -> Rect b -> Rect c)
-> (forall a b. Rect a -> Rect b -> Rect b)
-> (forall a b. Rect a -> Rect b -> Rect a)
-> Applicative Rect
forall a. a -> Rect a
forall a b. Rect a -> Rect b -> Rect a
forall a b. Rect a -> Rect b -> Rect b
forall a b. Rect (a -> b) -> Rect a -> Rect b
forall a b c. (a -> b -> c) -> Rect a -> Rect b -> Rect c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> Rect a
pure :: forall a. a -> Rect a
$c<*> :: forall a b. Rect (a -> b) -> Rect a -> Rect b
<*> :: forall a b. Rect (a -> b) -> Rect a -> Rect b
$cliftA2 :: forall a b c. (a -> b -> c) -> Rect a -> Rect b -> Rect c
liftA2 :: forall a b c. (a -> b -> c) -> Rect a -> Rect b -> Rect c
$c*> :: forall a b. Rect a -> Rect b -> Rect b
*> :: forall a b. Rect a -> Rect b -> Rect b
$c<* :: forall a b. Rect a -> Rect b -> Rect a
<* :: forall a b. Rect a -> Rect b -> Rect a
Applicative,
      (forall m. Monoid m => Rect m -> m)
-> (forall m a. Monoid m => (a -> m) -> Rect a -> m)
-> (forall m a. Monoid m => (a -> m) -> Rect a -> m)
-> (forall a b. (a -> b -> b) -> b -> Rect a -> b)
-> (forall a b. (a -> b -> b) -> b -> Rect a -> b)
-> (forall b a. (b -> a -> b) -> b -> Rect a -> b)
-> (forall b a. (b -> a -> b) -> b -> Rect a -> b)
-> (forall a. (a -> a -> a) -> Rect a -> a)
-> (forall a. (a -> a -> a) -> Rect a -> a)
-> (forall a. Rect a -> [a])
-> (forall a. Rect a -> Bool)
-> (forall a. Rect a -> Int)
-> (forall a. Eq a => a -> Rect a -> Bool)
-> (forall a. Ord a => Rect a -> a)
-> (forall a. Ord a => Rect a -> a)
-> (forall a. Num a => Rect a -> a)
-> (forall a. Num a => Rect a -> a)
-> Foldable Rect
forall a. Eq a => a -> Rect a -> Bool
forall a. Num a => Rect a -> a
forall a. Ord a => Rect a -> a
forall m. Monoid m => Rect m -> m
forall a. Rect a -> Bool
forall a. Rect a -> Int
forall a. Rect a -> [a]
forall a. (a -> a -> a) -> Rect a -> a
forall m a. Monoid m => (a -> m) -> Rect a -> m
forall b a. (b -> a -> b) -> b -> Rect a -> b
forall a b. (a -> b -> b) -> b -> Rect 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
$cfold :: forall m. Monoid m => Rect m -> m
fold :: forall m. Monoid m => Rect m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Rect a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Rect a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Rect a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Rect a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Rect a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Rect a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Rect a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Rect a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Rect a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Rect a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Rect a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Rect a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Rect a -> a
foldr1 :: forall a. (a -> a -> a) -> Rect a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Rect a -> a
foldl1 :: forall a. (a -> a -> a) -> Rect a -> a
$ctoList :: forall a. Rect a -> [a]
toList :: forall a. Rect a -> [a]
$cnull :: forall a. Rect a -> Bool
null :: forall a. Rect a -> Bool
$clength :: forall a. Rect a -> Int
length :: forall a. Rect a -> Int
$celem :: forall a. Eq a => a -> Rect a -> Bool
elem :: forall a. Eq a => a -> Rect a -> Bool
$cmaximum :: forall a. Ord a => Rect a -> a
maximum :: forall a. Ord a => Rect a -> a
$cminimum :: forall a. Ord a => Rect a -> a
minimum :: forall a. Ord a => Rect a -> a
$csum :: forall a. Num a => Rect a -> a
sum :: forall a. Num a => Rect a -> a
$cproduct :: forall a. Num a => Rect a -> a
product :: forall a. Num a => Rect a -> a
Foldable,
      Functor Rect
Foldable Rect
(Functor Rect, Foldable Rect) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Rect a -> f (Rect b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Rect (f a) -> f (Rect a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Rect a -> m (Rect b))
-> (forall (m :: * -> *) a. Monad m => Rect (m a) -> m (Rect a))
-> Traversable Rect
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 => Rect (m a) -> m (Rect a)
forall (f :: * -> *) a. Applicative f => Rect (f a) -> f (Rect a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Rect a -> m (Rect b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Rect a -> f (Rect b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Rect a -> f (Rect b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Rect a -> f (Rect b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Rect (f a) -> f (Rect a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Rect (f a) -> f (Rect a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Rect a -> m (Rect b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Rect a -> m (Rect b)
$csequence :: forall (m :: * -> *) a. Monad m => Rect (m a) -> m (Rect a)
sequence :: forall (m :: * -> *) a. Monad m => Rect (m a) -> m (Rect a)
Traversable,
      (forall x. Rect a -> Rep (Rect a) x)
-> (forall x. Rep (Rect a) x -> Rect a) -> Generic (Rect a)
forall x. Rep (Rect a) x -> Rect a
forall x. Rect a -> Rep (Rect a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Rect a) x -> Rect a
forall a x. Rect a -> Rep (Rect a) x
$cfrom :: forall a x. Rect a -> Rep (Rect a) x
from :: forall x. Rect a -> Rep (Rect a) x
$cto :: forall a x. Rep (Rect a) x -> Rect a
to :: forall x. Rep (Rect a) x -> Rect a
Generic
    )

-- | pattern of Rect lowerx upperx lowery uppery
pattern Rect :: a -> a -> a -> a -> Rect a
pattern $mRect :: forall {r} {a}.
Rect a -> (a -> a -> a -> a -> r) -> ((# #) -> r) -> r
$bRect :: forall a. a -> a -> a -> a -> Rect a
Rect a b c d = Rect' (Compose (Point (Range a b) (Range c d)))

{-# COMPLETE Rect #-}

-- | pattern of Ranges xrange yrange
pattern Ranges :: Range a -> Range a -> Rect a
pattern $mRanges :: forall {r} {a}.
Rect a -> (Range a -> Range a -> r) -> ((# #) -> r) -> r
$bRanges :: forall a. Range a -> Range a -> Rect a
Ranges a b = Rect' (Compose (Point a b))

{-# COMPLETE Ranges #-}

instance (Ord a, Additive a, Show a) => Show (Rect a) where
  show :: Rect a -> String
show (Rect a
a a
b a
c a
d) =
    String
"Rect " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall {a}. (Show a, Ord a, Additive a) => a -> String
wrap a
a String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall {a}. (Show a, Ord a, Additive a) => a -> String
wrap a
b String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall {a}. (Show a, Ord a, Additive a) => a -> String
wrap a
c String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall {a}. (Show a, Ord a, Additive a) => a -> String
wrap a
d
    where
      wrap :: a -> String
wrap a
x = String -> String -> Bool -> String
forall a. a -> a -> Bool -> a
bool (a -> String
forall a. Show a => a -> String
show a
x) (String
"(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")") (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
forall a. Additive a => a
zero)

instance Distributive Rect where
  collect :: forall (f :: * -> *) a b.
Functor f =>
(a -> Rect b) -> f a -> Rect (f b)
collect a -> Rect b
f f a
x =
    f b -> f b -> f b -> f b -> Rect (f b)
forall a. a -> a -> a -> a -> Rect a
Rect (Rect b -> b
forall {a}. Rect a -> a
getA (Rect b -> b) -> (a -> Rect b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Rect b
f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x) (Rect b -> b
forall {a}. Rect a -> a
getB (Rect b -> b) -> (a -> Rect b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Rect b
f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x) (Rect b -> b
forall {a}. Rect a -> a
getC (Rect b -> b) -> (a -> Rect b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Rect b
f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x) (Rect b -> b
forall {a}. Rect a -> a
getD (Rect b -> b) -> (a -> Rect b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Rect b
f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x)
    where
      getA :: Rect a -> a
getA (Rect a
a a
_ a
_ a
_) = a
a
      getB :: Rect a -> a
getB (Rect a
_ a
b a
_ a
_) = a
b
      getC :: Rect a -> a
getC (Rect a
_ a
_ a
c a
_) = a
c
      getD :: Rect a -> a
getD (Rect a
_ a
_ a
_ a
d) = a
d

instance Representable Rect where
  type Rep Rect = (Bool, Bool)

  tabulate :: forall a. (Rep Rect -> a) -> Rect a
tabulate Rep Rect -> a
f =
    a -> a -> a -> a -> Rect a
forall a. a -> a -> a -> a -> Rect a
Rect (Rep Rect -> a
f (Bool
False, Bool
False)) (Rep Rect -> a
f (Bool
False, Bool
True)) (Rep Rect -> a
f (Bool
True, Bool
False)) (Rep Rect -> a
f (Bool
True, Bool
True))

  index :: forall a. Rect a -> Rep Rect -> a
index (Rect a
a a
_ a
_ a
_) (Bool
False, Bool
False) = a
a
  index (Rect a
_ a
b a
_ a
_) (Bool
False, Bool
True) = a
b
  index (Rect a
_ a
_ a
c a
_) (Bool
True, Bool
False) = a
c
  index (Rect a
_ a
_ a
_ a
d) (Bool
True, Bool
True) = a
d

instance (Ord a) => Semigroup (Rect a) where
  <> :: Rect a -> Rect a -> Rect a
(<>) = Rect a -> Rect a -> Rect a
forall s. Space s => s -> s -> s
union

instance (Ord a) => Space (Rect a) where
  type Element (Rect a) = Point a

  union :: Rect a -> Rect a -> Rect a
union (Ranges Range a
a Range a
b) (Ranges Range a
c Range a
d) = Range a -> Range a -> Rect a
forall a. Range a -> Range a -> Rect a
Ranges (Range a
a Range a -> Range a -> Range a
forall s. Space s => s -> s -> s
`union` Range a
c) (Range a
b Range a -> Range a -> Range a
forall s. Space s => s -> s -> s
`union` Range a
d)

  intersection :: Rect a -> Rect a -> Rect a
intersection (Ranges Range a
a Range a
b) (Ranges Range a
c Range a
d) =
    Range a -> Range a -> Rect a
forall a. Range a -> Range a -> Rect a
Ranges
      (Range a
a Range a -> Range a -> Range a
forall s. Space s => s -> s -> s
`intersection` Range a
c)
      (Range a
b Range a -> Range a -> Range a
forall s. Space s => s -> s -> s
`intersection` Range a
d)

  >.< :: Element (Rect a) -> Element (Rect a) -> Rect a
(>.<) (Point a
l0 a
l1) (Point a
u0 a
u1) = a -> a -> a -> a -> Rect a
forall a. a -> a -> a -> a -> Rect a
Rect a
l0 a
u0 a
l1 a
u1

  lower :: Rect a -> Element (Rect a)
lower (Rect a
l0 a
_ a
l1 a
_) = a -> a -> Point a
forall a. a -> a -> Point a
Point a
l0 a
l1

  upper :: Rect a -> Element (Rect a)
upper (Rect a
_ a
u0 a
_ a
u1) = a -> a -> Point a
forall a. a -> a -> Point a
Point a
u0 a
u1

  singleton :: Element (Rect a) -> Rect a
singleton (Point a
x a
y) = a -> a -> a -> a -> Rect a
forall a. a -> a -> a -> a -> Rect a
Rect a
x a
x a
y a
y

  ... :: Element (Rect a) -> Element (Rect a) -> Rect a
(...) Element (Rect a)
p Element (Rect a)
p' = (Element (Rect a)
Point a
p Point a -> Point a -> Point a
forall a. MeetSemiLattice a => a -> a -> a
/\ Element (Rect a)
Point a
p') Element (Rect a) -> Element (Rect a) -> Rect a
forall s. Space s => Element s -> Element s -> s
>.< (Element (Rect a)
Point a
p Point a -> Point a -> Point a
forall a. JoinSemiLattice a => a -> a -> a
\/ Element (Rect a)
Point a
p')

  |.| :: Element (Rect a) -> Rect a -> Bool
(|.|) Element (Rect a)
a Rect a
s = (Element (Rect a)
Point a
a Point a -> Point a -> Bool
forall a. MeetSemiLattice a => a -> a -> Bool
`meetLeq` Rect a -> Element (Rect a)
forall s. Space s => s -> Element s
lower Rect a
s) Bool -> Bool -> Bool
&& (Rect a -> Element (Rect a)
forall s. Space s => s -> Element s
upper Rect a
s Point a -> Point a -> Bool
forall a. MeetSemiLattice a => a -> a -> Bool
`meetLeq` Element (Rect a)
Point a
a)

  |>| :: Rect a -> Rect a -> Bool
(|>|) Rect a
s0 Rect a
s1 = Rect a -> Element (Rect a)
forall s. Space s => s -> Element s
lower Rect a
s0 Point a -> Point a -> Bool
forall a. MeetSemiLattice a => a -> a -> Bool
`meetLeq` Rect a -> Element (Rect a)
forall s. Space s => s -> Element s
upper Rect a
s1

  |<| :: Rect a -> Rect a -> Bool
(|<|) Rect a
s0 Rect a
s1 = Rect a -> Element (Rect a)
forall s. Space s => s -> Element s
lower Rect a
s1 Point a -> Point a -> Bool
forall a. JoinSemiLattice a => a -> a -> Bool
`joinLeq` Rect a -> Element (Rect a)
forall s. Space s => s -> Element s
upper Rect a
s0

instance (FromIntegral a Int, Field a, Ord a) => FieldSpace (Rect a) where
  type Grid (Rect a) = Point Int

  grid :: Pos -> Rect a -> Grid (Rect a) -> [Element (Rect a)]
grid Pos
o Rect a
s Grid (Rect a)
n = (Point a -> Point a -> Point a
forall a. Additive a => a -> a -> a
+ Point a -> Point a -> Bool -> Point a
forall a. a -> a -> Bool -> a
bool Point a
forall a. Additive a => a
zero (Point a
step Point a -> Point a -> Point a
forall a. Divisive a => a -> a -> a
/ (Point a
forall a. Multiplicative a => a
one Point a -> Point a -> Point a
forall a. Additive a => a -> a -> a
+ Point a
forall a. Multiplicative a => a
one)) (Pos
o Pos -> Pos -> Bool
forall a. Eq a => a -> a -> Bool
== Pos
MidPos)) (Point a -> Point a) -> [Point a] -> [Point a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Point a]
posns
    where
      posns :: [Point a]
posns =
        (Rect a -> Element (Rect a)
forall s. Space s => s -> Element s
lower Rect a
s +) (Point a -> Point a)
-> (Point Int -> Point a) -> Point Int -> Point a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Point a
step *) (Point a -> Point a)
-> (Point Int -> Point a) -> Point Int -> Point a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Int -> a) -> Point Int -> Point a
forall a b. (a -> b) -> Point a -> Point b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> a
forall a b. FromIntegral a b => b -> a
fromIntegral
          (Point Int -> Point a) -> [Point Int] -> [Point a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int -> Int -> Point Int
forall a. a -> a -> Point a
Point Int
x Int
y | Int
x <- [Int
x0 .. Int
x1], Int
y <- [Int
y0 .. Int
y1]]
      step :: Point a
step = Point a -> Point a -> Point a
forall a. Divisive a => a -> a -> a
(/) (Rect a -> Element (Rect a)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Rect a
s) (Int -> a
forall a b. FromIntegral a b => b -> a
fromIntegral (Int -> a) -> Point Int -> Point a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Grid (Rect a)
Point Int
n)
      (Point Int
x0 Int
y0, Point Int
x1 Int
y1) =
        case Pos
o of
          Pos
OuterPos -> (Point Int
forall a. Additive a => a
zero, Grid (Rect a)
Point Int
n)
          Pos
InnerPos -> (Point Int
forall a. Multiplicative a => a
one, Grid (Rect a)
Point Int
n Point Int -> Point Int -> Point Int
forall a. Subtractive a => a -> a -> a
- Point Int
forall a. Multiplicative a => a
one)
          Pos
LowerPos -> (Point Int
forall a. Additive a => a
zero, Grid (Rect a)
Point Int
n Point Int -> Point Int -> Point Int
forall a. Subtractive a => a -> a -> a
- Point Int
forall a. Multiplicative a => a
one)
          Pos
UpperPos -> (Point Int
forall a. Multiplicative a => a
one, Grid (Rect a)
Point Int
n)
          Pos
MidPos -> (Point Int
forall a. Additive a => a
zero, Grid (Rect a)
Point Int
n Point Int -> Point Int -> Point Int
forall a. Subtractive a => a -> a -> a
- Point Int
forall a. Multiplicative a => a
one)

  gridSpace :: Rect a -> Grid (Rect a) -> [Rect a]
gridSpace (Ranges Range a
rX Range a
rY) (Point Int
stepX Int
stepY) =
    [ a -> a -> a -> a -> Rect a
forall a. a -> a -> a -> a -> Rect a
Rect a
x (a
x a -> a -> a
forall a. Additive a => a -> a -> a
+ a
sx) a
y (a
y a -> a -> a
forall a. Additive a => a -> a -> a
+ a
sy)
    | a
x <- Pos -> Range a -> Grid (Range a) -> [Element (Range a)]
forall s. FieldSpace s => Pos -> s -> Grid s -> [Element s]
grid Pos
LowerPos Range a
rX Int
Grid (Range a)
stepX,
      a
y <- Pos -> Range a -> Grid (Range a) -> [Element (Range a)]
forall s. FieldSpace s => Pos -> s -> Grid s -> [Element s]
grid Pos
LowerPos Range a
rY Int
Grid (Range a)
stepY
    ]
    where
      sx :: a
sx = Range a -> Element (Range a)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range a
rX a -> a -> a
forall a. Divisive a => a -> a -> a
/ Int -> a
forall a b. FromIntegral a b => b -> a
fromIntegral Int
stepX
      sy :: a
sy = Range a -> Element (Range a)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range a
rY a -> a -> a
forall a. Divisive a => a -> a -> a
/ Int -> a
forall a b. FromIntegral a b => b -> a
fromIntegral Int
stepY

-- | The first X coordinate of a Rect
--
-- >>> rx one
-- -0.5
rx :: Rect a -> a
rx :: forall {a}. Rect a -> a
rx (Rect a
x a
_ a
_ a
_) = a
x

-- | The second X coordinate of a Rect
--
-- >>> rz one
-- 0.5
rz :: Rect a -> a
rz :: forall {a}. Rect a -> a
rz (Rect a
_ a
z a
_ a
_) = a
z

-- | The first Y coordinate of a Rect
--
-- >>> ry one
-- -0.5
ry :: Rect a -> a
ry :: forall {a}. Rect a -> a
ry (Rect a
_ a
_ a
y a
_) = a
y

-- | The second Y coordinate of a Rect
--
-- >>> rw one
-- 0.5
rw :: Rect a -> a
rw :: forall {a}. Rect a -> a
rw (Rect a
_ a
_ a
_ a
w) = a
w

-- | flip axes
--
-- >>> flipAxes (Rect 1 2 3 4)
-- Rect 3 4 1 2
flipAxes :: Rect a -> Rect a
flipAxes :: forall a. Rect a -> Rect a
flipAxes (Rect a
x a
z a
y a
w) = a -> a -> a -> a -> Rect a
forall a. a -> a -> a -> a -> Rect a
Rect a
y a
w a
x a
z

-- | create a list of points representing the lower left and upper right corners of a rectangle.
--
-- >>> corners one
-- [Point (-0.5) (-0.5),Point 0.5 0.5]
corners :: (Ord a) => Rect a -> [Point a]
corners :: forall a. Ord a => Rect a -> [Point a]
corners Rect a
r = [Rect a -> Element (Rect a)
forall s. Space s => s -> Element s
lower Rect a
r, Rect a -> Element (Rect a)
forall s. Space s => s -> Element s
upper Rect a
r]

-- | the 4 corners
--
-- >>> corners4 one
-- [Point (-0.5) (-0.5),Point (-0.5) 0.5,Point 0.5 (-0.5),Point 0.5 0.5]
corners4 :: Rect a -> [Point a]
corners4 :: forall a. Rect a -> [Point a]
corners4 (Rect a
x a
z a
y a
w) =
  [ a -> a -> Point a
forall a. a -> a -> Point a
Point a
x a
y,
    a -> a -> Point a
forall a. a -> a -> Point a
Point a
x a
w,
    a -> a -> Point a
forall a. a -> a -> Point a
Point a
z a
y,
    a -> a -> Point a
forall a. a -> a -> Point a
Point a
z a
w
  ]

-- | project a Rect from an old Space (Rect) to a new one.
--
-- The Space instance of Rect uses Points as Elements, but a Rect can also be a Space over Rects.
--
-- >>> projectRect (Rect 0 1 (-1) 0) (Rect 0 4 0 8) (Rect 0.25 0.75 (-0.75) (-0.25))
-- Rect 1.0 3.0 2.0 6.0
projectRect ::
  (Field a, Ord a) =>
  Rect a ->
  Rect a ->
  Rect a ->
  Rect a
projectRect :: forall a. (Field a, Ord a) => Rect a -> Rect a -> Rect a -> Rect a
projectRect Rect a
r0 Rect a
r1 (Rect a
a a
b a
c a
d) = a -> a -> a -> a -> Rect a
forall a. a -> a -> a -> a -> Rect a
Rect a
a' a
b' a
c' a
d'
  where
    (Point a
a' a
c') = Rect a -> Rect a -> Element (Rect a) -> Element (Rect a)
forall s.
(Space s, Field (Element s)) =>
s -> s -> Element s -> Element s
project Rect a
r0 Rect a
r1 (a -> a -> Point a
forall a. a -> a -> Point a
Point a
a a
c)
    (Point a
b' a
d') = Rect a -> Rect a -> Element (Rect a) -> Element (Rect a)
forall s.
(Space s, Field (Element s)) =>
s -> s -> Element s -> Element s
project Rect a
r0 Rect a
r1 (a -> a -> Point a
forall a. a -> a -> Point a
Point a
b a
d)

-- | Numeric algebra based on interval arithmetic for addition and unitRect and projection for multiplication
-- >>> one + one :: Rect Double
-- Rect (-1.0) 1.0 (-1.0) 1.0
instance (Additive a) => Additive (Rect a) where
  + :: Rect a -> Rect a -> Rect a
(+) (Rect a
a a
b a
c a
d) (Rect a
a' a
b' a
c' a
d') =
    a -> a -> a -> a -> Rect a
forall a. a -> a -> a -> a -> Rect a
Rect (a
a a -> a -> a
forall a. Additive a => a -> a -> a
+ a
a') (a
b a -> a -> a
forall a. Additive a => a -> a -> a
+ a
b') (a
c a -> a -> a
forall a. Additive a => a -> a -> a
+ a
c') (a
d a -> a -> a
forall a. Additive a => a -> a -> a
+ a
d')
  zero :: Rect a
zero = a -> a -> a -> a -> Rect a
forall a. a -> a -> a -> a -> Rect a
Rect a
forall a. Additive a => a
zero a
forall a. Additive a => a
zero a
forall a. Additive a => a
zero a
forall a. Additive a => a
zero

instance (Subtractive a) => Subtractive (Rect a) where
  negate :: Rect a -> Rect a
negate = (a -> a) -> Rect a -> Rect a
forall a b. (a -> b) -> Rect a -> Rect b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Subtractive a => a -> a
negate

instance (Ord a, Field a) => Multiplicative (Rect a) where
  * :: Rect a -> Rect a -> Rect a
(*) (Ranges Range a
x0 Range a
y0) (Ranges Range a
x1 Range a
y1) =
    Range a -> Range a -> Rect a
forall a. Range a -> Range a -> Rect a
Ranges (Range a
x0 Range a -> Range a -> Range a
forall a. Multiplicative a => a -> a -> a
* Range a
x1) (Range a
y0 Range a -> Range a -> Range a
forall a. Multiplicative a => a -> a -> a
* Range a
y1)

  one :: Rect a
one = Range a -> Range a -> Rect a
forall a. Range a -> Range a -> Rect a
Ranges Range a
forall a. Multiplicative a => a
one Range a
forall a. Multiplicative a => a
one

instance (Ord a, Field a) => Divisive (Rect a) where
  recip :: Rect a -> Rect a
recip (Ranges Range a
x Range a
y) = Range a -> Range a -> Rect a
forall a. Range a -> Range a -> Rect a
Ranges (Range a -> Range a
forall a. Divisive a => a -> a
recip Range a
x) (Range a -> Range a
forall a. Divisive a => a -> a
recip Range a
y)

instance (Ord a, Field a) => Basis (Rect a) where
  type Mag (Rect a) = Rect a
  type Base (Rect a) = a
  basis :: Rect a -> Base (Rect a)
basis (Rect a
x a
z a
y a
w) = a -> a -> Bool -> a
forall a. a -> a -> Bool -> a
bool (a -> a
forall a. Subtractive a => a -> a
negate a
forall a. Multiplicative a => a
one) a
forall a. Multiplicative a => a
one (a
z a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
x Bool -> Bool -> Bool
&& (a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
y))
  magnitude :: Rect a -> Mag (Rect a)
magnitude (Ranges Range a
x Range a
y) = Range a -> Range a -> Rect a
forall a. Range a -> Range a -> Rect a
Ranges (Range a -> Mag (Range a)
forall a. Basis a => a -> Mag a
magnitude Range a
x) (Range a -> Mag (Range a)
forall a. Basis a => a -> Mag a
magnitude Range a
y)

-- | convex hull union of Rect's
--
-- >>> foldRect [Rect 0 1 0 1, one]
-- Just Rect (-0.5) 1.0 (-0.5) 1.0
foldRect :: (Ord a) => [Rect a] -> Maybe (Rect a)
foldRect :: forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect [] = Maybe (Rect a)
forall a. Maybe a
Nothing
foldRect (Rect a
x : [Rect a]
xs) = Rect a -> Maybe (Rect a)
forall a. a -> Maybe a
Just (Rect a -> Maybe (Rect a)) -> Rect a -> Maybe (Rect a)
forall a b. (a -> b) -> a -> b
$ NonEmpty (Rect a) -> Rect a
forall a. Semigroup a => NonEmpty a -> a
sconcat (Rect a
x Rect a -> [Rect a] -> NonEmpty (Rect a)
forall a. a -> [a] -> NonEmpty a
:| [Rect a]
xs)

-- | convex hull union of Rect's applied to a non-empty structure
--
-- >>> foldRectUnsafe [Rect 0 1 0 1, one]
-- Rect (-0.5) 1.0 (-0.5) 1.0
foldRectUnsafe :: (Foldable f, Ord a) => f (Rect a) -> Rect a
foldRectUnsafe :: forall (f :: * -> *) a. (Foldable f, Ord a) => f (Rect a) -> Rect a
foldRectUnsafe = (Rect a -> Rect a -> Rect a) -> f (Rect a) -> Rect a
forall a. (a -> a -> a) -> f a -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Rect a -> Rect a -> Rect a
forall a. Semigroup a => a -> a -> a
(<>)

-- | add a Point to a Rect
--
-- >>> addPoint (Point 0 1) one
-- Rect (-0.5) 0.5 0.5 1.5
addPoint :: (Additive a) => Point a -> Rect a -> Rect a
addPoint :: forall a. Additive a => Point a -> Rect a -> Rect a
addPoint (Point a
x' a
y') (Rect a
x a
z a
y a
w) = a -> a -> a -> a -> Rect a
forall a. a -> a -> a -> a -> Rect a
Rect (a
x a -> a -> a
forall a. Additive a => a -> a -> a
+ a
x') (a
z a -> a -> a
forall a. Additive a => a -> a -> a
+ a
x') (a
y a -> a -> a
forall a. Additive a => a -> a -> a
+ a
y') (a
w a -> a -> a
forall a. Additive a => a -> a -> a
+ a
y')

-- | rotate the corners of a Rect by x degrees relative to the origin, and fold to a new Rect
--
-- >>> rotationBound (pi/4) one
-- Rect (-0.7071067811865475) 0.7071067811865475 (-0.7071067811865475) 0.7071067811865475
rotationBound :: (TrigField a, Ord a) => a -> Rect a -> Rect a
rotationBound :: forall a. (TrigField a, Ord a) => a -> Rect a -> Rect a
rotationBound a
d = [Element (Rect a)] -> Rect a
[Point a] -> Rect a
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> s
unsafeSpace1 ([Point a] -> Rect a) -> (Rect a -> [Point a]) -> Rect a -> Rect a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Point a -> Point a) -> [Point a] -> [Point a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> Transform a
forall a. TrigField a => a -> Transform a
rotate a
d |.) ([Point a] -> [Point a])
-> (Rect a -> [Point a]) -> Rect a -> [Point a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rect a -> [Point a]
forall a. Rect a -> [Point a]
corners4

-- | Create Rects for a formulae y = f(x) across an x range where the y range is Range 0 y
--
-- >>> gridR (^2) (Range 0 4) 4
-- [Rect 0.0 1.0 0.0 0.25,Rect 1.0 2.0 0.0 2.25,Rect 2.0 3.0 0.0 6.25,Rect 3.0 4.0 0.0 12.25]
gridR :: (Field a, FromIntegral a Int, Ord a) => (a -> a) -> Range a -> Int -> [Rect a]
gridR :: forall a.
(Field a, FromIntegral a Int, Ord a) =>
(a -> a) -> Range a -> Int -> [Rect a]
gridR a -> a
f Range a
r Int
g = (\a
x -> a -> a -> a -> a -> Rect a
forall a. a -> a -> a -> a -> Rect a
Rect (a
x a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
tick a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
forall a. (Multiplicative a, Additive a) => a
two) (a
x a -> a -> a
forall a. Additive a => a -> a -> a
+ a
tick a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
forall a. (Multiplicative a, Additive a) => a
two) a
forall a. Additive a => a
zero (a -> a
f a
x)) (a -> Rect a) -> [a] -> [Rect a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pos -> Range a -> Grid (Range a) -> [Element (Range a)]
forall s. FieldSpace s => Pos -> s -> Grid s -> [Element s]
grid Pos
MidPos Range a
r Int
Grid (Range a)
g
  where
    tick :: a
tick = Range a -> Element (Range a)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range a
r a -> a -> a
forall a. Divisive a => a -> a -> a
/ Int -> a
forall a b. FromIntegral a b => b -> a
fromIntegral Int
g

-- | Create values c for Rects data for a formulae c = f(x,y)
--
-- >>> gridF (\(Point x y) -> x * y) (Rect 0 4 0 4) (Point 2 2)
-- [(Rect 0.0 2.0 0.0 2.0,1.0),(Rect 0.0 2.0 2.0 4.0,3.0),(Rect 2.0 4.0 0.0 2.0,3.0),(Rect 2.0 4.0 2.0 4.0,9.0)]
gridF :: (Point Double -> b) -> Rect Double -> Grid (Rect Double) -> [(Rect Double, b)]
gridF :: forall b.
(Point Double -> b)
-> Rect Double -> Grid (Rect Double) -> [(Rect Double, b)]
gridF Point Double -> b
f Rect Double
r Grid (Rect Double)
g = (\Rect Double
x -> (Rect Double
x, Point Double -> b
f (Rect Double -> Element (Rect Double)
forall s. (Space s, Field (Element s)) => s -> Element s
mid Rect Double
x))) (Rect Double -> (Rect Double, b))
-> [Rect Double] -> [(Rect Double, b)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rect Double -> Grid (Rect Double) -> [Rect Double]
forall s. FieldSpace s => s -> Grid s -> [s]
gridSpace Rect Double
r Grid (Rect Double)
g

-- | convert a ratio (eg x:1) to a Rect with a height of one.
--
-- >>> aspect 2
-- Rect (-1.0) 1.0 (-0.5) 0.5
aspect :: Double -> Rect Double
aspect :: Double -> Rect Double
aspect Double
a = Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect (Double
a Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* (-Double
0.5)) (Double
a Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
0.5) (-Double
0.5) Double
0.5

-- | convert a Rect to a ratio
--
-- >>> :set -XNegativeLiterals
-- >>> ratio (Rect (-1) 1 (-0.5) 0.5)
-- 2.0
ratio :: (Field a) => Rect a -> a
ratio :: forall a. Field a => Rect a -> a
ratio (Rect a
x a
z a
y a
w) = (a
z a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
x) a -> a -> a
forall a. Divisive a => a -> a -> a
/ (a
w a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
y)

-- | project a Rect from one Rect to another, preserving relative position, with guards for singleton Rects.
--
-- >>> projectOnR one (Rect 0 1 0 1) (Rect 0 0.5 0 0.5)
-- Rect (-0.5) 0.0 (-0.5) 0.0
projectOnR :: Rect Double -> Rect Double -> Rect Double -> Rect Double
projectOnR :: Rect Double -> Rect Double -> Rect Double -> Rect Double
projectOnR Rect Double
new old :: Rect Double
old@(Rect Double
x Double
z Double
y Double
w) ao :: Rect Double
ao@(Rect Double
ox Double
oz Double
oy Double
ow)
  | Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
z Bool -> Bool -> Bool
&& Double
y Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
w = Rect Double
ao
  | Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
z = Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
ox Double
oz Double
ny Double
nw
  | Double
y Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
w = Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
nx Double
nz Double
oy Double
ow
  | Bool
otherwise = Rect Double
a
  where
    a :: Rect Double
a@(Rect Double
nx Double
nz Double
ny Double
nw) = Rect Double -> Rect Double -> Rect Double -> Rect Double
forall a. (Field a, Ord a) => Rect a -> Rect a -> Rect a -> Rect a
projectRect Rect Double
old Rect Double
new Rect Double
ao

-- | project a Point from one Rect to another, preserving relative position, with guards for singleton Rects.
--
-- >>> projectOnP one (Rect 0 1 0 1) zero
-- Point (-0.5) (-0.5)
projectOnP :: Rect Double -> Rect Double -> Point Double -> Point Double
projectOnP :: Rect Double -> Rect Double -> Point Double -> Point Double
projectOnP Rect Double
new old :: Rect Double
old@(Rect Double
x Double
z Double
y Double
w) po :: Point Double
po@(Point Double
px Double
py)
  | Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
z Bool -> Bool -> Bool
&& Double
y Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
w = Point Double
po
  | Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
z = Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
px Double
py'
  | Double
y Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
w = Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
px' Double
py
  | Bool
otherwise = Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
px' Double
py'
  where
    (Point Double
px' Double
py') = Rect Double
-> Rect Double -> Element (Rect Double) -> Element (Rect Double)
forall s.
(Space s, Field (Element s)) =>
s -> s -> Element s -> Element s
project Rect Double
old Rect Double
new Element (Rect Double)
Point Double
po