{-# LANGUAGE PatternSynonyms #-}

module Data.OctTree.Internal where

import Control.Applicative (liftA2)
import Data.Maybe (isJust)
import Data.Monoid (Ap(..))
import GHC.Generics (Generic)
import Linear.V3
import Linear.V4


------------------------------------------------------------------------------
-- | An axis-aligned bounding box in 3-space.
data Cube a = Cube
  { forall a. Cube a -> V3 a
r_pos  :: !(V3 a)
  , forall a. Cube a -> V3 a
r_size :: !(V3 a)
  }
  deriving stock (Int -> Cube a -> ShowS
forall a. Show a => Int -> Cube a -> ShowS
forall a. Show a => [Cube a] -> ShowS
forall a. Show a => Cube a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cube a] -> ShowS
$cshowList :: forall a. Show a => [Cube a] -> ShowS
show :: Cube a -> String
$cshow :: forall a. Show a => Cube a -> String
showsPrec :: Int -> Cube a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Cube a -> ShowS
Show, ReadPrec [Cube a]
ReadPrec (Cube a)
ReadS [Cube a]
forall a. Read a => ReadPrec [Cube a]
forall a. Read a => ReadPrec (Cube a)
forall a. Read a => Int -> ReadS (Cube a)
forall a. Read a => ReadS [Cube a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Cube a]
$creadListPrec :: forall a. Read a => ReadPrec [Cube a]
readPrec :: ReadPrec (Cube a)
$creadPrec :: forall a. Read a => ReadPrec (Cube a)
readList :: ReadS [Cube a]
$creadList :: forall a. Read a => ReadS [Cube a]
readsPrec :: Int -> ReadS (Cube a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Cube a)
Read, Cube a -> Cube a -> Bool
forall a. Eq a => Cube a -> Cube a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cube a -> Cube a -> Bool
$c/= :: forall a. Eq a => Cube a -> Cube a -> Bool
== :: Cube a -> Cube a -> Bool
$c== :: forall a. Eq a => Cube a -> Cube a -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Cube a) x -> Cube a
forall a x. Cube a -> Rep (Cube a) x
$cto :: forall a x. Rep (Cube a) x -> Cube a
$cfrom :: forall a x. Cube a -> Rep (Cube a) x
Generic, Cube a -> Cube a -> Bool
Cube a -> Cube 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 (Cube a)
forall a. Ord a => Cube a -> Cube a -> Bool
forall a. Ord a => Cube a -> Cube a -> Ordering
forall a. Ord a => Cube a -> Cube a -> Cube a
min :: Cube a -> Cube a -> Cube a
$cmin :: forall a. Ord a => Cube a -> Cube a -> Cube a
max :: Cube a -> Cube a -> Cube a
$cmax :: forall a. Ord a => Cube a -> Cube a -> Cube a
>= :: Cube a -> Cube a -> Bool
$c>= :: forall a. Ord a => Cube a -> Cube a -> Bool
> :: Cube a -> Cube a -> Bool
$c> :: forall a. Ord a => Cube a -> Cube a -> Bool
<= :: Cube a -> Cube a -> Bool
$c<= :: forall a. Ord a => Cube a -> Cube a -> Bool
< :: Cube a -> Cube a -> Bool
$c< :: forall a. Ord a => Cube a -> Cube a -> Bool
compare :: Cube a -> Cube a -> Ordering
$ccompare :: forall a. Ord a => Cube a -> Cube a -> Ordering
Ord, forall a b. a -> Cube b -> Cube a
forall a b. (a -> b) -> Cube a -> Cube 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 -> Cube b -> Cube a
$c<$ :: forall a b. a -> Cube b -> Cube a
fmap :: forall a b. (a -> b) -> Cube a -> Cube b
$cfmap :: forall a b. (a -> b) -> Cube a -> Cube b
Functor)


