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

module Graphics.SVGFonts.KETTriangulation (ketTri) where
import List      ( (\\) )

type XYI = (Float,Float,Int)

ketTri                        :: [(Float,Float)] -> [(Int,Int,Int)]
ketTri poly                   = scan vs stack rs
  where ps@(p1:p2:p3:qs)      = vertices poly
        vs                    = qs ++ [p1]
        stack                 = [p3, p2, p1, last ps]
        rs                    = reflexVertices ps

scan	                      :: [XYI] -> [XYI] -> [XYI] -> [(Int,Int,Int)]
scan [] _ _                   = []
scan [v] [x_p, x_i, _, _] rs  = [(sel3_3 x_i, sel3_3 x_p, sel3_3 v)]
scan (v:vs) ss@[_,_,_] rs     = scan vs (v:ss) rs
scan vs@(v:vs') ss@(x_p:x_i:ss'@(x_m:x_mm:xs)) rs
  | isEar rs x_m x_i x_p      = (sel3_3 x_m, sel3_3 x_i, sel3_3 x_p) : scan vs (x_p:ss') rs'
  | otherwise                 = scan vs' (v:ss) rs
  where rs'                   = rs \\ (isConvex x_m x_p v ++ isConvex x_mm x_m x_p)
	isConvex im i ip      = if isLeftTurn im i ip then [i] else []

isEar                         :: [XYI] -> XYI -> XYI -> XYI -> Bool
isEar [] _ _ _                = True 
isEar rs m x p	              = isLeftTurn m x p && not (any ( (m,x,p) `containsBNV`) rs)

reflexVertices                :: [XYI] -> [XYI]
reflexVertices xs             = [ x | (m,x,p) <- angles xs, isRightTurnOrOn m x p ]

isRightTurnOrOn m x p = (area2 m x p) <= 0
isLeftTurn      m x p = (area2 m x p) > 0
area2 (x2,y2,_) (x0,y0,_) (x1,y1,_) = (x1-x0)*(y2-y0)-(x2-x0)*(y1-y0)

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                        :: [a] -> [(a,a,a)]
angles xs                     = zip3 (rotateR xs) xs (rotateL xs)

rotateL xs                    = tail xs ++ [head xs]
rotateR xs                    = [last xs] ++ init xs
sel3_1 (x,y,z) = x
sel3_2 (x,y,z) = y
sel3_3 (x,y,z) = z

-- make vertices of polygon counterclockwise and add an index
vertices :: [(Float,Float)] -> [XYI]
vertices qs | polygon_direction ps = ps
            | otherwise            = reverse ps
  where ps = zipWith (\(x,y) z -> (x,y,z) ) qs [0..]

-- the direction (clockwise or counterclockwise) of a polygon can be obtained by looking at a maximal point
polygon_direction :: [XYI] -> Bool
polygon_direction poly = isLeftTurn (p (l-1) poly)  (p l poly)  (p (l+1) poly)
         where p l poly = head (drop (l `mod` lp) poly)
               l = maxim poly 0 0 0 0
               lp = length poly
               -- the index of the right-/upmost point
               maxim []     l ml mx my = ml
               maxim (x:xs) l ml mx my | ((sel3_1 x) > mx) && ((sel3_2 x) >= my) = maxim xs (l+1) l (sel3_1 x) (sel3_2 x)
                                       | otherwise                               = maxim xs (l+1) ml mx my