module Graphics.SceneGraph.Basic where

import           Control.Lens               ((^.))
import           Control.Monad.Identity     (Identity)
import           Control.Monad.State        (lift)
import qualified Control.Monad.State        as ST
import           Data.Default               (Default (..))
import           Data.Graph.Inductive       (Node, (&))
import qualified Data.Graph.Inductive       as G
import qualified Data.Text                  as T
import           Graphics.SceneGraph.Matrix (rotateM, rotatePostM, scaleM,
                                             translateM, translatePostM)
import           Graphics.SceneGraph.Types  (ClickHandler, Color, DragHandler,
                                             KeyState (Down), Phong, Scene (..),
                                             SceneData (..), SceneEdge (..),
                                             SceneGraph, SceneNode (..),
                                             colorToPhong, llab, nullNode)
import           Linear                     (M44, R1 (..), R3 (..), V3 (..),
                                             (!*!))
import qualified Linear                     as L


-- | Holds state of graph as it is built.
data OSGState g = OSGState
  { OSGState g -> SceneGraph g
graph     :: SceneGraph g
  , OSGState g -> [SceneNode g]
context   :: [SceneNode g]
  , OSGState g -> Int
startNode :: Int
  , OSGState g -> Int
root      :: Int
  }
  deriving (OSGState g -> OSGState g -> Bool
(OSGState g -> OSGState g -> Bool)
-> (OSGState g -> OSGState g -> Bool) -> Eq (OSGState g)
forall g. OSGState g -> OSGState g -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OSGState g -> OSGState g -> Bool
$c/= :: forall g. OSGState g -> OSGState g -> Bool
== :: OSGState g -> OSGState g -> Bool
$c== :: forall g. OSGState g -> OSGState g -> Bool
Eq, Int -> OSGState g -> ShowS
[OSGState g] -> ShowS
OSGState g -> String
(Int -> OSGState g -> ShowS)
-> (OSGState g -> String)
-> ([OSGState g] -> ShowS)
-> Show (OSGState g)
forall g. Int -> OSGState g -> ShowS
forall g. [OSGState g] -> ShowS
forall g. OSGState g -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OSGState g] -> ShowS
$cshowList :: forall g. [OSGState g] -> ShowS
show :: OSGState g -> String
$cshow :: forall g. OSGState g -> String
showsPrec :: Int -> OSGState g -> ShowS
$cshowsPrec :: forall g. Int -> OSGState g -> ShowS
Show)

instance Default (OSGState g) where
  def :: OSGState g
def = SceneGraph g -> [SceneNode g] -> Int -> Int -> OSGState g
forall g. SceneGraph g -> [SceneNode g] -> Int -> Int -> OSGState g
OSGState SceneGraph g
forall g. SceneGraph g
emptyOSG [] Int
0 Int
0

emptyState :: OSGState g
emptyState :: OSGState g
emptyState = OSGState g
forall a. Default a => a
def

-- | The OSG monad within which construction of scene graphs occur.
-- was 'type OSGT m = ErrorT Throwable (ST.StateT OSGState m)'
type OSGT m g = ST.StateT (OSGState g) m
type OSGSceneT m g = OSGT m g (SceneNode g)

type OSG g = OSGT Identity g

