```-- |
-- 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)
```