collada-output 0.3 → 0.4

raw patch · 7 files changed

+105/−549 lines, 7 filesdep +collada-typesPVP ok

version bump matches the API change (PVP)

Dependencies added: collada-types

API changes (from Hackage documentation)

Files

• README +6/−1
• collada-output.cabal +11/−11
• src/Examples.hs +2/−3
• src/Graphics/Formats/Collada/Animations.hs +54/−52
• src/Graphics/Formats/Collada/ColladaTypes.hs +0/−283
• src/Graphics/Formats/Collada/GenerateCollada.hs +32/−16
• src/Graphics/Formats/Collada/GenerateObjects.hs +0/−183

@@ -22,4 +22,9 @@ 0.2 to 0.3
 ------------
 - Materials working again
-- Vec dependency removed+- Vec dependency removed
+
+0.2 to 0.3
+------------
+- Animation improved
+- Visualization of a stream of positions. Enumeration of 3-tuples is used as an example

@@ -1,7 +1,7 @@ Name:               collada-output
-Version:            0.3
+Version:            0.4
 Synopsis:           Generate animated 3d objects in COLLADA
-Description:        Generate a COLLADA file with textures, materials, animations, ...+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
@@ -9,21 +9,21 @@ Maintainer:         Tillmann.Vogt@rwth-aachen.de
 Build-Type:         Simple
 Cabal-Version:    >=1.6
--Library+
+Library
     hs-source-dirs: src
     build-depends:
         base ==4.*,
         xml == 1.3.*,
         containers == 0.4.*,
         time == 1.2.*,
-        SVGPath == 1.0.*
+        SVGPath == 1.0.*,
+        collada-types
     exposed-modules:
-        Graphics.Formats.Collada.ColladaTypes
         Graphics.Formats.Collada.Animations
         Graphics.Formats.Collada.GenerateCollada
-        Graphics.Formats.Collada.GenerateObjects
--Executable Examples-    hs-source-dirs: src-    Main-is:        Examples.hs+
+Executable Examples
+    hs-source-dirs: src
+    Main-is:        Examples.hs
+

@@ -4,6 +4,5 @@ import Graphics.Formats.Collada.GenerateCollada
 import Graphics.Formats.Collada.GenerateObjects
 
-main :: IO ()
-main = genCollada (fst animatedCubes) (snd animatedCubes)
-                  --animatedCube
+main = genCollada (fst animatedStream) (snd animatedStream)
+                  --animatedCube

@@ -1,6 +1,7 @@ module Graphics.Formats.Collada.Animations (attr, library_animations, animations, collada_array) where
 import Text.XML.Light
 import Graphics.Formats.Collada.ColladaTypes
+import Debug.Trace
 
 attr :: String -> String -> (Element -> Element)
 attr key value = add_attr (Attr (unqual key) value)
@@ -11,27 +12,43 @@   where as = map animations anims
 
 animations :: (SID, AnimChannel) -> Element
-animations (sid,(Bezier (inID,inFloat,inAccessor)
-                        (outID,outFloat,outAccessor)
-                        (intangentID,intangentFloat,intangentAccessor)
-                        (outtangentID,outtangentFloat,outtangentAccessor)
-                        (interpID,interpString,interpAccessor)
-                        targets )) =
+animations (sid, EmptyAnim) = attr "id" "animRoot" $ unode "animation" ()
+animations (sid,(AnimChannel (inID,inFloat,inAccessor)
+                             (outID,outFloat,outAccessor)
+							 interp
+                             targets )) =
                 attr "id" sid $ unode "animation" $
-                [ anim_source_input (sid ++ "-" ++ inID) inFloat inAccessor,
-                  anim_source_output (sid ++ "-" ++ outID) outFloat outAccessor,
-                  anim_source_intangents (sid ++ "-" ++ intangentID) intangentFloat intangentAccessor,
-                  anim_source_outtangents (sid ++ "-" ++ outtangentID) outtangentFloat outtangentAccessor,
-                  anim_source_interpolations (sid ++ "-" ++ interpID) interpString interpAccessor,
-                  anim_source_sampler sid inID outID intangentID outtangentID interpID
-                ]
+                [ anim_source_io (sid ++ "-" ++ inID) inFloat inAccessor,
+                  anim_source_io (sid ++ "-" ++ outID) outFloat outAccessor ] ++
+                (if intangent_exists then [ anim_source_tangents (sid ++ "-intangent") intangentFloat tAccessor ]
+                 else []) ++
+                (if outtangent_exists then [ anim_source_tangents (sid ++ "-outtangent") outtangentFloat tAccessor ]
+                 else []) ++
+                [ anim_source_interpolations (sid ++ "-interp") interpString [[("name","Interpolation"), ("type","Name")]],
+				  anim_source_sampler sid inID outID intangent_exists outtangent_exists "intangent" "outtangent" "interp" ]
                 ++ (map (anim_source_channel sid) targets)
