module Graphics.SceneGraph.BoundingBox where

import           Control.Applicative       (liftA2)
import           Control.Lens              ((^.))
import           Data.Graph.Inductive      (Node)
import qualified Data.Graph.Inductive      as G
import           Data.Maybe                (fromMaybe)
import           Graphics.SceneGraph.Types
import           Linear                    (R3 (..), V3 (..), (!*))
import qualified Linear                    as L


-- | A box. Used for calculating bounds
type Box a = (V3 a, V3 a)

-- | Return the diagonal vector across the box corners.
boxSize :: Box Float -> V3 Float
boxSize :: Box Float -> V3 Float
boxSize (V3 Float
a, V3 Float
b) = V3 Float
b V3 Float -> V3 Float -> V3 Float
forall a. Num a => a -> a -> a
- V3 Float
a

-- | Bounds suitable for starting off with
smallBox :: Box Float
smallBox :: Box Float
smallBox = (Float -> Float -> Float -> V3 Float
forall a. a -> a -> a -> V3 a
V3 (-Float
0.1) (-Float
0.1) (-Float
0.1), Float -> Float -> Float -> V3 Float
forall a. a -> a -> a -> V3 a
V3 Float
0.1 Float
0.1 Float
0.1)

-- | Create union of two boxes
union :: Box Float -> Box Float -> Box Float
union :: Box Float -> Box Float -> Box Float
union (V3 Float
v1,V3 Float
v2) (V3 Float
w1,V3 Float
w2) = ((Float -> Float -> Float) -> V3 Float -> V3 Float -> V3 Float
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Float -> Float -> Float
forall a. Ord a => a -> a -> a
min V3 Float
v1 V3 Float
w1, (Float -> Float -> Float) -> V3 Float -> V3 Float -> V3 Float
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Float -> Float -> Float
forall a. Ord a => a -> a -> a
max V3 Float
v2 V3 Float
w2)

bounds :: Scene g -> Box Float
bounds :: Scene g -> Box Float
bounds (Scene SceneGraph g
gr Node
nde) =
  let sn :: SceneNode g
sn = SceneGraph g -> Node -> SceneNode g
forall g. SceneGraph g -> Node -> SceneNode g
llab SceneGraph g
gr Node
nde in
  SceneGraph g -> SceneNode g -> Box Float
forall g. SceneGraph g -> SceneNode g -> Box Float
boundsSceneNode SceneGraph g
gr SceneNode g
sn

-- | Determine bounds of a @SceneNode@
boundsSceneNode :: SceneGraph g -> SceneNode g -> Box Float
boundsSceneNode :: SceneGraph g -> SceneNode g -> Box Float
boundsSceneNode SceneGraph g
gr (SceneNode Node
nde String
_ (MatrixTransform M44 Float
mt)) =
  let (V3 Float
v1, V3 Float
v2) = SceneGraph g -> Node -> Box Float
forall g. SceneGraph g -> Node -> Box Float
boundsOfChildren SceneGraph g
gr Node
nde in
  ((M44 Float
mt M44 Float -> V4 Float -> V4 Float
forall (m :: * -> *) (r :: * -> *) a.
(Functor m, Foldable r, Additive r, Num a) =>
m (r a) -> r a -> m a
!* V3 Float -> V4 Float
forall a. Num a => V3 a -> V4 a
L.point V3 Float
v1) V4 Float -> Getting (V3 Float) (V4 Float) (V3 Float) -> V3 Float
forall s a. s -> Getting a s a -> a
^. Getting (V3 Float) (V4 Float) (V3 Float)
forall (t :: * -> *) a. R3 t => Lens' (t a) (V3 a)
_xyz, (M44 Float
mt M44 Float -> V4 Float -> V4 Float
forall (m :: * -> *) (r :: * -> *) a.
(Functor m, Foldable r, Additive r, Num a) =>
m (r a) -> r a -> m a
!* V3 Float -> V4 Float
forall a. Num a => V3 a -> V4 a
L.point V3 Float
v2) V4 Float -> Getting (V3 Float) (V4 Float) (V3 Float) -> V3 Float
forall s a. s -> Getting a s a -> a
^. Getting (V3 Float) (V4 Float) (V3 Float)
forall (t :: * -> *) a. R3 t => Lens' (t a) (V3 a)
_xyz)

boundsSceneNode SceneGraph g
gr (SceneNode Node
nde String
_ (Switch Node
i)) =
  let nde' :: Node
nde' = SceneGraph g -> Node -> [Node]
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Node -> [Node]
G.suc SceneGraph g
gr Node
nde [Node] -> Node -> Node
forall a. [a] -> Node -> a
!! Node
i in
  Scene g -> Box Float
forall g. Scene g -> Box Float
bounds (SceneGraph g -> Node -> Scene g
forall g. SceneGraph g -> Node -> Scene g
Scene SceneGraph g
gr Node
nde')

boundsSceneNode SceneGraph g
_ (SceneNode Node
_ String
_ (Geode Text
_ g
_)) = Box Float
smallBox

boundsSceneNode SceneGraph g
gr (SceneNode Node
nde String
_ SceneData g
_) = SceneGraph g -> Node -> Box Float
forall g. SceneGraph g -> Node -> Box Float
boundsOfChildren SceneGraph g
gr Node
nde

boundsOfChildren :: SceneGraph g -> Node -> Box Float
boundsOfChildren :: SceneGraph g -> Node -> Box Float
boundsOfChildren SceneGraph g
gr =
  Box Float -> Maybe (Box Float) -> Box Float
forall a. a -> Maybe a -> a
fromMaybe Box Float
smallBox (Maybe (Box Float) -> Box Float)
-> (Node -> Maybe (Box Float)) -> Node -> Box Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node -> Maybe (Box Float) -> Maybe (Box Float))
-> Maybe (Box Float) -> [Node] -> Maybe (Box Float)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Node -> Maybe (Box Float) -> Maybe (Box Float)
f Maybe (Box Float)
forall a. Maybe a
Nothing ([Node] -> Maybe (Box Float))
-> (Node -> [Node]) -> Node -> Maybe (Box Float)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SceneGraph g -> Node -> [Node]
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Node -> [Node]
G.suc SceneGraph g
gr
  where
    f :: Node -> Maybe (Box Float) -> Maybe (Box Float)
f Node
nde Maybe (Box Float)
Nothing  = Box Float -> Maybe (Box Float)
forall a. a -> Maybe a
Just (Box Float -> Maybe (Box Float)) -> Box Float -> Maybe (Box Float)
forall a b. (a -> b) -> a -> b
$ Scene g -> Box Float
forall g. Scene g -> Box Float
bounds (SceneGraph g -> Node -> Scene g
forall g. SceneGraph g -> Node -> Scene g
Scene SceneGraph g
gr Node
nde)
    f Node
nde (Just Box Float
b) = Box Float -> Maybe (Box Float)
forall a. a -> Maybe a
Just (Box Float -> Maybe (Box Float)) -> Box Float -> Maybe (Box Float)
forall a b. (a -> b) -> a -> b
$ Box Float
b Box Float -> Box Float -> Box Float
`union` Scene g -> Box Float
forall g. Scene g -> Box Float
bounds (SceneGraph g -> Node -> Scene g
forall g. SceneGraph g -> Node -> Scene g
Scene SceneGraph g
gr Node
nde)