module Reanimate.Math.EarClip ( earCut , earCut' , earClip , earClip' , isEarCorner ) where import Data.List import qualified Data.Set as Set import Data.Tuple import Reanimate.Math.Common import Reanimate.Math.Triangulate import qualified Data.Vector as V import qualified Geometry.Earcut as C import Linear.V2 -- import Debug.Trace earCut :: (Real a) => Ring a -> Triangulation earCut = last . earCut' earCut' :: (Real a) => Ring a -> [Triangulation] earCut' p = map (edgesToTriangulation (ringSize p)) \$ inits \$ nub [ if fst pair < snd pair then pair else swap pair | (a,b,c) <- V.toList (C.earcut lst) , pair <- [(a,b), (a,c), (b,c)] , fst pair /= (snd pair+1) `mod` ringSize p , fst pair /= (snd pair-1) `mod` ringSize p ] where lst = [ (x,y) | V2 x y <- V.toList \$ V.map (fmap realToFrac) \$ ringUnpack p ] -- Triangulation by ear clipping. O(n^2) earClip :: (Fractional a, Ord a) => Ring a -> Triangulation earClip = last . earClip' earClip' :: (Fractional a, Ord a) => Ring a -> [Triangulation] earClip' p = map (edgesToTriangulation \$ ringSize p) \$ inits \$ let ears = Set.fromList [ i | i <- elts , isEarCorner p elts (mod (i-1) n) i (mod (i+1) n) ] in worker ears (mkQueue elts) where n = ringSize p elts = [0 .. n-1] -- worker :: Set.Set Int -> PolyQueue Int -> [(P,P)] worker _ears queue | isSimpleQ queue = [] worker ears queue | x `Set.member` ears = let dq = dropQ queue v0 = prevQ 1 queue v1 = prevQ 0 queue v3 = peekQ dq v4 = peekQ (nextQ dq) e1 = if isEarCorner p (toList dq) v0 v1 v3 then Set.insert v1 ears else Set.delete v1 ears e2 = if isEarCorner p (toList dq) v1 v3 v4 then Set.insert v3 e1 else Set.delete v3 e1 in (v1,v3) : worker e2 dq | otherwise = worker ears (nextQ queue) where x = peekQ queue data PolyQueue a = PolyQueue a [a] [a] [a] -- sizeQ :: PolyQueue a -> Int -- sizeQ (PolyQueue _ a b _) = 1 + length a + length b mkQueue :: [a] -> PolyQueue a mkQueue (x:xs) = PolyQueue x xs [] (reverse (x:xs)) mkQueue [] = error "mkQueue: empty" toList :: PolyQueue a -> [a] toList (PolyQueue e a b _) = e : a ++ b isSimpleQ :: PolyQueue a -> Bool isSimpleQ (PolyQueue _ xs ys _) = case xs ++ ys of [_,_] -> True _ -> False peekQ :: PolyQueue a -> a peekQ (PolyQueue e _ _ _) = e nextQ :: PolyQueue a -> PolyQueue a nextQ (PolyQueue x [] ys p) = let (y:xs) = reverse (x:ys) in PolyQueue y xs [] (x:p) nextQ (PolyQueue x (y:xs) ys p) = PolyQueue y xs (x:ys) (x:p) dropQ :: PolyQueue a -> PolyQueue a dropQ (PolyQueue _ [] ys p) = let (x:xs) = reverse ys in PolyQueue x xs [] p dropQ (PolyQueue _ (x:xs) ys p) = PolyQueue x xs ys p prevQ :: Int -> PolyQueue a -> a prevQ nth (PolyQueue _ _ _ p) = p!!nth -- O(n) -- Returns true if ac can be cut from polygon. That is, true if 'b' is an ear. -- isEarCorner polygon a b c = True iff ac can be cut isEarCorner :: (Fractional a, Ord a) => Ring a -> [Int] -> Int -> Int -> Int -> Bool isEarCorner p polygon a b c = isLeftTurn aP bP cP && -- If it is a right turn then the line ac will be outside the polygon and [ not (isInside aP bP cP (ringAccess p k)) | k <- polygon, k /= a && k /= b && k /= c ] where aP = ringAccess p a bP = ringAccess p b cP = ringAccess p c