+  where
+    intangentFloat = concat $ map fst gb
+    outtangentFloat = concat $ map snd gb
+    intangent_exists = (length intangentFloat) > 0
+    outtangent_exists = (length outtangentFloat) > 0
+    interpString = map getName interp
+    gb = getBezier interp
+    getBezier ((Bezier x y) : xs) = (x,y) : (getBezier xs)
+    getBezier (_:xs) = getBezier xs
+    getBezier [] = []
+    getName (Step) = "Step "
+    getName (Linear) = "Linear "
+    getName (Bezier _ _) = "Bezier "
 
+tAccessor = ( [ [("name","X"),("type","Float")],
+                [("name","Y"),("type","Float")] ] )
+
 accessor acc = map (foldr (\(x,y) -> (attr x y)) (unode "param" "")) acc
 
 collada_array list = concat (map (++" ") (map show list))
 
-anim_source_input str ar acc =
+anim_source_io str ar acc =
                   attr "id" str $ unode "source"
                   [ attr "id" (str ++ "-array") $
                     attr "count" (show (length ar)) $
@@ -43,30 +60,8 @@                     unode "accessor" $ accessor acc
                   ]
 
-anim_source_output str ar acc = attr "id" str $ unode "source"
-                            [ attr "id" (str ++ "-array") $
-                              attr "count" (show (length ar)) $
-                              unode "float_array" (collada_array ar),
-                              unode "technique_common" $
-                                attr "source" ("#" ++ str ++ "-array") $
-                                attr "count" (show (length ar)) $
-                                attr "stride" "1" $
-                                  unode "accessor" $ accessor acc
-                            ]
-
-anim_source_intangents str ar acc =
-                        attr "id" str $ unode "source"
-                        [ attr "id" (str ++ "-array") $
-                          attr "count" (show (length ar)) $
-                          unode "float_array" (collada_array ar),
-                          unode "technique_common" $
-                            attr "source" ("#" ++ str ++ "-array") $
-                            attr "count" (show ((length ar)`div`2)) $
-                            attr "stride" "2" $
-                              unode "accessor" $ accessor acc
-                        ]
-
-anim_source_outtangents str ar acc =
+anim_source_tangents :: String -> [Float] -> [[(String,String)]] -> Element
+anim_source_tangents str ar acc =
                         attr "id" str $ unode "source"
                         [ attr "id" (str ++ "-array") $
                           attr "count" (show (length ar)) $
@@ -78,6 +73,7 @@                               unode "accessor" $ accessor acc
                         ]
 
+anim_source_interpolations :: String -> [String] -> [[(String,String)]] -> Element
 anim_source_interpolations str ar acc =
                         attr "id" str $ unode "source"
                         [ attr "id" (str ++ "-array") $
@@ -90,23 +86,29 @@                               unode "accessor" $ accessor acc
                         ]
 
-anim_source_sampler str inID outID intangentID outtangentID interpID =
+anim_source_sampler str inID outID in_exists out_exists intangentID outtangentID interpID =
                   attr "id" (str ++ "-sampler") $
                   unode "sampler" 
