Improve chasm falls, add ear clipping

2026-03-23 19:35:07 +00:00
parent 505ced95bb
commit daba012e83
3 changed files with 33 additions and 11 deletions
@@ -151,13 +151,33 @@ convexHull :: [Point2] -> [Point2]
 convexHull (x : y : z : xs) = grahamScan $ orderAroundFirst $ sortOn (\(V2 a b) -> (b, a)) (x : y : z : xs)
 convexHull _ = error "Tried to create the convex hull of two or fewer points"

-- assumes the points go "anticlockwise" around a non-self intersecting shape
-convexPartition :: [Point2] -> [[Point2]]
-convexPartition (x:y:z:[]) = [[x,y,z]]
-convexPartition (x:y:z:xs)
-    | isLHS x y z = [x,y,z] : convexPartition (x:z:xs)
-    | otherwise = convexPartition (y:z:xs <> [x])
-convexPartition _ = error "unexpected shape for convexPartition"
+---- assumes the points go "anticlockwise" around a non-self intersecting shape
+--convexPartition :: [Point2] -> [[Point2]]
+--convexPartition (x:y:z:[]) = [[x,y,z]]
+--convexPartition (x:y:z:xs)
+--    | isLHS x y z = [x,y,z] : convexPartition (x:z:xs)
+--    | otherwise = convexPartition (y:z:xs <> [x])
+--convexPartition _ = error "unexpected shape for convexPartition"
+
+-- monotone means that all lines orthogonal to the first vector 
+-- must only intersect the polygon at most once
+partitionMonotonePoly :: Point2 -> [Point2] -> [[Point2]]
+partitionMonotonePoly v ps =  [qs]
+  where
+    qs = sortOn (dot v) ps
+
+monotonePolyChains :: Point2 -> [Point2] -> ([Point2],[Point2])
+monotonePolyChains v ps = undefined
+
+earClip :: [Point2] -> [[Point2]]
+earClip (x:y:z:[]) = [(x:y:z:[])]
+earClip (x:y:z:xs)
+    | isLHS x y z && not (any (`pointInPoly` (x:y:z:[])) xs) = (x:y:z:[]) : earClip (x:z:xs)
+    | otherwise = earClip (y:z:xs ++ [x])
+earClip _ = error "earClip: non-simple polygon input?"
+
+fusePolys :: [Point2] -> [Point2] -> [Point2]
+fusePolys xs ys = xs

 {- | Creates the convex hull of a set of points.
 assumes no repetition of points: try nubbing!