{-| Ear clipping triangulation -} module Earclipper.EarClipping ( toTriangle , triangulate , pointInTriangle , isAnyPointInTriangle , isConvex ) where import Data.List (any, length) -- | Triangulate given polygon and return a list of triangles. The given -- polygon's start point end end point has to be equal. The first point is -- removed before triangulation. Use the triangulate function if you want to -- supply a polygon directly without modification. toTriangle :: [(Double, Double)] -> [[(Double, Double)]] toTriangle [] = [] toTriangle (_:bounds) = triangulate bounds -- | Triangulate given polygon and return a list of triangles. -- It is assumed that the given polygon's end point is the start point -- and that the first point in the list is not the start point. triangulate :: [(Double, Double)] -> [[(Double, Double)]] triangulate = triangulateEar 0 -- | Ear clipping triangulation triangulateEar :: Int -> [(Double, Double)] -> [[(Double, Double)]] triangulateEar _ [] = [] triangulateEar _ [_] = [] triangulateEar _ [_, _] = [] triangulateEar _ [a, x, c] = [[a, x, c]] triangulateEar lastear (a:x:c:xs) | lastear > 2*size = [[a,x,c]] | earfound = [a, x, c] : triangulateEar 0 ([a]++[c]++xs) | otherwise = triangulateEar (lastear+1) ([x,c] ++ xs ++ [a]) where earfound = convex && noPointInTriangle noPointInTriangle = not $ isAnyPointInTriangle [a, x, c] xs convex = isConvex a x c size = 3 + length xs -- | Check if given point is in given triangle. pointInTriangle :: [(Double, Double)] -> (Double, Double) -> Bool pointInTriangle [(ax, ay), (bx, by), (cx, cy)] (px, py) | b0 == 0 = False | otherwise = (b1 > 0) && (b2 > 0) && (b3 > 0) where b0 = (bx - ax) * (cy - ay) - (cx - ax) * (by - ay) b1 = ((bx - px) * (cy - py) - (cx - px) * (by - py))/b0 b2 = ((cx - px) * (ay - py) - (ax - px) * (cy - py))/b0 b3 = 1.0 - b1 - b2 pointInTriangle _ _ = False -- | Check if any given point in list is in the given triangle. isAnyPointInTriangle :: [(Double, Double)] -> [(Double, Double)] -> Bool isAnyPointInTriangle triangle = any (pointInTriangle triangle) -- | Check if given points are convex. isConvex :: (Double, Double) -> (Double, Double) -> (Double, Double) -> Bool isConvex (p1x, p1y) (px, py) (p2x, p2y) = l < 0 where l = (p1x - px) * (p2y - py) - (p1y - py) * (p2x - px)