diff --git a/README b/README --- a/README +++ b/README @@ -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 diff --git a/collada-output.cabal b/collada-output.cabal --- a/collada-output.cabal +++ b/collada-output.cabal @@ -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 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 + diff --git a/src/Examples.hs b/src/Examples.hs --- a/src/Examples.hs +++ b/src/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 diff --git a/src/Graphics/Formats/Collada/Animations.hs b/src/Graphics/Formats/Collada/Animations.hs --- a/src/Graphics/Formats/Collada/Animations.hs +++ b/src/Graphics/Formats/Collada/Animations.hs @@ -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" () diff --git a/src/Graphics/Formats/Collada/ColladaTypes.hs b/src/Graphics/Formats/Collada/ColladaTypes.hs deleted file mode 100644 --- a/src/Graphics/Formats/Collada/ColladaTypes.hs +++ /dev/null @@ -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) diff --git a/src/Graphics/Formats/Collada/GenerateCollada.hs b/src/Graphics/Formats/Collada/GenerateCollada.hs --- a/src/Graphics/Formats/Collada/GenerateCollada.hs +++ b/src/Graphics/Formats/Collada/GenerateCollada.hs @@ -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 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" () diff --git a/src/Graphics/Formats/Collada/GenerateObjects.hs b/src/Graphics/Formats/Collada/GenerateObjects.hs deleted file mode 100644 --- a/src/Graphics/Formats/Collada/GenerateObjects.hs +++ /dev/null @@ -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) )