ALGO: add type signatures

This commit is contained in:
hasufell 2015-01-12 22:37:10 +01:00
parent ba3cfb879e
commit 8a248adc41
No known key found for this signature in database
GPG Key ID: 220CD1C5BDEED020

View File

@ -112,6 +112,7 @@ monotonePartitioning pts
| isYmonotone pts = [pts] | isYmonotone pts = [pts]
| otherwise = go (monotoneDiagonals pts) pts | otherwise = go (monotoneDiagonals pts) pts
where where
go :: [Segment] -> [PT] -> [[PT]]
go [] _ = [[]] go [] _ = [[]]
go _ [] = [[]] go _ [] = [[]]
go (x:xs) pts' go (x:xs) pts'
@ -128,16 +129,22 @@ monotonePartitioning pts
monotoneDiagonals :: [PT] -> [(PT, PT)] monotoneDiagonals :: [PT] -> [(PT, PT)]
monotoneDiagonals pts = catMaybes . go $ classifyList pts monotoneDiagonals pts = catMaybes . go $ classifyList pts
where where
go :: [(PT, VCategory)] -> [Maybe (PT, PT)]
go (x:xs) = case snd x of go (x:xs) = case snd x of
VMerge -> getSeg (belowS . fst $ x) (fst x) : go xs VMerge -> getSeg (belowS . fst $ x) (fst x) : go xs
VSplit -> getSeg (aboveS . fst $ x) (fst x) : go xs VSplit -> getSeg (aboveS . fst $ x) (fst x) : go xs
_ -> [] ++ go xs _ -> [] ++ go xs
go [] = [] go [] = []
getSeg :: [PT] -- all points above/below the current point
-> PT -- current point
-> Maybe (PT, PT)
getSeg [] _ = Nothing getSeg [] _ = Nothing
getSeg (z:zs) pt getSeg (z:zs) pt
| isInsidePoly pts (z, pt) = Just (z, pt) | isInsidePoly pts (z, pt) = Just (z, pt)
| otherwise = getSeg zs pt | otherwise = getSeg zs pt
aboveS :: PT -> [PT]
aboveS pt = tail . dropWhile (/= pt) $ sortedYX pts aboveS pt = tail . dropWhile (/= pt) $ sortedYX pts
belowS :: PT -> [PT]
belowS pt = reverse . takeWhile (/= pt) $ sortedYX pts belowS pt = reverse . takeWhile (/= pt) $ sortedYX pts
@ -146,6 +153,10 @@ triangulate :: [PT] -> [[PT]]
triangulate pts = triangulate pts =
go pts . A.first reverse . splitAt 3 . reverse . sortedYX $ pts go pts . A.first reverse . splitAt 3 . reverse . sortedYX $ pts
where where
go :: [PT] -- current polygon
-> ([PT], [PT]) -- (stack of visited vertices, rest)
-- sorted by Y-coordinate
-> [[PT]]
go xs (p@[_, _], r:rs) = go xs (r:p, rs) go xs (p@[_, _], r:rs) = go xs (r:p, rs)
go xs (p@(u:vi:vi1:ys), rs) go xs (p@(u:vi:vi1:ys), rs)
-- case 1 and 3 -- case 1 and 3