Port to diagrams >1.3
# Conflicts: # Algebra/Vector.hs # CG2.cabal # Graphics/Diagram/Core.hs # Graphics/Diagram/Gif.hs # Graphics/Diagram/Gtk.hs # Test/Vector.hs
This commit is contained in:
@@ -19,12 +19,12 @@ data VCategory = VStart
|
||||
|
||||
|
||||
-- |Classify all vertices on a polygon into five categories (see VCategory).
|
||||
classifyList :: [P2] -> [(P2, VCategory)]
|
||||
classifyList :: [P2 Double] -> [(P2 Double, VCategory)]
|
||||
classifyList p@(x:y:_:_) =
|
||||
-- need to handle the first and last element separately
|
||||
[classify (last p) x y] ++ go p ++ [classify (last . init $ p) (last p) x]
|
||||
where
|
||||
go :: [P2] -> [(P2, VCategory)]
|
||||
go :: [P2 Double] -> [(P2 Double, VCategory)]
|
||||
go (x':y':z':xs) = classify x' y' z' : go (y':z':xs)
|
||||
go _ = []
|
||||
classifyList _ = []
|
||||
@@ -32,10 +32,10 @@ classifyList _ = []
|
||||
|
||||
-- |Classify a vertex on a polygon given it's next and previous vertex
|
||||
-- into five categories (see VCategory).
|
||||
classify :: P2 -- ^ prev vertex
|
||||
-> P2 -- ^ classify this one
|
||||
-> P2 -- ^ next vertex
|
||||
-> (P2, VCategory)
|
||||
classify :: P2 Double -- ^ prev vertex
|
||||
-> P2 Double -- ^ classify this one
|
||||
-> P2 Double -- ^ next vertex
|
||||
-> (P2 Double, VCategory)
|
||||
classify prev v next
|
||||
| isVStart prev v next = (v, VStart)
|
||||
| isVSplit prev v next = (v, VSplit)
|
||||
@@ -46,9 +46,9 @@ classify prev v next
|
||||
|
||||
-- |Whether the vertex, given it's next and previous vertex,
|
||||
-- is a start vertex.
|
||||
isVStart :: P2 -- ^ previous vertex
|
||||
-> P2 -- ^ vertice to check
|
||||
-> P2 -- ^ next vertex
|
||||
isVStart :: P2 Double -- ^ previous vertex
|
||||
-> P2 Double -- ^ vertice to check
|
||||
-> P2 Double -- ^ next vertex
|
||||
-> Bool
|
||||
isVStart prev v next =
|
||||
ptCmpY next v == LT && ptCmpY prev v == LT && cw next v prev
|
||||
@@ -56,9 +56,9 @@ isVStart prev v next =
|
||||
|
||||
-- |Whether the vertex, given it's next and previous vertex,
|
||||
-- is a split vertex.
|
||||
isVSplit :: P2 -- ^ previous vertex
|
||||
-> P2 -- ^ vertice to check
|
||||
-> P2 -- ^ next vertex
|
||||
isVSplit :: P2 Double -- ^ previous vertex
|
||||
-> P2 Double -- ^ vertice to check
|
||||
-> P2 Double -- ^ next vertex
|
||||
-> Bool
|
||||
isVSplit prev v next =
|
||||
ptCmpY prev v == LT && ptCmpY next v == LT && cw prev v next
|
||||
@@ -66,9 +66,9 @@ isVSplit prev v next =
|
||||
|
||||
-- |Whether the vertex, given it's next and previous vertex,
|
||||
-- is an end vertex.
|
||||
isVEnd :: P2 -- ^ previous vertex
|
||||
-> P2 -- ^ vertice to check
|
||||
-> P2 -- ^ next vertex
|
||||
isVEnd :: P2 Double -- ^ previous vertex
|
||||
-> P2 Double -- ^ vertice to check
|
||||
-> P2 Double -- ^ next vertex
|
||||
-> Bool
|
||||
isVEnd prev v next =
|
||||
ptCmpY prev v == GT && ptCmpY next v == GT && cw next v prev
|
||||
@@ -76,9 +76,9 @@ isVEnd prev v next =
|
||||
|
||||
-- |Whether the vertex, given it's next and previous vertex,
|
||||
-- is a merge vertex.
|
||||
isVMerge :: P2 -- ^ previous vertex
|
||||
-> P2 -- ^ vertice to check
|
||||
-> P2 -- ^ next vertex
|
||||
isVMerge :: P2 Double -- ^ previous vertex
|
||||
-> P2 Double -- ^ vertice to check
|
||||
-> P2 Double -- ^ next vertex
|
||||
-> Bool
|
||||
isVMerge prev v next =
|
||||
ptCmpY next v == GT && ptCmpY prev v == GT && cw prev v next
|
||||
@@ -86,9 +86,9 @@ isVMerge prev v next =
|
||||
|
||||
-- |Whether the vertex, given it's next and previous vertex,
|
||||
-- is a regular vertex.
|
||||
isVRegular :: P2 -- ^ previous vertex
|
||||
-> P2 -- ^ vertice to check
|
||||
-> P2 -- ^ next vertex
|
||||
isVRegular :: P2 Double -- ^ previous vertex
|
||||
-> P2 Double -- ^ vertice to check
|
||||
-> P2 Double -- ^ next vertex
|
||||
-> Bool
|
||||
isVRegular prev v next =
|
||||
(not . isVStart prev v $ next)
|
||||
@@ -99,7 +99,7 @@ isVRegular prev v next =
|
||||
|
||||
|
||||
-- |A polygon P is y-monotone, if it has no split and merge vertices.
|
||||
isYmonotone :: [P2] -> Bool
|
||||
isYmonotone :: [P2 Double] -> Bool
|
||||
isYmonotone poly =
|
||||
not
|
||||
. any (\x -> x == VSplit || x == VMerge)
|
||||
@@ -108,12 +108,12 @@ isYmonotone poly =
|
||||
|
||||
|
||||
-- |Partition P into y-monotone pieces.
|
||||
monotonePartitioning :: [P2] -> [[P2]]
|
||||
monotonePartitioning :: [P2 Double] -> [[P2 Double]]
|
||||
monotonePartitioning pts
|
||||
| isYmonotone pts = [pts]
|
||||
| otherwise = go (monotoneDiagonals pts) pts
|
||||
where
|
||||
go :: [(P2, P2)] -> [P2] -> [[P2]]
|
||||
go :: [(P2 Double, P2 Double)] -> [P2 Double] -> [[P2 Double]]
|
||||
go (x:xs) pts'@(_:_)
|
||||
| isYmonotone a && isYmonotone b = [a, b]
|
||||
| isYmonotone b = b : go xs a
|
||||
@@ -125,37 +125,37 @@ monotonePartitioning pts
|
||||
|
||||
-- |Try to eliminate the merge and split vertices by computing the
|
||||
-- diagonals we have to use for splitting the polygon.
|
||||
monotoneDiagonals :: [P2] -> [(P2, P2)]
|
||||
monotoneDiagonals :: [P2 Double] -> [(P2 Double, P2 Double)]
|
||||
monotoneDiagonals pts = catMaybes . go $ classifyList pts
|
||||
where
|
||||
go :: [(P2, VCategory)] -> [Maybe (P2, P2)]
|
||||
go :: [(P2 Double, VCategory)] -> [Maybe (P2 Double, P2 Double)]
|
||||
go (x:xs) = case snd x of
|
||||
VMerge -> getSeg (belowS . fst $ x) (fst x) : go xs
|
||||
VSplit -> getSeg (aboveS . fst $ x) (fst x) : go xs
|
||||
_ -> [] ++ go xs
|
||||
go [] = []
|
||||
getSeg :: [P2] -- all points above/below the current point
|
||||
-> P2 -- current point
|
||||
-> Maybe (P2, P2)
|
||||
getSeg :: [P2 Double] -- all points above/below the current point
|
||||
-> P2 Double -- current point
|
||||
-> Maybe (P2 Double, P2 Double)
|
||||
getSeg [] _ = Nothing
|
||||
getSeg (z:zs) pt
|
||||
| isInsidePoly pts (z, pt) = Just (z, pt)
|
||||
| otherwise = getSeg zs pt
|
||||
aboveS :: P2 -> [P2]
|
||||
aboveS :: P2 Double -> [P2 Double]
|
||||
aboveS pt = tail . dropWhile (/= pt) $ sortedYX pts
|
||||
belowS :: P2 -> [P2]
|
||||
belowS :: P2 Double -> [P2 Double]
|
||||
belowS pt = reverse . takeWhile (/= pt) $ sortedYX pts
|
||||
|
||||
|
||||
-- |Triangulate a y-monotone polygon.
|
||||
triangulate :: [P2] -> [[P2]]
|
||||
triangulate :: [P2 Double] -> [[P2 Double]]
|
||||
triangulate pts =
|
||||
go pts . A.first reverse . splitAt 3 . reverse . sortedYX $ pts
|
||||
where
|
||||
go :: [P2] -- current polygon
|
||||
-> ([P2], [P2]) -- (stack of visited vertices, rest)
|
||||
go :: [P2 Double] -- current polygon
|
||||
-> ([P2 Double], [P2 Double]) -- (stack of visited vertices, rest)
|
||||
-- sorted by Y-coordinate
|
||||
-> [[P2]]
|
||||
-> [[P2 Double]]
|
||||
go xs (p@[_, _], r:rs) = go xs (r:p, rs)
|
||||
go xs (p@(u:vi:vi1:ys), rs)
|
||||
-- case 1 and 3
|
||||
|
||||
Reference in New Issue
Block a user