------------------------------------------------------------------------------
r_x, r_y, r_z, r_w, r_h, r_d :: Cube a -> a
r_x :: forall a. Cube a -> a
r_x (Cube (V3 a
x a
_ a
_) (V3 a
_ a
_ a
_)) = a
x
r_y :: forall a. Cube a -> a
r_y (Cube (V3 a
_ a
y a
_) (V3 a
_ a
_ a
_)) = a
y
r_z :: forall a. Cube a -> a
r_z (Cube (V3 a
_ a
_ a
z) (V3 a
_ a
_ a
_)) = a
z
r_w :: forall a. Cube a -> a
r_w (Cube (V3 a
_ a
_ a
_) (V3 a
w a
_ a
_)) = a
w
r_h :: forall a. Cube a -> a
r_h (Cube (V3 a
_ a
_ a
_) (V3 a
_ a
h a
_)) = a
h
r_d :: forall a. Cube a -> a
r_d (Cube (V3 a
_ a
_ a
_) (V3 a
_ a
_ a
d)) = a
d


------------------------------------------------------------------------------
-- | @'containsCube' c1 c2@ is true when @c2@ is inside or equal to @c1@.
cubeContainsCube :: (Num a, Ord a) => Cube a -> Cube a -> Bool
cubeContainsCube :: forall a. (Num a, Ord a) => Cube a -> Cube a -> Bool
cubeContainsCube r1 :: Cube a
r1@(Cube (V3 a
bx a
by a
bz) (V3 a
bw a
bh a
bd)) r2 :: Cube a
r2@(Cube (V3 a
sx a
sy a
sz) (V3 a
sw a
sh a
sd)) =
  Cube a
r1 forall a. Eq a => a -> a -> Bool
== Cube 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
bz forall a. Ord a => a -> a -> Bool
<= a
sz
    , 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
    , a
sz forall a. Num a => a -> a -> a
+ a
sd forall a. Ord a => a -> a -> Bool
<= a
bz forall a. Num a => a -> a -> a
+ a
bd
    ]


------------------------------------------------------------------------------
-- | Does the cube contain a given point?
cubeContainsPoint :: (Ord a, Num a) => Cube a -> V3 a -> Bool
cubeContainsPoint :: forall a. (Ord a, Num a) => Cube a -> V3 a -> Bool
cubeContainsPoint (forall a. (Num a, Ord a) => Cube a -> Cube a
normalize -> Cube V3 a
_ (V3 a
w a
h a
d)) V3 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 -> Bool -> Bool
|| a
d forall a. Ord a => a -> a -> Bool
<= a
0
  = Bool
False
cubeContainsPoint (forall a. (Num a, Ord a) => Cube a -> Cube a
normalize -> Cube (V3 a
x a
y a
z) (V3 a
w a
h a
d)) (V3 a
tx a
ty a
tz) =
  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
z forall a. Ord a => a -> a -> Bool
<= a
tz
    , 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
    , a
tz forall a. Ord a => a -> a -> Bool
< a
z forall a. Num a => a -> a -> a
+ a
d
    ]

------------------------------------------------------------------------------
-- | Get the co-ordinates of the corners of a 'Cube'.
cubeCorners :: Num a => Cube a -> Oct (V3 a)
cubeCorners :: forall a. Num a => Cube a -> Oct (V3 a)
cubeCorners (Cube (V3 a
x a
y a
z) (V3 a
w a
h a
d)) =
  let p :: V3 a
p = forall a. a -> a -> a -> V3 a
V3 a
x a
y a
z
      dx :: V3 a
dx = forall a. a -> a -> a -> V3 a
V3 a
w a
0 a
0
      dy :: V3 a
dy = forall a. a -> a -> a -> V3 a
V3 a
0 a
h a
0
      dz :: V3 a
dz = forall a. a -> a -> a -> V3 a
V3 a
0 a
0 a
d
   in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (V3 a
p forall a. Num a => a -> a -> a
+) forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> a -> a -> a -> a -> a -> Oct a
Oct8 V3 a
0   V3 a
dx         V3 a
dy       (V3 a
dx forall a. Num a => a -> a -> a
+ V3 a
dy)
                       V3 a