-                  [
-                    attr "semantic" "INPUT" $ attr "source" ("#" ++ str ++ "-" ++ inID) $
-                      unode "input" (),
-                    attr "semantic" "OUTPUT" $ attr "source" ("#" ++ str ++ "-" ++ outID) $
-                      unode "input" (),
-                    attr "semantic" "IN_TANGENT" $ attr "source" ("#" ++ str ++ "-" ++ intangentID) $
-                      unode "input" (),
-                    attr "semantic" "OUT_TANGENT" $ attr "source" ("#" ++ str ++ "-" ++ outtangentID) $
-                      unode "input" (),
-                    attr "semantic" "INTERPOLATION" $ attr "source" ("#" ++ str ++ "-" ++ interpID) $
-                      unode "input" ()
-                  ]
+                  ([
+                     attr "semantic" "INPUT" $ attr "source" ("#" ++ str ++ "-" ++ inID) $
+                       unode "input" (),
+                     attr "semantic" "OUTPUT" $ attr "source" ("#" ++ str ++ "-" ++ outID) $
+                       unode "input" ()
+                   ] ++
+                   (if in_exists then
+                   [attr "semantic" "IN_TANGENT" $ attr "source" ("#" ++ str ++ "-" ++ intangentID) $
+                       unode "input" ()]
+                   else [])
+                   ++
+                   (if out_exists then [attr "semantic" "OUT_TANGENT" $ attr "source" ("#" ++ str ++ "-" ++ outtangentID) $
+                       unode "input" ()]
+                   else [])
+                   ++
+                   [  attr "semantic" "INTERPOLATION" $ attr "source" ("#" ++ str ++ "-" ++ interpID) $
+                       unode "input" ()
+                  ])
 
 anim_source_channel s0 (targetID,accessorName) =
                      attr "source" ("#" ++ s0 ++ "-sampler") $
                      attr "target" (targetID ++ "." ++ accessorName) $
-                       unode "channel" ()
+                       unode "channel" ()

