-- |
-- Module    : Graphics.Triangulation.KETTriangulation
-- Copyright :(C) 1997, 1998, 2008 Joern Dinkla, www.dinkla.net
--
-- Triangulation of simple polygons after Kong, Everett, Toussaint 91
-- with some changes by T.Vogt: return indices instead of coordinates of triangles and Data.Vector instead of lists
--
-- see
--     Joern Dinkla, Geometrische Algorithmen in Haskell, Diploma Thesis,
--     University of Bonn, Germany, 1998. 

module Graphics.Triangulation.KETTriangulation (ketTri) where
import Graphics.Triangulation.Triangulation (isLeftTurn, isRightTurnOrOn)
import List      ( (\\) )
import Data.Vector (Vector)
import qualified Data.Vector as V
import Graphics.Formats.Collada.Vector2D3D (V2 (V))
import Debug.Trace

type V2i = (V2,Int)
toV2 = V.map (\(x,i) -> x)

ketTri :: Vector V2 -> [(Int,Int,Int)]
ketTri points | (V.length vertices) > 3 = scan vs stack rs
              | otherwise = []
  where vertices = V.zip points (V.generate (V.length points) id)
        [p1,p2,p3] = V.toList (V.take 3 vertices)
        qs         = V.drop 3 vertices
        vs         = qs V.++ (V.singleton p1)
        stack      = V.fromList [p3, p2, p1, V.last vertices]
        rs         = reflexVertices (angles vertices)

scan :: Vector V2i -> Vector V2i -> Vector V2i -> [(Int,Int,Int)]
scan vs stack rs | V.null vs            = []
                 | V.length vs == 1     = [(snd (V.head stack), snd (V.head (V.tail stack)), snd (V.head vs))]
                 | V.length stack == 3  = scan (V.tail vs) (V.cons (V.head vs) stack) rs
                 | isEar rs x_m x_i x_p = (snd x_p, snd x_i, snd x_m) : (scan vs (V.cons x_p ss') rs')
                 | otherwise            = scan (V.tail vs) (V.cons (V.head vs) stack) rs
  where [x_p, x_i, x_m] = V.toList (V.take 3 stack)
        ss' = V.drop 2 stack
        rs'   = V.fromList $ (V.toList rs) \\ (isConvex x_m x_p (V.head vs) ++
                                               isConvex (V.head (V.tail ss')) x_m x_p)
        isConvex (im,_) (i,ii) (ip,_) = if isLeftTurn im i ip then [(i,ii)] else []

isEar :: Vector V2i -> V2i -> V2i -> V2i -> Bool
isEar rs (m,_) (x,_) (p,_) | V.null rs = True
                           | otherwise = isLeftTurn m x p && not (V.any ( (m,x,p) `containsBNV`) (toV2 rs))

reflexVertices  :: Vector (V2i,V2i,V2i) -> Vector V2i
reflexVertices as | V.null as             = V.empty
                  | isRightTurnOrOn m x p = V.cons (x,xi) $ reflexVertices (V.tail as)
                  | otherwise             =                 reflexVertices (V.tail as)
  where ((m,_),(x,xi),(p,_)) = V.head as

containsBNV (s,t,v) p    = (a==b && b==c)
  where a                = isLeftTurn s t p
        b                = isLeftTurn t v p
        c                = isLeftTurn v s p

angles :: Vector a -> Vector (a,a,a)
angles xs = V.zip3 (rotateR xs) xs (rotateL xs)

rotateL xs = (V.tail xs) V.++ (V.singleton (V.head xs))
rotateR xs = (V.singleton (V.last xs)) V.++ (V.init xs)