Work towards convex partition of polygons
This commit is contained in:
@@ -238,10 +238,12 @@ sqPlatformChasm b a =
|
|||||||
|
|
||||||
sqSpitChasm :: Float -> Float -> ([[Point2]], [[Point2]])
|
sqSpitChasm :: Float -> Float -> ([[Point2]], [[Point2]])
|
||||||
sqSpitChasm b a =
|
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]]
|
||||||
, [[ibr, obr, otr, otl, obl, ibl, itl, itr]]
|
convexPartition clfs
|
||||||
|
, [clfs]
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
clfs = [ibr, obr, otr, otl, obl, ibl, itl, itr]
|
||||||
obr = V2 a (-a)
|
obr = V2 a (-a)
|
||||||
obl = V2 (-a) (-a)
|
obl = V2 (-a) (-a)
|
||||||
otl = V2 (-a) a
|
otl = V2 (-a) a
|
||||||
@@ -250,6 +252,12 @@ sqSpitChasm b a =
|
|||||||
ibl = V2 (-b) (-a)
|
ibl = V2 (-b) (-a)
|
||||||
itl = V2 (-b) b
|
itl = V2 (-b) b
|
||||||
itr = V2 b b
|
itr = V2 b b
|
||||||
|
-- otl---------otr
|
||||||
|
-- | itl-itr |
|
||||||
|
-- obr-ibl ibr-obl
|
||||||
|
|
||||||
|
nonConvexChasm :: [Point2] -> PSType
|
||||||
|
nonConvexChasm ps = PutChasm [] [ps]
|
||||||
|
|
||||||
midChasmSpit :: State LayoutVars Room
|
midChasmSpit :: State LayoutVars Room
|
||||||
midChasmSpit = do
|
midChasmSpit = do
|
||||||
@@ -300,13 +308,14 @@ chasmSpitTerminal = do
|
|||||||
, [spanLightI (V2 0 128) (V2 300 128)]
|
, [spanLightI (V2 0 128) (V2 300 128)]
|
||||||
, [spanLightI (V2 300 0) (V2 0 300), sps0 $ putShape $ thinHighBar 95 0 300]
|
, [spanLightI (V2 300 0) (V2 0 300), sps0 $ putShape $ thinHighBar 95 0 300]
|
||||||
]
|
]
|
||||||
gh <- takeOne [55,97]
|
gh <- takeOne [55,75,97]
|
||||||
gird <- takeOne [girderZ gh 30 10,girder gh 30 10,girderV gh 30 10]
|
gird <- takeOne [girderZ gh 30 10,girder gh 30 10,girderV gh 30 10]
|
||||||
dec <- takeOne $ -- replicate 3 [] <>
|
dec <- takeOne $ -- replicate 3 [] <>
|
||||||
[
|
[--[]
|
||||||
[sps0 $ putShape $ gird (V2 30 0) (V2 30 300)
|
-- ,[sps0 $ putShape $ gird (V2 30 0) (V2 30 300)
|
||||||
,sps0 $ putShape $ gird (V2 270 0) (V2 270 300)]
|
-- ,sps0 $ putShape $ gird (V2 270 0) (V2 270 300)]
|
||||||
,[sps0 $ putShape $ gird (V2 0 20) (V2 300 20)]
|
-- ,[sps0 $ putShape $ gird (V2 0 20) (V2 300 20)]
|
||||||
|
[sps0 $ putShape $ gird (V2 0 200) (V2 300 200)]
|
||||||
]
|
]
|
||||||
-- let y' = y & rmPmnts <>~ [l3, l4, l5]
|
-- let y' = y & rmPmnts <>~ [l3, l4, l5]
|
||||||
let y' = y & rmPmnts <>~ ls <> dec
|
let y' = y & rmPmnts <>~ ls <> dec
|
||||||
|
|||||||
@@ -151,6 +151,14 @@ convexHull :: [Point2] -> [Point2]
|
|||||||
convexHull (x : y : z : xs) = grahamScan $ orderAroundFirst $ sortOn (\(V2 a b) -> (b, a)) (x : y : z : xs)
|
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"
|
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"
|
||||||
|
|
||||||
{- | Creates the convex hull of a set of points.
|
{- | Creates the convex hull of a set of points.
|
||||||
assumes no repetition of points: try nubbing!
|
assumes no repetition of points: try nubbing!
|
||||||
-}
|
-}
|
||||||
|
|||||||
Reference in New Issue
Block a user