HGE2D 0.1.9.0 → 0.1.9.2
raw patch · 4 files changed
+170/−12 lines, 4 filesdep +QuickCheckdep +hspecPVP ok
version bump matches the API change (PVP)
Dependencies added: QuickCheck, hspec
API changes (from Hackage documentation)
Files
- HGE2D.cabal +10/−1
- src/HGE2D/Collision.hs +17/−10
- src/HGE2D/Geometry.hs +1/−1
- src/tests/Test.hs +142/−0
HGE2D.cabal view
@@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/ name: HGE2D-version: 0.1.9.0+version: 0.1.9.2 synopsis: 2D game engine written in Haskell description: See README and examples/ for further information license: MIT@@ -50,6 +50,15 @@ hs-source-dirs: src default-language: Haskell2010 ghc-options: -O2 -W -fwarn-incomplete-patterns++test-suite test1+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ main-is: Test.hs+ build-depends: base >= 4.8.2.0 && < 5.0, HGE2D, hspec, QuickCheck+ hs-source-dirs: src/tests+ ghc-options: -W -fwarn-incomplete-patterns+ executable example1 default-language: Haskell2010
src/HGE2D/Collision.hs view
@@ -17,8 +17,11 @@ -- | Tests whether two objects collide (overlap in any way) doCollide :: (HasBoundingBox a, HasBoundingBox b) => a -> b -> Bool-doCollide hasBB1 hasBB2 = abs (xcenterthis - xcenterother) < 0.5 * (xsizethis + xsizeother) &&- abs (ycenterthis - ycenterother) < 0.5 * (ysizethis + ysizeother)+doCollide hasBB1 hasBB2 | bb1 == BBEmpty = False+ | bb2 == BBEmpty = False+ | bb1 == bb2 = True+ | otherwise = abs (xcenterthis - xcenterother) < 0.5 * (xsizethis + xsizeother) &&+ abs (ycenterthis - ycenterother) < 0.5 * (ysizethis + ysizeother) where (bb1, bb2) = (getBB hasBB1, getBB hasBB2) (xsizethis, ysizethis) = (fst $ sizeBB bb1, snd $ sizeBB bb1)@@ -37,10 +40,13 @@ -- | Tests whether the first is fully in the second isInside :: (HasBoundingBox a, HasBoundingBox b) => a -> b -> Bool-isInside hasBBIn hasBBOut = (fst minIn) > (fst minOut)- && (snd minIn) > (snd minOut)- && (fst maxIn) < (fst maxOut)- && (snd maxIn) < (snd maxOut)+isInside hasBBIn hasBBOut | bbIn == BBEmpty = False+ | bbOut == BBEmpty = False+ | bbIn == bbOut = True+ | otherwise = (fst minIn) > (fst minOut)+ && (snd minIn) > (snd minOut)+ && (fst maxIn) < (fst maxOut)+ && (snd maxIn) < (snd maxOut) where (bbIn, bbOut) = (getBB hasBBIn, getBB hasBBOut) (minIn, maxIn) = (bbMin bbIn, bbMax bbIn)@@ -50,10 +56,11 @@ -- | Tests whether a position is within the bounding box isInsideRP :: (Positioned a, HasBoundingBox b) => a -> b -> Bool-isInsideRP pos hasBB = (posX > bbLeft)- && (posX < bbRight)- && (posY > bbTop)- && (posY < bbBottom)+isInsideRP pos hasBB | bb == BBEmpty = False+ | otherwise = (posX > bbLeft)+ && (posX < bbRight)+ && (posY > bbTop)+ && (posY < bbBottom) where posX = fst $ getPos pos posY = snd $ getPos pos
src/HGE2D/Geometry.hs view
@@ -84,7 +84,7 @@ -- | Find the furthest in [b] to a furthest :: (Positioned a, Positioned b) => a -> [b] -> Maybe b-furthest a bs = minimumByMay ( \ x y -> compare (distanceSqr a x) (distanceSqr a y) ) bs+furthest a bs = maximumByMay ( \ x y -> compare (distanceSqr a x) (distanceSqr a y) ) bs -- | Given a position and projectile speed of a gun / turret and an object defined by its current position and velocity -- Calculates the position where both will intercept. (useful for pre-aiming)
+ src/tests/Test.hs view
@@ -0,0 +1,142 @@+---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