{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE StrictData #-}
module Data.QuadTree
( QuadTree (..)
, fill
, combineAla
, lookup
, query
, fuse
, elements
, toRects
, boundingRect
, defaultValue
, Rect (..)
, mkRectByPow
, midpoint
, subdivide
, Raw.rectCorners
, V2 (..)
, V4 (..)
) where
import Data.Coerce
import Data.Foldable
import Data.Maybe (fromMaybe)
import Data.Monoid (Ap(..))
import Data.QuadTree.Internal (Free(..), Rect(..), unwrap, intersects, rectContainsRect, getIntersect, rectContainsPoint, normalize, rectSize)
import qualified Data.QuadTree.Internal as Raw
import Data.Semilattice
import Data.Set (Set)
import qualified Data.Set as S
import GHC.Base (liftA2)
import Linear.V2
import Linear.V4
import Prelude hiding (lookup)
midpoint :: (Fractional a) => Rect a -> V2 a
midpoint :: forall a. Fractional a => Rect a -> V2 a
midpoint (Rect V2 a
pos V2 a
sz) = V2 a
pos forall a. Num a => a -> a -> a
+ V2 a
sz forall a. Fractional a => a -> a -> a
/ V2 a
2
subdivide :: Fractional a => Rect a -> V4 (Rect a)
subdivide :: forall a. Fractional a => Rect a -> V4 (Rect a)
subdivide (Rect (V2 a
x a
y) (V2 a
w a
h)) =
let halfw :: a
halfw = a
w forall a. Fractional a => a -> a -> a
/ a
2
halfh :: a
halfh = a
h forall a. Fractional a => a -> a -> a
/ a
2
in forall a. a -> a -> a -> a -> V4 a
V4
(forall a. V2 a -> V2 a -> Rect a
Rect (forall a. a -> a -> V2 a
V2 a
x a
y) (forall a. a -> a -> V2 a
V2 a
halfw a
halfh))
(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
halfw) a
y) forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> V2 a
V2 (a
w forall a. Num a => a -> a -> a
- a
halfw) a
halfh)
(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
halfh)) forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> V2 a
V2 a
halfw (a
h forall a. Num a => a -> a -> a
- a
halfh))
(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
halfw) (a
y forall a. Num a => a -> a -> a
+ a
halfh)) forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> V2 a
V2 (a
w forall a. Num a => a -> a -> a
- a
halfw) (a
h forall a. Num a => a -> a -> a
- a
halfh))
data QuadTree a = QuadTree
{ forall a. QuadTree a -> a
ot_default :: a
, forall a. QuadTree a -> Integer
ot_root_pow :: Integer
, forall a. QuadTree a -> Free a
ot_tree :: Free a
}
deriving stock (Int -> QuadTree a -> ShowS
forall a. Show a => Int -> QuadTree a -> ShowS
forall a. Show a => [QuadTree a] -> ShowS
forall a. Show a => QuadTree a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QuadTree a] -> ShowS
$cshowList :: forall a. Show a => [QuadTree a] -> ShowS
show :: QuadTree a -> String
$cshow :: forall a. Show a => QuadTree a -> String
showsPrec :: Int -> QuadTree a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> QuadTree a -> ShowS
Show, forall a b. a -> QuadTree b -> QuadTree a
forall a b. (a -> b) -> QuadTree a -> QuadTree 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 -> QuadTree b -> QuadTree a
$c<$ :: forall a b. a -> QuadTree b -> QuadTree a
fmap :: forall a b. (a -> b) -> QuadTree a -> QuadTree b
$cfmap :: forall a b. (a -> b) -> QuadTree a -> QuadTree b
Functor)
deriving (Integer -> QuadTree a
QuadTree a -> QuadTree a
QuadTree a -> QuadTree a -> QuadTree a
forall a. Num a => Integer -> QuadTree a
forall a. Num a => QuadTree a -> QuadTree a
forall a. Num a => QuadTree a -> QuadTree a -> QuadTree a
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> QuadTree a
$cfromInteger :: forall a. Num a => Integer -> QuadTree a
signum :: QuadTree a -> QuadTree a
$csignum :: forall a. Num a => QuadTree a -> QuadTree a
abs :: QuadTree a -> QuadTree a
$cabs :: forall a. Num a => QuadTree a -> QuadTree a
negate :: QuadTree a -> QuadTree a
$cnegate :: forall a. Num a => QuadTree a -> QuadTree a
* :: QuadTree a -> QuadTree a -> QuadTree a
$c* :: forall a. Num a => QuadTree a -> QuadTree a -> QuadTree a
- :: QuadTree a -> QuadTree a -> QuadTree a
$c- :: forall a. Num a => QuadTree a -> QuadTree a -> QuadTree a
+ :: QuadTree a -> QuadTree a -> QuadTree a
$c+ :: forall a. Num a => QuadTree a -> QuadTree a -> QuadTree a
Num, NonEmpty (QuadTree a) -> QuadTree a
QuadTree a -> QuadTree a -> QuadTree a
forall b. Integral b => b -> QuadTree a -> QuadTree a
forall a. Semigroup a => NonEmpty (QuadTree a) -> QuadTree a
forall a. Semigroup a => QuadTree a -> QuadTree a -> QuadTree a
forall a b.
(Semigroup a, Integral b) =>
b -> QuadTree a -> QuadTree a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> QuadTree a -> QuadTree a
$cstimes :: forall a b.
(Semigroup a, Integral b) =>
b -> QuadTree a -> QuadTree a
sconcat :: NonEmpty (QuadTree a) -> QuadTree a
$csconcat :: forall a. Semigroup a => NonEmpty (QuadTree a) -> QuadTree a
<> :: QuadTree a -> QuadTree a -> QuadTree a
$c<> :: forall a. Semigroup a => QuadTree a -> QuadTree a -> QuadTree a
Semigroup, QuadTree a
[QuadTree a] -> QuadTree a
QuadTree a -> QuadTree a -> QuadTree a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall {a}. Monoid a => Semigroup (QuadTree a)
forall a. Monoid a => QuadTree a
forall a. Monoid a => [QuadTree a] -> QuadTree a
forall a. Monoid a => QuadTree a -> QuadTree a -> QuadTree a
mconcat :: [QuadTree a] -> QuadTree a
$cmconcat :: forall a. Monoid a => [QuadTree a] -> QuadTree a
mappend :: QuadTree a -> QuadTree a -> QuadTree a
$cmappend :: forall a. Monoid a => QuadTree a -> QuadTree a -> QuadTree a
mempty :: QuadTree a
$cmempty :: forall a. Monoid a => QuadTree a
Monoid) via (Ap QuadTree a)
instance Semilattice a => Semilattice (QuadTree a)
defaultValue :: QuadTree a -> a
defaultValue :: forall a. QuadTree a -> a
defaultValue = forall a. QuadTree a -> a
ot_default
instance Eq a => Eq (QuadTree a) where
q1 :: QuadTree a
q1@(QuadTree a
a Integer
m Free a
tr) == :: QuadTree a -> QuadTree a -> Bool
== q2 :: QuadTree a
q2@(QuadTree a
a' Integer
n Free a
tr') =
case forall a. Ord a => a -> a -> Ordering
compare Integer
m Integer
n of
Ordering
LT -> forall a. QuadTree a -> QuadTree a
realloc QuadTree a
q1 forall a. Eq a => a -> a -> Bool
== QuadTree a
q2
Ordering
EQ -> a
a forall a. Eq a => a -> a -> Bool
== a
a' Bool -> Bool -> Bool
&& Free a
tr forall a. Eq a => a -> a -> Bool
== Free a
tr'
Ordering
GT -> QuadTree a
q1 forall a. Eq a => a -> a -> Bool
== forall a. QuadTree a -> QuadTree a
realloc QuadTree a
q2
instance Applicative QuadTree where
pure :: forall a. a -> QuadTree a
pure a
a = forall a. a -> Integer -> Free a -> QuadTree a
QuadTree a
a Integer
0 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
liftA2 :: forall a b c.
(a -> b -> c) -> QuadTree a -> QuadTree b -> QuadTree c
liftA2 a -> b -> c
fabc q1 :: QuadTree a
q1@(QuadTree a
a Integer
m Free a
ota) q2 :: QuadTree b
q2@(QuadTree b
b Integer
n Free b
otb) =
case forall a. Ord a => a -> a -> Ordering
compare Integer
m Integer
n of
Ordering
LT -> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
fabc (forall a. QuadTree a -> QuadTree a
realloc QuadTree a
q1) QuadTree b
q2
Ordering
EQ -> forall a. a -> Integer -> Free a -> QuadTree a
QuadTree (a -> b -> c
fabc a
a b
b) Integer
m forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
fabc Free a
ota Free b
otb
Ordering
GT -> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
fabc QuadTree a
q1 (forall a. QuadTree a -> QuadTree a
realloc QuadTree b
q2)
boundingRect :: QuadTree a -> Rect Rational
boundingRect :: forall a. QuadTree a -> Rect Rational
boundingRect = Integer -> Rect Rational
mkRectByPow forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. QuadTree a -> Integer
ot_root_pow
mkRectByPow :: Integer -> Rect Rational
mkRectByPow :: Integer -> Rect Rational
mkRectByPow Integer
n =
let side :: Rational
side = Rational
2 forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
n
in forall a. V2 a -> V2 a -> Rect a
Rect (forall (f :: * -> *) a. Applicative f => a -> f a
pure (-Rational
side)) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Rational
side forall a. Num a => a -> a -> a
* Rational
2
doubleGo :: a -> V4 (Free a) -> Free a
doubleGo :: forall a. a -> V4 (Free a) -> Free a
doubleGo a
def (V4 Free a
tl Free a
tr Free a
bl Free a
br) = forall a. V4 (Free a) -> Free a
Split forall a b. (a -> b) -> a -> b
$
forall a. a -> a -> a -> a -> V4 a
V4
(forall a. V4 (Free a) -> Free a
Split (forall a. a -> a -> a -> a -> V4 a
V4 Free a
a Free a
a
Free a
a Free a
tl)) (forall a. V4 (Free a) -> Free a
Split (forall a. a -> a -> a -> a -> V4 a
V4 Free a
a Free a
a
Free a
tr Free a
a))
(forall a. V4 (Free a) -> Free a
Split (forall a. a -> a -> a -> a -> V4 a
V4 Free a
a Free a
bl
Free a
a Free a
a)) (forall a. V4 (Free a) -> Free a
Split (forall a. a -> a -> a -> a -> V4 a
V4 Free a
br Free a
a
Free a
a Free a
a))
where
a :: Free a
a = forall a. a -> Free a
Fill a
def
realloc :: QuadTree a -> QuadTree a
realloc :: forall a. QuadTree a -> QuadTree a
realloc (QuadTree a
a Integer
n Free a
q) = forall a. a -> Integer -> Free a -> QuadTree a
QuadTree a
a (Integer
n forall a. Num a => a -> a -> a
+ Integer
1) forall a b. (a -> b) -> a -> b
$ forall a. a -> V4 (Free a) -> Free a
doubleGo a
a forall a b. (a -> b) -> a -> b
$ forall a. Free a -> V4 (Free a)
unwrap Free a
q
rectBoundingLog :: Rect Rational -> Integer
rectBoundingLog :: Rect Rational -> Integer
rectBoundingLog (Rect (V2 Rational
x Rational
y) (V2 Rational
w Rational
h)) =
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ (Integer
0 forall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (RealFrac a, Integral b) => a -> b
ceiling @Double forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Floating a => a -> a -> a
logBase Double
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => Rational -> a
fromRational)
[ forall a. Num a => a -> a
abs Rational
x
, forall a. Num a => a -> a
abs forall a b. (a -> b) -> a -> b
$ Rational
x forall a. Num a => a -> a -> a
+ Rational
w
, forall a. Num a => a -> a
abs Rational
y
, forall a. Num a => a -> a
abs forall a b. (a -> b) -> a -> b
$ Rational
y forall a. Num a => a -> a -> a
+ Rational
h
]
fillSel :: (Fractional r, Ord r) => a -> a -> Maybe (Rect r) -> Rect r -> Free a
fillSel :: forall r a.
(Fractional r, Ord r) =>
a -> a -> Maybe (Rect r) -> Rect r -> Free a
fillSel a
def a
_ Maybe (Rect r)
Nothing Rect r
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
def
fillSel a
def a
v (Just Rect r
r) Rect r
qu = forall r a.
(Fractional r, Ord r) =>
a -> a -> Rect r -> Rect r -> Free a
fillImpl a
def a
v Rect r
r Rect r
qu
fillImpl :: (Fractional r, Ord r) => a -> a -> Rect r -> Rect r -> Free a
fillImpl :: forall r a.
(Fractional r, Ord r) =>
a -> a -> Rect r -> Rect r -> Free a
fillImpl a
def a
v Rect r
area Rect r
r
| forall a. (Num a, Ord a) => Rect a -> Rect a -> Bool
rectContainsRect Rect r
area Rect r
r = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v
| forall a. (Ord a, Num a) => Rect a -> Rect a -> Bool
intersects Rect r
area Rect r
r = do
let subr :: V4 (Rect r)
subr = forall a. Fractional a => Rect a -> V4 (Rect a)
subdivide Rect r
r
subarea :: V4 (Maybe (Rect r))
subarea = forall a. (Ord a, Num a) => Rect a -> Rect a -> Maybe (Rect a)
getIntersect Rect r
area forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> V4 (Rect r)
subr
forall a. V4 (Free a) -> Free a
Split forall a b. (a -> b) -> a -> b
$ forall r a.
(Fractional r, Ord r) =>
a -> a -> Maybe (Rect r) -> Rect r -> Free a
fillSel a
def a
v forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> V4 (Maybe (Rect r))
subarea forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> V4 (Rect r)
subr
| Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
def
rect :: a -> a -> Rect Rational -> QuadTree a
rect :: forall a. a -> a -> Rect Rational -> QuadTree a
rect a
def a
v (forall a. (Num a, Ord a) => Rect a -> Rect a
normalize -> Rect Rational
r)
| forall a. Num a => Rect a -> a
rectSize Rect Rational
r forall a. Eq a => a -> a -> Bool
== Rational
0 = forall a. a -> Integer -> Free a -> QuadTree a
QuadTree a
def (Rect Rational -> Integer
rectBoundingLog Rect Rational
r) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure a
def
| Bool
otherwise = forall a. a -> Integer -> Free a -> QuadTree a
QuadTree a
def (Rect Rational -> Integer
rectBoundingLog Rect Rational
r) forall a b. (a -> b) -> a -> b
$ forall r a.
(Fractional r, Ord r) =>
a -> a -> Rect r -> Rect r -> Free a
fillImpl a
def a
v Rect Rational
r forall a b. (a -> b) -> a -> b
$ Integer -> Rect Rational
mkRectByPow (Rect Rational -> Integer
rectBoundingLog Rect Rational
r)
fill :: forall a. Rect Rational -> a -> QuadTree a -> QuadTree a
fill :: forall a. Rect Rational -> a -> QuadTree a -> QuadTree a
fill (forall a. (Num a, Ord a) => Rect a -> Rect a
normalize -> Rect Rational
r) a
a QuadTree a
q = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. a -> Maybe a -> a
fromMaybe QuadTree a
q (forall a. a -> a -> Rect Rational -> QuadTree a
rect forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just a
a) Rect Rational
r)
lookupImpl :: V2 Rational -> Rect Rational -> Free a -> Maybe a
lookupImpl :: forall a. V2 Rational -> Rect Rational -> Free a -> Maybe a
lookupImpl V2 Rational
p Rect Rational
r Free a
ot
| forall a. (Ord a, Num a) => Rect a -> V2 a -> Bool
rectContainsPoint Rect Rational
r V2 Rational
p = case Free a
ot of
Fill a
a -> forall a. a -> Maybe a
Just a
a
Split V4 (Free a)
qu -> forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum forall a b. (a -> b) -> a -> b
$ forall a. V2 Rational -> Rect Rational -> Free a -> Maybe a
lookupImpl V2 Rational
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Fractional a => Rect a -> V4 (Rect a)
subdivide Rect Rational
r forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> V4 (Free a)
qu
| Bool
otherwise = forall a. Maybe a
Nothing
lookup :: V2 Rational -> QuadTree a -> a
lookup :: forall a. V2 Rational -> QuadTree a -> a
lookup V2 Rational
v2 (QuadTree a
a Integer
n Free a
q) = forall a. a -> Maybe a -> a
fromMaybe a
a forall a b. (a -> b) -> a -> b
$ forall a. V2 Rational -> Rect Rational -> Free a -> Maybe a
lookupImpl V2 Rational
v2 (Integer -> Rect Rational
mkRectByPow Integer
n) Free a
q
query :: Semilattice s => (a -> s) -> Rect Rational -> QuadTree a -> s
query :: forall s a.
Semilattice s =>
(a -> s) -> Rect Rational -> QuadTree a -> s
query a -> s
f (forall a. (Num a, Ord a) => Rect a -> Rect a
normalize -> Rect Rational
area) (QuadTree a
a Integer
n Free a
q)
| forall a. (Num a, Ord a) => Rect a -> Rect a -> Bool
rectContainsRect Rect Rational
r Rect Rational
area = forall s a.
Semilattice s =>
(a -> s) -> Rect Rational -> Rect Rational -> Free a -> s
queryImpl a -> s
f Rect Rational
area Rect Rational
r Free a
q
| forall a. (Ord a, Num a) => Rect a -> Rect a -> Bool
intersects Rect Rational
r Rect Rational
area = forall s a.
Semilattice s =>
(a -> s) -> Rect Rational -> Rect Rational -> Free a -> s
queryImpl a -> s
f Rect Rational
area Rect Rational
r Free a
q forall a. Semilattice a => a -> a -> a
/\ a -> s
f a
a
| Bool
otherwise = a -> s
f a
a
where
r :: Rect Rational
r = Integer -> Rect Rational
mkRectByPow Integer
n
queryImpl :: Semilattice s => (a -> s) -> Rect Rational -> Rect Rational -> Free a -> s
queryImpl :: forall s a.
Semilattice s =>
(a -> s) -> Rect Rational -> Rect Rational -> Free a -> s
queryImpl a -> s
f Rect Rational
area Rect Rational
r (Fill a
a)
| forall a. (Ord a, Num a) => Rect a -> Rect a -> Bool
intersects Rect Rational
area Rect Rational
r = a -> s
f a
a
| Bool
otherwise = forall a. Monoid a => a
mempty
queryImpl a -> s
f Rect Rational
area Rect Rational
r (Split V4 (Free a)
qu)
| forall a. (Ord a, Num a) => Rect a -> Rect a -> Bool
intersects Rect Rational
area Rect Rational
r = do
let subr :: V4 (Rect Rational)
subr = forall a. Fractional a => Rect a -> V4 (Rect a)
subdivide Rect Rational
r
subarea :: V4 (Maybe (Rect Rational))
subarea = forall a. (Ord a, Num a) => Rect a -> Rect a -> Maybe (Rect a)
getIntersect Rect Rational
area forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> V4 (Rect Rational)
subr
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall a b. (a -> b) -> a -> b
$ forall s a.
Semilattice s =>
(a -> s) -> Maybe (Rect Rational) -> Rect Rational -> Free a -> s
querySel a -> s
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> V4 (Maybe (Rect Rational))
subarea forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> V4 (Rect Rational)
subr forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> V4 (Free a)
qu
| Bool
otherwise = forall a. Monoid a => a
mempty
querySel :: Semilattice s => (a -> s) -> Maybe (Rect Rational) -> Rect Rational -> Free a -> s
querySel :: forall s a.
Semilattice s =>
(a -> s) -> Maybe (Rect Rational) -> Rect Rational -> Free a -> s
querySel a -> s
_ Maybe (Rect Rational)
Nothing Rect Rational
_ Free a
_ = forall a. Monoid a => a
mempty
querySel a -> s
f (Just Rect Rational
area) Rect Rational
r Free a
q = forall s a.
Semilattice s =>
(a -> s) -> Rect Rational -> Rect Rational -> Free a -> s
queryImpl a -> s
f Rect Rational
area Rect Rational
r Free a
q
toRects :: QuadTree a -> [(Rect Rational, a)]
toRects :: forall a. QuadTree a -> [(Rect Rational, a)]
toRects (QuadTree a
_ Integer
n Free a
q) = forall a. Rect Rational -> Free a -> [(Rect Rational, a)]
toRectsImpl (Integer -> Rect Rational
mkRectByPow Integer
n) Free a
q
toRectsImpl :: Rect Rational -> Free a -> [(Rect Rational, a)]
toRectsImpl :: forall a. Rect Rational -> Free a -> [(Rect Rational, a)]
toRectsImpl Rect Rational
r (Fill a
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rect Rational
r, a
a)
toRectsImpl Rect Rational
r (Split V4 (Free a)
qu) = do
let subr :: V4 (Rect Rational)
subr = forall a. Fractional a => Rect a -> V4 (Rect a)
subdivide Rect Rational
r
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall a b. (a -> b) -> a -> b
$ forall a. Rect Rational -> Free a -> [(Rect Rational, a)]
toRectsImpl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> V4 (Rect Rational)
subr forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> V4 (Free a)
qu
elements :: Ord a => QuadTree a -> Set a
elements :: forall a. Ord a => QuadTree a -> Set a
elements QuadTree a
ot = forall a. Ord a => a -> Set a -> Set a
S.insert (forall a. QuadTree a -> a
ot_default QuadTree a
ot) forall a b. (a -> b) -> a -> b
$ forall s a.
Semilattice s =>
(a -> s) -> Rect Rational -> QuadTree a -> s
query forall a. a -> Set a
S.singleton (forall a. QuadTree a -> Rect Rational
boundingRect QuadTree a
ot) QuadTree a
ot
fuse :: Eq a => QuadTree a -> QuadTree a
fuse :: forall a. Eq a => QuadTree a -> QuadTree a
fuse (QuadTree a
a Integer
n Free a
ot) = forall a. a -> Integer -> Free a -> QuadTree a
QuadTree a
a Integer
n forall a b. (a -> b) -> a -> b
$ forall a. Eq a => Free a -> Free a
Raw.fuse Free a
ot
combineAla :: forall n a. (Coercible a n, Semigroup n) => (a -> n) -> QuadTree a -> QuadTree a -> QuadTree a
combineAla :: forall n a.
(Coercible a n, Semigroup n) =>
(a -> n) -> QuadTree a -> QuadTree a -> QuadTree a
combineAla a -> n
_ QuadTree a
x QuadTree a
y = coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ (coerce :: forall a b. Coercible a b => a -> b
coerce QuadTree a
x :: QuadTree n) forall a. Semigroup a => a -> a -> a
<> coerce :: forall a b. Coercible a b => a -> b
coerce QuadTree a
y