{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE NamedFieldPuns       #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Graphics.SceneGraph.Render where

import qualified Data.Graph.Inductive      as G
import           Graphics.SceneGraph.Types (Color (White), Phong (..),
                                            Scene (..), SceneData (..),
                                            SceneGraph, SceneNode (..),
                                            colorToPhong, llab)
import           Linear                    (M44, (!*!))
import qualified Linear                    as L


-- | Draw a scene graph (or a scenegraph fragment)
drawScene :: Monad m => Scene g -> (M44 Float -> Phong -> g -> m ()) -> m ()
drawScene :: Scene g -> (M44 Float -> Phong -> g -> m ()) -> m ()
drawScene = M44 Float
-> Phong -> Scene g -> (M44 Float -> Phong -> g -> m ()) -> m ()
forall (m :: * -> *) g.
Monad m =>
M44 Float
-> Phong -> Scene g -> (M44 Float -> Phong -> g -> m ()) -> m ()
drawScene' M44 Float
forall a (t :: * -> *).
(Num a, Traversable t, Applicative t) =>
t (t a)
L.identity (Color -> Phong
colorToPhong Color
White)

drawScene' :: Monad m => M44 Float -> Phong -> Scene g -> (M44 Float -> Phong -> g -> m ()) -> m ()
drawScene' :: M44 Float
-> Phong -> Scene g -> (M44 Float -> Phong -> g -> m ()) -> m ()
drawScene' M44 Float
curMat Phong
curPhong (Scene SceneGraph g
gr Node
n) M44 Float -> Phong -> g -> m ()
drawGeode = do
  case SceneGraph g -> Node -> SceneNode g
forall g. SceneGraph g -> Node -> SceneNode g
llab SceneGraph g
gr Node
n of
    SceneNode Node
_ String
_ (MatrixTransform M44 Float
m) -> do
      M44 Float -> Phong -> m ()
recurse (M44 Float
m M44 Float -> M44 Float -> M44 Float
forall (m :: * -> *) (t :: * -> *) (n :: * -> *) a.
(Functor m, Foldable t, Additive t, Additive n, Num a) =>
m (t a) -> t (n a) -> m (n a)
!*! M44 Float
curMat) Phong
curPhong
    SceneNode Node
_ String
_ (Material Phong
phong) -> do
      M44 Float -> Phong -> m ()
recurse M44 Float
curMat Phong
phong
    SceneNode Node
_ String
_ (Geode Text
_ g
g) -> do
      M44 Float -> Phong -> g -> m ()
drawGeode M44 Float
curMat Phong
curPhong g
g
      M44 Float -> Phong -> m ()
recurse M44 Float
curMat Phong
curPhong
    SceneNode g
_ -> do
      -- TODO: implement
      M44 Float -> Phong -> m ()
recurse M44 Float
curMat Phong
curPhong

  where
    recurse :: M44 Float -> Phong -> m ()
recurse M44 Float
nextMat Phong
nextPhong =
      (Node -> m ()) -> [Node] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Node
next -> M44 Float
-> Phong -> Scene g -> (M44 Float -> Phong -> g -> m ()) -> m ()
forall (m :: * -> *) g.
Monad m =>
M44 Float
-> Phong -> Scene g -> (M44 Float -> Phong -> g -> m ()) -> m ()
drawScene' M44 Float
nextMat Phong
nextPhong (SceneGraph g -> Node -> Scene g
forall g. SceneGraph g -> Node -> Scene g
Scene SceneGraph g
gr Node
next) M44 Float -> Phong -> g -> m ()
drawGeode) (SceneGraph g -> Node -> [Node]
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Node -> [Node]
G.suc SceneGraph g
gr Node
n)


mapSceneData :: (SceneData g1 -> SceneData g2) -> SceneGraph g1 -> SceneGraph g2
mapSceneData :: (SceneData g1 -> SceneData g2) -> SceneGraph g1 -> SceneGraph g2
mapSceneData SceneData g1 -> SceneData g2
f =
  (SceneNode g1 -> SceneNode g2) -> SceneGraph g1 -> SceneGraph g2
forall (gr :: * -> * -> *) a c b.
DynGraph gr =>
(a -> c) -> gr a b -> gr c b
G.nmap (\(SceneNode Node
nde String
lbl SceneData g1
sd) -> Node -> String -> SceneData g2 -> SceneNode g2
forall g. Node -> String -> SceneData g -> SceneNode g
SceneNode Node
nde String
lbl (SceneData g1 -> SceneData g2
f SceneData g1
sd))

foldSceneData :: (SceneData g -> a -> a) -> a -> SceneGraph g -> a
foldSceneData :: (SceneData g -> a -> a) -> a -> SceneGraph g -> a
foldSceneData SceneData g -> a -> a
f =
  (Context (SceneNode g) SceneEdge -> a -> a)
-> a -> SceneGraph g -> a
forall (gr :: * -> * -> *) a b c.
Graph gr =>
(Context a b -> c -> c) -> c -> gr a b -> c
G.ufold (\(Adj SceneEdge
_, Node
_, SceneNode Node
_ String
_ SceneData g
sd, Adj SceneEdge
_) a
acc -> SceneData g -> a -> a
f SceneData g
sd a
acc)