{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NegativeLiterals #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wall #-}
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.Foldable (Foldable (foldr1))
import Data.Functor.Compose
import Data.Functor.Rep
import GHC.Show (show)
import NumHask.Prelude hiding (Distributive, rotate, show)
import NumHask.Space.Point
import NumHask.Space.Range
import NumHask.Space.Types
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 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 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 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 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 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 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 :: (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 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 a
forall a. Multiplicative a => a -> a -> a
*) (Point a -> Point a)
-> (Point Int -> Point a) -> Point Int -> Point a
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 (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
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]
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
]
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)
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)
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)
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
(<>)
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')
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
space1 ([Point a] -> Rect a) -> (Rect a -> [Point a]) -> Rect a -> Rect a
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 (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 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
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
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
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
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)
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
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