108 lines
3.3 KiB
Haskell
108 lines
3.3 KiB
Haskell
--import Test.HUnit
|
|
import Test.Tasty
|
|
import qualified Test.Tasty.QuickCheck as QC
|
|
import Test.Tasty.HUnit
|
|
--import Dodge.Room.CheckConsistency
|
|
--import Geometry
|
|
|
|
--import Dodge.LevelGen.StaticWalls
|
|
import Geometry
|
|
import Data.Maybe
|
|
|
|
main :: IO ()
|
|
main = defaultMain $
|
|
testGroup "Tests"
|
|
[testGroup "Geometry tests" geometryTests
|
|
,testGroup "angleVV" angleVVTests
|
|
]
|
|
|
|
geometryTests :: [TestTree]
|
|
geometryTests =
|
|
[ testGroup "(HUnit)" geometryUnitTests
|
|
, testGroup "(QuickCheck)" geometryQuickCheckTests
|
|
]
|
|
|
|
geometryUnitTests :: [TestTree]
|
|
geometryUnitTests =
|
|
[ testCase "intersectSegSegTest cross intersect" $
|
|
intersectSegSegTest (V2 1 0) (V2 1 2) (V2 0 1) (V2 2 1)
|
|
@?= True
|
|
, testCase "intersectSegSegTest v intersect" $
|
|
intersectSegSegTest (V2 0 0) (V2 1 0) (V2 0 0) (V2 0 1)
|
|
@?= True
|
|
, testCase "intersectSegSegTest miss" $
|
|
intersectSegSegTest (V2 1 0) (V2 1 2) (V2 0 0) (V2 0 2)
|
|
@?= False
|
|
, testCase "circOnSeg endpoint1" $
|
|
circOnSeg (V2 (-1) (-1)) 2 (V2 0 0) (V2 10 10)
|
|
@?= True
|
|
, testCase "circOnSeg endpoint2" $
|
|
circOnSeg (V2 11 10) 2 (V2 0 0) (V2 10 10)
|
|
@?= True
|
|
, testCase "circOnSeg mid" $
|
|
circOnSeg (V2 5 5) 2 (V2 0 0) (V2 10 10)
|
|
@?= True
|
|
, testCase "circOnSeg mid" $
|
|
circOnSeg (V2 5 4) 2 (V2 0 0) (V2 10 10)
|
|
@?= True
|
|
, testCase "circOnSeg miss endpoint1" $
|
|
circOnSeg (V2 (-1) (-1)) 1 (V2 0 0) (V2 10 10)
|
|
@?= False
|
|
, testCase "circOnSeg miss endpoint2" $
|
|
circOnSeg (V2 11 10) 0.9 (V2 0 0) (V2 10 10)
|
|
@?= False
|
|
, testCase "circOnSeg miss mid" $
|
|
circOnSeg (V2 7 3) 0.9 (V2 0 0) (V2 10 10)
|
|
@?= False
|
|
]
|
|
|
|
geometryQuickCheckTests :: [TestTree]
|
|
geometryQuickCheckTests =
|
|
[ QC.testProperty "intersectSegSeg--intersectSegSegTest" $
|
|
\(x1,y1,x2,y2,x3,y3,x4,y4) ->
|
|
isJust (intersectSegSeg (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x4 y4))
|
|
== intersectSegSegTest (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x4 y4)
|
|
]
|
|
|
|
angleVVTests :: [TestTree]
|
|
angleVVTests = [QC.testProperty "random vectors give positive result" $
|
|
\(x,y,a,b) -> 0 <= angleVV (V2 x y) (V2 a b)
|
|
]
|
|
|
|
--nextPair :: Eq a => (a,a) -> [(a,a)] -> [(a,a)]
|
|
--nextPair (_,y) = filter (\(x,_) -> x == y)
|
|
--
|
|
--isLooping :: Eq a => [(a,a)] -> Bool
|
|
--isLooping xs = all (( == 1) . length . flip nextPair xs) xs
|
|
--
|
|
--isLooping' :: Eq a => [(a,a)] -> Bool
|
|
--isLooping' xs = all (f xs) xs
|
|
-- where
|
|
-- f ys (x,y) = length ins == length outs && length rins == length routs
|
|
-- where
|
|
-- ins = filter (\(a,b) -> a == x) ys
|
|
-- outs = filter (\(a,b) -> b == x) ys
|
|
-- rins = filter (\(a,b) -> a == y) ys
|
|
-- routs = filter (\(a,b) -> b == y) ys
|
|
--
|
|
--polygonStrictlyConvex :: [Point2] -> Bool
|
|
--polygonStrictlyConvex ps = True
|
|
--
|
|
--
|
|
--shrinkTris [] = []
|
|
--shrinkTris (x:xs) = xs : map (x :) (shrinkTris xs)
|
|
--
|
|
--genTri = zip <$> trip <*> trip
|
|
-- where
|
|
-- trip = vectorOf 3 $ fromIntegral <$> choose (0,3::Int)
|
|
--
|
|
--genTris = listOf genTri
|
|
|
|
--extractLoops :: Eq a => [(a,a)] -> [[(a,a)]]
|
|
--extractLoops [] = []
|
|
--extractLoops (x:xs) =
|
|
|
|
--
|
|
--[[(0.0,1.0),(3.0,4.0),(5.0,5.0)],[(2.0,0.0),(2.0,4.0),(1.0,1.0)],[(5.0,5.0),(2.0,2.0),(1.0,3.0)]]
|
|
--
|