-- | Create and run a OSG monad to return a scene graph and root node.
runOSG :: Monad m => OSGState g -> OSGSceneT m g -> m (SceneNode g, OSGState g, Node)
runOSG :: OSGState g -> OSGSceneT m g -> m (SceneNode g, OSGState g, Int)
runOSG OSGState g
state OSGSceneT m g
f = do
  (SceneNode g
ret, OSGState g
state') <- OSGSceneT m g -> OSGState g -> m (SceneNode g, OSGState g)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
ST.runStateT OSGSceneT m g
f OSGState g
state
  (SceneNode g, OSGState g, Int) -> m (SceneNode g, OSGState g, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (SceneNode g
ret, OSGState g
state', OSGState g -> Int
forall g. OSGState g -> Int
root OSGState g
state')


runOSGShow :: OSGSceneT IO g -> IO ()
runOSGShow :: OSGSceneT IO g -> IO ()
runOSGShow OSGSceneT IO g
f = do
  (SceneNode g
ret, OSGState g
state, Int
i) <- OSGState g -> OSGSceneT IO g -> IO (SceneNode g, OSGState g, Int)
forall (m :: * -> *) g.
Monad m =>
OSGState g -> OSGSceneT m g -> m (SceneNode g, OSGState g, Int)
runOSG OSGState g
forall g. OSGState g
emptyState OSGSceneT IO g
f
  (SceneNode g, OSGState g, Int) -> IO ()
forall a. Show a => a -> IO ()
print (SceneNode g
ret, OSGState g
state, Int
i)


-- | Wrapper for running the OSG monad to return a scene graph and root node.
osg :: Monad m => OSGSceneT m g -> m (Scene g)
osg :: OSGSceneT m g -> m (Scene g)
osg OSGSceneT m g
f = do
  (SceneNode g
n, OSGState g
state, Int
_) <- OSGState g -> OSGSceneT m g -> m (SceneNode g, OSGState g, Int)
forall (m :: * -> *) g.
Monad m =>
OSGState g -> OSGSceneT m g -> m (SceneNode g, OSGState g, Int)
runOSG OSGState g
forall g. OSGState g
emptyState OSGSceneT m g
f
  Scene g -> m (Scene g)
forall (m :: * -> *) a. Monad m => a -> m a
return (Scene g -> m (Scene g)) -> Scene g -> m (Scene g)
forall a b. (a -> b) -> a -> b
$ SceneGraph g -> Int -> Scene g
forall g. SceneGraph g -> Int -> Scene g
Scene (OSGState g -> SceneGraph g
forall g. OSGState g -> SceneGraph g
graph OSGState g
state) (SceneNode g -> Int
forall g. SceneNode g -> Int
idd SceneNode g
n)


idd :: SceneNode g -> Node
idd :: SceneNode g -> Int
idd (SceneNode Int
i String
_ SceneData g
_) = Int
i


-- | Basic add node
addNodeBasic :: Monad m => SceneNode g -> OSGSceneT m g
addNodeBasic :: SceneNode g -> OSGSceneT m g
addNodeBasic SceneNode g
nde = SceneNode g -> [(SceneEdge, Int)] -> OSGSceneT m g
forall (m :: * -> *) g.
Monad m =>
SceneNode g -> [(SceneEdge, Int)] -> OSGSceneT m g
addNode SceneNode g
nde []

-- | Add node with scene data
addBasicNode :: Monad m => SceneData g -> OSGSceneT m g
addBasicNode :: SceneData g -> OSGSceneT m g
addBasicNode SceneData g
g = SceneNode g -> [(SceneEdge, Int)] -> OSGSceneT m g
forall (m :: * -> *) g.
Monad m =>
SceneNode g -> [(SceneEdge, Int)] -> OSGSceneT m g
addNode (Int -> String -> SceneData g -> SceneNode g
forall g. Int -> String -> SceneData g -> SceneNode g
SceneNode Int
0 String
"" SceneData g
g) []

-- | Add node with scene data
addBasicNamedNode :: Monad m => String -> SceneData g -> OSGSceneT m g
addBasicNamedNode :: String -> SceneData g -> OSGSceneT m g
addBasicNamedNode String
name SceneData g
g = SceneNode g -> [(SceneEdge, Int)] -> OSGSceneT m g
forall (m :: * -> *) g.
Monad m =>
SceneNode g -> [(SceneEdge, Int)] -> OSGSceneT m g
addNode (Int -> String -> SceneData g -> SceneNode g
forall g. Int -> String -> SceneData g -> SceneNode g
SceneNode Int
0 String
name SceneData g
g) []

-- | Add empty node
addNullNode :: Monad m => OSGSceneT m g
addNullNode :: OSGSceneT m g
addNullNode = SceneNode g -> OSGSceneT m g
forall (m :: * -> *) g. Monad m => SceneNode g -> OSGSceneT m g
addNodeBasic (SceneNode g -> OSGSceneT m g) -> SceneNode g -> OSGSceneT m g
forall a b. (a -> b) -> a -> b
$ Int -> SceneNode g
forall g. Int -> SceneNode g
nullNode Int
0

-- | Add a node to a scene graph with supplied children
addNode :: Monad m => SceneNode g -> [(SceneEdge, Node)] -> OSGSceneT m g
addNode :: SceneNode g -> [(SceneEdge, Int)] -> OSGSceneT m g
addNode SceneNode g
nde [(SceneEdge, Int)]
children = do
  OSGState g
s <- StateT (OSGState g) m (OSGState g)
forall s (m :: * -> *). MonadState s m => m s
ST.get
  let (SceneNode g
sn, OSGState g
s') = OSGState g
-> SceneNode g -> [(SceneEdge, Int)] -> (SceneNode g, OSGState g)
forall g.
OSGState g
-> SceneNode g -> [(SceneEdge, Int)] -> (SceneNode g, OSGState g)
addNode' OSGState g
s SceneNode g
nde [(SceneEdge, Int)]
children
  OSGState g -> StateT (OSGState g) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
ST.put OSGState g
s'
  SceneNode g -> OSGSceneT m g
forall (m :: * -> *) a. Monad m => a -> m a
return SceneNode g
sn

-- | Non-monadic form of addNode
addNode' :: OSGState g -> SceneNode g -> [(SceneEdge, Node)] -> (SceneNode g, OSGState g)
addNode' :: OSGState g
-> SceneNode g -> [(SceneEdge, Int)] -> (SceneNode g, OSGState g)
addNode' OSGState g
s (SceneNode Int
m String
l SceneData g
d) [(SceneEdge, Int)]
children =
  let n :: Int
n = if Int
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then OSGState g -> Int
forall g. OSGState g -> Int
startNode OSGState g
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 else Int
m
      sn :: SceneNode g
sn = Int -> String -> SceneData g -> SceneNode g
forall g. Int -> String -> SceneData g -> SceneNode g
SceneNode Int
n String
l SceneData g
d
      g' :: Gr (SceneNode g) SceneEdge
g' = ([], Int
n, SceneNode g
sn, [(SceneEdge, Int)]
children) Context (SceneNode g) SceneEdge
-> Gr (SceneNode g) SceneEdge -> Gr (SceneNode g) SceneEdge
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
Context a b -> gr a b -> gr a b
& OSGState g -> Gr (SceneNode g) SceneEdge
forall g. OSGState g -> SceneGraph g
graph OSGState g
s
      s' :: OSGState g
s' = OSGState g
s { graph :: Gr (SceneNode g) SceneEdge
graph = Gr (SceneNode g) SceneEdge
g', startNode :: Int
startNode = Int
n, root :: Int
root = Int
n }
  in (SceneNode g
sn, OSGState g
s')

-- | Replace a Scene Node
replaceNode :: Monad m => SceneNode g -> OSGSceneT m g
replaceNode :: SceneNode g -> OSGSceneT m g
replaceNode SceneNode g
n = do
  OSGState g
s <- StateT (OSGState g) m (OSGState g)
forall s (m :: * -> *). MonadState s m => m s
ST.get
  SceneGraph g
g' <- m (SceneGraph g) -> StateT (OSGState g) m (SceneGraph g)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (SceneGraph g) -> StateT (OSGState g) m (SceneGraph g))
-> m (SceneGraph g) -> StateT (OSGState g) m (SceneGraph g)
forall a b. (a -> b) -> a -> b
$ SceneGraph g -> SceneNode g -> m (SceneGraph g)
forall (md :: * -> *) g.
Monad md =>
SceneGraph g -> SceneNode g -> md (SceneGraph g)
replaceNode' (OSGState g -> SceneGraph g
forall g. OSGState g -> SceneGraph g
graph OSGState g
s) SceneNode g
n
  OSGState g -> StateT (OSGState g) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
ST.put OSGState g
s{ graph :: SceneGraph g
graph = SceneGraph g
g' }
  SceneNode g -> OSGSceneT m g
forall (m :: * -> *) a. Monad m => a -> m a
return SceneNode g
n

-- | Inner monad version of replace node
replaceNode' :: Monad md => SceneGraph g -> SceneNode g -> md (SceneGraph g)
replaceNode' :: SceneGraph g -> SceneNode g -> md (SceneGraph g)
replaceNode' SceneGraph g
gr SceneNode g
nn = SceneGraph g -> md (SceneGraph g)
forall (m :: * -> *) a. Monad m => a -> m a
return (SceneGraph g -> md (SceneGraph g))
-> SceneGraph g -> md (SceneGraph g)
forall a b. (a -> b) -> a -> b
$ SceneGraph g -> SceneNode g -> SceneGraph g
forall g. SceneGraph g -> SceneNode g -> SceneGraph g
replaceNode'' SceneGraph g
gr SceneNode g
nn

-- | Actually does the job of replacing node in a scene graph
replaceNode'' :: SceneGraph g -> SceneNode g -> SceneGraph g
replaceNode'' :: SceneGraph g -> SceneNode g -> SceneGraph g
replaceNode'' SceneGraph g
gr SceneNode g
nn =
  let (MContext (SceneNode g) SceneEdge
m, SceneGraph g
gr') = Int
-> SceneGraph g -> (MContext (SceneNode g) SceneEdge, SceneGraph g)
forall (gr :: * -> * -> *) a b.
Graph gr =>
Int -> gr a b -> Decomp gr a b
G.match (SceneNode g -> Int
forall g. SceneNode g -> Int
idd SceneNode g
nn) SceneGraph g
gr in
  case MContext (SceneNode g) SceneEdge
m of
    MContext (SceneNode g) SceneEdge
Nothing           -> SceneGraph g
gr
    Just ([(SceneEdge, Int)]
i, Int
n, SceneNode g
_, [(SceneEdge, Int)]
o) -> ([(SceneEdge, Int)]
i, Int
n, SceneNode g
nn, [(SceneEdge, Int)]
o) ([(SceneEdge, Int)], Int, SceneNode g, [(SceneEdge, Int)])
-> SceneGraph g -> SceneGraph g
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
Context a b -> gr a b -> gr a b
& SceneGraph g
gr'

-- | Run the monad but keep it in the family.
runOSGL :: Monad m => OSGState g -> OSGSceneT m g -> OSGT m g (SceneNode g, OSGState g, Node)
runOSGL :: OSGState g
-> OSGSceneT m g -> OSGT m g (SceneNode g, OSGState g, Int)
runOSGL OSGState g
s OSGSceneT m g
n = m (SceneNode g, OSGState g, Int)
-> OSGT m g (SceneNode g, OSGState g, Int)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (SceneNode g, OSGState g, Int)
 -> OSGT m g (SceneNode g, OSGState g, Int))
-> m (SceneNode g, OSGState g, Int)
-> OSGT m g (SceneNode g, OSGState g, Int)
forall a b. (a -> b) -> a -> b
$ OSGState g -> OSGSceneT m g -> m (SceneNode g, OSGState g, Int)
forall (m :: * -> *) g.
Monad m =>
OSGState g -> OSGSceneT m g -> m (SceneNode g, OSGState g, Int)
runOSG OSGState g
s OSGSceneT m g
n

-- | Run the monad but keep it in the family.
runOSGL' :: Monad m => OSGSceneT m g -> OSGT m g (SceneNode g, Node)
runOSGL' :: OSGSceneT m g -> OSGT m g (SceneNode g, Int)
runOSGL' OSGSceneT m g
n = do
  OSGState g
s <- StateT (OSGState g) m (OSGState g)
forall s (m :: * -> *). MonadState s m => m s
ST.get
  (SceneNode g
n1, OSGState g
s', Int
i) <- OSGState g
-> OSGSceneT m g -> OSGT m g (SceneNode g, OSGState g, Int)
forall (m :: * -> *) g.
Monad m =>
OSGState g
-> OSGSceneT m g -> OSGT m g (SceneNode g, OSGState g, Int)
runOSGL OSGState g
s OSGSceneT m g
n
  OSGState g -> StateT (OSGState g) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
ST.put OSGState g
s'
  (SceneNode g, Int) -> OSGT m g (SceneNode g, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (SceneNode g
n1, Int
i)

-- | Perform a function on a scene node
doOnNode :: Monad m => OSGSceneT m g -> (SceneNode g -> SceneNode g) -> OSGSceneT m g
doOnNode :: OSGSceneT m g -> (SceneNode g -> SceneNode g) -> OSGSceneT m g
doOnNode OSGSceneT m g
n SceneNode g -> SceneNode g
f = do
  OSGState g
s <- StateT (OSGState g) m (OSGState g)
forall s (m :: * -> *). MonadState s m => m s
ST.get
  (SceneNode g
anode, OSGState g
s', Int
_) <- OSGState g
-> OSGSceneT m g -> OSGT m g (SceneNode g, OSGState g, Int)
forall (m :: * -> *) g.
Monad m =>
OSGState g
-> OSGSceneT m g -> OSGT m g (SceneNode g, OSGState g, Int)
runOSGL OSGState g
s OSGSceneT m g
n
  OSGState g -> StateT (OSGState g) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
ST.put OSGState g
s'
  SceneNode g -> OSGSceneT m g
forall (m :: * -> *) g. Monad m => SceneNode g -> OSGSceneT m g
replaceNode (SceneNode g -> SceneNode g
f SceneNode g
anode)

-- | Create a light
light :: Monad m => OSGSceneT m g
light :: OSGSceneT m g
light = SceneData g -> OSGSceneT m g
forall (m :: * -> *) g. Monad m => SceneData g -> OSGSceneT m g
addBasicNode SceneData g
forall g. SceneData g
Light

-- | Create a camera
camera :: Monad m => OSGSceneT m g
camera :: OSGSceneT m g
camera = SceneData g -> OSGSceneT m g
forall (m :: * -> *) g. Monad m => SceneData g -> OSGSceneT m g
addBasicNode SceneData g
forall g. SceneData g
Camera

-- | Create a camera
mesh :: Monad m => T.Text -> g -> OSGSceneT m g
mesh :: Text -> g -> OSGSceneT m g
mesh Text
name g
geom = SceneData g -> OSGSceneT m g
forall (m :: * -> *) g. Monad m => SceneData g -> OSGSceneT m g
addBasicNode (SceneData g -> OSGSceneT m g) -> SceneData g -> OSGSceneT m g
forall a b. (a -> b) -> a -> b
$ Text -> g -> SceneData g
forall g. Text -> g -> SceneData g
Geode Text
name g
geom


fi :: (Integral a, Integral b) => a -> b
fi :: a -> b
fi = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral


-- plane' :: Int -> ([(PrimitiveMode, Int, Int)],[VectorD],[VectorD])
-- plane' w = foldr (\ (a1,a2,a3) (b1,b2,b3) -> (a1:b1,a2++b2,a3++b3))  ([],[],[])    [ up w xs | xs <- [0..(w-1)]]

-- up :: Int -> Int -> ( (PrimitiveMode,Int,Int), [VectorD],[VectorD])
-- up w xs = ( (TriangleStrip, (xs*(w*2+2))+1, w*2+2),  [ fromList [(fi x),(fi y),0] | y <- [0..w],x <-[xs..(xs+1)]], [ fromList [0,0,1] |  x <-[1..2], y <- [0..w]])

-- -- | Create a plane
-- planeT ::  Monad m => Int -> OSGSceneT m g
-- planeT w = addBasicNode (Geode $ Mesh1 a b c) where (a,b,c) = plane' w

-- -- | Create a quad mesh
-- quad :: (Int,Int) ->  ([(PrimitiveMode, Int, Int)],[VectorD],[VectorD])
-- quad (x,y) = ( [(Quads,1,100) ], [ fromList[x',y',0], fromList[(x'+1),y',0], fromList[(x'+1),(y'+1),0],
--                  fromList [x',(y'+1),0]], [fromList [0,0,1] | i <- [0..3]])
--              where x' = fi x
--                    y' = fi y

-- planeq' w = foldr (\ (a1,a2,a3) (b1,b2,b3) -> (a1,a2++b2,a3++b3))  ([],[],[])  [ quad (x,y) | x <- [0..(w-1)], y <- [0..(w-1)]]

-- plane ::  Monad m => Int -> OSGSceneT m g
-- plane w = addBasicNode (Geode $ Mesh1 a b c) where (a,b,c) = planeq' w

-- planeQ ::  Monad m => Int -> OSGSceneT m g
-- planeQ = plane


-- -- | Create a node containing a torus.
-- torus :: Monad m => Float -> OSGSceneT m g
-- torus i =  addBasicNode  (Geode $ GLObj $ GL.Torus (realToFrac i) (realToFrac (r*2)) 50 50)

-- -- | Create a node containing a sphere
-- sphere :: Monad m => Float -> OSGSceneT m g
-- sphere r =  addBasicNode  (Geode $ GLObj $ GL.Sphere' (realToFrac r) 50 50)

-- -- | Create a node containing a tetrahedron
-- tetra :: Monad m => OSGSceneT m g
-- tetra =  addBasicNode  (Geode $ GLObj $ GL.Tetrahedron)

-- -- | Create a node containing a line
-- line :: Monad m => VectorD -> VectorD -> OSGSceneT m g
-- line p q = addBasicNode (Geode $ Mesh1 [(Lines,1,2)] [p,q] [v1,v1] )

-- -- | Create a node containing a cube.
-- -- Fixme: Faces are not orientated same way.
-- cube :: Monad m => GLdouble -> OSGSceneT m g
-- cube i = addBasicNode (Geode $ Mesh1 [ (Quads,1,6) ] (map fromList [
-- 	   [md,md,md], [d,md,md],  [d,d,md], [md,d,md], -- Z
-- 	   [md,d,d], [d,d,d],  [d,md,d], [md,md,d],
-- 	   [d,md,md], [d,d,md], [d,d,d],[d,md,d],       -- X
-- 	   [md,md,d], [md,d,d], [md,d,md],[md,md,md],
-- 	   [md,d,md], [d,d,md], [d,d,d], [md,d,d],      -- Y
-- 	   [md,md,md], [d,md,md], [d,md,d], [md,md,d]
-- 	])
-- 	(map fromList [
-- 	   [0,0,1],  [0,0,1],  [0,0,1],  [0,0,1],
-- 	   [0,0,mu],  [0,0,mu],  [0,0,mu],  [0,0,mu],
-- 	   [mu,0,0],  [mu,0,0],  [mu,0,0],  [mu,0,0],
-- 	   [1,0,0],  [1,0,0],  [1,0,0],  [1,0,0],
-- 	   [0,mu,0], [0,mu,0],[0,mu,0],[0,mu,0],
-- 	   [0,1,0],[0,1,0],[0,1,0],[0,1,0]
-- 	]))  where (d,md,mu) = (i/2,(-i/2),(-1))



-- -- | Create cylinder as a BezierMesh
-- cylinder :: Monad m => GLfloat -> GLfloat -> OSGSceneT m g
-- cylinder r h = addBasicNode $ Geode $ BezierMesh $ [
--   [ (let z=z'*h in [Vertex3 0 (-r) z, Vertex3 (-d) (-r)  z, Vertex3 (-r) (-d) z, Vertex3 (-r) 0 z ]) | z' <- [0..1]],
--   [ (let z=z'*h in[Vertex3 (-r) 0 z, Vertex3 (-r) d z    , Vertex3 (-d) r z   , Vertex3 0 r z    ]) | z' <- [0..1]] ,
--   [ (let z=z'*h in[Vertex3 0 r z   , Vertex3 d r z       , Vertex3 r d z      , Vertex3 r 0 z    ]) | z' <- [0..1]],
--   [ (let z=z'*h in[Vertex3 r 0 z   , Vertex3 r (-d) z    , Vertex3 d (-r) z   , Vertex3 0 (-r) z ]) | z' <- [0..1]]]
--  where d = 0.66 * r

-- | Scale a node by equal amounts in all directions
scaleS :: Monad m => Float -> OSGSceneT m g -> OSGSceneT m g
scaleS :: Float -> OSGSceneT m g -> OSGSceneT m g
scaleS Float
f = V3 Float -> OSGSceneT m g -> OSGSceneT m g
forall (m :: * -> *) g.
Monad m =>
V3 Float -> OSGSceneT m g -> OSGSceneT m g
scale (Float -> V3 Float
forall (f :: * -> *) a. Applicative f => a -> f a
pure Float
f)

-- | Scale a node
scale :: Monad m => V3 Float -> OSGSceneT m g -> OSGSceneT m g
scale :: V3 Float -> OSGSceneT m g -> OSGSceneT m g
scale V3 Float
v = (M44 Float -> M44 Float)
-> (OSGSceneT m g -> OSGSceneT m g)
-> OSGSceneT m g
-> OSGSceneT m g
forall (m :: * -> *) g.
Monad m =>
(M44 Float -> M44 Float)
-> (OSGSceneT m g -> OSGSceneT m g)
-> OSGSceneT m g
-> OSGSceneT m g
transformSG (V3 Float -> M44 Float -> M44 Float
scaleM V3 Float
v) (V3 Float -> OSGSceneT m g -> OSGSceneT m g
forall (m :: * -> *) g.
Monad m =>
V3 Float -> OSGSceneT m g -> OSGSceneT m g
scale V3 Float
v)

-- | Translate a node
translate :: Monad m => V3 Float -> OSGSceneT m g -> OSGSceneT m g
translate :: V3 Float -> OSGSceneT m g -> OSGSceneT m g
translate V3 Float
v = (M44 Float -> M44 Float)
-> (OSGSceneT m g -> OSGSceneT m g)
-> OSGSceneT m g
-> OSGSceneT m g
forall (m :: * -> *) g.
Monad m =>
(M44 Float -> M44 Float)
-> (OSGSceneT m g -> OSGSceneT m g)
-> OSGSceneT m g
-> OSGSceneT m g
transformSG (V3 Float -> M44 Float -> M44 Float
translateM V3 Float
v) (V3 Float -> OSGSceneT m g -> OSGSceneT m g
forall (m :: * -> *) g.
Monad m =>
V3 Float -> OSGSceneT m g -> OSGSceneT m g
translate V3 Float
v)

-- | Rotate a node by an angle around a vector.
rotate :: Monad m => (Float, V3 Float) -> OSGSceneT m g -> OSGSceneT m g
rotate :: (Float, V3 Float) -> OSGSceneT m g -> OSGSceneT m g
rotate a :: (Float, V3 Float)
a@(Float
theta, V3 Float
v) = (M44 Float -> M44 Float)
-> (OSGSceneT m g -> OSGSceneT m g)
-> OSGSceneT m g
-> OSGSceneT m g
forall (m :: * -> *) g.
Monad m =>
(M44 Float -> M44 Float)
-> (OSGSceneT m g -> OSGSceneT m g)
-> OSGSceneT m g
-> OSGSceneT m g
transformSG (Float -> V3 Float -> M44 Float -> M44 Float
rotateM Float
theta V3 Float
v) ((Float, V3 Float) -> OSGSceneT m g -> OSGSceneT m g
forall (m :: * -> *) g.
Monad m =>
(Float, V3 Float) -> OSGSceneT m g -> OSGSceneT m g
rotate (Float, V3 Float)
a)

rad :: Float -> Float
rad :: Float -> Float
rad Float
x = Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
forall a. Floating a => a
pi Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
180

-- | Rotate a node around X axis
rotateX :: Monad m => Float -> OSGSceneT m g -> OSGSceneT m g
rotateX :: Float -> OSGSceneT m g -> OSGSceneT m g
rotateX Float
theta = (Float, V3 Float) -> OSGSceneT m g -> OSGSceneT m g
forall (m :: * -> *) g.
Monad m =>
(Float, V3 Float) -> OSGSceneT m g -> OSGSceneT m g
rotate (Float -> Float
rad Float
theta, Float -> Float -> Float -> V3 Float
forall a. a -> a -> a -> V3 a
V3 Float
1 Float
0 Float
0 )

-- | Rotate a node around Y axis
rotateY :: Monad m => Float -> OSGSceneT m g -> OSGSceneT m g
rotateY :: Float -> OSGSceneT m g -> OSGSceneT m g
rotateY Float
theta = (Float, V3 Float) -> OSGSceneT m g -> OSGSceneT m g
forall (m :: * -> *) g.
Monad m =>
(Float, V3 Float) -> OSGSceneT m g -> OSGSceneT m g
rotate (Float -> Float
rad Float
theta, Float -> Float -> Float -> V3 Float
forall a. a -> a -> a -> V3 a
V3 Float
0 Float
1 Float
0)

-- | Rotate a node around Z axis
rotateZ :: Monad m => Float -> OSGSceneT m g -> OSGSceneT m g
rotateZ :: Float -> OSGSceneT m g -> OSGSceneT m g
rotateZ Float
theta = (Float, V3 Float) -> OSGSceneT m g -> OSGSceneT m g
forall (m :: * -> *) g.
Monad m =>
(Float, V3 Float) -> OSGSceneT m g -> OSGSceneT m g
rotate (Float -> Float
rad Float
theta, Float -> Float -> Float -> V3 Float
forall a. a -> a -> a -> V3 a
V3 Float
0 Float
0 Float
1)

-- | Apply colour to the node
colourSG :: Monad m => OSGSceneT m g -> (Phong -> Phong) -> (OSGSceneT m g -> OSGSceneT m g) -> OSGSceneT m g
colourSG :: OSGSceneT m g
-> (Phong -> Phong)
-> (OSGSceneT m g -> OSGSceneT m g)
-> OSGSceneT m g
colourSG OSGSceneT m g
sn Phong -> Phong
action OSGSceneT m g -> OSGSceneT m g
self = do
  (SceneNode g
n1, Int
i) <- OSGSceneT m g -> OSGT m g (SceneNode g, Int)
forall (m :: * -> *) g.
Monad m =>
OSGSceneT m g -> OSGT m g (SceneNode g, Int)
runOSGL' OSGSceneT m g
sn
  case SceneNode g
n1 of
    SceneNode Int
n String
lbl (Material Phong
p) -> do
      let p' :: Phong
p' = Phong -> Phong
action Phong
p
      SceneNode g -> OSGSceneT m g
forall (m :: * -> *) g. Monad m => SceneNode g -> OSGSceneT m g
replaceNode (Int -> String -> SceneData g -> SceneNode g
forall g. Int -> String -> SceneData g -> SceneNode g
SceneNode Int
n String
lbl (Phong -> SceneData g
forall g. Phong -> SceneData g
Material Phong
p'))
    SceneNode g
_ -> do
      let n'' :: OSGSceneT m g
n'' = SceneNode g -> [(SceneEdge, Int)] -> OSGSceneT m g
forall (m :: * -> *) g.
Monad m =>
SceneNode g -> [(SceneEdge, Int)] -> OSGSceneT m g
addNode (Int -> String -> SceneData g -> SceneNode g
forall g. Int -> String -> SceneData g -> SceneNode g
SceneNode Int
0 String
"" (Phong -> SceneData g
forall g. Phong -> SceneData g
Material Phong
forall a. Default a => a
def)) [(SceneEdge
DefaultEdge, Int
i)]
      OSGSceneT m g -> OSGSceneT m g
self OSGSceneT m g
forall g. OSGSceneT m g
n''

-- | Transform the node of a scene graph within the Monad with the supplied matrix transform
transformSG :: Monad m => (M44 Float -> M44 Float) -> (OSGSceneT m g -> OSGSceneT m g) -> OSGSceneT m g -> OSGSceneT m g
transformSG :: (M44 Float -> M44 Float)
-> (OSGSceneT m g -> OSGSceneT m g)
-> OSGSceneT m g
-> OSGSceneT m g
transformSG M44 Float -> M44 Float
action OSGSceneT m g -> OSGSceneT m g
self OSGSceneT m g
n = do
  (SceneNode g
n1, Int
i) <- OSGSceneT m g -> OSGT m g (SceneNode g, Int)
forall (m :: * -> *) g.
Monad m =>
OSGSceneT m g -> OSGT m g (SceneNode g, Int)
runOSGL' OSGSceneT m g
n
  case SceneNode g
n1 of
    SceneNode Int
num String
lbl (MatrixTransform M44 Float
m) -> do
      let m' :: M44 Float
m' = M44 Float -> M44 Float
action M44 Float
m
      SceneNode g -> OSGSceneT m g
forall (m :: * -> *) g. Monad m => SceneNode g -> OSGSceneT m g
replaceNode (Int -> String -> SceneData g -> SceneNode g
forall g. Int -> String -> SceneData g -> SceneNode g
SceneNode Int
num String
lbl (M44 Float -> SceneData g
forall g. M44 Float -> SceneData g
MatrixTransform M44 Float
m'))
    SceneNode g
_ -> do
      let n'' :: OSGSceneT m g
n'' = SceneNode g -> [(SceneEdge, Int)] -> OSGSceneT m g
forall (m :: * -> *) g.
Monad m =>
SceneNode g -> [(SceneEdge, Int)] -> OSGSceneT m g
addNode (Int -> String -> SceneData g -> SceneNode g
forall g. Int -> String -> SceneData g -> SceneNode g
SceneNode Int
0 String
"" (M44 Float -> SceneData g
forall g. M44 Float -> SceneData g
MatrixTransform M44 Float
forall a (t :: * -> *).
(Num a, Traversable t, Applicative t) =>
t (t a)
L.identity)) [(SceneEdge
DefaultEdge, Int
i)]
      OSGSceneT m g -> OSGSceneT m g
self OSGSceneT m g
forall g. OSGSceneT m g
n''

-- | Transform the node of a scene graph with the supplied matrix transform
transformSG' :: SceneGraph g -> Node -> (M44 Float -> M44 Float) -> SceneGraph g
transformSG' :: SceneGraph g -> Int -> (M44 Float -> M44 Float) -> SceneGraph g
transformSG' SceneGraph g
sg Int
nde M44 Float -> M44 Float
mf =
  case SceneGraph g -> Int -> SceneNode g
forall g. SceneGraph g -> Int -> SceneNode g
llab SceneGraph g
sg Int
nde of
    SceneNode Int
_ String
_ (MatrixTransform M44 Float
m) -> SceneGraph g -> SceneNode g -> SceneGraph g
forall g. SceneGraph g -> SceneNode g -> SceneGraph g
replaceNode'' SceneGraph g
sg (Int -> String -> SceneData g -> SceneNode g
forall g. Int -> String -> SceneData g -> SceneNode g
SceneNode Int
nde (Int -> String
forall a. Show a => a -> String
show Int
nde) (M44 Float -> SceneData g
forall g. M44 Float -> SceneData g
MatrixTransform (M44 Float -> M44 Float
mf M44 Float
m)))
    SceneNode g
_ -> String -> SceneGraph g
forall a. HasCallStack => String -> a
error String
"FIXME: Not a transform node"

translateSG' :: SceneGraph g -> Node -> V3 Float -> SceneGraph g
translateSG' :: SceneGraph g -> Int -> V3 Float -> SceneGraph g
translateSG' SceneGraph g
sg Int
nde V3 Float
v = SceneGraph g -> Int -> (M44 Float -> M44 Float) -> SceneGraph g
forall g.
SceneGraph g -> Int -> (M44 Float -> M44 Float) -> SceneGraph g
transformSG' SceneGraph g
sg Int
nde (V3 Float -> M44 Float -> M44 Float
translateM V3 Float
v)

translatePostSG' :: SceneGraph g -> Node -> V3 Float -> SceneGraph g
translatePostSG' :: SceneGraph g -> Int -> V3 Float -> SceneGraph g
translatePostSG' SceneGraph g
sg Int
nde V3 Float
v = SceneGraph g -> Int -> (M44 Float -> M44 Float) -> SceneGraph g
forall g.
SceneGraph g -> Int -> (M44 Float -> M44 Float) -> SceneGraph g
transformSG' SceneGraph g
sg Int
nde (V3 Float -> M44 Float -> M44 Float
translatePostM V3 Float
v)

rotatePostSG' :: SceneGraph g -> Node -> V3 Float -> Float -> SceneGraph g
rotatePostSG' :: SceneGraph g -> Int -> V3 Float -> Float -> SceneGraph g
rotatePostSG' SceneGraph g
sg Int
nde V3 Float
v Float
theta = SceneGraph g -> Int -> (M44 Float -> M44 Float) -> SceneGraph g
forall g.
SceneGraph g -> Int -> (M44 Float -> M44 Float) -> SceneGraph g
transformSG' SceneGraph g
sg Int
nde (Float -> V3 Float -> M44 Float -> M44 Float
rotatePostM Float
theta V3 Float
v)

-- | Add color to a node
color ::  Monad m => Color -> OSGSceneT m g -> OSGSceneT m g
color :: Color -> OSGSceneT m g -> OSGSceneT m g
color Color
c OSGSceneT m g
n = OSGSceneT m g
-> (Phong -> Phong)
-> (OSGSceneT m g -> OSGSceneT m g)
-> OSGSceneT m g
forall (m :: * -> *) g.
Monad m =>
OSGSceneT m g
-> (Phong -> Phong)
-> (OSGSceneT m g -> OSGSceneT m g)
-> OSGSceneT m g
colourSG OSGSceneT m g
n (Phong -> Phong -> Phong
forall a b. a -> b -> a
const (Phong -> Phong -> Phong) -> Phong -> Phong -> Phong
forall a b. (a -> b) -> a -> b
$ Color -> Phong
colorToPhong Color
c) (Color -> OSGSceneT m g -> OSGSceneT m g
forall (m :: * -> *) g.
Monad m =>
Color -> OSGSceneT m g -> OSGSceneT m g
color Color
c)

-- | Label a node
label :: Monad m => OSGSceneT m g -> String -> OSGSceneT m g
label :: OSGSceneT m g -> String -> OSGSceneT m g
label OSGSceneT m g
anode String
lbl = do
  (SceneNode Int
nde String
_ SceneData g
dte, Int
_) <- OSGSceneT m g -> OSGT m g (SceneNode g, Int)
forall (m :: * -> *) g.
Monad m =>
OSGSceneT m g -> OSGT m g (SceneNode g, Int)
runOSGL' OSGSceneT m g
anode
  SceneNode g -> OSGSceneT m g
forall (m :: * -> *) g. Monad m => SceneNode g -> OSGSceneT m g
replaceNode (Int -> String -> SceneData g -> SceneNode g
forall g. Int -> String -> SceneData g -> SceneNode g
SceneNode Int
nde String
lbl SceneData g
dte)


-- | Add texture
texture :: Monad m => OSGSceneT m g -> String -> OSGSceneT m g
texture :: OSGSceneT m g -> String -> OSGSceneT m g
texture OSGSceneT m g
n String
texName = do
  Int
i <- (SceneNode g, Int) -> Int
forall a b. (a, b) -> b
snd ((SceneNode g, Int) -> Int)
-> StateT (OSGState g) m (SceneNode g, Int)
-> StateT (OSGState g) m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OSGSceneT m g -> StateT (OSGState g) m (SceneNode g, Int)
forall (m :: * -> *) g.
Monad m =>
OSGSceneT m g -> OSGT m g (SceneNode g, Int)
runOSGL' OSGSceneT m g
n
  SceneNode g -> [(SceneEdge, Int)] -> OSGSceneT m g
forall (m :: * -> *) g.
Monad m =>
SceneNode g -> [(SceneEdge, Int)] -> OSGSceneT m g
addNode (Int -> String -> SceneData g -> SceneNode g
forall g. Int -> String -> SceneData g -> SceneNode g
SceneNode Int
0 String
"" (String -> SceneData g
forall g. String -> SceneData g
Texture String
texName))  [(SceneEdge
DefaultEdge, Int
i)]

-- -- | Add Text
text :: Monad m => T.Text -> OSGSceneT m g
text :: Text -> OSGSceneT m g
text Text
str =  SceneData g -> OSGSceneT m g
forall (m :: * -> *) g. Monad m => SceneData g -> OSGSceneT m g
addBasicNode (Text -> SceneData g
forall g. Text -> SceneData g
Text Text
str)



infixr 5 <+>
infixl 9 <->
infixl 9 </>


-- | Join two graphs together
(<+>) ::  Monad m => OSGSceneT m g -> OSGSceneT m g -> OSGSceneT m g
<+> :: OSGSceneT m g -> OSGSceneT m g -> OSGSceneT m g
(<+>) OSGSceneT m g
a OSGSceneT m g
b = do
  OSGState g
s <- StateT (OSGState g) m (OSGState g)
forall s (m :: * -> *). MonadState s m => m s
ST.get
  (SceneNode g
_, OSGState g
s', Int
i) <- OSGState g
-> OSGSceneT m g -> OSGT m g (SceneNode g, OSGState g, Int)
forall (m :: * -> *) g.
Monad m =>
OSGState g
-> OSGSceneT m g -> OSGT m g (SceneNode g, OSGState g, Int)
runOSGL OSGState g
s OSGSceneT m g
a
  (SceneNode g
_, OSGState g
s'', Int
j) <- OSGState g
-> OSGSceneT m g -> OSGT m g (SceneNode g, OSGState g, Int)
forall (m :: * -> *) g.
Monad m =>
OSGState g
-> OSGSceneT m g -> OSGT m g (SceneNode g, OSGState g, Int)
runOSGL OSGState g
s' OSGSceneT m g
b
  OSGState g -> StateT (OSGState g) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
ST.put OSGState g
s''
  SceneNode g -> [(SceneEdge, Int)] -> OSGSceneT m g
forall (m :: * -> *) g.
Monad m =>
SceneNode g -> [(SceneEdge, Int)] -> OSGSceneT m g
addNode (Int -> String -> SceneData g -> SceneNode g
forall g. Int -> String -> SceneData g -> SceneNode g
SceneNode Int
0 String
"" SceneData g
forall g. SceneData g
Group) [(SceneEdge
DefaultEdge, Int
i), (SceneEdge
DefaultEdge, Int
j)]


-- | Translate a node
(<->) :: Monad m => OSGSceneT m g -> V3 Float -> OSGSceneT m g
<-> :: OSGSceneT m g -> V3 Float -> OSGSceneT m g
(<->) = (V3 Float -> OSGSceneT m g -> OSGSceneT m g)
-> OSGSceneT m g -> V3 Float -> OSGSceneT m g
forall a b c. (a -> b -> c) -> b -> a -> c
flip V3 Float -> OSGSceneT m g -> OSGSceneT m g
forall (m :: * -> *) g.
Monad m =>
V3 Float -> OSGSceneT m g -> OSGSceneT m g
translate

-- | Scale a node
(</>) :: Monad m => OSGSceneT m g -> V3 Float -> OSGSceneT m g
</> :: OSGSceneT m g -> V3 Float -> OSGSceneT m g
(</>) = (V3 Float -> OSGSceneT m g -> OSGSceneT m g)
-> OSGSceneT m g -> V3 Float -> OSGSceneT m g
forall a b c. (a -> b -> c) -> b -> a -> c
flip V3 Float -> OSGSceneT m g -> OSGSceneT m g
forall (m :: * -> *) g.
Monad m =>
V3 Float -> OSGSceneT m g -> OSGSceneT m g
scale


doNothing :: Monad m => p -> m ()
doNothing :: p -> m ()
doNothing p
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Add an handler node
handler :: Monad m => OSGSceneT m g -> ClickHandler g -> OSGSceneT m g
handler :: OSGSceneT m g -> ClickHandler g -> OSGSceneT m g
handler OSGSceneT m g
n ClickHandler g
f = do
  (SceneNode g
_, Int
i) <- OSGSceneT m g -> OSGT m g (SceneNode g, Int)
forall (m :: * -> *) g.
Monad m =>
OSGSceneT m g -> OSGT m g (SceneNode g, Int)
runOSGL' OSGSceneT m g
n
  SceneNode g -> [(SceneEdge, Int)] -> OSGSceneT m g
forall (m :: * -> *) g.
Monad m =>
SceneNode g -> [(SceneEdge, Int)] -> OSGSceneT m g
addNode (Int -> String -> SceneData g -> SceneNode g
forall g. Int -> String -> SceneData g -> SceneNode g
SceneNode Int
0 String
"" (Maybe (ClickHandler g, Sink ())
-> Maybe (DragHandler g, Sink Float) -> SceneData g
forall g.
Maybe (ClickHandler g, Sink ())
-> Maybe (DragHandler g, Sink Float) -> SceneData g
Handler ((ClickHandler g, Sink ()) -> Maybe (ClickHandler g, Sink ())
forall a. a -> Maybe a
Just (ClickHandler g
f, Sink ()
forall (m :: * -> *) p. Monad m => p -> m ()
doNothing)) Maybe (DragHandler g, Sink Float)
forall a. Maybe a
Nothing)) [(SceneEdge
DefaultEdge, Int
i)]

handler2 :: Monad m => OSGSceneT m g -> (ClickHandler g, DragHandler g) -> OSGSceneT m g
handler2 :: OSGSceneT m g -> (ClickHandler g, DragHandler g) -> OSGSceneT m g
handler2 OSGSceneT m g
n (ClickHandler g
f,DragHandler g
g) = do
  (SceneNode g
_, Int
i) <- OSGSceneT m g -> OSGT m g (SceneNode g, Int)
forall (m :: * -> *) g.
Monad m =>
OSGSceneT m g -> OSGT m g (SceneNode g, Int)
runOSGL' OSGSceneT m g
n
  SceneNode g -> [(SceneEdge, Int)] -> OSGSceneT m g
forall (m :: * -> *) g.
Monad m =>
SceneNode g -> [(SceneEdge, Int)] -> OSGSceneT m g
addNode (Int -> String -> SceneData g -> SceneNode g
forall g. Int -> String -> SceneData g -> SceneNode g
SceneNode Int
0 String
"" (Maybe (ClickHandler g, Sink ())
-> Maybe (DragHandler g, Sink Float) -> SceneData g
forall g.
Maybe (ClickHandler g, Sink ())
-> Maybe (DragHandler g, Sink Float) -> SceneData g
Handler ((ClickHandler g, Sink ()) -> Maybe (ClickHandler g, Sink ())
forall a. a -> Maybe a
Just (ClickHandler g
f, Sink ()
forall (m :: * -> *) p. Monad m => p -> m ()
doNothing)) ((DragHandler g, Sink Float) -> Maybe (DragHandler g, Sink Float)
forall a. a -> Maybe a
Just (DragHandler g
g, Sink Float
forall (m :: * -> *) p. Monad m => p -> m ()
doNothing)))) [(SceneEdge
DefaultEdge, Int
i)]

-- | Create a DragHandler
dragHandler :: DragHandler g
dragHandler :: DragHandler g
dragHandler (Scene SceneGraph g
sg Int
nde) V3 Float
vec = do
  let tnde :: Int
tnde = [Int] -> Int
forall a. [a] -> a
head ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ SceneGraph g -> Int -> [Int]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> [Int]
G.pre SceneGraph g
sg Int
nde
      sg' :: SceneGraph g
sg' = SceneGraph g -> Int -> V3 Float -> SceneGraph g
forall g. SceneGraph g -> Int -> V3 Float -> SceneGraph g
translateSG' SceneGraph g
sg Int
tnde V3 Float
vec
      SceneNode Int
_ String
_ (MatrixTransform M44 Float
m) = SceneGraph g -> Int -> SceneNode g
forall g. SceneGraph g -> Int -> SceneNode g
llab SceneGraph g
sg' Int
tnde
      posx :: Float
posx = M44 Float
mM44 Float -> Getting Float (M44 Float) Float -> Float
forall s a. s -> Getting a s a -> a
^.((V4 Float -> Const Float (V4 Float))
-> M44 Float -> Const Float (M44 Float)
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x((V4 Float -> Const Float (V4 Float))
 -> M44 Float -> Const Float (M44 Float))
-> ((Float -> Const Float Float)
    -> V4 Float -> Const Float (V4 Float))
-> Getting Float (M44 Float) Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Float -> Const Float Float) -> V4 Float -> Const Float (V4 Float)
forall (t :: * -> *) a. R3 t => Lens' (t a) a
_z)
  (SceneGraph g, Float) -> IO (SceneGraph g, Float)
forall (m :: * -> *) a. Monad m => a -> m a
return (if Float -> Float
forall a. Num a => a -> a
abs Float
posx Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
1 then SceneGraph g
sg' else SceneGraph g
sg,Float
posx)

-- | Create a ClickHandler
switchHandler :: ClickHandler g
switchHandler :: ClickHandler g
switchHandler (Scene SceneGraph g
sg Int
nde) KeyState
ev = do
  let sn :: Int
sn = [Int] -> Int
forall a. [a] -> a
head ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ SceneGraph g -> Int -> [Int]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> [Int]
G.suc SceneGraph g
sg Int
nde
      sn' :: SceneNode g
sn' = SceneGraph g -> Int -> SceneNode g
forall g. SceneGraph g -> Int -> SceneNode g
llab SceneGraph g
sg Int
sn
  let sg' :: SceneGraph g
sg' = SceneNode g -> Int -> SceneGraph g -> SceneGraph g
forall g. SceneNode g -> Int -> SceneGraph g -> SceneGraph g
switchNode SceneNode g
sn' (if KeyState
ev KeyState -> KeyState -> Bool
forall a. Eq a => a -> a -> Bool
== KeyState
Down then Int
1 else Int
0) SceneGraph g
sg
  SceneGraph g -> IO (SceneGraph g)
forall (m :: * -> *) a. Monad m => a -> m a
return SceneGraph g
sg'

switchNode' :: Node -> Int -> SceneGraph g -> SceneGraph g
switchNode' :: Int -> Int -> SceneGraph g -> SceneGraph g
switchNode' Int
nde Int
n SceneGraph g
gr = SceneGraph g -> SceneNode g -> SceneGraph g
forall g. SceneGraph g -> SceneNode g -> SceneGraph g
replaceNode'' SceneGraph g
gr (Int -> String -> SceneData g -> SceneNode g
forall g. Int -> String -> SceneData g -> SceneNode g
SceneNode Int
nde (Int -> String
forall a. Show a => a -> String
show Int
nde) (Int -> SceneData g
forall g. Int -> SceneData g
Switch Int
n))


switchNode ::  SceneNode g -> Int -> SceneGraph g -> SceneGraph g
switchNode :: SceneNode g -> Int -> SceneGraph g -> SceneGraph g
switchNode (SceneNode Int
nde String
lbl (Switch Int
_)) Int
n SceneGraph g
gr =
  SceneGraph g -> SceneNode g -> SceneGraph g
forall g. SceneGraph g -> SceneNode g -> SceneGraph g
replaceNode'' SceneGraph g
gr SceneNode g
forall g. SceneNode g
newNode
  where newNode :: SceneNode g
newNode = Int -> String -> SceneData g -> SceneNode g
forall g. Int -> String -> SceneData g -> SceneNode g
SceneNode Int
nde String
lbl (Int -> SceneData g
forall g. Int -> SceneData g
Switch Int
n)
switchNode SceneNode g
_ Int
_ SceneGraph g
_ = String -> SceneGraph g
forall a. HasCallStack => String -> a
error String
"no Switch"

-- | Create a switch node
switch ::  Monad m => OSGSceneT m g -> OSGSceneT m g -> OSGSceneT m g
switch :: OSGSceneT m g -> OSGSceneT m g -> OSGSceneT m g
switch = Int -> OSGSceneT m g -> OSGSceneT m g -> OSGSceneT m g
forall (m :: * -> *) g.
Monad m =>
Int -> OSGSceneT m g -> OSGSceneT m g -> OSGSceneT m g
switch' Int
0


switch':: Monad m => Int -> OSGSceneT m g -> OSGSceneT m g -> OSGSceneT m g
switch' :: Int -> OSGSceneT m g -> OSGSceneT m g -> OSGSceneT m g
switch' Int
nde OSGSceneT m g
a OSGSceneT m g
b = do
  OSGState g
s <- StateT (OSGState g) m (OSGState g)
forall s (m :: * -> *). MonadState s m => m s
ST.get
  (SceneNode g
_, OSGState g
s', Int
i) <- OSGState g
-> OSGSceneT m g -> OSGT m g (SceneNode g, OSGState g, Int)
forall (m :: * -> *) g.
Monad m =>
OSGState g
-> OSGSceneT m g -> OSGT m g (SceneNode g, OSGState g, Int)
runOSGL OSGState g
s OSGSceneT m g
a
  (SceneNode g
_, OSGState g
s'', Int
j) <- OSGState g
-> OSGSceneT m g -> OSGT m g (SceneNode g, OSGState g, Int)
forall (m :: * -> *) g.
Monad m =>
OSGState g
-> OSGSceneT m g -> OSGT m g (SceneNode g, OSGState g, Int)
runOSGL OSGState g
s' OSGSceneT m g
b
  OSGState g -> StateT (OSGState g) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
ST.put OSGState g
s''
  SceneNode g -> [(SceneEdge, Int)] -> OSGSceneT m g
forall (m :: * -> *) g.
Monad m =>
SceneNode g -> [(SceneEdge, Int)] -> OSGSceneT m g
addNode (Int -> String -> SceneData g -> SceneNode g
forall g. Int -> String -> SceneData g -> SceneNode g
SceneNode Int
nde (Int -> String
forall a. Show a => a -> String
show Int
nde) (Int -> SceneData g
forall g. Int -> SceneData g
Switch Int
0)) [(SceneEdge
DefaultEdge, Int
i), (SceneEdge
DefaultEdge, Int
j)]


-- -- | Get a strip mesh
-- strip :: Monad m => OSGSceneT m g
-- strip = do
--            let n = SceneNode 0 "" (Geode $ Mesh1 [(TriangleStrip,0,3)] [
--                                    vector3 (-2) 0 (-2),
--                                    vector3 (2)  0 (-2),
--                                    vector3 0 0 0 ] [
--                                    vector3 0 (-1) 0,
--                                    vector3 0 (-1) 0,
--                                    vector3 0 (-1) 0 ] )
--            addNode n []

-- | Make a group node from list of nodes
group :: Monad m => [SceneNode g] -> OSGSceneT m g
group :: [SceneNode g] -> OSGSceneT m g
group [] = String -> OSGSceneT m g
forall a. HasCallStack => String -> a
error String
"empty"
group [SceneNode g
n] = SceneNode g -> [(SceneEdge, Int)] -> OSGSceneT m g
forall (m :: * -> *) g.
Monad m =>
SceneNode g -> [(SceneEdge, Int)] -> OSGSceneT m g
addNode SceneNode g
n []
group (SceneNode g
n:[SceneNode g]
ns) =
  let n' :: OSGSceneT m g
n' = [SceneNode g] -> OSGSceneT m g
forall (m :: * -> *) g. Monad m => [SceneNode g] -> OSGSceneT m g
group [SceneNode g]
ns in
  SceneNode g -> [(SceneEdge, Int)] -> OSGSceneT m g
forall (m :: * -> *) g.
Monad m =>
SceneNode g -> [(SceneEdge, Int)] -> OSGSceneT m g
addNode SceneNode g
n [] OSGSceneT m g -> OSGSceneT m g -> OSGSceneT m g
forall (m :: * -> *) g.
Monad m =>
OSGSceneT m g -> OSGSceneT m g -> OSGSceneT m g
<+> OSGSceneT m g
n'

emptyScene :: Scene g
emptyScene :: Scene g
emptyScene = SceneGraph g -> Int -> Scene g
forall g. SceneGraph g -> Int -> Scene g
Scene SceneGraph g
forall (gr :: * -> * -> *) a b. Graph gr => gr a b
G.empty Int
0


getHitAction :: Scene g -> (Int -> IO ())
getHitAction :: Scene g -> Int -> IO ()
getHitAction = (Int -> IO ()) -> Scene g -> Int -> IO ()
forall a b. a -> b -> a
const ((Int -> IO ()) -> Scene g -> Int -> IO ())
-> (Int -> IO ()) -> Scene g -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> Int -> IO ()
forall a b. a -> b -> a
const (IO () -> Int -> IO ()) -> IO () -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Sink ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Work up the tree from indicated no to find the first handler scene node.
findHandler :: SceneGraph g -> Int -> Maybe (SceneNode g)
findHandler :: SceneGraph g -> Int -> Maybe (SceneNode g)
findHandler SceneGraph g
gr Int
num =
  let start :: Int
start = Int -> Int
forall a. Enum a => a -> Int
fromEnum Int
num
      findUp :: Int -> [SceneNode g]
findUp Int
num' =
        case SceneGraph g -> Int -> SceneNode g
forall g. SceneGraph g -> Int -> SceneNode g
llab SceneGraph g
gr Int
num' of
          SceneNode Int
n String
_ (Handler Maybe (ClickHandler g, Sink ())
_ Maybe (DragHandler g, Sink Float)
_) -> [SceneGraph g -> Int -> SceneNode g
forall g. SceneGraph g -> Int -> SceneNode g
llab SceneGraph g
gr Int
n]
          SceneNode g
_                           -> (Int -> [SceneNode g]) -> [Int] -> [SceneNode g]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Int -> [SceneNode g]
findUp (SceneGraph g -> Int -> [Int]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> [Int]
G.pre SceneGraph g
gr Int
num')
  in
  case Int -> [SceneNode g]
findUp Int
start of
    []    -> Maybe (SceneNode g)
forall a. Maybe a
Nothing
    (SceneNode g
a:[SceneNode g]
_) -> SceneNode g -> Maybe (SceneNode g)
forall a. a -> Maybe a
Just SceneNode g
a


-- | Work down the tree from indicated no to find the first handler scene node.
findHandlerDown :: SceneGraph g -> Int -> Int
findHandlerDown :: SceneGraph g -> Int -> Int
findHandlerDown SceneGraph g
gr Int
num =
  let findDown :: Int -> [Int]
findDown Int
num' =
        case SceneGraph g -> Int -> SceneNode g
forall g. SceneGraph g -> Int -> SceneNode g
llab SceneGraph g
gr Int
num' of
          SceneNode Int
n String
_ (Handler Maybe (ClickHandler g, Sink ())
_ Maybe (DragHandler g, Sink Float)
_) -> [Int
n]
          SceneNode g
_                           -> (Int -> [Int]) -> [Int] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Int -> [Int]
findDown (SceneGraph g -> Int -> [Int]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> [Int]
G.suc SceneGraph g
gr Int
num')
  in
  case Int -> [Int]
findDown Int
num of
    []    -> String -> Int
forall a. HasCallStack => String -> a
error String
"findHandlerDown failed"
    (Int
a:[Int]
_) -> Int
a


findTextDown :: SceneGraph g -> Int -> Int
findTextDown :: SceneGraph g -> Int -> Int
findTextDown SceneGraph g
gr Int
num =
  let findDown :: Int -> [Int]
findDown Int
num' =
        case SceneGraph g -> Int -> SceneNode g
forall g. SceneGraph g -> Int -> SceneNode g
llab SceneGraph g
gr Int
num' of
          SceneNode Int
n String
_ (Text Text
_ ) -> [Int
n]
          SceneNode g
_                       -> (Int -> [Int]) -> [Int] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Int -> [Int]
findDown (SceneGraph g -> Int -> [Int]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> [Int]
G.suc SceneGraph g
gr Int
num')
  in
  case Int -> [Int]
findDown Int
num of
    []    -> String -> Int
forall a. HasCallStack => String -> a
error String
"findHandlerDown failed"
    (Int
a:[Int]
_) -> Int
a

-- {--
-- -- Buttons are always switch nodes but selected geometry will not be so we need to search
-- -- up to find the owning widget.
-- -- FIXME use switchNode?
-- --}

-- | Handle some event
handleClickEvent :: Scene g -> Int -> KeyState -> IO (Scene g, Maybe (Scene g), Maybe (SceneGraph g -> SceneGraph g))
handleClickEvent :: Scene g
-> Int
-> KeyState
-> IO
     (Scene g, Maybe (Scene g), Maybe (SceneGraph g -> SceneGraph g))
handleClickEvent (Scene SceneGraph g
gr Int
start) Int
n KeyState
ks = do
  -- putStrLn $ "handle event" ++ show ks
  case SceneGraph g -> Int -> Maybe (SceneNode g)
forall g. SceneGraph g -> Int -> Maybe (SceneNode g)
findHandler SceneGraph g
gr Int
n of
    Just (SceneNode Int
nid String
_ (Handler (Just (ClickHandler g
fn, Sink ()
snk)) Maybe (DragHandler g, Sink Float)
_ )) -> do
      SceneGraph g
sg <- ClickHandler g
fn (SceneGraph g -> Int -> Scene g
forall g. SceneGraph g -> Int -> Scene g
Scene SceneGraph g
gr Int
nid) KeyState
ks
      case KeyState
ks of
        KeyState
Down -> Sink ()
snk ()
        KeyState
_    -> Sink ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      (Scene g, Maybe (Scene g), Maybe (SceneGraph g -> SceneGraph g))
-> IO
     (Scene g, Maybe (Scene g), Maybe (SceneGraph g -> SceneGraph g))
forall (m :: * -> *) a. Monad m => a -> m a
return (SceneGraph g -> Int -> Scene g
forall g. SceneGraph g -> Int -> Scene g
Scene SceneGraph g
sg Int
start, Scene g -> Maybe (Scene g)
forall a. a -> Maybe a
Just (SceneGraph g -> Int -> Scene g
forall g. SceneGraph g -> Int -> Scene g
Scene SceneGraph g
sg Int
nid), Maybe (SceneGraph g -> SceneGraph g)
forall a. Maybe a
Nothing)
    Maybe (SceneNode g)
_ -> (Scene g, Maybe (Scene g), Maybe (SceneGraph g -> SceneGraph g))
-> IO
     (Scene g, Maybe (Scene g), Maybe (SceneGraph g -> SceneGraph g))
forall (m :: * -> *) a. Monad m => a -> m a
return (SceneGraph g -> Int -> Scene g
forall g. SceneGraph g -> Int -> Scene g
Scene SceneGraph g
gr Int
start, Maybe (Scene g)
forall a. Maybe a
Nothing, Maybe (SceneGraph g -> SceneGraph g)
forall a. Maybe a
Nothing)

emptyOSG :: SceneGraph g
emptyOSG :: SceneGraph g
emptyOSG = SceneGraph g
forall (gr :: * -> * -> *) a b. Graph gr => gr a b
G.empty

findCamera :: Scene g -> Int -> Node
findCamera :: Scene g -> Int -> Int
findCamera (Scene SceneGraph g
gr Int
_) Int
_ = [Int] -> Int
forall a. [a] -> a
head ([Int] -> Int) -> (SceneGraph g -> [Int]) -> SceneGraph g -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Int
x ->
    case SceneGraph g -> Int -> SceneNode g
forall g. SceneGraph g -> Int -> SceneNode g
llab SceneGraph g
gr Int
x of
      SceneNode Int
_ String
_ SceneData g
Camera -> Bool
True
      SceneNode g
_                    -> Bool
False) ([Int] -> [Int])
-> (SceneGraph g -> [Int]) -> SceneGraph g -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SceneGraph g -> [Int]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Int]
G.nodes (SceneGraph g -> Int) -> SceneGraph g -> Int
forall a b. (a -> b) -> a -> b
$ SceneGraph g
gr

findCameraPath :: Scene g -> Int -> G.Path
findCameraPath :: Scene g -> Int -> [Int]
findCameraPath (Scene SceneGraph g
gr Int
nde) Int
i =
  let nde2 :: Int
nde2 = Scene g -> Int -> Int
forall g. Scene g -> Int -> Int
findCamera (SceneGraph g -> Int -> Scene g
forall g. SceneGraph g -> Int -> Scene g
Scene SceneGraph g
gr Int
nde) Int
i in
  Int -> Int -> SceneGraph g -> [Int]
forall (gr :: * -> * -> *) a b.
Graph gr =>
Int -> Int -> gr a b -> [Int]
G.esp Int
nde Int
nde2 SceneGraph g
gr


-- | Return the matrix got by traversing down the Node
getTransformTo :: Scene g -> Node -> M44 Float
getTransformTo :: Scene g -> Int -> M44 Float
getTransformTo (Scene SceneGraph g
gr Int
start) Int
nde =
  (Int -> M44 Float -> M44 Float) -> M44 Float -> [Int] -> M44 Float
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> M44 Float -> M44 Float
forall (m :: * -> *).
Functor m =>
Int -> m (V4 Float) -> m (V4 Float)
trans M44 Float
forall a (t :: * -> *).
(Num a, Traversable t, Applicative t) =>
t (t a)
L.identity ([Int] -> M44 Float) -> [Int] -> M44 Float
forall a b. (a -> b) -> a -> b
$ Int -> Int -> SceneGraph g -> [Int]
forall (gr :: * -> * -> *) a b.
Graph gr =>
Int -> Int -> gr a b -> [Int]
G.esp Int
start Int
nde SceneGraph g
gr
  where
    trans :: Int -> m (V4 Float) -> m (V4 Float)
trans Int
n m (V4 Float)
mat1 =
      case SceneGraph g -> Int -> SceneNode g
forall g. SceneGraph g -> Int -> SceneNode g
llab SceneGraph g
gr Int
n of
        SceneNode Int
_ String
_ (MatrixTransform M44 Float
mat2) -> m (V4 Float)
mat1 m (V4 Float) -> M44 Float -> m (V4 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
mat2
        SceneNode g
_                                    -> m (V4 Float)
mat1


getByLabel :: SceneGraph g -> String -> Node
getByLabel :: SceneGraph g -> String -> Int
getByLabel SceneGraph g
gr String
lbl =
  [Int] -> Int
forall a. [a] -> a
head
  ([Int] -> Int) -> (SceneGraph g -> [Int]) -> SceneGraph g -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Int
n -> let (SceneNode Int
_ String
lbl' SceneData g
_) = SceneGraph g -> Int -> SceneNode g
forall g. SceneGraph g -> Int -> SceneNode g
llab SceneGraph g
gr Int
n in String
lbl String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
lbl')
  ([Int] -> [Int])
-> (SceneGraph g -> [Int]) -> SceneGraph g -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SceneGraph g -> [Int]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Int]
G.nodes
  (SceneGraph g -> Int) -> SceneGraph g -> Int
forall a b. (a -> b) -> a -> b
$ SceneGraph g
gr