module Graphics.Formats.Collada.GenerateObjects
where
import Graphics.Formats.Collada.ColladaTypes
import Data.Tree
import Data.Tuple.Gen
import Data.Enumerable
import Data.Word
animatedCube = (aScene, animation)
aScene :: Scene
aScene = Node EmptyRoot [ n aCamera,
n (pointLight "pointLight" 3 4 10),
n (pointLight "pointL" (500) 1000 400),
n aCube ]
n x = Node x []
aCamera = SceneNode "camera0" NOTYPE []
[("tran", Translate (1000,1000,2500)),
("rot", Rotate (1,0,0) (22)
(0,1,0) 13
(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]
[]
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
[]
animation :: [Animation]
animation = [Node ("cube_rotate", anim_channel) []]
anim_channel = AnimChannel ("input", [0, 1, 2, 3], [[("name","TIME"), ("type","Float")]] )
("output",[0, 50, 100, 150], [[("name","ANGLE"), ("type","Float")]] )
[ Bezier [0.333333, 0] [2.5, 0],
Bezier [5,0] [7.916667, 0],
Bezier [8.333333, 56] [9.166667, 56],
Bezier [9.583333, 18.666666] [10.333333, 14.933331] ]
[("cube_geometry/rotateY","ANGLE")]
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,0,0,0],[1,1,1,1],[2,2,2,2],[3,3,3,3],[4,4,4,4],[5,5,5,5]]
[]
[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,1,0), (0,1,0), (1,0,0), (1,0,0), (0,0,1)]
)
blue = ("blue", COMMON "" NoParam
(PhongCol [(CEmission (Color (0,0,0,1))),
(CAmbient (Color (0,0,0,1))),
(CDiffuse(Color (0.137255,0.403922,0.870588,1))),
(CSpecular(Color (0.5,0.5,0.5,1))),
(CShininess 16),
(CReflective (Color (0,0,0,1))),
(CReflectivity 0.5),
(CTransparent (Color (0,0,0,1))),
(CTransparency 1),
(CIndex_of_refraction 0)]
)
""
)
logo = ("haskell-logo", COMMON "" NoParam
(PhongTex [(TDiffuse tex)]
[[0,0,1,0,1,1,0,1]]
)
""
)
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
ni
[]
[blue]
)]
(Vertices "polygons_vertices" p n)]
lines :: [(Float,Float,Float)] -> [(Float,Float,Float)] -> [[Int]] -> [[Int]] -> [Geometry]
lines p n pi ni = [Geometry "lines"
[LS (LinePrimitive pi
ni
[]
[blue]
)]
(Vertices "lines_vertices" p n)]
trifans :: [(Float,Float,Float)] -> [(Float,Float,Float)] -> [[Int]] -> [[Int]] -> [Geometry]
trifans p n pi ni = [Geometry "trifans"
[Trf (LinePrimitive pi
ni
[]
[blue]
)]
(Vertices "trifans_vertices" p n)]
tristrips :: [(Float,Float,Float)] -> [(Float,Float,Float)] -> [[Int]] -> [[Int]] -> [Geometry]
tristrips p n pi ni = [Geometry "tristrips"
[Trs (LinePrimitive pi
ni
[]
[blue]
)]
(Vertices "trifans_vertices" p n)]
lightedScene :: [Geometry] -> Scene
lightedScene g = Node EmptyRoot ( [ 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]
animatedCubes = (scene2, animation2)
animatedCubes2 = [(scene2, animation2)]
scene2 :: Scene
scene2 = Node EmptyRoot $ [ n aCamera, n (pointLight "pl" (500) 1000 400) ] ++ (map n test_objs)
animation2 :: [Animation]
animation2 = [Node ("cube_rotate", new_channels anim_channel test_objs) []]
emptyAnimation :: [[Animation]]
emptyAnimation = []
emptyAnim :: [Animation]
emptyAnim = []
new_channels :: AnimChannel -> [SceneNode] -> AnimChannel
new_channels (AnimChannel i o interp _) nodes =
AnimChannel i o interp $ map (\obj -> ((obj_name obj) ++ "/rotateY","ANGLE")) nodes
obj_name (SceneNode n _ _ _ _ _ _ _) = n
tran :: SceneNode -> (Float,Float,Float) -> String -> SceneNode
tran (SceneNode _ typ layer tr cam contr geo light) (tx, ty, tz) str =
(SceneNode str typ layer [("tr", Translate (tx,ty,tz))] cam contr geo light)
test_objs :: [SceneNode]
test_objs = xyz_grid 10 10 10 150 aCube
xyz_grid :: Int -> Int -> Int -> Float -> SceneNode -> [SceneNode]
xyz_grid x y z d obj = zipWith (tran obj)
(concat (concat (x_line x (map (map (\(a,b,c) -> (a+d,b,c)))) $
x_line y (map (\(a,b,c) -> (a,b+d,c))) $
x_line z (\(a,b,c) -> (a,b,c+d)) (0,0,0)) ))
(enum_obj obj [1..(x*y*z)])
enum_obj obj (i:is) = ((obj_name obj) ++ (show i)) : (enum_obj obj is)
x_line 0 change value = []
x_line n change value = value : ( x_line (n1) change (change value) )
positions = take 50 $ map (\(x, y, z) -> (x*100, y*100, z*100) ) $
map (\(x,y,z) -> (fromIntegral x, fromIntegral y, fromIntegral z)) en
en :: [(Word8,Word8,Word8)]
en = enumerate
base_objects = map (rename aCube) (map show [1..(length positions)])
rename :: SceneNode -> String -> SceneNode
rename (SceneNode str typ layer tr cam contr geo light) s =
(SceneNode (str ++ s) typ layer tr cam contr geo light)
getName (SceneNode str _ _ _ _ _ _ _) = str
animatedStream = (streamScene base_objects, streamAnimation positions base_objects)
streamScene :: [SceneNode] -> Scene
streamScene objects = Node EmptyRoot $ [ n aCamera,
n (pointLight "pl" (500) 1000 400) ] ++
(map n $ objects)
streamAnimation :: [(Float,Float,Float)] -> [SceneNode] -> [Animation]
streamAnimation ps base_objects =
[Node ("cube_stream", EmptyAnim) (map n $ concat $
zipWith (\ind bo -> [tr_channel ind ((show ind) ++ "1") bo (length ps) s1 "X"] ++
[tr_channel ind ((show ind) ++ "2") bo (length ps) s2 "Y"] ++
[tr_channel ind ((show ind) ++ "3") bo (length ps) s3 "Z"])
[1..(length ps)] (map getName base_objects) )
]
where
s1 = map (\(a,b,c) -> a) ps
s2 = map (\(a,b,c) -> b) ps
s3 = map (\(a,b,c) -> c) ps
tr_channel ind name bname lps s c = ( "anim" ++ name,
AnimChannel ("input", map (*0.3) (map fromIntegral [0..(lps1)]), [[("name","TIME"), ("type","Float")]] )
("output", (take ind s) ++ (take (lpsind) (repeat (head (drop ind s)))),
[[("name",c), ("type","Float")]] )
(take lps (repeat Linear))
[(bname ++ "/tran",c)]
)