collada-output 0.1 → 0.2

raw patch · 6 files changed

+146/−86 lines, 6 filesdep −haskell98dep ~timebinary-addedPVP ok

version bump matches the API change (PVP)

Dependencies removed: haskell98

Dependency ranges changed: time

API changes (from Hackage documentation)

Files

• README +20/−0
• collada-output.cabal +3/−4
• src/Graphics/Formats/Collada/ColladaTypes.hs +5/−4
• src/Graphics/Formats/Collada/GenerateCollada.hs +89/−56
• src/Graphics/Formats/Collada/GenerateObjects.hs +29/−22
• src/Graphics/Formats/Collada/Haskell-Logo-Variation.png binary

@@ -0,0 +1,20 @@+Testing this library:
+----------------------
+"cabal build" generates an executable that generates a Collada file.
+GenerateObjects.hs contains examples how to construct objects.
+
+Collada files can be viewed with nearly every major 3d-Tool. For my tests I used ScenixViewer from NVidia,
+where the green play button on the right plays animations.
+To see textures you have to copy the .png file to where the Collada-file is generated.
+
+Further improvements:
+-------------------------
+The data structures are not final, patches or suggestions are welcome.
+I would enjoy if the 3d graphics libraries on hackage would share data types to allow
+the combination of libraries. I would even write a patch to YOUR library (if you allow me to).
+If you make changes to this library, you can test the correctness
+of the generated files with the Collada refinery (coherency test under "Conditioners").
+
+Changes from 0.1 to 0.2
+------------------------
+Textures working

@@ -1,5 +1,5 @@ Name:               collada-output
-Version:            0.1
+Version:            0.2
 Synopsis:           Generate animated 3d objects in COLLADA
 Description:        Generate a COLLADA file with textures, materials, animations, ... category:           graphics
@@ -13,12 +13,11 @@ Library     hs-source-dirs: src
     build-depends:
-        haskell98,
-        base == 4.*,
+        base ==4.*,
         xml == 1.3.*,
         containers == 0.3.*,
         Vec == 0.9.7,
-        time == 1.1.*,
+        time == 1.*,
         SVGPath == 1.0.*
     exposed-modules:
         Graphics.Formats.Collada.ColladaTypes

@@ -190,8 +190,9 @@             }
 
 data LinePrimitive = LinePrimitive {
-                lineP :: [[Int]],
-                lineN :: [[Int]],
+                lineP :: [[Int]], -- point indices
+                lineN :: [[Int]], -- normal indices
+                lineT :: [[Int]], -- texture indices
                 ms :: [Material]
             }
 
@@ -237,9 +238,9 @@ type Include = String
 data NewParam = Annotate | Semantic | Modifier | NoParam
 data TechniqueCommon = Constant | LambertCol [Fx_common_color_type]
-                                | LambertTex [Fx_common_texture_type]
+                                | LambertTex [Fx_common_texture_type] [[Float]]
                                 | PhongCol [Fx_common_color_type]
-                                | PhongTex [Fx_common_texture_type]
+                                | PhongTex [Fx_common_texture_type] [[Float]]
                                 | Blinn
 data TechniqueCG = IsAsset | IsAnnotate | Pass | Extra
 data Extra = String -- Asset | Technique

@@ -15,13 +15,10 @@ import Data.List
 import Data.Vec (Vec2, Vec3, Mat44, Mat33, (:.)(..), )
 
-type Point = (Float,Float,Float)
-type Normal = (Float,Float,Float)
-
 genCollada :: Element -> (Scene, Animations) -> IO ()
-genCollada asset (sc, anim) = writeFile "../Collada-File.dae" $
+genCollada asset (sc, anim) = writeFile "Collada-File.dae" $
                               ppTopElement (basicFrame asset (sc, anim))
--- | the basic structure of a Collada file, contains library_... nodes, where library_s are for referencing
+-- | The basic structure of a Collada file, contains library_... nodes, where library_s are used for referencing
 basicFrame :: Element -> (Scene, Animations) -> Element
 basicFrame asset (sc, anim) =
   attr "xmlns" "http://www.collada.org/2005/11/COLLADASchema" $ attr "version" "1.4.0" $
