Improve chasm falls, add ear clipping
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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
@@ -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!
|
||||
|
||||
Reference in New Issue
Block a user