{-# 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 Geom2d.Translate import Geom2d.Line 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) prop_circle_area_1 :: Float -> Bool prop_circle_area_1 r = area (circle (fromCoords 0 0 :: Point' Float) r) ~== abs r ^ (2::Int) * pi prop_polygon_area_1 :: Float -> Float -> Bool prop_polygon_area_1 a' b' = fromMaybe True $ do rect <- rectangle (fromCoords 0 0 :: Point' Float) a b return (area rect ~== a * b) where a = abs a' b = abs b' prop_shape_area :: Point' Float -> Shape Point' Float -> Bool prop_shape_area v s = area s ~== (area.translate v) s prop_shape_min_max_values :: Shape Point' Float -> Point' Float -> Bool prop_shape_min_max_values s v = minX s + dx ~== minX (translate v s) && maxX s + dx ~== maxX (translate v s) && minY s + dy ~== minY (translate v s) && maxY s + dy ~== maxY (translate v s) where dx = x v dy = y v prop_circle_min_max_values :: Circle Point' Float -> Bool prop_circle_min_max_values circ = minX circ ~== x m - r && maxX circ ~== x m + r && minY circ ~== y m - r && maxY circ ~== y m + r where m = center circ r = radius circ prop_rectangle_min_max_values :: Float -> Float -> Bool prop_rectangle_min_max_values a' b' = fromMaybe True $ do rect <- rectangle (fromCoords 0 0 :: Point' Float) a b return ( minX rect ~== (-a/2) && maxX rect ~== a/2 && minY rect ~== (-b/2) && maxY rect ~== b/2 ) where a = abs a' b = abs b' prop_intersect_finline_circle :: Bool prop_intersect_finline_circle = fromMaybe False $ do line <- mkFinLine (point (-5) 0) (point 5 0) return (circle (point 0 0) 3 `intersect` line && not (circle (point 0 100) 3 `intersect` line)) where point :: Float -> Float -> Point' Float point = fromCoords prop_intersect_finline_polygon :: Bool prop_intersect_finline_polygon = fromMaybe False $ do line <- mkFinLine (point (-5) 0) (point 5 0) rectNotCol <- rectangle (point 0 100) 3 3 rectCol <- rectangle (point 0 0) 2 2 return (rectCol `intersect` line && not (rectNotCol `intersect` line)) where point :: Float -> Float -> Point' Float point = fromCoords return [] runTests = $quickCheckAll main = runTests >>= doExit