module Graphics.Formats.Collada.GenerateObjects
where

import Graphics.Formats.Collada.ColladaTypes
import Graphics.Formats.Collada.GenerateCollada
-- import Graphics.SVGFonts.ReadFont (displayString, triang, cycleNeighbours, AObj(..), Prop(..), Mode(..), Spacing(..), CharProp(..), makeMaps)
import Data.Tree

animatedCube = (aScene, animation)

-- | Example scene with a camera, lights and a cube
aScene :: Scene
aScene = Node empty_root [ n aCamera,
                           n (pointLight "pointLight" 3 4 10),
                           n (pointLight "pointL" (-500) 1000 400),
                           n aCube ]

-- type Scene = Tree SceneNode

n x = Node x []
empty_root = SceneNode "empty" NOTYPE [] [] [] [] [] []

aCamera = SceneNode "camera0" NOTYPE []
                       [("tran", Translate ((-827.749),633.855,1255.017)),
                        ("rot", Rotate (1,0,0) (-22.1954)
                                       (0,1,0) (-33)
                                       (0,0,1) 0)]
                       [(Perspective "Persp" (ViewSizeXY (37,37)) (Z 10 1000) )]
                       [] [] []

pointLight str x y z = SceneNode str NOTYPE []
                         [("tran", Translate (x,y,z)),
                          ("rot", Rotate (1,0,0) 0
                                         (0,1,0) 0
                                         (0,0,1) 0)]
                         [] [] []
                         [(Point "point" (RGB 1 1 1) (Attenuation 1 0 0) )]

ambientLight = SceneNode "ambientLight" NOTYPE []
                         [("tran", Translate ((-500),1000,400)),
                          ("rot", Rotate (1,0,0) 0
                                         (0,1,0) 0
                                         (0,0,1) 0)]
                         [] [] []
                         [(Ambient "ambient" (RGB 1 1 1) )]

aCube :: SceneNode
aCube = SceneNode "cube_geometry" NOTYPE []
                         [("tran", Translate (0,0,0)),
                          ("rot", Rotate (1,0,0) 0
                                         (0,1,0) 0
                                         (0,0,1) 0) ]
                         [] []
                         [cube] -- geometries
                         []

obj :: String -> [Geometry] -> SceneNode
obj name c = SceneNode name NOTYPE []
                         [("tran", Translate (0,0,0)),
                          ("rot", Rotate (1,0,0) 0
                                         (0,1,0) 0
                                         (0,0,1) 0)]
                         [] []
                         c -- geometries
                         []

-- | Example animation of the cube
animation :: [Animation]
animation = [Node ("cube_rotate", anim_channel) []]

anim_channel = Bezier ("input", [0, 2.5, 3.75, 5], [[("name","TIME"),("type","Float")]] )
                      ("output",[0, 0, 56, 0], [[("name","ANGLE"),("type","Float")]] )
                      ("intangent",[-0.333333, 0, 5, 0, 8.333333, 56, 9.583333, 18.666666],
                                   [[("name","X"),("type","Float")],
                                    [("name","Y"),("type","Float")]] )
                      ("outtangent",[2.5, 0, 7.916667, 0, 9.166667, 56, 10.333333, -14.933331],
                                   [[("name","X"),("type","Float")],
                                    [("name","Y"),("type","Float")]] )
                      ("interpolations",["BEZIER ", "BEZIER ", "BEZIER ", "BEZIER"],
                                   [[("name","Interpolation"),("type","Name")]] )
                      [("cube_geometry/rotateY","ANGLE"),
                       ("cube_geometry/rotateY","ANGLE"),
                       ("cube_geometry/rotateY","ANGLE")]

-- | A blue/textured cube
cube :: Geometry
cube = Geometry "cube"
  [PL (LinePrimitive [[0,2,3,1],[0,1,5,4],[6,7,3,2],[0,4,6,2],[3,7,5,1],[5,7,6,4]] -- indices to vertices
              [[0,0,0,0],[1,1,1,1],[2,2,2,2],[3,3,3,3],[4,4,4,4],[5,5,5,5]] -- indices to normals
              [[0,1,2,3],[0,1,2,3],[0,1,2,3],[0,1,2,3],[0,1,2,3],[0,1,2,3]] -- indices to texture coordinates, use an empty list when no texture
              [logo]
              -- [blue]
         )]
 (Vertices "cube_vertices"
           [(-50,50,50), (50,50,50), (-50,-50,50), (50,-50,50), -- vertices
            (-50,50,-50),(50,50,-50),(-50,-50,-50),(50,-50,-50)]
           [(0,0,1), (0,1,0), (0,-1,0), (-1,0,0), (1,0,0), (0,0,-1)] -- normals
  )