dz (V3 a
dx forall a. Num a => a -> a -> a
+ V3 a
dz) (V3 a
dy forall a. Num a => a -> a -> a
+ V3 a
dz) (V3 a
dx forall a. Num a => a -> a -> a
+ V3 a
dy forall a. Num a => a -> a -> a
+ V3 a
dz)


------------------------------------------------------------------------------
-- | 'Control.Monad.Free.Free', but with better instances.
data Free a
  = Fill a
  | Split (Oct (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 Oct (Free a)
qu == Split Oct (Free a)
qu' = Oct (Free a)
qu            forall a. Eq a => a -> a -> Bool
== Oct (Free a)
qu'
  Fill a
a   == Split Oct (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
== Oct (Free a)
qu
  Split Oct (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
== Oct (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 Oct (Free b)
qu) = forall a. Oct (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)) Oct (Free b)
qu
  liftA2 a -> b -> c
fabc (Split Oct (Free a)
qu) (Fill b
b) = forall a. Oct (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)) Oct (Free a)
qu
  liftA2 a -> b -> c
fabc (Split Oct (Free a)
qu) (Split Oct (Free b)
qu') = forall a. Oct (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) Oct (Free a)
qu Oct (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 Oct (Free a)
qu >>= a -> Free b
f = forall a. Oct (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) Oct (Free a)
qu


------------------------------------------------------------------------------
-- | An 8-tuple of values.
data Oct a = Oct !(V4 a) !(V4 a)
  deriving stock (Oct a -> Oct a -> Bool
forall a. Eq a => Oct a -> Oct a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Oct a -> Oct a -> Bool
$c/= :: forall a. Eq a => Oct a -> Oct a -> Bool
== :: Oct a -> Oct a -> Bool
$c== :: forall a. Eq a => Oct a -> Oct a -> Bool
Eq, Oct a -> Oct a -> Bool
Oct a -> Oct 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 (Oct a)
forall a. Ord a => Oct a -> Oct a -> Bool
forall a. Ord a => Oct a -> Oct a -> Ordering
forall a. Ord a => Oct a -> Oct a -> Oct a
min :: Oct a -> Oct a -> Oct a
$cmin :: forall a. Ord a => Oct a -> Oct a -> Oct a
max :: Oct a -> Oct a -> Oct a
$cmax :: forall a. Ord a => Oct a -> Oct a -> Oct a
>= :: Oct a -> Oct a -> Bool
$c>= :: forall a. Ord a => Oct a -> Oct a -> Bool
> :: Oct a -> Oct a -> Bool
$c> :: forall a. Ord a => Oct a -> Oct a -> Bool
<= :: Oct a -> Oct a -> Bool
$c<= :: forall a. Ord a => Oct a -> Oct a -> Bool
< :: Oct a -> Oct a -> Bool
$c< :: forall a. Ord a => Oct a -> Oct a -> Bool
compare :: Oct a -> Oct a -> Ordering
$ccompare :: forall a. Ord a => Oct a -> Oct a -> Ordering
Ord, Int -> Oct a -> ShowS
forall a. Show a => Int -> Oct a -> ShowS
forall a. Show a => [Oct a] -> ShowS
forall a. Show a => Oct a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Oct a] -> ShowS
$cshowList :: forall a. Show a => [Oct a] -> ShowS
show :: Oct a -> String
$cshow :: forall a. Show a => Oct a -> String
showsPrec :: Int -> Oct a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Oct a -> ShowS
Show, forall a b. a -> Oct b -> Oct a
forall a b. (a -> b) -> Oct a -> Oct 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 -> Oct b -> Oct a
$c<$ :: forall a b. a -> Oct b -> Oct a
fmap :: forall a b. (a -> b) -> Oct a -> Oct b
$cfmap :: forall a b. (a -> b) -> Oct a -> Oct b
Functor, forall a. Eq a => a -> Oct a -> Bool
forall a. Num a => Oct a -> a
forall a. Ord a => Oct a -> a
forall m. Monoid m => Oct m -> m
forall a. Oct a -> Bool
forall a. Oct a -> Int
forall a. Oct a -> [a]
forall a. (a -> a -> a) -> Oct a -> a
forall m a. Monoid m => (a -> m) -> Oct a -> m
forall b a. (b -> a -> b) -> b -> Oct a -> b
forall a b. (a -> b -> b) -> b -> Oct 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 => Oct a -> a
$cproduct :: forall a. Num a => Oct a -> a
sum :: forall a. Num a => Oct a -> a
$csum :: forall a. Num a => Oct a -> a
minimum :: forall a. Ord a => Oct a -> a
$cminimum :: forall a. Ord a => Oct a -> a
maximum :: forall a. Ord a => Oct a -> a
$cmaximum :: forall a. Ord a => Oct a -> a
elem :: forall a. Eq a => a -> Oct a -> Bool
$celem :: forall a. Eq a => a -> Oct a -> Bool
length :: forall a. Oct a -> Int
$clength :: forall a. Oct a -> Int
null :: forall a. Oct a -> Bool
$cnull :: forall a. Oct a -> Bool
toList :: forall a. Oct a -> [a]
$ctoList :: forall a. Oct a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Oct a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Oct a -> a
foldr1 :: forall a. (a -> a -> a) -> Oct a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Oct a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Oct a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Oct a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Oct a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Oct a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Oct a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Oct a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Oct a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Oct a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Oct a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Oct a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Oct a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Oct a -> m
fold :: forall m. Monoid m => Oct m -> m
$cfold :: forall m. Monoid m => Oct m -> m
Foldable, Functor Oct
Foldable Oct
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 => Oct (m a) -> m (Oct a)
forall (f :: * -> *) a. Applicative f => Oct (f a) -> f (Oct a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Oct a -> m (Oct b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Oct a -> f (Oct b)
sequence :: forall (m :: * -> *) a. Monad m => Oct (m a) -> m (Oct a)
$csequence :: forall (m :: * -> *) a. Monad m => Oct (m a) -> m (Oct a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Oct a -> m (Oct b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Oct a -> m (Oct b)
sequenceA :: forall (f :: * -> *) a. Applicative f => Oct (f a) -> f (Oct a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Oct (f a) -> f (Oct a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Oct a -> f (Oct b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Oct a -> f (Oct b)
Traversable, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Oct a) x -> Oct a
forall a x. Oct a -> Rep (Oct a) x
$cto :: forall a x. Rep (Oct a) x -> Oct a
$cfrom :: forall a x. Oct a -> Rep (Oct a) x
Generic)
  deriving (NonEmpty (Oct a) -> Oct a
Oct a -> Oct a -> Oct a
forall b. Integral b => b -> Oct a -> Oct a
forall a. Semigroup a => NonEmpty (Oct a) -> Oct a
forall a. Semigroup a => Oct a -> Oct a -> Oct a
forall a b. (Semigroup a, Integral b) => b -> Oct a -> Oct a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Oct a -> Oct a
$cstimes :: forall a b. (Semigroup a, Integral b) => b -> Oct a -> Oct a
sconcat :: NonEmpty (Oct a) -> Oct a
$csconcat :: forall a. Semigroup a => NonEmpty (Oct a) -> Oct a
<> :: Oct a -> Oct a -> Oct a
$c<> :: forall a. Semigroup a => Oct a -> Oct a -> Oct a
Semigroup, Oct a
[Oct a] -> Oct a
Oct a -> Oct a -> Oct a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall {a}. Monoid a => Semigroup (Oct a)
forall a. Monoid a => Oct a
forall a. Monoid a => [Oct a] -> Oct a
forall a. Monoid a => Oct a -> Oct a -> Oct a
mconcat :: [Oct a] -> Oct a
$cmconcat :: forall a. Monoid a => [Oct a] -> Oct a
mappend :: Oct a -> Oct a -> Oct a
$cmappend :: forall a. Monoid a => Oct a -> Oct a -> Oct a
mempty :: Oct a
$cmempty :: forall a. Monoid a => Oct a
Monoid) via Ap Oct a

pattern Oct8 :: a -> a -> a -> a -> a -> a -> a -> a -> Oct a
pattern $bOct8 :: forall a. a -> a -> a -> a -> a -> a -> a -> a -> Oct a
$mOct8 :: forall {r} {a}.
Oct a
-> (a -> a -> a -> a -> a -> a -> a -> a -> r) -> ((# #) -> r) -> r
Oct8 a b c d e f g h = Oct (V4 a b c d) (V4 e f g h)
{-# COMPLETE Oct8 #-}

instance Applicative Oct where
  pure :: forall a. a -> Oct a
pure a
a = forall a. V4 a -> V4 a -> Oct a
Oct (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)
  liftA2 :: forall a b c. (a -> b -> c) -> Oct a -> Oct b -> Oct c
liftA2 a -> b -> c
fabc (Oct V4 a
a1 V4 a
a2) (Oct V4 b
b1 V4 b
b2)
    = forall a. V4 a -> V4 a -> Oct a
Oct (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
fabc V4 a
a1 V4 b
b1) (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
fabc V4 a
a2 V4 b
b2)


------------------------------------------------------------------------------
-- | Normalize a 'Cube' so it has a positive 'r_size'.
normalize :: (Num a, Ord a) => Cube a -> Cube a
normalize :: forall a. (Num a, Ord a) => Cube a -> Cube a
normalize q :: Cube a
q@(Cube (V3 a
x a
y a
z) (V3 a
w a
h a
d))
  | 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) => Cube a -> Cube a
normalize forall a b. (a -> b) -> a -> b
$ forall a. V3 a -> V3 a -> Cube a
Cube (forall a. a -> a -> a -> V3 a
V3 (a
x forall a. Num a => a -> a -> a
- a
w') a
y a
z) forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> V3 a
V3 a
w' a
h a
d
  | 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) => Cube a -> Cube a
normalize forall a b. (a -> b) -> a -> b
$ forall a. V3 a -> V3 a -> Cube a
Cube (forall a. a -> a -> a -> V3 a
V3 a
x (a
y forall a. Num a => a -> a -> a
- a
h') a
z) forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> V3 a
V3 a
w a
h' a
d
  | a
d forall a. Ord a => a -> a -> Bool
< a
0 = let d' :: a
d' = forall a. Num a => a -> a
abs a
d in forall a. (Num a, Ord a) => Cube a -> Cube a
normalize forall a b. (a -> b) -> a -> b
$ forall a. V3 a -> V3 a -> Cube a
Cube (forall a. a -> a -> a -> V3 a
V3 a
x a
y (a
z forall a. Num a => a -> a -> a
- a
d')) forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> V3 a
V3 a
w a
h a
d'
  | Bool
otherwise = Cube a
q


------------------------------------------------------------------------------
-- | Do two 'Cube's intersect?
intersects :: (Ord a, Num a) => Cube a -> Cube a -> Bool
intersects :: forall a. (Ord a, Num a) => Cube a -> Cube a -> Bool
intersects Cube a
r1 Cube a
r2 = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall a. (Ord a, Num a) => Cube a -> Cube a -> Maybe (Cube a)
getIntersect Cube a
r1 Cube a
r2


------------------------------------------------------------------------------
-- | Get the volume of a 'Cube'.
cubeSize :: Num a => Cube a -> a
cubeSize :: forall a. Num a => Cube a -> a
cubeSize (Cube V3 a
_ (V3 a
w a
h a
d)) = forall a. Num a => a -> a
abs a
w forall a. Num a => a -> a -> a
* forall a. Num a => a -> a
abs a
h forall a. Num a => a -> a -> a
* forall a. Num a => a -> a
abs a
d


------------------------------------------------------------------------------
-- | Compute the intersection of two 'Cube's.
getIntersect :: (Ord a, Num a) => Cube a -> Cube a -> Maybe (Cube a)
getIntersect :: forall a. (Ord a, Num a) => Cube a -> Cube a -> Maybe (Cube a)
getIntersect (forall a. (Num a, Ord a) => Cube a -> Cube a
normalize -> Cube a
r1) (forall a. (Num a, Ord a) => Cube a -> Cube a
normalize -> Cube a
r2)
 | forall a. Num a => Cube a -> a
cubeSize Cube a
r1 forall a. Eq a => a -> a -> Bool
== a
0 = forall a. a -> Maybe a
Just Cube a
r1
 | forall a. Num a => Cube a -> a
cubeSize Cube a
r2 forall a. Eq a => a -> a -> Bool
== a
0 = forall a. a -> Maybe a
Just Cube a
r2
 | Bool
otherwise =
  let x0 :: a
x0 = forall a. Ord a => a -> a -> a
max (forall a. Cube a -> a
r_x Cube a
r1) (forall a. Cube a -> a
r_x Cube a
r2)
      y0 :: a
y0 = forall a. Ord a => a -> a -> a
max (forall a. Cube a -> a
r_y Cube a
r1) (forall a. Cube a -> a
r_y Cube a
r2)
      z0 :: a
z0 = forall a. Ord a => a -> a -> a
max (forall a. Cube a -> a
r_z Cube a
r1) (forall a. Cube a -> a
r_z Cube a
r2)
      x1 :: a
x1 = forall a. Ord a => a -> a -> a
min (forall a. Cube a -> a
r_x Cube a
r1 forall a. Num a => a -> a -> a
+ forall a. Cube a -> a
r_w Cube a
r1) (forall a. Cube a -> a
r_x Cube a
r2 forall a. Num a => a -> a -> a
+ forall a. Cube a -> a
r_w Cube a
r2)
      y1 :: a
y1 = forall a. Ord a => a -> a -> a
min (forall a. Cube a -> a
r_y Cube a
r1 forall a. Num a => a -> a -> a
+ forall a. Cube a -> a
r_h Cube a
r1) (forall a. Cube a -> a
r_y Cube a
r2 forall a. Num a => a -> a -> a
+ forall a. Cube a -> a
r_h Cube a
r2)
      z1 :: a
z1 = forall a. Ord a => a -> a -> a
min (forall a. Cube a -> a
r_z Cube a
r1 forall a. Num a => a -> a -> a
+ forall a. Cube a -> a
r_d Cube a
r1) (forall a. Cube a -> a
r_z Cube a
r2 forall a. Num a => a -> a -> a
+ forall a. Cube a -> a
r_d Cube 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
      d :: a
d = a
z1 forall a. Num a => a -> a -> a
- a
z0
   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 Bool -> Bool -> Bool
&& a
0 forall a. Ord a => a -> a -> Bool
< a
d of
        Bool
True -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. V3 a -> V3 a -> Cube a
Cube (forall a. a -> a -> a -> V3 a
V3 a
x0 a
y0 a
z0) (forall a. a -> a -> a -> V3 a
V3 a
w a
h a
d)
        Bool
False -> forall a. Maybe a
Nothing


unwrap :: Free a -> Oct (Free a)
unwrap :: forall a. Free a -> Oct (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 Oct (Free a)
qu) = Oct (Free a)
qu


------------------------------------------------------------------------------
-- | Join together 'Split' constructors which all contain the same value.
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 Oct (Free a)
q) = forall a. Eq a => Oct (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 Oct (Free a)
q


doFuse :: Eq a => Oct (Free a) -> Free a
doFuse :: forall a. Eq a => Oct (Free a) -> Free a
doFuse (Oct8 (Fill a
a) (Fill a
b) (Fill a
c) (Fill a
d) (Fill a
e) (Fill a
f) (Fill a
g) (Fill a
h))
  | 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
  , a
d forall a. Eq a => a -> a -> Bool
== a
e
  , a
e forall a. Eq a => a -> a -> Bool
== a
f
  , a
f forall a. Eq a => a -> a -> Bool
== a
g
  , a
g forall a. Eq a => a -> a -> Bool
== a
h
  = forall a. a -> Free a
Fill a
a
doFuse Oct (Free a)
q = forall a. Oct (Free a) -> Free a
Split Oct (Free a)
q