@@ -1,283 +0,0 @@--- some of the Types are from http://hackage.haskell.org/package/GPipe-Collada
--- adopted for possible future combination
-
-module Graphics.Formats.Collada.ColladaTypes
-(
-    Scene,
-    SceneNode(..), NodeType(..),
-    Transform(..),
-    Camera(..),
-    ViewSize(..),
-    Z(..),
-    
-    Light(..),
-    Attenuation(..),
-    Controller(..),
-    
-    Geometry(..),
-    Mesh(..),
-    Vertices(..),
-    LinePrimitive(..), Polygon(..),
-	-- Polylist(..), Spline(..), TriangleMesh(..), TriFan(..), TriStrip(..),
-    AnimChannel(..),
-    ID, SID,
-    Semantic,
-    Profile(..), NewParam(..), TechniqueCommon(..), Material, Effect,
-    C(..), Color(..),
-    Animation(..),
-    Fx_common_color_type(..), Fx_common_texture_type(..), Texture(..)
-)
-where
-
-import Data.Tree
-type Vec3 = (Float,Float,Float)
-type Mat44 = ((Float,Float,Float,Float),
-              (Float,Float,Float,Float),
-			  (Float,Float,Float,Float),
-			  (Float,Float,Float,Float))
-
-type Scene = Tree SceneNode
-
-data SceneNode = SceneNode {
-                nodeId :: ID,
-                nodeType :: NodeType,
-                nodeLayers :: [String],
-                nodeTransformations :: [(SID, Transform)],
-                nodeCameras :: [Camera],
-                nodeController :: [Controller],
-                nodeGeometries :: [Geometry],
-                nodeLights :: [Light]
-              }
-              deriving (Show, Eq)
-
-
-data NodeType = JOINT | NODE | NOTYPE deriving (Show, Eq)
-
-data Transform = LookAt {
-                    lookAtEye:: Vec3,
-                    lookAtInterest :: Vec3,
-                    lookAtUp :: Vec3
-                 }
-               | Matrix Mat44
-               | Rotate Vec3 Float Vec3 Float Vec3 Float
-               | Scale Vec3
-               | Skew {
-                    skewAngle :: Float,
-                    skewRotation :: Vec3,
-                    skewTranslation :: Vec3
-                 }
-               | Translate Vec3
-               deriving (Show, Eq)
-
-data Camera = Perspective {
-                perspectiveID :: ID,
-                perspectiveFov :: ViewSize,
-                perspectiveZ :: Z
-              }
-            | Orthographic {
-                orthographicID :: ID,
-                orthographicViewSize :: ViewSize,
-                orthographicZ :: Z
-              }
-              deriving (Show, Eq)
-
-data ViewSize = ViewSizeX Float
-              | ViewSizeY Float
-              | ViewSizeXY (Float,Float)
-              deriving (Show, Eq)
-
-data Z = Z { 
-            zNear :: Float, 
-            zFar :: Float
-           }
-           deriving (Show, Eq)
-
-data Light = Ambient {
-                ambientID :: ID,
-                ambientColor :: Color
-             }
-           | Directional {
-                directionalID :: ID,
-                directionalColor :: Color
-             }
-           | Point {
-                pointID :: ID,
-                pointColor :: Color,
-                pointAttenuation :: Attenuation
-             }
-           | Spot {
-                spotID :: ID,
-                spotColor :: Color,
-                spotAttenuation :: Attenuation,
-                spotFallOffAngle :: Float,
-                spotFallOffExponent :: Float
-             }
-              deriving (Show, Eq)
-
-data Attenuation = Attenuation {
-                attenuationConstant :: Float,
-                attenuationLinear :: Float,
-                attenuationQuadratic :: Float
-            }
-              deriving (Show, Eq)
-
-data Controller = Controller {
-                contrId :: ID,
-                skin :: [Skin],
-                morph :: [Morph]
-            }
-              deriving (Show, Eq)
-
-data Skin = Skin {
-                bindShapeMatrix :: [Mat44],
-                source :: [String],
-                joint :: [Joint],
-                vertexWeights :: String
-            }
-              deriving (Show, Eq)
-
-data Morph = Morph {
-                geometrySource :: String,
-                method :: MorphMethod,
-                morphSource :: String,
-                morphTargets :: [Input]
-            }
-              deriving (Show, Eq)
-
-data MorphMethod = Normalized | Relative deriving (Show, Eq)
-
-data Joint = Joint {
-                jointID :: String,
-                prismatic :: Prismatic,
-                revolute :: Revolute
-            }
-              deriving (Show, Eq)
-
-type Prismatic = String
-type Revolute = String
-
-data Input = Input {
-                offset :: Int,
-                semantic :: Semantic,
-                inputSource :: String,
-                set :: Int
-            }
-              deriving (Show, Eq)
-
-data Semantic = BINORMAL | COLOR | CONTINUITY | IMAGE | INPUT | IN_TANGENT | INTERPOLATION |
-                INV_BIND_MATRIX | ISJOINT | LINEAR_STEPS | MORPH_TARGET | MORPH_WEIGHT |
-                NORMAL | OUTPUT | OUT_TANGENT | POSITION | TANGENT | TEXBINORMAL |
-                TEXCOORD | TEXTANGENT | UV | VERTEX | WEIGHT
-                deriving (Show, Eq)
-
-data Geometry = Geometry {
-                meshID :: ID,
-                mesh :: [Mesh],
-                vertices :: Vertices
---                convexMesh :: [Mesh],
---                splines :: [Spline],
---                breps :: [Brep]
-            }
-            deriving (Show)
-
-instance Eq Geometry where
-  (Geometry mid1 _ _) == (Geometry mid2 _ _) = mid1 == mid2
-
-data Mesh = LP LinePrimitive | -- ^Lines
-            LS LinePrimitive | -- ^LineStrips
-			P Polygon | -- ^Polygon: Contains polygon primitives which may contain holes.
-			PL LinePrimitive | -- ^PolyList: Contains polygon primitives that cannot contain holes.
-            Tr LinePrimitive | -- ^Triangles
-			Trf LinePrimitive | -- ^TriFans
-			Trs LinePrimitive | -- ^TriStrips
-            S LinePrimitive -- ^Splines
-            deriving (Show, Eq)
-
-data Vertices = Vertices {
-                  name :: ID,
-                  verts :: [(Float,Float,Float)],
-                  normals :: [(Float,Float,Float)]
-            }
-            deriving (Show, Eq)
-
-data LinePrimitive = LinePrimitive {
-                lineP :: [[Int]], -- point indices
-                lineN :: [[Int]], -- normal indices
-                lineT :: [[Int]], -- texture indices
-                ms :: [Material]
-            }
-            deriving (Show, Eq)
-
-data Polygon = Polygon {
-                poylgonP :: [[Int]],
-                poylgonN :: [[Int]],
-                polygonPh :: ([Int],[Int]), -- (indices, indices of a hole)
-                polygonMs :: [Material]
-            }
-            deriving (Show, Eq)
-
-type Material = (SID,Effect)
-
-type Effect = Profile
-
-type Animation = Tree (SID, AnimChannel)
-
-data AnimChannel = Bezier {
-                     -- these 5 items are called sampler in Collada
-                     -- we don't need the modularity to define everyone seperately
-                     input :: (ID,[Float],Accessor) , -- Accessor: "TIME"
-                     output :: (ID,[Float],Accessor), 
-                     intangent :: (ID,[Float],Accessor), -- for bezier curves: smooth values at the beginnig transition
-                     outtangent :: (ID,[Float],Accessor), -- end
-                     interpolation :: (ID,[String],Accessor),
-                     -- target channels in Collada
-                     targets :: [(TargetID,AccessorName)] -- transfer values to several objects
-                   }
-                   deriving (Show, Eq)
-
-type TargetID = String
-type Accessor = [[(AccessorName, AccessorType)]]
-type AccessorName = String
-type AccessorType = String
-
-data Profile = BRIDGE Asset Extra |
-               CG Asset Code Include NewParam TechniqueCG Extra |
-               COMMON Asset NewParam TechniqueCommon String |
-               GLES Asset NewParam TechniqueCG Extra |
-               GLES2 Asset Code Include NewParam TechniqueCG Extra |
-               GLSL Asset Code Include NewParam TechniqueCG Extra
-			   deriving (Show, Eq)
-
-type Asset = String
-type Code = String
-type Include = String
-data NewParam = Annotat | Semantic | Modifier | NoParam deriving (Show, Eq)
-data TechniqueCommon = Constant | LambertCol [Fx_common_color_type]
-                                | LambertTex [Fx_common_texture_type] [[Float]]
-                                | PhongCol [Fx_common_color_type]
-                                | PhongTex [Fx_common_texture_type] [[Float]]
-                                | Blinn
-                                deriving (Show, Eq)
-data TechniqueCG = IsAsset | IsAnnotate | Pass | Extra deriving (Show, Eq)
-data Extra = String deriving (Show, Eq) -- Asset | Technique
-data Technique = Profile deriving (Show, Eq) -- XML -- | Xmlns Schema
-data Fx_common_color_type = CEmission C | CAmbient C | CDiffuse C | CSpecular C |
-                            CShininess Float | CReflective C | CReflectivity Float |
-                            CTransparent C | CTransparency Float | CIndex_of_refraction Float
-                            deriving (Show, Eq)
-data Fx_common_texture_type = TEmission Texture | TAmbient Texture | TDiffuse Texture | TSpecular Texture |
-                              TShininess Float | TReflective Texture | TReflectivity Float |
-                              TTransparent Texture | TTransparency Float | TIndex_of_refraction Float
-                              deriving (Show, Eq)
-data C = Color (Float, Float, Float, Float) deriving (Show, Eq)
-
-data Texture = Texture {
-                   imageSID :: ID,
-                   path :: String -- ToDo: better type, embedded images
-            }
-            deriving (Show, Eq)
-
-type ID = String
-type SID = String -- Maybe
-
-data Color = RGB Float Float Float deriving (Eq, Show)

