module Gamgine.Math.BoxTree where
import qualified Gamgine.Math.Vect as V
import qualified Gamgine.Math.Box as B
import Data.List (concat)
import Debug.Trace

data BoxTree a = Node B.Box [BoxTree a]
                  | Leaf B.Box a
                  deriving (Int -> BoxTree a -> ShowS
[BoxTree a] -> ShowS
BoxTree a -> String
(Int -> BoxTree a -> ShowS)
-> (BoxTree a -> String)
-> ([BoxTree a] -> ShowS)
-> Show (BoxTree a)
forall a. Show a => Int -> BoxTree a -> ShowS
forall a. Show a => [BoxTree a] -> ShowS
forall a. Show a => BoxTree a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> BoxTree a -> ShowS
showsPrec :: Int -> BoxTree a -> ShowS
$cshow :: forall a. Show a => BoxTree a -> String
show :: BoxTree a -> String
$cshowList :: forall a. Show a => [BoxTree a] -> ShowS
showList :: [BoxTree a] -> ShowS
Show)

-- intersection details
data Intersection a = Intersection {
   forall a. Intersection a -> (Box, a)
leaf1 :: (B.Box, a),
   forall a. Intersection a -> (Box, a)
leaf2 :: (B.Box, a)
   }
   deriving (Int -> Intersection a -> ShowS
[Intersection a] -> ShowS
Intersection a -> String
(Int -> Intersection a -> ShowS)
-> (Intersection a -> String)
-> ([Intersection a] -> ShowS)
-> Show (Intersection a)
forall a. Show a => Int -> Intersection a -> ShowS
forall a. Show a => [Intersection a] -> ShowS
forall a. Show a => Intersection a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Intersection a -> ShowS
showsPrec :: Int -> Intersection a -> ShowS
$cshow :: forall a. Show a => Intersection a -> String
show :: Intersection a -> String
$cshowList :: forall a. Show a => [Intersection a] -> ShowS
showList :: [Intersection a] -> ShowS
Show)

intersection :: BoxTree a -> BoxTree a -> [Intersection a]
BoxTree a
qt1 intersection :: forall a. BoxTree a -> BoxTree a -> [Intersection a]
`intersection` BoxTree a
qt2 = BoxTree a
qt1 BoxTree a -> BoxTree a -> [Intersection a]
forall a. BoxTree a -> BoxTree a -> [Intersection a]
`isect` BoxTree a
qt2
   where
      isect :: BoxTree a -> BoxTree a -> [Intersection a]

      (Node Box
b1 [BoxTree a]
qts1) isect :: forall a. BoxTree a -> BoxTree a -> [Intersection a]
`isect` (Node Box
b2 [BoxTree a]
qts2)
         | Box
b1 Box -> Box -> Bool
`B.intersects` Box
b2 = [[Intersection a]] -> [Intersection a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Intersection a]] -> [Intersection a])
-> [[Intersection a]] -> [Intersection a]
forall a b. (a -> b) -> a -> b
$ [BoxTree a
qt1 BoxTree a -> BoxTree a -> [Intersection a]
forall a. BoxTree a -> BoxTree a -> [Intersection a]
`isect` BoxTree a
qt2 | BoxTree a
qt1 <- [BoxTree a]
qts1, BoxTree a
qt2 <- [BoxTree a]
qts2]
         | Bool
otherwise            = []

      l :: BoxTree a
l@(Leaf Box
b1 a
_) `isect` (Node Box
b2 [BoxTree a]
qts2)
         | Box
b1 Box -> Box -> Bool
`B.intersects` Box
b2 = [[Intersection a]] -> [Intersection a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Intersection a]] -> [Intersection a])
-> [[Intersection a]] -> [Intersection a]
forall a b. (a -> b) -> a -> b
$ [BoxTree a
l BoxTree a -> BoxTree a -> [Intersection a]
forall a. BoxTree a -> BoxTree a -> [Intersection a]
`isect` BoxTree a
qt2 | BoxTree a
qt2 <- [BoxTree a]
qts2]
         | Bool
otherwise            = []

      (Node Box
b1 [BoxTree a]
qts1) `isect` l :: BoxTree a
l@(Leaf Box
b2 a
_)
         | Box
b1 Box -> Box -> Bool
`B.intersects` Box
b2 = [[Intersection a]] -> [Intersection a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Intersection a]] -> [Intersection a])
-> [[Intersection a]] -> [Intersection a]
forall a b. (a -> b) -> a -> b
$ [BoxTree a
qt1 BoxTree a -> BoxTree a -> [Intersection a]
forall a. BoxTree a -> BoxTree a -> [Intersection a]
`isect` BoxTree a
l | BoxTree a
qt1 <- [BoxTree a]
qts1]
         | Bool
otherwise            = []

      (Leaf Box
b1 a
a1) `isect` (Leaf Box
b2 a
a2)
--       | b1 `B.intersects` b2 = trace ("b1: " ++ show b1 ++ "\nb2: " ++ show b2) [Intersection (b1, a1) (b2, a2)]
         | Box
b1 Box -> Box -> Bool
`B.intersects` Box
b2 = [(Box, a) -> (Box, a) -> Intersection a
forall a. (Box, a) -> (Box, a) -> Intersection a
Intersection (Box
b1, a
a1) (Box
b2, a
a2)]
         | Bool
otherwise            = []


moveBy :: BoxTree a -> V.Vect -> BoxTree a
(Node Box
b [BoxTree a]
qts) moveBy :: forall a. BoxTree a -> Vect -> BoxTree a
`moveBy` Vect
v = Box -> [BoxTree a] -> BoxTree a
forall a. Box -> [BoxTree a] -> BoxTree a
Node (Box
b Box -> Vect -> Box
`B.moveBy` Vect
v) [BoxTree a
qt BoxTree a -> Vect -> BoxTree a
forall a. BoxTree a -> Vect -> BoxTree a
`moveBy` Vect
v | BoxTree a
qt <- [BoxTree a]
qts]
(Leaf Box
b a
a)   `moveBy` Vect
v = Box -> a -> BoxTree a
forall a. Box -> a -> BoxTree a
Leaf (Box
b Box -> Vect -> Box
`B.moveBy` Vect
v) a
a


asBox :: BoxTree a -> B.Box
asBox :: forall a. BoxTree a -> Box
asBox (Node Box
box [BoxTree a]
_) = Box
box
asBox (Leaf Box
box a
_) = Box
box

asBoxTree :: B.Box -> a -> BoxTree a
asBoxTree :: forall a. Box -> a -> BoxTree a
asBoxTree Box
b a
a = Box -> a -> BoxTree a
forall a. Box -> a -> BoxTree a
Leaf Box
b a
a