module Geom2d.Shape.Internal
( Circle (..)
, mkCircleInt
, radius
, center
, Polygon (..)
, convexHull'
, rectangleInt
, Shape (..)
)
where
import Data.Function
import Data.List hiding (intersect)
import Data.Maybe
import Geom2d.Distance
import Geom2d.Intersect
import Geom2d.Line.Internal
import Geom2d.Point
import Geom2d.Point.Internal
import Geom2d.Rotation
import Geom2d.Translate
import Test.QuickCheck
data Circle p a = Circle (p a) a deriving (Show,Read,Eq)
instance (Point p, Distance p p) => Distance (Circle p) p where
distance (Circle m r) p =
max (distance m p r) 0
instance (Point p, Distance p p) => Distance p (Circle p) where
distance = flip distance
instance (Floating a, Ord a, Distance p p) =>
Intersect (Circle p a) (p a) where
intersect (Circle m r) p
| distance m p <= r = True
| otherwise = False
instance (Floating a, Ord a, Distance p p) =>
Intersect (p a) (Circle p a) where
intersect = flip intersect
instance (Floating a, Ord a, Distance p p) =>
Intersect (Circle p a) (Circle p a) where
intersect (Circle m1 r1) (Circle m2 r2) =
distance m1 m2 <= r1 + r2
instance (Arbitrary a, Arbitrary (p a), Ord a, Num a) =>
Arbitrary (Circle p a) where
arbitrary = Circle <$> arbitrary <*>
(arbitrary `suchThat`(>0))
instance (Rotation p, Point p) => Rotation (Circle p) where
angle (Circle m _) = angle m
rotate ang (Circle m r) = Circle (rotate ang m) r
mkCircleInt :: (Num a) => p a -> a -> Circle p a
mkCircleInt m r' = Circle m (abs r')
radius :: Circle p a -> a
radius (Circle _ r) = r
center :: Circle p a -> p a
center (Circle m _) = m
data Polygon p a =
Polygon (p a) [p a]
deriving (Show,Read,Eq)
instance (Point p, Fractional a, Num (p a), Eq (p a), Ord a) =>
Intersect (p a) (Polygon p a) where
intersect p (Polygon m vs) =
any (`pointInTriangle` p) triangles
where triangles = map (\(a,b) -> (m,a,b))
( zip verteces (tail verteces ++ [head verteces]))
verteces = map (+ m) vs
instance (Point p, Fractional a, Num (p a), Eq (p a), Ord a) =>
Intersect (Polygon p a) (p a) where
intersect = flip intersect
instance ( Arbitrary (p a), Num (p a), RealFloat a, Point p, Scale p
, Eq (p a)) =>
Arbitrary (Polygon p a) where
arbitrary = do
vs' <- listOf1 (arbitrary `suchThat` (\a -> magnitude a > 0)) `suchThat`
((>= 4).length)
(return.fromJust.convexHull') vs'
instance (Eq (p a), Floating a, Num (p a), Ord a, Point p) =>
Intersect (Polygon p a) (Circle p a) where
intersect poly@(Polygon p vs') (Circle m r)
| m `intersect` poly = True
| otherwise =
any ((r >=). distance m)
verteces
where verteces = zipWith FinLine
vs
(tail vs ++ [head vs])
vs = map (p+) vs'
instance (Eq (p a), Num (p a), RealFloat a, Point p) =>
Intersect (Polygon p a) (Polygon p a) where
intersect poly1@(Polygon p1 vs1) poly2@(Polygon p2 vs2) =
let verts1 = map (p1+) vs1
verts2 = map (p2+) vs2
edges1 = zipWith FinLine verts1 (tail verts1 ++ [head verts1])
edges2 = zipWith FinLine verts2 (tail verts2 ++ [head verts2])
in any (uncurry intersect)
[ (v1,v2) | v1 <- edges1, v2 <- edges2 ] ||
any (intersect poly2) verts1 ||
any (intersect poly1) verts2
instance (Eq (p a), Floating a, Num (p a), Ord a, Point p) =>
Intersect (Circle p a) (Polygon p a) where
intersect = flip intersect
instance (Rotation p) => Rotation (Polygon p) where
rotate r (Polygon m vs) = Polygon (rotate r m) (map (rotate r) vs)
angle (Polygon m _) = angle m
convexHull' :: forall p a.
(Num (p a), Fractional a, Ord a, Scale p, Point p) =>
[p a] -> Maybe (Polygon p a)
convexHull' [] = Nothing
convexHull' [_] = Nothing
convexHull' [_,_] = Nothing
convexHull' ps = Just $
Polygon middle (map (subtract middle) hull)
where middle :: p a
middle = (1 / (fromIntegral.length) hull) `scale`
sum hull
hull :: [p a]
hull = chain sortedPs
chain :: [p a] -> [p a]
chain xs = lower ++ upper
where lower = go [] xs
upper = go [] (reverse xs)
go :: [p a] -> [p a] -> [p a]
go acc@(r1:r2:rs) (x:xs)
| clockwise r2 r1 x = go (r2:rs) (x:xs)
| otherwise = go (x:acc) xs
go acc (x:xs) = go (x:acc) xs
go acc [] = reverse $ tail acc
sortedPs :: [p a]
sortedPs = sortBy
(\p q ->
case compare (x p) (x q) of
EQ -> compare (y p) (y q)
c -> c
) ps
clockwise :: p a -> p a -> p a -> Bool
clockwise o a b = (a o) `cross` (b o) <= 0
rectangleInt :: forall p a. (Point p, RealFloat a, Eq a, Translate p
, Rotation p) =>
p a
-> a
-> a
-> Maybe (Polygon p a)
rectangleInt m a b
| a == 0 || b == 0 = Nothing
| otherwise =
Just $
Polygon
m
( sortBy
(compare `on` angle)
[ fromCoords (negate a/2) (negate b/2) :: p a
, fromCoords (a/2) (negate b/2) :: p a
, fromCoords (a/2) (b/2) :: p a
, fromCoords (negate a/2) (b/2) :: p a
]
)
data Shape p a = ShapeCircle (Circle p a)
| ShapePolygon (Polygon p a)
deriving (Show,Read,Eq)
instance ( Ord a, Distance p p, Eq (p a)
, Num (p a), Point p, RealFloat a) =>
Intersect (Shape p a) (Shape p a) where
intersect (ShapeCircle c) (ShapePolygon p) = c `intersect` p
intersect (ShapePolygon p) (ShapeCircle c) = c `intersect` p
intersect (ShapeCircle a) (ShapeCircle b) = a `intersect` b
intersect (ShapePolygon a) (ShapePolygon b) = a `intersect` b
instance ( Floating a, Eq (p a), Num (p a), Ord a, Point p, Distance p p ) =>
Intersect (Shape p a) (p a) where
intersect (ShapeCircle c) p = c `intersect` p
intersect (ShapePolygon c) p = c `intersect` p
instance ( Floating a, Eq (p a), Num (p a), Ord a, Point p, Distance p p ) =>
Intersect (p a) (Shape p a) where
intersect = flip intersect
instance (Rotation p, Point p) => Rotation (Shape p) where
rotate a (ShapeCircle s) = ShapeCircle (rotate a s)
rotate a (ShapePolygon s) = ShapePolygon (rotate a s)
angle (ShapeCircle s) = angle s
angle (ShapePolygon s) = angle s