diff options
Diffstat (limited to 'src/Graphics/Formats/Collada/Transformations.hs')
| -rw-r--r-- | src/Graphics/Formats/Collada/Transformations.hs | 97 |
1 files changed, 97 insertions, 0 deletions
diff --git a/src/Graphics/Formats/Collada/Transformations.hs b/src/Graphics/Formats/Collada/Transformations.hs new file mode 100644 index 0000000..9efa801 --- /dev/null +++ b/src/Graphics/Formats/Collada/Transformations.hs | |||
| @@ -0,0 +1,97 @@ | |||
| 1 | module Graphics.Formats.Collada.Transformations where | ||
| 2 | import Graphics.Formats.Collada.ColladaTypes | ||
| 3 | import Graphics.Formats.Collada.GenerateObjects | ||
| 4 | import Graphics.Formats.Collada.Vector2D3D | ||
| 5 | import Data.Vector (Vector) | ||
| 6 | import qualified Data.Vector as V | ||
| 7 | import Data.Tuple.Select | ||
| 8 | |||
| 9 | translate :: V3 -> Geometry -> Geometry | ||
| 10 | translate v (Geometry name prims (Vertices vname ps ns)) = Geometry name prims (Vertices vname (V.map (+ v) ps) ns) | ||
| 11 | |||
| 12 | -- |extrude a 2d polygon to 3d, the same points are added again with extrusion direction v | ||
| 13 | extrude :: V3 -> Geometry -> Geometry | ||
| 14 | extrude v (Geometry name prims (Vertices vname ps _)) = Geometry name | ||
| 15 | (map addIndices prims) | ||
| 16 | (Vertices vname (addNewPoints ps) | ||
| 17 | (fourN ns) ) | ||
| 18 | where | ||
| 19 | addNewPoints :: Vector V3 -> Vector V3 | ||
| 20 | addNewPoints vs | V.null vs = V.empty | ||
| 21 | | otherwise = V.cons (V.head vs) $ V.cons ((V.head vs)+v) (addNewPoints (V.tail vs)) | ||
| 22 | |||
| 23 | fourN :: Vector V3 -> Vector V3 | ||
| 24 | fourN vs | V.null vs = V.empty | ||
| 25 | | otherwise = V.cons (V.head vs) $ | ||
| 26 | V.cons (V.head vs) $ | ||
| 27 | V.cons (V.head vs) $ V.cons (V.head vs) (fourN (V.tail vs)) | ||
| 28 | |||
| 29 | addIndices (LP (LinePrimitive points normals tex color)) = PL (LinePrimitive (p points) (p points) tex color) | ||
| 30 | |||
| 31 | ns = V.map (normalsFrom v) (cycleNeighbours ps) | ||
| 32 | p :: Vector (Vector Int) -> Vector (Vector Int) | ||
| 33 | p several_outlines = V.foldr (V.++) V.empty (V.map extr_outline several_outlines) | ||
| 34 | |||
| 35 | extr_outline :: Vector Int -> Vector (Vector Int) | ||
| 36 | extr_outline points = V.map quads (cycleNeighbours points) | ||
| 37 | where | ||
| 38 | quads xs = V.cons ((V.head xs)*2) $ -- [x*2,y*2,x*2+1,y*2+1] | ||
| 39 | V.cons ((V.head (V.tail xs))*2) $ | ||
| 40 | V.cons ((V.head (V.tail xs))*2+1) $ | ||
| 41 | V.singleton ((V.head xs)*2+1) | ||
| 42 | |||
| 43 | normalsFrom (V3 x0 y0 z0) xs = crosspr (v1x-x0,v1y-y0,v1z-z0) (v1x-v2x,v1y-v2y,v1z-v2z) | ||
| 44 | where (V3 v1x v1y v1z ,V3 v2x v2y v2z) = (V.head xs, V.head (V.tail xs)) :: (V3,V3) | ||
| 45 | crosspr (v0,v1,v2) (w0,w1,w2) = (V3 (v1*w2-v2*w1) (v2*w0-v0*w2) (v0*w1-v1*w0)) | ||
| 46 | |||
| 47 | -- |return a list containing lists of every element with its neighbour | ||
| 48 | -- i.e. [e1,e2,e3] -> [ [e1,e2], [e2,e3], [e3, e1] ] | ||
| 49 | cycleNeighbours :: Vector a -> Vector (Vector a) | ||
| 50 | cycleNeighbours xs | V.null xs = V.empty | ||
| 51 | | otherwise = cycleN (V.head xs) xs | ||
| 52 | |||
| 53 | cycleN :: a -> Vector a -> Vector (Vector a) | ||
| 54 | cycleN f xs | V.length xs >= 2 = V.cons (V.fromList [V.head xs, V.head (V.tail xs)]) (cycleN f (V.tail xs)) | ||
| 55 | | otherwise = V.singleton (V.fromList [V.head xs, f ]) -- if the upper doesn't match close cycle | ||
| 56 | |||
| 57 | |||
| 58 | atop :: Geometry -> Geometry -> Geometry | ||
| 59 | atop (Geometry name0 prims0 (Vertices vname0 ps0 ns0)) | ||
| 60 | (Geometry name1 prims1 (Vertices vname1 ps1 ns1)) = Geometry name0 | ||
| 61 | ( prims0 ++ (map (changeIndices l) prims1) ) | ||
| 62 | ( Vertices vname0 (ps0 V.++ ps1) (ns0 V.++ ns1) ) | ||
| 63 | where changeIndices l (LP (LinePrimitive points normals texCoord mat)) = | ||
| 64 | LP (LinePrimitive (V.map (V.map (l+)) points) (V.map (V.map (l+)) normals) texCoord mat) | ||
| 65 | changeIndices l (LS (LinePrimitive points normals texCoord mat)) = | ||
| 66 | LS (LinePrimitive (V.map (V.map (l+)) points) (V.map (V.map (l+)) normals) texCoord mat) | ||
| 67 | changeIndices l (PL (LinePrimitive points normals texCoord mat)) = | ||
| 68 | PL (LinePrimitive (V.map (V.map (l+)) points) (V.map (V.map (l+)) normals) texCoord mat) | ||
| 69 | changeIndices l (Tr (LinePrimitive points normals texCoord mat)) = | ||
| 70 | Tr (LinePrimitive (V.map (V.map (l+)) points) (V.map (V.map (l+)) normals) texCoord mat) | ||
| 71 | l = V.length ps0 | ||
| 72 | |||
| 73 | |||
| 74 | changeDiffuseColor :: String -> V4 -> Geometry -> Geometry | ||
| 75 | changeDiffuseColor str color (Geometry name prims | ||
| 76 | (Vertices vname ps ns)) = (Geometry name (map (c color) prims) (Vertices vname ps ns)) | ||
| 77 | where c col (LP (LinePrimitive ps ns texCoord mat)) = | ||
| 78 | LP (LinePrimitive ps ns texCoord (map (diffuse col str) mat)) | ||
| 79 | c col (LS (LinePrimitive ps ns texCoord mat)) = | ||
| 80 | LS (LinePrimitive ps ns texCoord (map (diffuse col str) mat)) | ||
| 81 | c col (PL (LinePrimitive ps ns texCoord mat)) = | ||
| 82 | PL (LinePrimitive ps ns texCoord (map (diffuse col str) mat)) | ||
| 83 | c col (Tr (LinePrimitive ps ns texCoord mat)) = | ||
| 84 | Tr (LinePrimitive ps ns texCoord (map (diffuse col str) mat)) | ||
| 85 | |||
| 86 | changeAmbientColor :: String -> V4 -> Geometry -> Geometry | ||
| 87 | changeAmbientColor str color (Geometry name prims | ||
| 88 | (Vertices vname ps ns)) = (Geometry name (map (c color) prims) (Vertices vname ps ns)) | ||
| 89 | where c col (LP (LinePrimitive ps ns texCoord mat)) = | ||
| 90 | LP (LinePrimitive ps ns texCoord (map (ambient col str) mat) ) | ||
| 91 | c col (LS (LinePrimitive ps ns texCoord mat)) = | ||
| 92 | LS (LinePrimitive ps ns texCoord (map (ambient col str) mat) ) | ||
| 93 | c col (PL (LinePrimitive ps ns texCoord mat)) = | ||
| 94 | PL (LinePrimitive ps ns texCoord (map (ambient col str) mat) ) | ||
| 95 | c col (Tr (LinePrimitive ps ns texCoord mat)) = | ||
| 96 | Tr (LinePrimitive ps ns texCoord (map (ambient col str) mat) ) | ||
| 97 | |||