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) )