{-# LANGUAGE TemplateHaskell #-} import Data.AEq import Data.Fixed import Data.Maybe import Geom2d.Distance import Geom2d.Intersect import Geom2d.Point import Geom2d.Rotation import Geom2d.Shape import Geom2d.Shape.Internal import Test.QuickCheck import Test.Utils prop_circle_radius :: Point' Float -> Float -> Bool prop_circle_radius m r = radius (mkCircleInt m r) ~== abs r prop_circle_rotate_1 :: Bool prop_circle_rotate_1 = rotate 5 circ == circ where circ :: Shape Point' Float circ = circle (fromCoords 0 0) 4 prop_circle_rotate_2 :: Point' Float -> Bool prop_circle_rotate_2 m = let circ = circle m 1 in angle circ ~== angle m prop_circle_center :: Point' Float -> Float -> Bool prop_circle_center m r = center (mkCircleInt m r) ~== m prop_distance_circle_point :: Bool prop_distance_circle_point = distance (mkCircleInt (fromCoords 0 0 :: Point' Float) 1) (fromCoords 5 0 :: Point' Float) ~== 4 prop_point_in_circle :: Bool prop_point_in_circle = let circ :: Circle Point' Float circ = mkCircleInt (fromCoords 0 0) 1 p :: Point' Float p = fromCoords 0 0 in circ `intersect` p && p `intersect` circ prop_intersect_circle_circle :: Circle Point' Float -> Circle Point' Float -> Bool prop_intersect_circle_circle a b = intersect a b == ( distance (center a) (center b) <= radius a + radius b ) prop_point_outside_circle :: Bool prop_point_outside_circle = let circ :: Shape Point' Float circ = circle (fromCoords 0 0) 1 p :: Point' Float p = fromCoords 2 0 in not (circ `intersect` p) || not (p `intersect` circ) prop_point_in_polygon :: Bool prop_point_in_polygon = maybe False ( intersect (fromCoords 0 0::Point' Float) ) ( rectangle (fromCoords 0 0::Point' Float) 1 1 ) prop_point_outside_polygon :: Bool prop_point_outside_polygon = maybe False ( not.intersect (fromCoords 10 0::Point' Float) ) ( rectangle (fromCoords 0 0::Point' Float) 1 1 ) prop_point_outside_polygon_1 :: Bool prop_point_outside_polygon_1 = maybe False ( not.intersect (fromCoords (-5) 0 :: Point' Float)) ( rectangle (fromCoords 0 5 :: Point' Float) 4 4) prop_intersect_polygon_circle_1 :: Bool prop_intersect_polygon_circle_1 = maybe False ( intersect (circle (fromCoords 0 0 :: Point' Float) 1 )) ( rectangle (fromCoords 0 0 :: Point' Float) 4 4 ) prop_intersect_polygon_circle_2 :: Bool prop_intersect_polygon_circle_2 = maybe False ( (intersect :: Shape Point' Float -> Shape Point' Float -> Bool) (circle (fromCoords 0 5 :: Point' Float) 4 )) ( rectangle (fromCoords 0 0 :: Point' Float) 4 4 ) -- | This test make a rectangleInt (-9,-9) (11,11) and a circle (10,15) -- with radius 2. so these shapes should not intersect. prop_intersect_polygon_circle_3 :: Bool prop_intersect_polygon_circle_3 = maybe False ( not. (intersect :: Shape Point' Float -> Shape Point' Float -> Bool) (circle (fromCoords 10 15 :: Point' Float) 2 )) ( rectangle (fromCoords 10 10 :: Point' Float) 1 1 ) prop_intersect_polygon_1 :: Bool prop_intersect_polygon_1 = fromMaybe False $ intersect <$> rectangle (fromCoords 0 0 :: Point' Float) 1 3 <*> rectangle (fromCoords 1 2 :: Point' Float) 3 1 prop_intersect_polygon_eq :: Polygon Point' Float -> Bool prop_intersect_polygon_eq p = p `intersect` p prop_polygon_convexHull_1 :: Bool prop_polygon_convexHull_1 = fromMaybe False $ do shape <- convexHull' [ fromCoords (-1) (-1) :: Point' Float , fromCoords 1 (-1) , fromCoords 1 1 , fromCoords (-1) 1 ] return ( shape `intersect` point 1 1 && shape `intersect` point (-1) 1 && shape `intersect` point 1 (-1) && shape `intersect` point (-1) (-1)) where point :: Float -> Float -> Point' Float point = fromCoords prop_polygon_convexHull_2 :: Bool prop_polygon_convexHull_2 = fromMaybe False $ do shape <- convexHull' points return (all (intersect shape) points) where points = [ point 5 5 , point 7 4 , point 8 3 , point 10 20 , point 2 20 , point 5 5 ] point :: Float -> Float -> Point' Float point = fromCoords prop_polygon_rotate :: Polygon Point' Float -> Bool prop_polygon_rotate p = fromMaybe True $ do angBefore <- angle p angAfter <- angle (rotate rotAng p) return (normalize (angBefore + rotAng) ~== angAfter) where rotAng = 1 normalize = subtract pi.(`mod'` (2*pi)).(+pi) prop_polygon_rotate_defined :: Bool prop_polygon_rotate_defined = fromMaybe False $ do rect <- rectangle (fromCoords 1 0 :: Point' Float) 1 1 ang <- angle rect return (ang ~== 0) return [] runTests = $quickCheckAll main = runTests >>= doExit