packages feed

collada-output 0.5 → 0.6

raw patch · 3 files changed

+94/−68 lines, 3 filesdep +vectordep ~SVGPathdep ~collada-typesPVP ok

version bump matches the API change (PVP)

Dependencies added: vector

Dependency ranges changed: SVGPath, collada-types

API changes (from Hackage documentation)

+ Graphics.Formats.Collada.GenerateCollada: interleave :: VI -> VI -> String
+ Graphics.Formats.Collada.GenerateCollada: interleave3 :: VI -> VI -> VI -> String
+ Graphics.Formats.Collada.GenerateCollada: primitives :: String -> String -> Vector V3 -> Vector V3 -> Mesh -> [Element]
+ Graphics.Formats.Collada.GenerateCollada: primitivesSources :: String -> String -> Vector V3 -> Vector V3 -> Mesh -> [Element]
+ Graphics.Formats.Collada.GenerateCollada: triple_serialize :: Vector V3 -> [Float]
+ Graphics.Formats.Collada.GenerateCollada: type VI = Vector (Vector Int)
- Graphics.Formats.Collada.GenerateCollada: material :: [[Int]] -> [[Int]] -> [[Int]] -> String -> String -> String -> (SID, Profile) -> [Element]
+ Graphics.Formats.Collada.GenerateCollada: material :: VI -> VI -> VI -> String -> String -> String -> (SID, Profile) -> [Element]
- Graphics.Formats.Collada.GenerateCollada: tex_ar :: [[Int]] -> [[Int]] -> [[Int]] -> String -> String -> String -> (SID, Profile) -> [Element]
+ Graphics.Formats.Collada.GenerateCollada: tex_ar :: VI -> VI -> VI -> String -> String -> String -> (SID, Profile) -> [Element]

Files

collada-output.cabal view
@@ -1,12 +1,12 @@ Name:               collada-output
-Version:            0.5
+Version:            0.6
 Synopsis:           Generate animated 3d objects in COLLADA
 Description:        Generate a COLLADA file with textures, materials, animations, ... It can be used to visualize algorithms that produce a stream of positions, see <http://www.youtube.com/watch?v=ZpJzG28Yv8Y>
 category:           graphics
 License:            BSD3
 License-file:       LICENSE
 Author:             Tillmann Vogt
-Maintainer:         Tillmann.Vogt@rwth-aachen.de
+Maintainer:         tillk.vogt@googlemail.com
 Build-Type:         Simple
 Cabal-Version:    >=1.6
 
@@ -17,8 +17,9 @@         xml == 1.3.*,
         containers == 0.4.*,
         time == 1.2.*,
-        SVGPath == 1.0.*,
-        collada-types
+        SVGPath == 1.1.*,
+        collada-types == 0.3,
+        vector
     exposed-modules:
         Graphics.Formats.Collada.Animations
         Graphics.Formats.Collada.GenerateCollada
src/Examples.hs view
@@ -5,4 +5,4 @@ import Graphics.Formats.Collada.GenerateObjects
 
 main = genCollada (fst animatedStream) (snd animatedStream)
-                  --animatedCube+                  -- (fst animatedCube) (snd animatedCube)
src/Graphics/Formats/Collada/GenerateCollada.hs view
@@ -1,11 +1,5 @@ module Graphics.Formats.Collada.GenerateCollada where
 
-import Text.XML.Light
-import System.IO
-import System.IO.Unsafe
-import Graphics.SVG.ReadPath(bSubCurve)
-import Graphics.Formats.Collada.ColladaTypes
-import Graphics.Formats.Collada.Animations (attr, library_animations, collada_array)
 import Data.Time.Clock
 import Data.Time.Calendar
 import Data.Time.LocalTime
@@ -13,6 +7,15 @@ import Data.Fixed (div')
 import Data.Tree
 import Data.List
+import Data.Vector (Vector)
+import qualified Data.Vector as V
+import Graphics.SVG.ReadPath(bSubCurve)
+import Graphics.Formats.Collada.ColladaTypes
+import Graphics.Formats.Collada.Animations (attr, library_animations, collada_array)
+import Graphics.Formats.Collada.Vector2D3D (V3(..), V4(..))
+import System.IO
+import System.IO.Unsafe
+import Text.XML.Light
 import Debug.Trace
 
 genCollada :: Scene -> [Animation] -> IO ()
@@ -165,12 +168,12 @@     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)
-    extr_id_path (TAmbient     (Texture name path)) = (name,path)
-    extr_id_path (TDiffuse     (Texture name path)) = (name,path)
-    extr_id_path (TSpecular    (Texture name path)) = (name,path)
-    extr_id_path (TReflective  (Texture name path)) = (name,path)
-    extr_id_path (TTransparent (Texture name path)) = (name,path)
+    extr_id_path (TEmission    (Texture name path _)) = (name,path)
+    extr_id_path (TAmbient     (Texture name path _)) = (name,path)
+    extr_id_path (TDiffuse     (Texture name path _)) = (name,path)
+    extr_id_path (TSpecular    (Texture name path _)) = (name,path)
+    extr_id_path (TReflective  (Texture name path _)) = (name,path)
+    extr_id_path (TTransparent (Texture name path _)) = (name,path)
 
 isTex (TShininess _) = False
 isTex (TReflectivity _) = False
