{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NegativeLiterals #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wall #-}

-- | A (finite) two-dimensional plane, implemented as a composite of a 'Point' of 'Range's.
module NumHask.Space.Rect
  ( Rect (..),
    pattern Rect,
    pattern Ranges,
    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
--
-- >>> :set -XFlexibleContexts
-- >>> 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
/= :: Rect a -> Rect a -> Bool
$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
Eq,
      a -> Rect b -> Rect a
(a -> b) -> Rect a -> Rect b
(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
<$ :: a -> Rect b -> Rect a
$c<$ :: forall a b. a -> Rect b -> Rect a
fmap :: (a -> b) -> Rect a -> Rect b
$cfmap :: forall a b. (a -> b) -> Rect a -> Rect b
Functor,
      Functor Rect
a -> Rect a
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
Rect a -> Rect b -> Rect b
Rect a -> Rect b -> Rect a
Rect (a -> b) -> Rect a -> Rect b
(a -> b -> c) -> Rect a -> Rect b -> Rect c
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
<* :: Rect a -> Rect b -> Rect a
$c<* :: forall a b. Rect a -> Rect b -> Rect a
*> :: Rect a -> Rect b -> Rect b
$c*> :: forall a b. Rect a -> Rect b -> Rect b
liftA2 :: (a -> b -> c) -> Rect a -> Rect b -> Rect c
$cliftA2 :: forall a b c. (a -> b -> c) -> Rect a -> Rect b -> Rect c
<*> :: Rect (a -> b) -> Rect a -> Rect b
$c<*> :: forall a b. Rect (a -> b) -> Rect a -> Rect b
pure :: a -> Rect a
$cpure :: forall a. a -> Rect a
$cp1Applicative :: Functor Rect
Applicative,
      a -> Rect a -> Bool
Rect m -> m
Rect a -> [a]
Rect a -> Bool
Rect a -> Int
Rect a -> a
Rect a -> a
Rect a -> a
Rect a -> a
(a -> m) -> Rect a -> m
(a -> m) -> Rect a -> m
(a -> b -> b) -> b -> Rect a -> b
(a -> b -> b) -> b -> Rect a -> b
(b -> a -> b) -> b -> Rect a -> b
(b -> a -> b) -> b -> Rect a -> b
(a -> a -> a) -> Rect a -> a
(a -> a -> a) -> Rect a -> a
(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
product :: Rect a -> a
$cproduct :: forall a. Num a => Rect a -> a
sum :: Rect a -> a
$csum :: forall a. Num a => Rect a -> a
minimum :: Rect a -> a
$cminimum :: forall a. Ord a => Rect a -> a
maximum :: Rect a -> a
$cmaximum :: forall a. Ord a => Rect a -> a
elem :: a -> Rect a -> Bool
$celem :: forall a. Eq a => a -> Rect a -> Bool
length :: Rect a -> Int
$clength :: forall a. Rect a -> Int
null :: Rect a -> Bool
$cnull :: forall a. Rect a -> Bool
toList :: Rect a -> [a]
$ctoList :: forall a. Rect a -> [a]
foldl1 :: (a -> a -> a) -> Rect a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Rect a -> a
foldr1 :: (a -> a -> a) -> Rect a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Rect a -> a
foldl' :: (b -> a -> b) -> b -> Rect a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Rect a -> b
foldl :: (b -> a -> b) -> b -> Rect a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Rect a -> b
foldr' :: (a -> b -> b) -> b -> Rect a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Rect a -> b
foldr :: (a -> b -> b) -> b -> Rect a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Rect a -> b
foldMap' :: (a -> m) -> Rect a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Rect a -> m
foldMap :: (a -> m) -> Rect a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Rect a -> m
fold :: Rect m -> m
$cfold :: forall m. Monoid m => Rect m -> m
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
(a -> f b) -> Rect a -> f (Rect 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 => 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)
sequence :: Rect (m a) -> m (Rect a)
$csequence :: forall (m :: * -> *) a. Monad m => Rect (m a) -> m (Rect a)
mapM :: (a -> m b) -> Rect a -> m (Rect b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Rect a -> m (Rect b)
sequenceA :: Rect (f a) -> f (Rect a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Rect (f a) -> f (Rect a)
traverse :: (a -> f b) -> Rect a -> f (Rect b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Rect a -> f (Rect b)
$cp2Traversable :: Foldable Rect
$cp1Traversable :: Functor Rect
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
$cto :: forall a x. Rep (Rect a) x -> Rect a
$cfrom :: forall a x. Rect a -> Rep (Rect a) x
Generic
    )

-- | pattern of Rect lowerx upperx lowery uppery
pattern Rect :: a -> a -> a -> a -> Rect a
pattern $bRect :: a -> a -> a -> a -> Rect a
$mRect :: forall r a. Rect a -> (a -> a -> a -> a -> r) -> (Void# -> r) -> r
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 $bRanges :: Range a -> Range a -> Rect a
$mRanges :: forall r a.
Rect a -> (Range a -> Range a -> r) -> (Void# -> r) -> r
Ranges a b = Rect' (Compose (Point a b))

{-# COMPLETE Ranges #-}

instance (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 => a -> String
show 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 => a -> String
show 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 => a -> String
show 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 => a -> String
show a
d

instance Distributive Rect where
  collect :: (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
. 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
. 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
. 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
. 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 :: (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 :: Rect a -> Rep Rect -> a
index (Rect a
a a
_ a
_ a
_) (False, False) = a
a
  index (Rect a
_ a
b a
_ a
_) (False, True) = a
b
  index (Rect a
_ a
_ a
c a
_) (True, False) = a
c
  index (Rect a
_ a
_ a
_ a
d) (True, 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 l0 l1) (Point u0 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 x 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 a
forall a. Additive a => a -> a -> a
+) (Point a -> Point a)
-> (Point Int -> Point a) -> Point Int -> Point a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point a
step Point a -> Point a -> Point a
forall a. Multiplicative a => a -> a -> a
*) (Point a -> Point a)
-> (Point Int -> Point a) -> Point Int -> Point a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a) -> Point Int -> Point a
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 stepX 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

-- | 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 :: 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 :: 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 :: 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 arithmetioc 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 (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) => Signed (Rect a) where
  sign :: Rect a -> Rect a
sign (Rect a
x a
z a
y a
w) = Rect a -> Rect a -> Bool -> Rect a
forall a. a -> a -> Bool -> a
bool (Rect a -> Rect a
forall a. Subtractive a => a -> a
negate Rect a
forall a. Multiplicative a => a
one) Rect 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))
  abs :: Rect a -> Rect a
abs (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. Signed a => a -> a
abs Range a
x) (Range a -> Range a
forall a. Signed a => a -> a
abs 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 :: [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 :: f (Rect a) -> Rect a
foldRectUnsafe = (Rect a -> Rect a -> Rect a) -> f (Rect a) -> Rect 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 :: 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 :: a -> Rect a -> Rect a
rotationBound a
d = [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
. (Point a -> Point a) -> [Point a] -> [Point a]
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 Transform a -> Point a -> Point a
forall a b. Affinity a b => Transform b -> a -> a
|.) ([Point a] -> [Point a])
-> (Rect a -> [Point a]) -> Rect a -> [Point a]
forall b c a. (b -> c) -> (a -> b) -> 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 :: (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 :: (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 :: 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