Improve chasm falls, add ear clipping

src/Dodge/Creature/Update.hs

@@ -150,7 +150,8 @@ chasmTestLiving cr w
   where
     tocr = cWorld . lWorld . creatures . ix (_crID cr)
     g = uncurry $ circOnSeg (cr ^. crPos . _xy) (crRad $ cr ^. crType)
-    f = circInPolygon (cr ^. crPos . _xy) (crRad $ cr ^. crType)
+    --f = circInPolygon (cr ^. crPos . _xy) (crRad $ cr ^. crType)
+    f = pointInPoly (cr ^. crPos . _xy)
 
 chasmTestCorpse :: Creature -> World -> World
 chasmTestCorpse cr w
@@ -168,7 +169,8 @@ chasmTestCorpse cr w
   where
     tocr = cWorld . lWorld . creatures . ix (_crID cr)
     g = uncurry $ circOnSeg (cr ^. crPos . _xy) (crRad $ cr ^. crType)
-    f = circInPolygon (cr ^. crPos . _xy) (crRad $ cr ^. crType)
+    --f = circInPolygon (cr ^. crPos . _xy) (crRad $ cr ^. crType)
+    f = pointInPoly (cr ^. crPos . _xy)
 
 chasmRotate :: Creature -> Point2 -> World -> World
 chasmRotate cr v w

src/Dodge/Room/Tutorial.hs

@@ -238,8 +238,8 @@ sqPlatformChasm b a =
 
 sqSpitChasm :: Float -> Float -> ([[Point2]], [[Point2]])
 sqSpitChasm b a =
-    ( --[[ibr, obr, otr, itr], [itr, otr, otl, itl], [itl, otl, obl, ibl]]
+    ( [[ibr, obr, otr, itr], [itr, otr, otl, itl], [itl, otl, obl, ibl]]
-        convexPartition clfs
+--    ( earClip clfs
     , [clfs]
     )
   where

src/Geometry/Polygon.hs

@@ -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
+---- assumes the points go "anticlockwise" around a non-self intersecting shape
-convexPartition :: [Point2] -> [[Point2]]
+--convexPartition :: [Point2] -> [[Point2]]
-convexPartition (x:y:z:[]) = [[x,y,z]]
+--convexPartition (x:y:z:[]) = [[x,y,z]]
-convexPartition (x:y:z:xs)
+--convexPartition (x:y:z:xs)
-    | isLHS x y z = [x,y,z] : convexPartition (x:z:xs)
+--    | isLHS x y z = [x,y,z] : convexPartition (x:z:xs)
-    | otherwise = convexPartition (y:z:xs <> [x])
+--    | otherwise = convexPartition (y:z:xs <> [x])
-convexPartition _ = error "unexpected shape for convexPartition"
+--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!