@@ -232,25 +235,25 @@          concat $ map texNodes texs
 
 colorNodes :: Fx_common_color_type -> Element
-colorNodes (CEmission (Color (e0,e1,e2,e3))) = cnodes "emission" $ collada_array [e0,e1,e2,e3]
-colorNodes (CAmbient (Color (a0,a1,a2,a3))) = cnodes "ambient" $ collada_array [a0,a1,a2,a3]
-colorNodes (CDiffuse (Color (d0,d1,d2,d3))) = cnodes "diffuse" $ collada_array [d0,d1,d2,d3]
-colorNodes (CSpecular (Color (s0,s1,s2,s3))) = cnodes "specular" $ collada_array [s0,s1,s2,s3]
+colorNodes (CEmission (Color (V4 e0 e1 e2 e3))) = cnodes "emission" $ collada_array [e0,e1,e2,e3]
+colorNodes (CAmbient (Color (V4 a0 a1 a2 a3))) = cnodes "ambient" $ collada_array [a0,a1,a2,a3]
+colorNodes (CDiffuse (Color (V4 d0 d1 d2 d3))) = cnodes "diffuse" $ collada_array [d0,d1,d2,d3]
+colorNodes (CSpecular (Color (V4 s0 s1 s2 s3))) = cnodes "specular" $ collada_array [s0,s1,s2,s3]
 colorNodes (CShininess sh) = unode "shininess" $ unode "float" $ show sh
-colorNodes (CReflective (Color (r0,r1,r2,r3))) = cnodes "reflective" $ collada_array [r0,r1,r2,r3]
+colorNodes (CReflective (Color (V4 r0 r1 r2 r3))) = cnodes "reflective" $ collada_array [r0,r1,r2,r3]
 colorNodes (CReflectivity r) = unode "reflectivity" $ unode "float" $ show r
-colorNodes (CTransparent (Color (t0,t1,t2,t3))) = cnodes "transparent" $ collada_array [t0,t1,t2,t3]
+colorNodes (CTransparent (Color (V4 t0 t1 t2 t3))) = cnodes "transparent" $ collada_array [t0,t1,t2,t3]
 colorNodes (CTransparency t) = unode "transparency" $ unode "float" $ show t
 colorNodes (CIndex_of_refraction ind) = unode "index_of_refraction" $ unode "float" $ show ind
 
-texNodes (TEmission (Texture name path)) = tnodes "emission" "id1" "UVSet0" name
-texNodes (TAmbient (Texture name path)) = tnodes "ambient" "id1" "UVSet0" name
-texNodes (TDiffuse (Texture name path)) = tnodes "diffuse" "id1" "UVSet0" name
-texNodes (TSpecular (Texture name path)) = tnodes "specular" "id1" "UVSet0" name
+texNodes (TEmission (Texture name path _)) = tnodes "emission" "id1" "UVSet0" name
+texNodes (TAmbient (Texture name path _)) = tnodes "ambient" "id1" "UVSet0" name
+texNodes (TDiffuse (Texture name path _)) = tnodes "diffuse" "id1" "UVSet0" name
+texNodes (TSpecular (Texture name path _)) = tnodes "specular" "id1" "UVSet0" name
 texNodes (TShininess sh) = [ unode "shininess" $ unode "float" $ show sh ]
-texNodes (TReflective (Texture name path)) = tnodes "reflective" "id1" "UVSet0" name
+texNodes (TReflective (Texture name path _)) = tnodes "reflective" "id1" "UVSet0" name
 texNodes (TReflectivity r) = [ unode "reflectivity" $ unode "float" $ show r ]
-texNodes (TTransparent (Texture name path)) = tnodes "transparent" "id1" "UVSet0" name
+texNodes (TTransparent (Texture name path _)) = tnodes "transparent" "id1" "UVSet0" name
 texNodes (TTransparency t) = [ unode "transparency" $ unode "float" $ show t ]
 texNodes (TIndex_of_refraction ind) = [ unode "index_of_refraction" $ unode "float" $ show ind ]
 
