module Graphics.Formats.Collada.Transformations where
import Graphics.Formats.Collada.ColladaTypes
import Graphics.Formats.Collada.GenerateObjects
import Graphics.Formats.Collada.Vector2D3D
import Data.Vector (Vector)
import qualified Data.Vector as V
import Data.Tuple.Select

translate :: V3 -> Geometry -> Geometry
translate v (Geometry name prims (Vertices vname ps ns)) = Geometry name prims (Vertices vname (V.map (+ v) ps) ns)

-- |extrude a 2d polygon to 3d, the same points are added again with extrusion direction v
extrude :: V3 -> Geometry -> Geometry
extrude v (Geometry name prims (Vertices vname ps _)) = Geometry name
                                                         (map addIndices prims)
                                                         (Vertices vname (addNewPoints ps)
                                                                         (fourN ns) )
  where
  addNewPoints :: Vector V3 -> Vector V3
  addNewPoints vs | V.null vs   = V.empty
                  | otherwise = V.cons (V.head vs) $ V.cons ((V.head vs)+v) (addNewPoints (V.tail vs))

  fourN :: Vector V3 -> Vector V3
  fourN vs | V.null vs = V.empty
           | otherwise = V.cons (V.head vs) $
                         V.cons (V.head vs) $
                         V.cons (V.head vs) $ V.cons (V.head vs) (fourN (V.tail vs))

  addIndices (LP (LinePrimitive points normals tex color)) = PL (LinePrimitive (p points) (p points) tex color)

  ns = V.map (normalsFrom v) (cycleNeighbours ps)
  p :: Vector (Vector Int) -> Vector (Vector Int)
  p several_outlines = V.foldr (V.++) V.empty (V.map extr_outline several_outlines)

extr_outline :: Vector Int -> Vector (Vector Int)
extr_outline points = V.map quads (cycleNeighbours points)
  where
  quads xs = V.cons ((V.head xs)*2) $          -- [x*2,y*2,x*2+1,y*2+1]
             V.cons ((V.head (V.tail xs))*2) $
             V.cons ((V.head (V.tail xs))*2+1) $
             V.singleton ((V.head xs)*2+1)

normalsFrom (V3 x0 y0 z0) xs = crosspr (v1x-x0,v1y-y0,v1z-z0) (v1x-v2x,v1y-v2y,v1z-v2z)
  where (V3 v1x v1y v1z ,V3 v2x v2y v2z) = (V.head xs, V.head (V.tail xs)) :: (V3,V3)
        crosspr (v0,v1,v2) (w0,w1,w2) = (V3 (v1*w2-v2*w1) (v2*w0-v0*w2) (v0*w1-v1*w0))

-- |return a list containing lists of every element with its neighbour
-- i.e. [e1,e2,e3] -> [ [e1,e2], [e2,e3], [e3, e1] ]
cycleNeighbours :: Vector a -> Vector (Vector a)
cycleNeighbours xs | V.null xs = V.empty
                   | otherwise = cycleN (V.head xs) xs

cycleN :: a -> Vector a -> Vector (Vector a)
cycleN f xs | V.length xs >= 2 = V.cons (V.fromList [V.head xs, V.head (V.tail xs)]) (cycleN f (V.tail xs))
            | otherwise        = V.singleton (V.fromList [V.head xs, f ]) -- if the upper doesn't match close cycle


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 V.++ ps1) (ns0 V.++ ns1) )
  where changeIndices l (LP (LinePrimitive points                                  normals  texCoord mat)) =
                         LP (LinePrimitive (V.map (V.map (l+)) points) (V.map (V.map (l+)) normals) texCoord mat)
        changeIndices l (LS (LinePrimitive points                                  normals  texCoord mat)) =
                         LS (LinePrimitive (V.map (V.map (l+)) points) (V.map (V.map (l+)) normals) texCoord mat)
        changeIndices l (PL (LinePrimitive points                                  normals  texCoord mat)) =
                         PL (LinePrimitive (V.map (V.map (l+)) points) (V.map (V.map (l+)) normals) texCoord mat)
        changeIndices l (Tr (LinePrimitive points                                  normals  texCoord mat)) =
                         Tr (LinePrimitive (V.map (V.map (l+)) points) (V.map (V.map (l+)) normals) texCoord mat)
        l = V.length ps0


changeDiffuseColor :: String -> V4 -> Geometry -> Geometry
changeDiffuseColor str color (Geometry name prims
                               (Vertices vname ps ns)) = (Geometry name (map (c color) prims) (Vertices vname ps ns))
  where c col (LP (LinePrimitive ps ns texCoord mat)) =
               LP (LinePrimitive ps ns texCoord (map (diffuse col str) mat))
        c col (LS (LinePrimitive ps ns texCoord mat)) =
               LS (LinePrimitive ps ns texCoord (map (diffuse col str) mat))
        c col (PL (LinePrimitive ps ns texCoord mat)) =
               PL (LinePrimitive ps ns texCoord (map (diffuse col str) mat))
        c col (Tr (LinePrimitive ps ns texCoord mat)) =
               Tr (LinePrimitive ps ns texCoord (map (diffuse col str) mat))

changeAmbientColor :: String -> V4 -> Geometry -> Geometry
changeAmbientColor str color (Geometry name prims
                               (Vertices vname ps ns)) = (Geometry name (map (c color) prims) (Vertices vname ps ns))
  where c col (LP (LinePrimitive ps ns texCoord mat)) =
               LP (LinePrimitive ps ns texCoord (map (ambient col str) mat) ) 
        c col (LS (LinePrimitive ps ns texCoord mat)) =
               LS (LinePrimitive ps ns texCoord (map (ambient col str) mat) )
        c col (PL (LinePrimitive ps ns texCoord mat)) =
               PL (LinePrimitive ps ns texCoord (map (ambient col str) mat) )
        c col (Tr (LinePrimitive ps ns texCoord mat)) =
               Tr (LinePrimitive ps ns texCoord (map (ambient col str) mat) )