@@ -58,7 +55,7 @@         extr_eff = extr_mat -- materials are always effects
         extr_geo = extract_geometries fs
 
--- | document information: author, time created ...
+-- | Document information: author, time created ...
 standardAsset :: String -> String -> Element
 standardAsset author tool = unode "asset"
                       [ unode "contributor"
@@ -72,7 +69,7 @@                         unode "unit" (), unode "up_axis" "Y_UP"
                       ]
 
--- | time according to iso 8601
+-- | Time according to iso 8601
 time8601 :: UTCTime -> IO String
 time8601 t = return $ (showGregorian (utctDay t)) ++ ("T" ++ h ++ ":" ++ m ++ ":00Z")
   where
@@ -86,17 +83,20 @@ -- Filtering of SeneNodes to remove duplicates
 ----------------------------------------------------------
 
--- | extract cameras from SceneNodes and remove duplicates
-extract_cameras snodes = nubBy (\(SceneNode _ _ _ _ c0s _ _ _) (SceneNode _ _ _ _ c1s _ _ _) -> c0s == c1s) $
-                         filter (\(SceneNode _ _ _ _ cs _ _ _) -> (length cs)>0) snodes
+-- | Extract cameras from SceneNodes and remove duplicates
+extract_cameras :: [SceneNode] -> [SceneNode]
+extract_cameras snodes = nubBy (\(SceneNode _ _ _ _ c0s _ _ _)
+                                 (SceneNode _ _ _ _ c1s _ _ _) -> c0s == c1s) $ snodes
 
--- | extract lights from SceneNodes and remove duplicates
-extract_lights snodes = nubBy (\(SceneNode _ _ _ _ _ _ _ l0s) (SceneNode _ _ _ _ _ _ _ l1s) -> l0s == l1s) $
-                        filter (\(SceneNode _ _ _ _ _ _ _ ls) -> (length ls)>0) snodes
+-- | Extract lights from SceneNodes and remove duplicates
+extract_lights :: [SceneNode] -> [SceneNode]
+extract_lights snodes = nubBy (\(SceneNode _ _ _ _ _ _ _ l0s)
+                                (SceneNode _ _ _ _ _ _ _ l1s) -> l0s == l1s) $ snodes
 
--- | extract geometries from SceneNodes and remove duplicates
-extract_geometries snodes = nubBy (\(SceneNode _ _ _ _ _ _ g0s _) (SceneNode _ _ _ _ _ _ g1s _) -> g0s == g1s) $
-                            filter (\(SceneNode _ _ _ _ _ _ gs _) -> (length gs)>0) snodes
+-- | Extract geometries from SceneNodes and remove duplicates
+extract_geometries :: [SceneNode] -> [SceneNode]
+extract_geometries snodes = nubBy (\(SceneNode _ _ _ _ _ _ g0s _)
+                                    (SceneNode _ _ _ _ _ _ g1s _) -> g0s == g1s) $ snodes
 
 ---------------------------------------------------------
 -- | library_cameras
@@ -104,6 +104,7 @@ cam (SceneNode _ _ _ _ cs _ _ _) = map cam2 cs
 
 -- | Perpective projection: see <http://en.wikipedia.org/wiki/Viewing_frustum>
+cam2 :: Camera -> Element
 cam2 (Perspective sid (ViewSizeXY (xfov,yfov)) (Z znear zfar)) =
                       attr "id" (sid ++ "-lib") $ attr "name" sid $
                         unode "camera" $ unode "optics" $
@@ -149,7 +150,7 @@              map getGeometries fs
 
     getTextures :: (SID,Profile) -> [(String,String)]
-    getTextures (_,(COMMON str _ (PhongTex textures) "")) = map extr_id_path (filter isTex textures)
+    getTextures (_,(COMMON str _ (PhongTex textures _) "")) = map extr_id_path (filter isTex textures)
     getTextures (_,(COMMON str _ (PhongCol _) "")) = []
     extr_id_path :: Fx_common_texture_type	-> (String,String)
     extr_id_path (TEmission    (Texture name path)) = (name,path)
