module Graphics.Formats.Collada.GenerateObjects where import Graphics.Formats.Collada.ColladaTypes import Graphics.Formats.Collada.GenerateCollada import Data.Vec (Vec2, Vec3, Mat44, Mat33, (:.)(..), ) import Data.Tree animatedCube = (aScene, animations) aScene :: Scene aScene = Node empty_root [ n aCamera, n (pointLight "pointLight" 3 4 10), n (pointLight "pointL" (-500) 1000 400), n aCube ] n x = Node x [] empty_root = SceneNode "empty" NOTYPE [] [] [] [] [] [] aCamera = SceneNode "camera0" NOTYPE [] [("cubeTran", 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 [] [("cubeTran", 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 [] [("cubeTran", 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 "cube_geometry" NOTYPE [] [("cubeTran", Translate (0:.0:.0)), ("rot", Rotate (1:.0:.0) 0 (0:.1:.0) 0 (0:.0:.1) 0) ] [] [] [cube] -- geometries [] animations :: Animations animations = 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]] [[0,1,2,3],[4,5,6,7],[8,9,10,11],[12,13,14,15],[16,17,18,19],[20,21,22,23]] -- [logo] [blue] )] (Vertices "cube_vertices" [(-50,50,50),(50,50,50),(-50,-50,50),(50,-50,50),(-50,50,-50), (50,50,-50),(-50,-50,-50),(50,-50,-50)] [(0,0,1),(0,0,1),(0,0,1),(0,0,1),(0,1,0),(0,1,0),(0,1,0),(0,1,0),(0,-1,0), (0,-1,0),(0,-1,0),(0,-1,0),(-1,0,0),(-1,0,0),(-1,0,0),(-1,0,0),(1,0,0), (1,0,0),(1,0,0),(1,0,0),(0,0,-1),(0,0,-1),(0,0,-1),(0,0,-1)] ) 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)] ) "" ) tex = Texture "logo" "Haskell-Logo-Variation.png" -- ------------------ -- generation example -- ------------------ animatedCubes = (scene2, animations2) scene2 = Node empty_root $ [ n aCamera, n (pointLight "pl" (-500) 1000 400) ] ++ (map n test_objs) animations2 :: Animations animations2 = Node ("cube_rotate", new_channels anim_channel test_objs) [] 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 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 5 5 5 150 aCube 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) )