module Graphics.Formats.Collada.Transformations where import Graphics.Formats.Collada.ColladaTypes type V = (Float,Float,Float) -- |extrude a 2d polygon to 3d, the same points are added again with extrusion direction v extrude :: V -> Geometry -> Geometry extrude v (Geometry name prims (Vertices vname ps _)) = Geometry name (map addIndices prims) (Vertices vname (concat twoPoints) (concat (map (\x -> [x,x,x,x]) ns)) ) where twoPoints = map addPoint ps addPoint point = [point, add v point] addIndices (LP (LinePrimitive points normals tex color)) = PL (LinePrimitive (p points) (p points) tex color) p several_outlines = concat $ map extr_outline several_outlines extr_outline points = map quads (cycleNeighbours points) quads = \[x,y] -> [x*2, y*2, y*2+1, x*2+1] ns = map (normals v) (cycleNeighbours ps) normals (vx0,vy0,vz0) [(vx1,vy1,vz1),(vx2,vy2,vz2)] = crosspr (vx1-vx0,vy1-vy0,vz1-vz0) (vx1-vx2,vy1-vy2,vz1-vz2) crosspr (v0,v1,v2) (w0,w1,w2) = (v1*w2-v2*w1, v2*w0-v0*w2, v0*w1-v1*w0) add (x0,y0,z0) (x1,y1,z1) = (x0+x1, y0+y1, z0+z1) atop :: Geometry -> Geometry -> Geometry atop (Geometry name0 prims0 (Vertices vname0 ps0 ns0)) (Geometry name1 prims1 (Vertices vname1 ps1 ns1)) = Geometry name0 ( prims0 ++ (map (changeIndices l) prims1) ) ( Vertices vname0 (ps0++ps1) (ns0++ns1) ) where changeIndices l (LP (LinePrimitive points normals tex color)) = LP (LinePrimitive (map (map (l+)) points) (map (map (l+)) normals) tex color) changeIndices l (LS (LinePrimitive points normals tex color)) = LS (LinePrimitive (map (map (l+)) points) (map (map (l+)) normals) tex color) changeIndices l (PL (LinePrimitive points normals tex color)) = PL (LinePrimitive (map (map (l+)) points) (map (map (l+)) normals) tex color) changeIndices l (Tr (LinePrimitive points normals tex color)) = Tr (LinePrimitive (map (map (l+)) points) (map (map (l+)) normals) tex color) l = length ps0 translate :: (Float,Float,Float) -> Geometry -> Geometry translate v (Geometry name prims (Vertices vname ps ns)) = Geometry name prims (Vertices vname (map (add v) ps) ns) -- |return a list containing lists of every element with its neighbour -- i.e. [e1,e2,e3] -> [ [e1,e2], [e2,e3], [e3, e1] ] cycleNeighbours :: [a] -> [[a]] cycleNeighbours [] = [] cycleNeighbours xs = cycleN (head xs) xs cycleN :: a -> [a] -> [[a]] cycleN f (x:y:xs) = [x,y] : (cycleN f (y:xs)) cycleN f e = [[head e, f ]] -- if the upper doesn't match close cycle