geom2d-0.1.0.1: Test/Shape.hs

{-# 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