Reorganise geometry modules slightly
This commit is contained in:
+14
-125
@@ -16,16 +16,18 @@ module Geometry
|
||||
, module Geometry.Vector
|
||||
, module Geometry.Vector3D
|
||||
, module Geometry.LHS
|
||||
, module Geometry.Polygon
|
||||
) where
|
||||
import Geometry.Data
|
||||
import Geometry.Polygon
|
||||
import Geometry.Intersect
|
||||
import Geometry.Bezier
|
||||
import Geometry.Vector
|
||||
import Geometry.Vector3D
|
||||
import Geometry.LHS
|
||||
import Geometry.ConvexPoly
|
||||
--import Geometry.ConvexPoly
|
||||
|
||||
import Data.Maybe
|
||||
--import Data.Maybe
|
||||
import Data.List
|
||||
-- | Return a point a distance away from a first point towards a second point.
|
||||
-- Does not go past the second point.
|
||||
@@ -33,65 +35,6 @@ alongSegBy :: Float -> Point2 -> Point2 -> Point2
|
||||
alongSegBy !x !a !b = a +.+ y *.* normalizeV (b -.- a)
|
||||
where
|
||||
y = min x $ dist a b
|
||||
-- | Given a line and a point return the point on the line closest to the
|
||||
-- point.
|
||||
closestPointOnLine
|
||||
:: Point2 -- ^ First line point.
|
||||
-> Point2 -- ^ Second line point.
|
||||
-> Point2 -- ^ Point not on line.
|
||||
-> Point2
|
||||
{-# INLINE closestPointOnLine #-}
|
||||
closestPointOnLine !a !b !p = a +.+ u *.* (b -.- a)
|
||||
where u = closestPointOnLineParam a b p
|
||||
-- | Given a line and a point return a value corresponding to how far along the
|
||||
-- line the point is.
|
||||
closestPointOnLineParam
|
||||
:: Point2 -- ^ First line point.
|
||||
-> Point2 -- ^ Second line point.
|
||||
-> Point2 -- ^ Point not on line.
|
||||
-> Float
|
||||
{-# INLINE closestPointOnLineParam #-}
|
||||
closestPointOnLineParam !a !b !p
|
||||
= (p -.- a) `dotV` (b -.- a) / (b -.- a) `dotV` (b -.- a)
|
||||
-- | Draw a rectangle based on maximal N E S W values.
|
||||
rectNESW :: Float -> Float -> Float -> Float -> [Point2]
|
||||
rectNESW !a !b !c !d = [V2 b a,V2 b c,V2 d c,V2 d a]
|
||||
-- | Draw a rectangle based on maximal N S E W values.
|
||||
rectNSEW :: Float -> Float -> Float -> Float -> [Point2]
|
||||
rectNSEW !n !s !e !w = rectNESW n e s w
|
||||
-- | Draw a rectangle based on maximal N S W E values.
|
||||
rectNSWE :: Float -> Float -> Float -> Float -> [Point2]
|
||||
rectNSWE !n !s !w !e = [V2 w n, V2 w s, V2 e s, V2 e n]
|
||||
-- | Draw a rectangle around the origin with given height and width
|
||||
rectWH :: Float -> Float -> [Point2]
|
||||
rectWH w h = rectNSWE h (-h) (-w) w
|
||||
|
||||
rectXH :: Float -> Float -> [Point2]
|
||||
rectXH x h = rectNSWE h (-h) 0 x
|
||||
|
||||
rectXY :: Float -> Float -> [Point2]
|
||||
rectXY x y = rectNSWE y 0 0 x
|
||||
|
||||
square :: Float -> [Point2]
|
||||
square n = rectWH n n
|
||||
|
||||
mirrorXAxis :: [Point2] -> [Point2]
|
||||
mirrorXAxis ps = orderPolygon $ ps ++ mapMaybe f ps
|
||||
where
|
||||
f (V2 _ 0) = Nothing
|
||||
f (V2 x y) = Just $ V2 x (-y)
|
||||
|
||||
-- | Test whether a point is in a polygon or on the polygon border.
|
||||
-- Supposes the points in the
|
||||
-- polygon are listed in anticlockwise order.
|
||||
pointInOrOnPolygon :: Point2 -> [Point2] -> Bool
|
||||
pointInOrOnPolygon !p (x:xs) = all (\l -> not (uncurry isRHS l p)) $ zip (x:xs) (xs ++ [x])
|
||||
pointInOrOnPolygon _ _ = undefined
|
||||
-- | Test whether a point is strictly inside a polygon.
|
||||
-- Supposes the points in the polygon are listed in anticlockwise order.
|
||||
pointInPolygon :: Point2 -> [Point2] -> Bool
|
||||
pointInPolygon !p (x:xs) = all (\l -> uncurry isLHS l p) $ zip (x:xs) (xs ++ [x])
|
||||
pointInPolygon _ [] = False
|
||||
-- | Debug version of 'pointInPolygon'.
|
||||
errorPointInPolygon :: Int -> Point2 -> [Point2] -> Bool
|
||||
errorPointInPolygon !i !p xs
|
||||
@@ -123,55 +66,6 @@ errorClosestPointOnLineParam :: Int -> Point2 -> Point2 -> Point2 -> Float
|
||||
errorClosestPointOnLineParam _ !x! y! z
|
||||
| x == y = dist x z
|
||||
| otherwise = closestPointOnLineParam x y z
|
||||
orderPolygonAround
|
||||
:: Point2 -- ^ point to order around
|
||||
-> [Point2]
|
||||
-> [Point2]
|
||||
orderPolygonAround _ [] = []
|
||||
orderPolygonAround cen ps = sortOn (\p -> argV (p -.- cen)) ps
|
||||
|
||||
orderAroundFirstReverse :: [Point2] -> [Point2]
|
||||
orderAroundFirstReverse [] = []
|
||||
orderAroundFirstReverse (a:as) = a : reverse (orderPolygonAround a as)
|
||||
|
||||
orderAroundFirst :: [Point2] -> [Point2]
|
||||
orderAroundFirst [] = []
|
||||
orderAroundFirst (a:as) = a : orderPolygonAround a as
|
||||
-- | Reorder points to be anticlockwise around their center.
|
||||
orderPolygon :: [Point2] -> [Point2]
|
||||
orderPolygon [] = []
|
||||
--orderPolygon ps = orderPolygonAround (1/ fromIntegral (length ps) *.* foldr1 (+.+) ps) ps
|
||||
orderPolygon ps = orderPolygonAround (centroid ps) ps
|
||||
-- | Adds a point to a convex polygon.
|
||||
-- If the point is inside, returns the original.
|
||||
-- Points ordered anticlockwise, input not checked.
|
||||
addPointPolygon :: Point2 -> [Point2] -> [Point2]
|
||||
addPointPolygon p ps
|
||||
| pointInOrOnPolygon p ps = ps
|
||||
| otherwise = orderPolygon $ p : ps
|
||||
-- | Creates the convex hull of a set of points.
|
||||
-- Need to verify whether or not this is ordered
|
||||
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"
|
||||
-- | Creates the convex hull of a set of points.
|
||||
-- assumes no repetition of points: try nubbing!
|
||||
convexHullSafe :: [Point2] -> [Point2]
|
||||
--convexHullSafe (x:y:z:xs) = grahamScan $ orderAroundFirst $ sortOn (\(V2 a b) -> (b,a)) (x:y:z:xs)
|
||||
convexHullSafe (x:y:z:xs) = grahamScan $ orderAroundFirst $ sortOn (\(V2 a b) -> (b,a)) (x:y:z:xs)
|
||||
convexHullSafe _ = []
|
||||
|
||||
grahamScan :: [Point2] -> [Point2]
|
||||
grahamScan = foldr push []
|
||||
where
|
||||
push point stack = grahamEliminate (point:stack)
|
||||
-- | Remove second element if top three elements are not counterclockwise.
|
||||
-- Repeat if necessary. See
|
||||
-- https://codereview.stackexchange.com/questions/206019/graham-scan-algorithm-in-haskell
|
||||
grahamEliminate :: [Point2] -> [Point2]
|
||||
grahamEliminate (x:y:z:xs)
|
||||
| not $ isLHS x y z = grahamEliminate (x:z:xs)
|
||||
grahamEliminate xs = xs
|
||||
|
||||
-- | Return midpoint between two points.
|
||||
pHalf :: Point2 -> Point2 -> Point2
|
||||
@@ -302,19 +196,14 @@ ssaTriPoint' pa pb pc' bc
|
||||
= Just $ ssaTriPoint pa pb pc' bc
|
||||
-- | A potential correction of 'ssaTriPoint'.
|
||||
-- This should be tested and benchmarked.
|
||||
ssaTriPointCorrect :: Point2 -> Point2 -> Point2 -> Float -> Maybe Point2
|
||||
ssaTriPointCorrect pa pb pc' bc
|
||||
| param <= 1 && param >= 0 = Just p
|
||||
| otherwise = Nothing
|
||||
where
|
||||
p = ssaTriPoint pa pb pc' bc
|
||||
param = closestPointOnLineParam pa pc' p
|
||||
-- | Given a segment and external point, find the closest point on the segment.
|
||||
closestPointOnSeg :: Point2 -> Point2 -> Point2 -> Point2
|
||||
closestPointOnSeg segP1 segP2 p
|
||||
| errorClosestPointOnLineParam 3 segP1 segP2 p <= 0 = segP1
|
||||
| errorClosestPointOnLineParam 4 segP1 segP2 p >= 1 = segP2
|
||||
| otherwise = errorClosestPointOnLine 2 segP1 segP2 p
|
||||
--ssaTriPointCorrect :: Point2 -> Point2 -> Point2 -> Float -> Maybe Point2
|
||||
--ssaTriPointCorrect pa pb pc' bc
|
||||
-- | param <= 1 && param >= 0 = Just p
|
||||
-- | otherwise = Nothing
|
||||
-- where
|
||||
-- p = ssaTriPoint pa pb pc' bc
|
||||
-- param = closestPointOnLineParam pa pc' p
|
||||
|
||||
-- | Return Just a point if it is inside a circle, Nothing otherwise.
|
||||
pointInCircle :: Point2 -> Float -> Point2 -> Maybe Point2
|
||||
pointInCircle p r c
|
||||
@@ -335,8 +224,8 @@ collidePointCirc'' :: Point2 -> Point2 -> Float -> Point2 -> Maybe (Point2,Float
|
||||
collidePointCirc'' p1 p2 rad c = (,) <$> collidePointCirc p1 p2 rad c
|
||||
<*> collidePointCirc' p1 p2 rad c
|
||||
-- | As 'collidePointCirc', but uses the supposedly correct version of ssaTriPoint.
|
||||
collidePointCircCorrect :: Point2 -> Point2 -> Float -> Point2 -> Maybe Point2
|
||||
collidePointCircCorrect p1 p2 rad c = ssaTriPointCorrect p2 c p1 rad
|
||||
--collidePointCircCorrect :: Point2 -> Point2 -> Float -> Point2 -> Maybe Point2
|
||||
--collidePointCircCorrect p1 p2 rad c = ssaTriPointCorrect p2 c p1 rad
|
||||
-- | Finds the height of a triangle using herons formula.
|
||||
-- The base is the line between the first two points.
|
||||
heron :: Point2 -> Point2 -> Point2 -> Float
|
||||
|
||||
Reference in New Issue
Block a user