Test.hs

---TODO copy
---TODO module

import HGE2D.Types
import HGE2D.Datas
import HGE2D.Classes
import HGE2D.Instances
import HGE2D.Geometry
import HGE2D.Time
import HGE2D.Collision

import Test.Hspec
import Test.QuickCheck
import Control.Exception (evaluate)

main :: IO ()
main = hspec $ do
    describe "Time.hs" $ do
        it "toMilliSeconds" $ do
            toMilliSeconds 0.73     `shouldBe`      (730 :: Int)
            toMilliSeconds 0.0      `shouldBe`      (0 :: Int)
            toMilliSeconds (-10.0)  `shouldBe`      (-10000 :: Int)

    describe "Geometry.hs" $ do
        it "rad2deg" $
            property $ \ x -> x * 180.0 / pi    == rad2deg ( x :: Double)
        it "deg2rad" $
            property $ \x -> x * pi / 180.0     == deg2rad ( x :: Double)

        it "radRealPos" $ do
            radRealPos (0.0, 0.0) (1.0, 0.0)    `shouldBe` (0.0 * pi)
            radRealPos (0.0, 0.0) (0.0, 1.0)    `shouldBe` (0.5 * pi)
            radRealPos (0.0, 0.0) (-1.0, 0.0)   `shouldBe` (1.0 * pi)
            radRealPos (0.0, 0.0) (0.0, -1.0)   `shouldBe` (-0.5 * pi)

        --it "velAngle" $ ---TODO not working
        --    property $ \ x1 y1 x2 y2    -> abs ((radRealPos (x1, y1) (x2, y2)) - (velAngle (x2 - x1, y2 - y1))) < 0.0001

        it "sqrDistance" $
            property $ \ x1 y1 x2 y2 -> distanceSqr (x1,y1) (x2,y2) == (x2 - x1)**2 + (y2 - y1)**2

        it "distance" $
            property $ \ x1 y1 x2 y2 -> (distance (x1,y1) (x2, y2)) == (sqrt $ distanceSqr (x1 :: Double, y1 :: Double) (x2 :: Double, y2 :: Double))

        it "distanceBB" $ --- TODO must also test distance function itself
            property $ \ x y -> distanceBB (x,y) (BoundingBox (0, 0) (10, 10)) == (sqrt $ distanceBBSqr (x :: Double, y :: Double) (BoundingBox (0, 0) (10, 10)))

        it "direction" $ do
            direction ((0.0, 0.0) :: RealPosition) ((1.0, 0.0) :: RealPosition)     `shouldBe` ((1.0, 0.0) :: RealPosition)
            direction ((0.0, 0.0) :: RealPosition) ((2.0, 0.0) :: RealPosition)     `shouldBe` ((1.0, 0.0) :: RealPosition)
            direction ((0.0, 0.0) :: RealPosition) ((0.0, 2.0) :: RealPosition)     `shouldBe` ((0.0, 1.0) :: RealPosition)

        it "closest" $ do
            closest ((0.0, 0.0) :: RealPosition) ([] :: [RealPosition])                         `shouldBe` Nothing
            closest ((0.0, 0.0) :: RealPosition) ([(5.0, 5.0)] :: [RealPosition])               `shouldBe` Just (5.0, 5.0)
            closest ((0.0, 0.0) :: RealPosition) ([(1.0, 1.0), (5.0, 5.0)] :: [RealPosition])   `shouldBe` Just (1.0, 1.0)

        it "furthest" $ do
            furthest ((0.0, 0.0) :: RealPosition) ([] :: [RealPosition])                         `shouldBe` Nothing
            furthest ((0.0, 0.0) :: RealPosition) ([(5.0, 5.0)] :: [RealPosition])               `shouldBe` Just (5.0, 5.0)
            furthest ((0.0, 0.0) :: RealPosition) ([(1.0, 1.0), (5.0, 5.0)] :: [RealPosition])   `shouldBe` Just (5.0, 5.0)

        --- TODO interceptionPos

        it "makeRB" $
            property $ \ center vel width height -> makeRB center vel width height == RigidBody { rigidPos = center, rigidVel = vel, rigidBB = sizedBB center width height }

        it "sizedBB" $
            sizedBB (0.0, 0.0) 10 20 `shouldBe` BoundingBox (-5.0, -10.0) (5.0, 10.0)

        it "sizeBBW" $
            property $ \ center width height -> (abs $ (fst $ sizeBB $ sizedBB center width height) - width) < 0.001

        it "sizeBBH" $
            property $ \ center width height -> (abs $ (snd $ sizeBB $ sizedBB center width height) - height) < 0.001

        it "centerBB" $
            property $ \ center width height -> distance center (centerBB (sizedBB center width height)) < 0.001

        it "bbFromList" $ do
            bbFromList ([] :: [RealPosition])                                       `shouldBe` BBEmpty
            bbFromList ([(0.0, 0.0)] :: [RealPosition])                             `shouldBe` BBEmpty
            bbFromList ([(0.0, 0.0), (1.0, 1.0)] :: [RealPosition])                 `shouldBe` BoundingBox (0.0, 0.0) (1.0, 1.0)
            bbFromList ([(0.0, 0.0), (1.0, 1.0), (1.5, 0.8)] :: [RealPosition])     `shouldBe` BoundingBox (0.0, 0.0) (1.5, 1.0)

        it "mergeBBEmpty" $
            property $ \ minPos maxPos -> mergeBB (BoundingBox minPos maxPos) BBEmpty == (BoundingBox minPos maxPos)

        it "mergeBB" $ do
            mergeBB (BoundingBox (0.0, 5.0) (1.0, 6.0)) (BoundingBox (-5.0, 2.0) (2.0, 12.0)) `shouldBe` (BoundingBox (-5.0, 2.0) (2.0, 12.0))

        it "makeBB" $ ---TODO same as sizedBB (drop one of the functions)
            property $ \ center width height -> makeBB center width height == sizedBB center width height

        it "applyVelocity" $
            property $ \ pos vel time -> applyVelocity pos vel time == (((fst pos) + (fromIntegral time * (fst vel))), ((snd pos) + (fromIntegral time * (snd vel))))

    describe "Collision.hs" $ do
        it "doCollideNull1" $
            property $ \ pMin pMax -> doCollide (BBEmpty) (BoundingBox pMin pMax) == False
        it "doCollideNull2" $
            property $ \ pMin pMax -> doCollide (BoundingBox pMin pMax) (BBEmpty) == False
        it "doCollideSelf" $
            property $ \pMin pMax -> doCollide (BoundingBox pMin pMax) (BoundingBox pMin pMax) == True
        it "doCollide" $ do
            doCollide (BoundingBox (0.0, 0.0) (1.0, 1.0)) (BoundingBox (1.1, 1.1) (2.0, 2.0)) `shouldBe` False
            doCollide (BoundingBox (0.0, 0.0) (1.0, 1.0)) (BoundingBox (0.99, 0.99) (2.0, 2.0)) `shouldBe` True
        it "isInsideNull1" $
            property $ \ pMin pMax -> isInside (BBEmpty) (BoundingBox pMin pMax) == False
        it "isInsideNull2" $
            property $ \ pMin pMax -> isInside (BoundingBox pMin pMax) (BBEmpty) == False
        it "isInside" $ do
            isInside (BoundingBox (0.0, 0.0) (1.0, 1.0)) (BoundingBox (1.1, 1.1) (2.0, 2.0)) `shouldBe` False
            isInside (BoundingBox (0.0, 0.0) (1.0, 1.0)) (BoundingBox (0.99, 0.99) (2.0, 2.0)) `shouldBe` False
            isInside (BoundingBox (0.5, 0.5) (1.0, 1.0)) (BoundingBox (0.0, 0.0) (2.0, 2.0)) `shouldBe` True
        it "isInsideRPNull1" $
            property $ \ p -> isInsideRP (p :: RealPosition) BBEmpty == False
        it "isInsideRP" $ do
            isInsideRP ((0.0, 0.0) :: RealPosition) (BoundingBox (0.5, 0.5) (1.0, 1.0)) `shouldBe` False
            isInsideRP ((0.7, 0.0) :: RealPosition) (BoundingBox (0.5, 0.5) (1.0, 1.0)) `shouldBe` False
            isInsideRP ((0.7, 0.7) :: RealPosition) (BoundingBox (0.5, 0.5) (1.0, 1.0)) `shouldBe` True
        it "doContainNull1" $
            property $ \ pMin pMax -> doContain (BBEmpty) (BoundingBox pMin pMax) == False
        it "doContainNull2" $
            property $ \ pMin pMax -> doContain (BoundingBox pMin pMax) (BBEmpty) == False
        it "doContain" $ do
            doContain (BoundingBox (0.0, 0.0) (1.0, 1.0)) (BoundingBox (1.1, 1.1) (2.0, 2.0)) `shouldBe` False
            doContain (BoundingBox (0.0, 0.0) (1.0, 1.0)) (BoundingBox (0.99, 0.99) (2.0, 2.0)) `shouldBe` False
            doContain (BoundingBox (0.5, 0.5) (1.0, 1.0)) (BoundingBox (0.0, 0.0) (2.0, 2.0)) `shouldBe` True
            doContain (BoundingBox (0.0, 0.0) (2.0, 2.0)) (BoundingBox (0.5, 0.5) (1.0, 1.0)) `shouldBe` True

    describe "RealPosition" $ do
        it "Positioned getX" $
            property $ \ x y -> fst (x,y)       == getX   ( (x,y) :: RealPosition )
        it "Positioned getY" $
            property $ \ x y -> snd (x,y)       == getY   ( (x,y) :: RealPosition )
        it "Positioned getPos" $
            property $ \ x y ->     (x,y)       == getPos ( (x,y) :: RealPosition )

    ---TODO AABBTree
    ---TODO QuadTree
    ---TODO instances