blue = ("blue", COMMON "" NoParam
               (PhongCol [(CEmission (Color (0,0,0,1))),
                          (CAmbient  (Color (0,0,0,1))),
                          (CDiffuse(Color (0.137255,0.403922,0.870588,1))),
                          (CSpecular(Color (0.5,0.5,0.5,1))),
                          (CShininess 16), 
                          (CReflective (Color (0,0,0,1))),
                          (CReflectivity 0.5),
                          (CTransparent (Color (0,0,0,1))),
                          (CTransparency 1),
                          (CIndex_of_refraction 0)]
               )
               ""
       )

logo = ("haskell-logo", COMMON "" NoParam
               (PhongTex [(TDiffuse tex)]
			             [[0,0,1,0,1,1,0,1]] -- [u0,v0,u1,v1,..] -coordinates (Floats between 0 and 1) that point into the texture
               )
               ""
       )

tex = Texture "logo" "Haskell-Logo-Variation.png"

polys :: [(Float,Float,Float)] -> [(Float,Float,Float)] -> [[Int]] -> [[Int]] -> [Geometry]
polys p n pi ni = [Geometry "polygons"
  [PL (LinePrimitive pi -- indices to vertices
                     ni -- indices to normals
                     [] -- no texure
              [blue]
         )]
 (Vertices "polygons_vertices" p n)]


lightedScene :: [Geometry] -> [Scene]
lightedScene g = [ Node empty_root ( [ n aCamera,
                                       n (pointLight "pointLight" 3 4 10),
                                       n (pointLight "pointL" (-500) 1000 400)] ++
                                       (map n (map ge g)) ) ]

ge :: Geometry -> SceneNode
ge (Geometry name p v) = obj name [Geometry name p v]
-- ------------------
-- a bigger example
-- ------------------
animatedCubes = (scene2, animation2)
animatedCubes2 = [(scene2, animation2)]

scene2 :: Scene
scene2 = Node empty_root $ [ n aCamera, n (pointLight "pl" (-500) 1000 400) ] ++ (map n test_objs)

-- | Animation of several cubes
animation2 :: [Animation]
animation2 = [Node ("cube_rotate", new_channels anim_channel test_objs) []]

emptyAnimation :: [[Animation]]
emptyAnimation = []

-- | generate an animation that points to the cubes
new_channels :: AnimChannel -> [SceneNode] -> AnimChannel
new_channels (Bezier i o it ot interp _) nodes =
              Bezier i o it ot interp $ map (\obj -> ((obj_name obj) ++ "/rotateY","ANGLE")) nodes

obj_name (SceneNode n _ _ _ _ _ _ _) = n

-- | a helper function for xyz_grid
tran :: SceneNode -> (Float,Float,Float) -> String -> SceneNode
tran (SceneNode _   typ layer tr                                           cam contr geo light) (tx, ty, tz) str =
     (SceneNode str typ	layer ([("tr", Translate (tx,ty,tz))] ++ tr) cam contr geo light)

test_objs :: [SceneNode]
test_objs = xyz_grid 2 2 2 150 aCube

-- | Generate a 3 dimensional grid where an object (stored in a SceneNode) is repeated in along the grid
xyz_grid :: Int -> Int -> Int -> Float -> SceneNode -> [SceneNode]
xyz_grid x y z d obj = zipWith (tran obj)
                       (concat (concat (x_line x (map (map (\(a,b,c) -> (a+d,b,c)))) $
                                        x_line y (map (\(a,b,c) -> (a,b+d,c))) $
                                        x_line z (\(a,b,c) -> (a,b,c+d))        (0,0,0)) ))
                       (map enum_obj [1..(x*y*z)])
  where enum_obj i = (obj_name obj) ++ (show i)

x_line 0 change value = []
x_line n change value = value : ( x_line (n-1) change (change value) )