module Graphics.Formats.Collada.Transformations where
import Graphics.Formats.Collada.ColladaTypes
type V = (Float,Float,Float)
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 (vx1vx0,vy1vy0,vz1vz0)
(vx1vx2,vy1vy2,vz1vz2)
crosspr (v0,v1,v2) (w0,w1,w2) = (v1*w2v2*w1, v2*w0v0*w2, v0*w1v1*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)
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 ]]