Improve chasm falls, add ear clipping

This commit is contained in:
2026-03-23 19:35:07 +00:00
parent 505ced95bb
commit daba012e83
3 changed files with 33 additions and 11 deletions
+4 -2
View File
@@ -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
+2 -2
View File
@@ -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]]
convexPartition clfs
( [[ibr, obr, otr, itr], [itr, otr, otl, itl], [itl, otl, obl, ibl]]
-- ( earClip clfs
, [clfs]
)
where
+27 -7
View File
@@ -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!