@@ -295,22 +298,25 @@            unode "geometry" $
            unode "mesh" $
            (sources (show s) str parr narr) ++
+           ( concat $ map (primitivesSources (show s) str parr narr) pris ) ++
            (lib_vertices (show s) str parr narr) ++
            ( concat $ map (primitives (show s) str parr narr) pris )
 
-tex_ar :: [[Int]] -> [[Int]] -> [[Int]] -> String -> String -> String -> (SID,Profile) -> [Element]
+type VI = Vector (Vector Int)
+
+tex_ar :: VI -> VI -> VI -> 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 :: VI -> VI -> VI -> String -> String -> String -> (SID,Profile) -> [Element]
 material ps ns ts prname s str (symbol,profile) =
-                  [ attr "count" (show $ length ps) $
+                  [ attr "count" (show $ V.length ps) $
                     attr "material" (symbol ++ "G") $
                       unode prname
                       ( (vnt s str (symbol,profile)) ++
-                        [ unode "vcount" (collada_array $ map length ps),
+                        [ unode "vcount" (collada_array $ V.toList $ V.map V.length ps),
                           unode "p" $
-						  if (or $ hasTextures (symbol,profile)) then (collada_array $ concat $ zipWith3 interleave3 ps ns ts)
-						  else (collada_array $ concat $ zipWith interleave ps ns)
+						  if (or $ hasTextures (symbol,profile)) then interleave3 ps ns ts
+						                                         else interleave ps ns
                         ]
                       )
                   ]
@@ -338,29 +344,41 @@         new_ps = [[0..((length spl)-1)]]
         difference_x = (maximum x) - (minimum x)
         difference_y = (maximum y) - (minimum y)
-        x = map sel3_1 parr
-        y = map sel3_2 parr
+        x = map sel1 parr
+        y = map sel2 parr
 -}
+
+primitivesSources :: String -> String -> Vector V3 -> Vector V3 -> Mesh -> [Element]
+primitivesSources s str parr narr (LP (LinePrimitive ps ns ts mats))
+                = (concat (map (tex_ar ps ns ts "lines" s str) mats))
+
+primitivesSources s str parr narr (LS (LinePrimitive ps ns ts mats))
+                = (concat (map (tex_ar ps ns ts "linestrips" s str) mats))
+
+primitivesSources s str parr narr (P (Polygon ps ns phs mats))
+                = (concat (map (tex_ar ps ns V.empty "polygon" s str) mats))
+
+primitivesSources s str parr narr (PL (LinePrimitive ps ns ts mats))
+                = (concat (map (tex_ar ps ns ts "polylist" s str) mats))
+
+primitives :: String -> String -> Vector V3 -> Vector V3 -> Mesh -> [Element]
 primitives s str parr narr (LP (LinePrimitive ps ns ts mats))
-                = (concat (map (tex_ar ps ns ts "lines" s str) mats)) ++
-                  (concat (map (material ps ns ts "lines" s str) mats))
+                = (concat (map (material ps ns ts "lines" s str) mats))
 
 primitives s str parr narr (LS (LinePrimitive ps ns ts mats))
-                = (concat (map (tex_ar ps ns ts "linestrips" s str) mats)) ++
-                  (concat (map (material ps ns ts "linestrips" s str) mats))
+                = (concat (map (material ps ns ts "linestrips" s str) mats))
 
 primitives s str parr narr (P (Polygon ps ns phs mats))
-                = (concat (map (tex_ar ps ns [] "polygon" s str) mats)) ++
-                  (concat (map (material ps ns [] "polygon" s str) mats))
+                = (concat (map (material ps ns V.empty "polygon" s str) mats))
 
 primitives s str parr narr (PL (LinePrimitive ps ns ts mats))
-                = (concat (map (tex_ar ps ns ts "polylist" s str) mats)) ++
-                  (concat (map (material ps ns ts "polylist" s str) mats))
+                = (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
+triple_serialize :: Vector V3 -> [Float]
+triple_serialize triples = concat $V.toList $ V.map (\(V3 x y z) -> [x,y,z]) triples
 
 sources s str parr narr =
             [ attr "id" (str ++ s ++ "-lib-positions") $
@@ -381,17 +399,25 @@ 
 
 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 _ _ = []
+interl l = il ([0..(l-1)]++[0]) ([0..(l-1)]++[0])
+  where
+   il (p:points) (n:normals) = [p,n] ++ (il points normals)
+   il _ _ = []
 
-interleave3 (p:points) (n:normals) (t:textures) = [p,n,t] ++ (interleave3 points normals textures)
-interleave3 _ _ _ = []
+interleave :: VI -> VI -> String
+interleave points normals | V.null points || V.null normals = []
+                          | otherwise = (concat (V.toList (V.zipWith (\x y -> show x ++ " " ++ show y ++ " ") p n))) ++
+                                        (interleave (V.tail points) (V.tail normals))
+  where p = V.head points
+        n = V.head normals
 
-sel3_1 (a,b,c) = a
-sel3_2 (a,b,c) = b
-sel3_3 (a,b,c) = c
+interleave3 :: VI -> VI -> VI -> String
+interleave3 points normals tex | V.null points || V.null normals || V.null tex = []
+          | otherwise = (concat (V.toList (V.zipWith3 (\x y z ->show x ++" "++ show y ++" "++ show z ++" ") p n t))) ++
+                        (interleave3 (V.tail points) (V.tail normals) (V.tail tex))
+  where p = V.head points
+        n = V.head normals
+        t = V.head tex
 
 vnt s str (symbol,profile) = 
            [ attr "offset" "0" $ attr "semantic" "VERTEX" $ attr "source" ("#" ++ str ++ s ++ "-lib-vertices") $
@@ -452,20 +478,19 @@ instances_geo inst (Geometry str meshes _) =
         attr "url" ("#" ++ str ++ "-lib") $
         unode inst $
+		unode "bind_material" $
+        unode "technique_common" $
         getm
-  where getm | or $ concat $ map hasTextures mats = map (bindsTex.fst) mats
-             | otherwise                           = map (binds.fst) mats
+  where getm = map (\m -> if or (hasTextures m) then (bindsTex.fst) m
+                                                else (binds.fst) m    ) mats
+  
         mats = concat $ map getMaterials meshes
 
-binds str = unode "bind_material" $
-            unode "technique_common" $
-            attr "symbol" (str++"G") $
+binds str = attr "symbol" (str++"G") $
             attr "target" ("#" ++ str ++ "-lib") $
             unode "instance_material" ()
 
-bindsTex str = unode "bind_material" $
-               unode "technique_common" $
-               attr "symbol" (str++"G") $
+bindsTex str = attr "symbol" (str++"G") $
                attr "target" ("#" ++ str ++ "-lib") $
                unode "instance_material" $
                attr "semantic" "UVSET0" $
@@ -479,7 +504,7 @@ 
 transf :: (SID,Transform) -> [Element] 
 -- transf (Matrix (Mat44 Float)) = unode
-transf (sid, Rotate (xrx,xry,xrz) x (yrx,yry,yrz) y (zrx,zry,zrz) z ) =
+transf (sid, Rotate (V3 xrx xry xrz) x (V3 yrx yry yrz) y (V3 zrx zry zrz) z ) =
                   [  add_attr (Attr (unqual "sid") sid) $
                     unode "rotate" (show xrx ++ " " ++ show xry ++ " " ++ show xrz ++ " " ++ show x),
                      add_attr (Attr (unqual "sid") sid) $
@@ -487,17 +512,17 @@                      add_attr (Attr (unqual "sid") sid) $
                     unode "rotate" (show zrx ++ " " ++ show zry ++ " " ++ show zrz ++ " " ++ show z) ]
 
-transf (sid, Scale (s0,s1,s2) ) =
+transf (sid, Scale (V3 s0 s1 s2) ) =
                      [ add_attr (Attr (unqual "sid") sid) $
                        unode "scale" (show s0 ++ " " ++ show s1 ++ " " ++ show s2) ] 
 
-transf (sid, Translate (t0,t1,t2) ) =
+transf (sid, Translate (V3 t0 t1 t2) ) =
                      [ add_attr (Attr (unqual "sid") sid) $
                        unode "translate" (show t0 ++ " " ++ show t1 ++ " " ++ show t2) ]
 
-transf (sid, LookAt (px,py,pz) (ix,iy,iz) (upx, upy, upz) ) =
+transf (sid, LookAt (V3 px py pz) (V3 ix iy iz) (V3 upx upy upz) ) =
                      [ unode "lookat" (show px ++ " " ++ show py ++ " " ++ show pz ++ " " ++
                                        show ix ++ " " ++ show iy ++ " " ++ show iz ++ " " ++
                                        show upx ++ " " ++ show upy ++ " " ++ show upz) ]
 
-scene str = add_attr (Attr (unqual "url") ("#" ++ str)) $ unode "instance_visual_scene" ()+scene str = add_attr (Attr (unqual "url") ("#" ++ str)) $ unode "instance_visual_scene" ()