geom2d-0.1.2.0: 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 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