@@ -89,23 +89,30 @@ 
 -- | Extract cameras from SceneNodes and remove duplicates
 extract_cameras :: [SceneNode] -> [SceneNode]
-extract_cameras snodes = nubBy (\(SceneNode _ _ _ _ c0s _ _ _)
-                                 (SceneNode _ _ _ _ c1s _ _ _) -> c0s == c1s) snodes
+extract_cameras snodes = nubBy eqCamera snodes
 
+eqCamera (SceneNode _ _ _ _ c0s _ _ _) (SceneNode _ _ _ _ c1s _ _ _) = c0s == c1s
+eqCamera _  _ = False
+
 -- | Extract lights from SceneNodes and remove duplicates
 extract_lights :: [SceneNode] -> [SceneNode]
-extract_lights snodes = nubBy (\(SceneNode _ _ _ _ _ _ _ l0s)
-                                (SceneNode _ _ _ _ _ _ _ l1s) -> l0s == l1s) snodes
+extract_lights snodes = nubBy eqLight snodes
 
+eqLight (SceneNode _ _ _ _ _ _ _ l0s) (SceneNode _ _ _ _ _ _ _ l1s) = l0s == l1s
+eqLight _ _ = False
+
 -- | Extract geometries from SceneNodes and remove duplicates
 extract_geometries :: [SceneNode] -> [SceneNode]