@@ -174,10 +175,10 @@ getMeshes :: Geometry -> [Mesh]
 getMeshes (Geometry _ mes _) = mes
 getMaterials :: Mesh -> [Material]
-getMaterials (LP (LinePrimitive p n m)) = m
-getMaterials (LS (LinePrimitive p n m)) = m
+getMaterials (LP (LinePrimitive p n t m)) = m
+getMaterials (LS (LinePrimitive p n t m)) = m
 getMaterials (P (Polygon p n ph m)) = m
-getMaterials (PL (LinePrimitive p n m)) = m
+getMaterials (PL (LinePrimitive p n t m)) = m
 
 ----------------------------------------------------------
 -- | library_materials
@@ -210,7 +211,7 @@          unode "phong" $
          map colorNodes colors
 
-effects (sid,(COMMON str _ (PhongTex texs) "")) =
+effects (sid,(COMMON str _ (PhongTex texs _) "")) =
          attr "id" (sid ++ "-fx") $
          unode "effect" $
          unode "profile_COMMON" $
@@ -281,24 +282,40 @@            unode "mesh" $
            concat $ map (primitives (show s) str parr narr) pris
 
-material :: [[Int]] -> [[Int]] -> String -> String -> String -> String -> [Element]
-material ps ns prname s str symbol =
+tex_ar :: [[Int]] -> [[Int]] -> [[Int]] -> String -> String -> String -> (SID,Profile) -> [Element]
+tex_ar ps ns ts prname s str (symbol,profile) = tex_array s str (symbol,profile)
+
+material :: [[Int]] -> [[Int]] -> [[Int]] -> String -> String -> String -> (SID,Profile) -> [Element]
+material ps ns ts prname s str (symbol,profile) =
                   [ attr "count" (show $ length ps) $
                     attr "material" (symbol ++ "G") $
                       unode prname
-                      ( (vn s str) ++
+                      ( (vnt s str (symbol,profile)) ++
                         [ unode "vcount" (collada_array $ map length ps), 
-                          unode "p" (collada_array $ concat $ zipWith interleave ps ns)
+                          unode "p" (collada_array $ concat $ zipWith3 interleave3 ps ns ts)
                         ] 
                       )
                   ]
 
+extract_sts (COMMON _ _ (PhongTex _ sts) _) = sts
+
+tex_array s str (symbol,profile) | or (hasTextures (symbol,profile)) =
+              [ attr "id" (str ++ s ++ "-lib-texs") $
+               (source str "-lib-tex-array" (concat (extract_sts profile))
+			                               ["S","T"] )]
+                                 | otherwise = []
+
 -- bSubCurve :: Bool -> (X,Y) -> [F2] -> [F2]
 -- bSubCurve useTex (dx,dy) bs
+type Point = (Float,Float,Float)
+type Normal = (Float,Float,Float)
+
 primitives :: String -> String -> [Point] -> [Normal] -> Mesh -> [Element]
-primitives s str parr narr (S (LinePrimitive ps ns mats)) -- Spline
-                = (sources_vertices s str (toTriple spl) na)
-                ++ (concat (map (material ps ns "linestrips" s str) (map fst mats)))
+primitives s str parr narr (S (LinePrimitive ps ns ts mats)) -- Spline
+                = (sources s str (toTriple spl) na)
+               ++ (concat (map (tex_ar ps ns ts "linestrips" s str) mats))
+               ++ (lib_vertices s str (toTriple spl) na)
+               ++ (concat (map (material ps ns ts "linestrips" s str) mats))
   where spl = bSubCurve False (difference_x / 100, difference_y / 100) (toTuple parr) -- using bSubCurve is a hack
         na = take (length spl) $ repeat (head narr)                                   
         il = interleave [0..((length spl)-1)] [0..((length spl)-1)]
@@ -306,65 +323,81 @@         difference_y = (maximum y) - (minimum y)
         x = map sel3_1 parr
         y = map sel3_2 parr
-        toTuple xs = map (\(x,y,z)->(x,y)) xs
 
-primitives s str parr narr (LP (LinePrimitive ps ns mats))
-                = (sources_vertices s str parr narr)
-                ++ (concat (map (material ps ns "lines" s str) (map fst mats)))
+primitives s str parr narr (LP (LinePrimitive ps ns ts mats))
+                = (sources s str parr narr)
+               ++ (concat (map (tex_ar ps ns ts "lines" s str) mats))
+               ++ (lib_vertices s str parr narr)
+               ++ (concat (map (material ps ns ts "lines" s str) mats))
 
-primitives s str parr narr (LS (LinePrimitive ps ns mats))
-                = (sources_vertices s str parr narr)
-                ++ (concat (map (material ps ns "linestrips" s str) (map fst mats)))
+primitives s str parr narr (LS (LinePrimitive ps ns ts mats))
+                = (sources s str parr narr)
+               ++ (concat (map (tex_ar ps ns ts "linestrips" s str) mats))
+               ++ (lib_vertices s str parr narr)
+               ++ (concat (map (material ps ns ts "linestrips" s str) mats))
 
 primitives s str parr narr (P (Polygon ps ns phs mats))
-                = (sources_vertices s str parr narr)
-                ++ (concat (map (material ps ns "polygon" s str) (map fst mats)))
+                = (sources s str parr narr)
+               ++ (concat (map (tex_ar ps ns [] "polygon" s str) mats))
+               ++ (lib_vertices s str parr narr)
+               ++ (concat (map (material ps ns [] "polygon" s str) mats))
 
-primitives s str parr narr (PL (LinePrimitive ps ns mats))
-                = (sources_vertices s str parr narr)
-                ++ (concat (map (material ps ns "polylist" s str) (map fst mats)))
+primitives s str parr narr (PL (LinePrimitive ps ns ts mats))
+                = (sources s str parr narr)
+               ++ (concat (map (tex_ar ps ns ts "polylist" s str) mats))
+               ++ (lib_vertices s str parr narr)
+               ++ (concat (map (material ps ns ts "polylist" s str) mats))
 
 --  TODO: Tr TriangleMesh | Trf TriFan | Trs TriStrip
 
 collada_array_str list = concat (map (++" ") list)
 triple_serialize triples = concat $ map (\(x,y,z) -> [x,y,z]) triples
 
-sources_vertices s str parr narr =
+sources s str parr narr =
             [ attr "id" (str ++ s ++ "-lib-positions") $
               attr "name" "position" $
                 (source str "-lib-positions-array" (triple_serialize parr) ["X", "Y", "Z"]),
               attr "id" (str ++ s ++ "-lib-normals") $
               attr "name" "normal" $
-                (source str "-lib-normals-array" (triple_serialize narr) ["X", "Y", "Z"]),
-              attr "id" (str ++ s ++ "-lib-texs") $
-              (source str "-lib-tex-array" [0,0,1,0,1,1,0,1] -- [3.855715,1,0,1,3.855715,0,0,0,8.881784e-016,1,1.826221,0,1.826221,1,8.881784e-016,0]
-			                               ["S","T"] ),
-
-              attr "id" (str ++ s ++ "-lib-vertices") $
-                unode "vertices" $
-                attr "semantic" "POSITION" $
-                attr "source" ("#" ++ str ++ s ++ "-lib-positions") $
-                  unode "input" ()
+                (source str "-lib-normals-array" (triple_serialize narr) ["X", "Y", "Z"])
             ]
 
+lib_vertices s str parr narr =
+           [  attr "id" (str ++ s ++ "-lib-vertices") $
+              unode "vertices" $
+              attr "semantic" "POSITION" $
+              attr "source" ("#" ++ str ++ s ++ "-lib-positions") $
+              unode "input" ()
+           ]
 
+
 interl :: Int -> [Int]
 interl l = interleave ([0..(l-1)]++[0]) ([0..(l-1)]++[0])
 
 interleave (p:points) (n:normals) = [p,n] ++ (interleave points normals)
 interleave _ _ = []
 
+interleave3 (p:points) (n:normals) (t:textures) = [p,n,t] ++ (interleave3 points normals textures)
+interleave3 _ _ _ = []
+
 sel3_1 (a,b,c) = a
 sel3_2 (a,b,c) = b
 sel3_3 (a,b,c) = c
 
-vn s str = [ attr "offset" "0" $ attr "semantic" "VERTEX" $ attr "source" ("#" ++ str ++ s ++ "-lib-vertices") $
+vnt s str (symbol,profile) = 
+           [ attr "offset" "0" $ attr "semantic" "VERTEX" $ attr "source" ("#" ++ str ++ s ++ "-lib-vertices") $
              unode "input" (),
              attr "offset" "1" $ attr "semantic" "NORMAL" $ attr "source" ("#" ++ str ++ s ++ "-lib-normals") $
-               unode "input" (),
-             attr "offset" "0" $ attr "semantic" "TEXCOORD" $ attr "source" ("#" ++ str ++ s ++ "-lib-texs") $
                unode "input" ()]
+           ++ (texcoord s str (symbol,profile))
 
+texcoord s str (symbol,profile) | or (hasTextures (symbol,profile)) =
+                 [ attr "offset" "2" $
+                   attr "semantic" "TEXCOORD" $
+                   attr "source" ("#" ++ str ++ s ++ "-lib-texs") $
+                   unode "input" () ]
+                                | otherwise = []
+
 source str com ar acc =
        unode "source" [ attr "id" (str ++ com) $ attr "count" (show (length ar)) $
                           unode "float_array" (collada_array ar),
@@ -377,7 +410,7 @@ floatAccessor acc = map (\x -> attr "name" x $ attr "type" "float" $ unode "param" "") acc
 
 ----------------------------------------------------------
--- | library_visual_scenes: nested nodes with references to cameras, lights, geometries, ...
+-- | library_visual_scenes: Nested nodes with references to cameras, lights, geometries, ...
 visual_scene :: Scene -> Element
 visual_scene sc = attr "id" "VisualSceneNode" $ attr "name" "untitled" $
                   unode "visual_scene" $ treeToNodes sc
@@ -430,7 +463,7 @@                unode "bind_vertex_input" ()
 
 hasTextures :: (SID,Profile) -> [Bool]
-hasTextures (_,(COMMON str _ (PhongTex textures) "")) = map isTex textures
+hasTextures (_,(COMMON str _ (PhongTex textures _) "")) = map isTex textures
 hasTextures (_,(COMMON str _ (PhongCol _) "")) = []
 
 transf :: (SID,Transform) -> [Element] 

@@ -6,8 +6,9 @@ import Data.Vec (Vec2, Vec3, Mat44, Mat33, (:.)(..), )
 import Data.Tree
 
-animatedCube = (aScene, animations)
+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),
@@ -50,9 +51,9 @@                          [cube] -- geometries
                          []
 
-
-animations :: Animations
-animations = Node ("cube_rotate", anim_channel) []
+-- | Example animation of the cube
+animation :: Animations
+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")]] )
@@ -68,23 +69,24 @@                        ("cube_geometry/rotateY","ANGLE"),
                        ("cube_geometry/rotateY","ANGLE")]
 
--- ----------------
--- a blue/textured cube
--- ----------------
-
+-- | 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]
+  [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,1,2,3],[4,5,6,7],[8,9,10,11],[12,13,14,15],[16,17,18,19],[20,21,22,23]] -- 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),(-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)]
+           [(-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,0,1),(0,0,1),(0,0,1), -- normals
+            (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
@@ -104,6 +106,7 @@ 
 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
                )
                ""
        )
@@ -111,28 +114,32 @@ tex = Texture "logo" "Haskell-Logo-Variation.png"
 
 -- ------------------
--- generation example
+-- a bigger example
 -- ------------------
-animatedCubes = (scene2, animations2)
+animatedCubes = (scene2, animation2)
 
 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) []
+-- | Animation of several cubes
+animation2 :: Animations
+animation2 = Node ("cube_rotate", new_channels anim_channel test_objs) []
 
+-- | 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 5 5 5 150 aCube
+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)))) $

binary file changed (absent → 8123 bytes)