From 54284193cd5fe7be0088861e11e0ab78e2e1cff2 Mon Sep 17 00:00:00 2001 From: hasufell Date: Fri, 9 Jan 2015 03:58:05 +0100 Subject: [PATCH] ALGO: improve naming of functions --- Algorithms/PolygonTriangulation.hs | 22 ++++++++++------------ Graphics/Diagram/AlgoDiags.hs | 5 ++++- 2 files changed, 14 insertions(+), 13 deletions(-) diff --git a/Algorithms/PolygonTriangulation.hs b/Algorithms/PolygonTriangulation.hs index 6326308..9dcbb62 100644 --- a/Algorithms/PolygonTriangulation.hs +++ b/Algorithms/PolygonTriangulation.hs @@ -107,18 +107,16 @@ isYmonotone poly = $ classifyList poly -monotonize :: [PT] -> [[PT]] -monotonize pts - | isYmonotone pts = partitionPoly pts - | and . fmap isYmonotone $ maybeMonotone = - concat . fmap partitionPoly $ maybeMonotone - | otherwise = (\(x, y) -> x ++ (concat . fmap monotonize $ y)) +monotonePartitioning :: [PT] -> [[PT]] +monotonePartitioning pts + | isYmonotone pts = [pts] + | and . fmap isYmonotone $ maybeMonotone = maybeMonotone + | otherwise = (\(x, y) -> x ++ (concat . fmap monotonePartitioning $ y)) (partition isYmonotone maybeMonotone) where - go (x:xs) = splitPoly pts x ++ go xs - go _ = [] - maybeMonotone = go (monotoneDiagonals pts) - + maybeMonotone = foldr (\x y -> splitPoly pts x ++ y) + [] + (monotoneDiagonals pts) monotoneDiagonals :: [PT] -> [(PT, PT)] @@ -137,8 +135,8 @@ monotoneDiagonals pts = catMaybes . go $ classifyList pts belowS pt pts' = reverse . takeWhile (/= pt) $ sortedYX pts' -partitionPoly :: [PT] -> [[PT]] -partitionPoly pts = +triangulate :: [PT] -> [[PT]] +triangulate pts = go pts . A.first reverse . splitAt 3 . reverse . sortedYX $ pts where go xs (p@[_, _], r:rs) = go xs (r:p, rs) diff --git a/Graphics/Diagram/AlgoDiags.hs b/Graphics/Diagram/AlgoDiags.hs index d162d20..6e12c73 100644 --- a/Graphics/Diagram/AlgoDiags.hs +++ b/Graphics/Diagram/AlgoDiags.hs @@ -270,6 +270,9 @@ monotonePolys :: Diag monotonePolys = Diag f where f _ vts = foldl (\x y -> x <> strokePoly y) mempty - $ monotonize (concat vts) + (concat + . fmap triangulate + . monotonePartitioning + $ concat vts) where strokePoly x' = fromVertices $ x' ++ (maybeToList . headMay $ x')