{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.QuadTree.Internal where
import Control.Applicative (liftA2)
import Data.Maybe (isJust)
import Data.Monoid (Ap(..))
import GHC.Generics (Generic)
import Linear.V2
import Linear.V4
data Rect a = Rect
{ forall a. Rect a -> V2 a
r_pos :: !(V2 a)
, forall a. Rect a -> V2 a
r_size :: !(V2 a)
}
deriving stock (Int -> Rect a -> ShowS
forall a. Show a => Int -> Rect a -> ShowS
forall a. Show a => [Rect a] -> ShowS
forall a. Show a => Rect a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rect a] -> ShowS
$cshowList :: forall a. Show a => [Rect a] -> ShowS
show :: Rect a -> String
$cshow :: forall a. Show a => Rect a -> String
showsPrec :: Int -> Rect a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Rect a -> ShowS
Show, ReadPrec [Rect a]
ReadPrec (Rect a)
ReadS [Rect a]
forall a. Read a => ReadPrec [Rect a]
forall a. Read a => ReadPrec (Rect a)
forall a. Read a => Int -> ReadS (Rect a)
forall a. Read a => ReadS [Rect a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Rect a]
$creadListPrec :: forall a. Read a => ReadPrec [Rect a]
readPrec :: ReadPrec (Rect a)
$creadPrec :: forall a. Read a => ReadPrec (Rect a)
readList :: ReadS [Rect a]
$creadList :: forall a. Read a => ReadS [Rect a]
readsPrec :: Int -> ReadS (Rect a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Rect a)
Read, Rect a -> Rect a -> Bool
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, 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, Rect a -> Rect a -> Bool
Rect a -> Rect a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Rect a)
forall a. Ord a => Rect a -> Rect a -> Bool
forall a. Ord a => Rect a -> Rect a -> Ordering
forall a. Ord a => Rect a -> Rect a -> Rect a
min :: Rect a -> Rect a -> Rect a
$cmin :: forall a. Ord a => Rect a -> Rect a -> Rect a
max :: Rect a -> Rect a -> Rect a
$cmax :: forall a. Ord a => Rect a -> Rect a -> Rect a
>= :: Rect a -> Rect a -> Bool
$c>= :: forall a. Ord a => Rect a -> Rect a -> Bool
> :: Rect a -> Rect a -> Bool
$c> :: forall a. Ord a => Rect a -> Rect a -> Bool
<= :: Rect a -> Rect a -> Bool
$c<= :: forall a. Ord a => Rect a -> Rect a -> Bool
< :: Rect a -> Rect a -> Bool
$c< :: forall a. Ord a => Rect a -> Rect a -> Bool
compare :: Rect a -> Rect a -> Ordering
$ccompare :: forall a. Ord a => Rect a -> Rect a -> Ordering
Ord, 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
<$ :: forall a b. a -> Rect b -> Rect a
$c<$ :: forall a b. a -> Rect b -> Rect a
fmap :: forall a b. (a -> b) -> Rect a -> Rect b
$cfmap :: forall a b. (a -> b) -> Rect a -> Rect b
Functor)
r_x, r_y, r_w, r_h :: Rect a -> a
r_x :: forall a. Rect a -> a
r_x (Rect (V2 a
x a
_) (V2 a
_ a
_)) = a
x
r_y :: forall a. Rect a -> a
r_y (Rect (V2 a
_ a
y) (V2 a
_ a
_)) = a
y
r_w :: forall a. Rect a -> a
r_w (Rect (V2 a
_ a
_) (V2 a
w a
_)) = a
w
r_h :: forall a. Rect a -> a
r_h (Rect (V2 a
_ a
_) (V2 a
_ a
h)) = a
h
rectContainsRect :: (Num a, Ord a) => Rect a -> Rect a -> Bool
rectContainsRect :: forall a. (Num a, Ord a) => Rect a -> Rect a -> Bool
rectContainsRect r1 :: Rect a
r1@(Rect (V2 a
bx a
by) (V2 a
bw a
bh)) r2 :: Rect a
r2@(Rect (V2 a
sx a
sy) (V2 a
sw a
sh)) =
Rect a
r1 forall a. Eq a => a -> a -> Bool
== Rect a
r2 Bool -> Bool -> Bool
||
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
[ a
bx forall a. Ord a => a -> a -> Bool
<= a
sx
, a
by forall a. Ord a => a -> a -> Bool
<= a
sy
, a
sx forall a. Num a => a -> a -> a
+ a
sw forall a. Ord a => a -> a -> Bool
<= a
bx forall a. Num a => a -> a -> a
+ a
bw
, a
sy forall a. Num a => a -> a -> a
+ a
sh forall a. Ord a => a -> a -> Bool
<= a
by forall a. Num a => a -> a -> a
+ a
bh
]
rectContainsPoint :: (Ord a, Num a) => Rect a -> V2 a -> Bool
rectContainsPoint :: forall a. (Ord a, Num a) => Rect a -> V2 a -> Bool
rectContainsPoint (forall a. (Num a, Ord a) => Rect a -> Rect a
normalize -> Rect V2 a
_ (V2 a
w a
h)) V2 a
_
| a
w forall a. Ord a => a -> a -> Bool
<= a
0 Bool -> Bool -> Bool
|| a
h forall a. Ord a => a -> a -> Bool
<= a
0
= Bool
False
rectContainsPoint (forall a. (Num a, Ord a) => Rect a -> Rect a
normalize -> Rect (V2 a
x a
y) (V2 a
w a
h)) (V2 a
tx a
ty) =
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
[ a
x forall a. Ord a => a -> a -> Bool
<= a
tx
, a
y forall a. Ord a => a -> a -> Bool
<= a
ty
, a
tx forall a. Ord a => a -> a -> Bool
< a
x forall a. Num a => a -> a -> a
+ a
w
, a
ty forall a. Ord a => a -> a -> Bool
< a
y forall a. Num a => a -> a -> a
+ a
h
]
rectCorners :: Num a => Rect a -> V4 (V2 a)
rectCorners :: forall a. Num a => Rect a -> V4 (V2 a)
rectCorners (Rect (V2 a
x a
y) (V2 a
w a
h)) =
let p :: V2 a
p = forall a. a -> a -> V2 a
V2 a
x a
y
dx :: V2 a
dx = forall a. a -> a -> V2 a
V2 a
w a
0
dy :: V2 a
dy = forall a. a -> a -> V2 a
V2 a
0 a
h
in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (V2 a
p forall a. Num a => a -> a -> a
+) forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> a -> V4 a
V4 V2 a
0 V2 a
dx V2 a
dy (V2 a
dx forall a. Num a => a -> a -> a
+ V2 a
dy)
data Free a
= Fill a
| Split (V4 (Free a))
deriving (forall a b. a -> Free b -> Free a
forall a b. (a -> b) -> Free a -> Free b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Free b -> Free a
$c<$ :: forall a b. a -> Free b -> Free a
fmap :: forall a b. (a -> b) -> Free a -> Free b
$cfmap :: forall a b. (a -> b) -> Free a -> Free b
Functor, forall a. Eq a => a -> Free a -> Bool
forall a. Num a => Free a -> a
forall a. Ord a => Free a -> a
forall m. Monoid m => Free m -> m
forall a. Free a -> Bool
forall a. Free a -> Int
forall a. Free a -> [a]
forall a. (a -> a -> a) -> Free a -> a
forall m a. Monoid m => (a -> m) -> Free a -> m
forall b a. (b -> a -> b) -> b -> Free a -> b
forall a b. (a -> b -> b) -> b -> Free 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 :: forall a. Num a => Free a -> a
$cproduct :: forall a. Num a => Free a -> a
sum :: forall a. Num a => Free a -> a
$csum :: forall a. Num a => Free a -> a
minimum :: forall a. Ord a => Free a -> a
$cminimum :: forall a. Ord a => Free a -> a
maximum :: forall a. Ord a => Free a -> a
$cmaximum :: forall a. Ord a => Free a -> a
elem :: forall a. Eq a => a -> Free a -> Bool
$celem :: forall a. Eq a => a -> Free a -> Bool
length :: forall a. Free a -> Int
$clength :: forall a. Free a -> Int
null :: forall a. Free a -> Bool
$cnull :: forall a. Free a -> Bool
toList :: forall a. Free a -> [a]
$ctoList :: forall a. Free a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Free a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Free a -> a
foldr1 :: forall a. (a -> a -> a) -> Free a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Free a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Free a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Free a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Free a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Free a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Free a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Free a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Free a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Free a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Free a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Free a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Free a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Free a -> m
fold :: forall m. Monoid m => Free m -> m
$cfold :: forall m. Monoid m => Free m -> m
Foldable, Functor Free
Foldable Free
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 => Free (m a) -> m (Free a)
forall (f :: * -> *) a. Applicative f => Free (f a) -> f (Free a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Free a -> m (Free b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Free a -> f (Free b)
sequence :: forall (m :: * -> *) a. Monad m => Free (m a) -> m (Free a)
$csequence :: forall (m :: * -> *) a. Monad m => Free (m a) -> m (Free a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Free a -> m (Free b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Free a -> m (Free b)
sequenceA :: forall (f :: * -> *) a. Applicative f => Free (f a) -> f (Free a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Free (f a) -> f (Free a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Free a -> f (Free b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Free a -> f (Free b)
Traversable, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Free a) x -> Free a
forall a x. Free a -> Rep (Free a) x
$cto :: forall a x. Rep (Free a) x -> Free a
$cfrom :: forall a x. Free a -> Rep (Free a) x
Generic)
deriving via Ap Free a instance (Semigroup a) => Semigroup (Free a)
deriving via Ap Free a instance (Monoid a) => Monoid (Free a)
deriving stock instance (Show a) => Show (Free a)
instance (Eq a) => Eq (Free a) where
Fill a
a == :: Free a -> Free a -> Bool
== Fill a
b = a
a forall a. Eq a => a -> a -> Bool
== a
b
Split V4 (Free a)
qu == Split V4 (Free a)
qu' = V4 (Free a)
qu forall a. Eq a => a -> a -> Bool
== V4 (Free a)
qu'
Fill a
a == Split V4 (Free a)
qu = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) forall a. Eq a => a -> a -> Bool
== V4 (Free a)
qu
Split V4 (Free a)
qu == Fill a
a = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) forall a. Eq a => a -> a -> Bool
== V4 (Free a)
qu
instance Applicative Free where
pure :: forall a. a -> Free a
pure = forall a. a -> Free a
Fill
liftA2 :: forall a b c. (a -> b -> c) -> Free a -> Free b -> Free c
liftA2 a -> b -> c
fabc (Fill a
a) (Fill b
b) = forall a. a -> Free a
Fill forall a b. (a -> b) -> a -> b
$ a -> b -> c
fabc a
a b
b
liftA2 a -> b -> c
fabc (Fill a
a) (Split V4 (Free b)
qu) = forall a. V4 (Free a) -> Free a
Split forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
fabc a
a)) V4 (Free b)
qu
liftA2 a -> b -> c
fabc (Split V4 (Free a)
qu) (Fill b
b) = forall a. V4 (Free a) -> Free a
Split forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> c
fabc b
b)) V4 (Free a)
qu
liftA2 a -> b -> c
fabc (Split V4 (Free a)
qu) (Split V4 (Free b)
qu') = forall a. V4 (Free a) -> Free a
Split forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
fabc) V4 (Free a)
qu V4 (Free b)
qu'
instance Monad Free where
Fill a
a >>= :: forall a b. Free a -> (a -> Free b) -> Free b
>>= a -> Free b
f = a -> Free b
f a
a
Split V4 (Free a)
qu >>= a -> Free b
f = forall a. V4 (Free a) -> Free a
Split forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Free b
f) V4 (Free a)
qu
normalize :: (Num a, Ord a) => Rect a -> Rect a
normalize :: forall a. (Num a, Ord a) => Rect a -> Rect a
normalize q :: Rect a
q@(Rect (V2 a
x a
y) (V2 a
w a
h))
| a
w forall a. Ord a => a -> a -> Bool
< a
0 = let w' :: a
w' = forall a. Num a => a -> a
abs a
w in forall a. (Num a, Ord a) => Rect a -> Rect a
normalize forall a b. (a -> b) -> a -> b
$ forall a. V2 a -> V2 a -> Rect a
Rect (forall a. a -> a -> V2 a
V2 (a
x forall a. Num a => a -> a -> a
- a
w') a
y) forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> V2 a
V2 a
w' a
h
| a
h forall a. Ord a => a -> a -> Bool
< a
0 = let h' :: a
h' = forall a. Num a => a -> a
abs a
h in forall a. (Num a, Ord a) => Rect a -> Rect a
normalize forall a b. (a -> b) -> a -> b
$ forall a. V2 a -> V2 a -> Rect a
Rect (forall a. a -> a -> V2 a
V2 a
x (a
y forall a. Num a => a -> a -> a
- a
h')) forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> V2 a
V2 a
w a
h'
| Bool
otherwise = Rect a
q
intersects :: (Ord a, Num a) => Rect a -> Rect a -> Bool
intersects :: forall a. (Ord a, Num a) => Rect a -> Rect a -> Bool
intersects Rect a
r1 Rect a
r2 = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall a. (Ord a, Num a) => Rect a -> Rect a -> Maybe (Rect a)
getIntersect Rect a
r1 Rect a
r2
rectSize :: Num a => Rect a -> a
rectSize :: forall a. Num a => Rect a -> a
rectSize (Rect V2 a
_ (V2 a
w a
h)) = a
w forall a. Num a => a -> a -> a
* a
h
getIntersect :: (Ord a, Num a) => Rect a -> Rect a -> Maybe (Rect a)
getIntersect :: forall a. (Ord a, Num a) => Rect a -> Rect a -> Maybe (Rect a)
getIntersect (forall a. (Num a, Ord a) => Rect a -> Rect a
normalize -> Rect a
r1) (forall a. (Num a, Ord a) => Rect a -> Rect a
normalize -> Rect a
r2)
| forall a. Num a => Rect a -> a
rectSize Rect a
r1 forall a. Eq a => a -> a -> Bool
== a
0 = forall a. a -> Maybe a
Just Rect a
r1
| forall a. Num a => Rect a -> a
rectSize Rect a
r2 forall a. Eq a => a -> a -> Bool
== a
0 = forall a. a -> Maybe a
Just Rect a
r2
| Bool
otherwise =
let x0 :: a
x0 = forall a. Ord a => a -> a -> a
max (forall a. Rect a -> a
r_x Rect a
r1) (forall a. Rect a -> a
r_x Rect a
r2)
y0 :: a
y0 = forall a. Ord a => a -> a -> a
max (forall a. Rect a -> a
r_y Rect a
r1) (forall a. Rect a -> a
r_y Rect a
r2)
x1 :: a
x1 = forall a. Ord a => a -> a -> a
min (forall a. Rect a -> a
r_x Rect a
r1 forall a. Num a => a -> a -> a
+ forall a. Rect a -> a
r_w Rect a
r1) (forall a. Rect a -> a
r_x Rect a
r2 forall a. Num a => a -> a -> a
+ forall a. Rect a -> a
r_w Rect a
r2)
y1 :: a
y1 = forall a. Ord a => a -> a -> a
min (forall a. Rect a -> a
r_y Rect a
r1 forall a. Num a => a -> a -> a
+ forall a. Rect a -> a
r_h Rect a
r1) (forall a. Rect a -> a
r_y Rect a
r2 forall a. Num a => a -> a -> a
+ forall a. Rect a -> a
r_h Rect a
r2)
w :: a
w = a
x1 forall a. Num a => a -> a -> a
- a
x0
h :: a
h = a
y1 forall a. Num a => a -> a -> a
- a
y0
in case a
0 forall a. Ord a => a -> a -> Bool
< a
w Bool -> Bool -> Bool
&& a
0 forall a. Ord a => a -> a -> Bool
< a
h of
Bool
True -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. V2 a -> V2 a -> Rect a
Rect (forall a. a -> a -> V2 a
V2 a
x0 a
y0) (forall a. a -> a -> V2 a
V2 a
w a
h)
Bool
False -> forall a. Maybe a
Nothing
unwrap :: Free a -> V4 (Free a)
unwrap :: forall a. Free a -> V4 (Free a)
unwrap (Fill a
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
unwrap (Split V4 (Free a)
qu) = V4 (Free a)
qu
fuse :: Eq a => Free a -> Free a
fuse :: forall a. Eq a => Free a -> Free a
fuse (Fill a
a) = forall a. a -> Free a
Fill a
a
fuse (Split V4 (Free a)
q) = forall a. Eq a => V4 (Free a) -> Free a
doFuse forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Eq a => Free a -> Free a
fuse V4 (Free a)
q
doFuse :: Eq a => V4 (Free a) -> Free a
doFuse :: forall a. Eq a => V4 (Free a) -> Free a
doFuse (V4 (Fill a
a) (Fill a
b) (Fill a
c) (Fill a
d))
| a
a forall a. Eq a => a -> a -> Bool
== a
b
, a
b forall a. Eq a => a -> a -> Bool
== a
c
, a
c forall a. Eq a => a -> a -> Bool
== a
d
= forall a. a -> Free a
Fill a
a
doFuse V4 (Free a)
q = forall a. V4 (Free a) -> Free a
Split V4 (Free a)
q