-extract_geometries snodes = nubBy (\(SceneNode _ _ _ _ _ _ g0s _)
-                                    (SceneNode _ _ _ _ _ _ g1s _) -> g0s == g1s) snodes
+extract_geometries snodes = nubBy eqGeometries snodes
 
+eqGeometries (SceneNode _ _ _ _ _ _ g0s _) (SceneNode _ _ _ _ _ _ g1s _) = g0s == g1s
+eqGeometries _ _ = False
+
 ---------------------------------------------------------
 -- | library_cameras
 cam :: SceneNode -> [Element]
 cam (SceneNode _ _ _ _ cs _ _ _) = map cam2 cs
+cam EmptyRoot = []
 
 -- | Perpective projection: see <http://en.wikipedia.org/wiki/Viewing_frustum>
 cam2 :: Camera -> Element
@@ -121,6 +128,7 @@ -- | library_lights
 light :: SceneNode -> [Element]
 light (SceneNode _ _ _ _ _ _ _ l) = map light2 l
+light EmptyRoot = []
 
 light2 :: Light -> Element
 light2 ((Point sid (RGB c0 c1 c2) (Attenuation c_att l_att q_att))) =
@@ -176,6 +184,7 @@ 
 getGeometries :: SceneNode -> [Geometry]
 getGeometries (SceneNode _ _ _ _ _ _ gs _) = gs
+getGeometries EmptyRoot = []
 getMeshes :: Geometry -> [Mesh]
 getMeshes (Geometry _ mes _) = mes
 getMaterials :: Mesh -> [Material]
@@ -425,6 +434,8 @@ treeToNodes (Node (SceneNode sid _ _ tr cs _ gs ls ) tree) =
     attr "id" sid $ attr "name" sid $ unode "node" $
     (ttn sid tr cs gs ls) ++ (map treeToNodes tree)
+treeToNodes (Node EmptyRoot tree) =
+    attr "id" "root" $ attr "name" "root" $ unode "node" $ (map treeToNodes tree)
 
 ttn :: String -> [(ID,Transform)] -> [Camera] -> [Geometry] -> [Light] -> [Element]
 ttn sid tr cs gs ls = (concat $ map transf tr)
@@ -454,13 +465,13 @@ 
 binds str = unode "bind_material" $
             unode "technique_common" $
-            attr "symbol" (str ++ "G") $
+            attr "symbol" (str++"G") $
             attr "target" ("#" ++ str ++ "-lib") $
             unode "instance_material" ()
 
 bindsTex str = unode "bind_material" $
                unode "technique_common" $
-               attr "symbol" (str ++ "G") $
+               attr "symbol" (str++"G") $
                attr "target" ("#" ++ str ++ "-lib") $
                unode "instance_material" $
                attr "semantic" "UVSET0" $
@@ -474,20 +485,25 @@ 
 transf :: (SID,Transform) -> [Element] 
 -- transf (Matrix (Mat44 Float)) = unode
-transf (sid,(Rotate (xrx,xry,xrz) x (yrx,yry,yrz) y (zrx,zry,zrz) z)) =
-                  [  add_attr (Attr (unqual "sid") "rotateX") $
+transf (sid, Rotate (xrx,xry,xrz) x (yrx,yry,yrz) y (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") "rotateY") $
+                     add_attr (Attr (unqual "sid") sid) $
                     unode "rotate" (show yrx ++ " " ++ show yry ++ " " ++ show yrz ++ " " ++ show y),
-                     add_attr (Attr (unqual "sid") "rotateZ") $
+                     add_attr (Attr (unqual "sid") sid) $
                     unode "rotate" (show zrx ++ " " ++ show zry ++ " " ++ show zrz ++ " " ++ show z) ]
 
-transf (sid,(Scale (s0,s1,s2))) =
-                     [ add_attr (Attr (unqual "sid") "scale") $
+transf (sid, Scale (s0,s1,s2) ) =
+                     [ add_attr (Attr (unqual "sid") sid) $
                        unode "scale" (show s0 ++ " " ++ show s1 ++ " " ++ show s2) ] 
 
-transf (sid,(Translate (t0,t1,t2))) =
-                     [ add_attr (Attr (unqual "sid") "translate") $
+transf (sid, Translate (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) ) =
+                     [ 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" ()

@@ -1,183 +0,0 @@-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) )