diff --git a/src/Dodge/Creature/Update.hs b/src/Dodge/Creature/Update.hs index 342e853a7..674dcb64d 100644 --- a/src/Dodge/Creature/Update.hs +++ b/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 diff --git a/src/Dodge/Room/Tutorial.hs b/src/Dodge/Room/Tutorial.hs index 73c3ac23b..026da54f1 100644 --- a/src/Dodge/Room/Tutorial.hs +++ b/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]] - convexPartition clfs + ( [[ibr, obr, otr, itr], [itr, otr, otl, itl], [itl, otl, obl, ibl]] +-- ( earClip clfs , [clfs] ) where diff --git a/src/Geometry/Polygon.hs b/src/Geometry/Polygon.hs index b6b7125ec..310a4ef3d 100644 --- a/src/Geometry/Polygon.hs +++ b/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 -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!