--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] geometryTests = [ testGroup "(HUnit)" geometryUnitTests , testGroup "(QuickCheck)" geometryQuickCheckTests ] 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 0 0) (V2 10 10) (V2 (-1) (-1)) 2 @?= True , testCase "circOnSeg endpoint2" $ circOnSeg (V2 0 0) (V2 10 10) (V2 11 10) 2 @?= True , testCase "circOnSeg mid" $ circOnSeg (V2 0 0) (V2 10 10) (V2 5 5) 2 @?= True , testCase "circOnSeg mid" $ circOnSeg (V2 0 0) (V2 10 10) (V2 5 4) 2 @?= True , testCase "circOnSeg miss endpoint1" $ circOnSeg (V2 0 0) (V2 10 10) (V2 (-1) (-1)) 1 @?= False , testCase "circOnSeg miss endpoint2" $ circOnSeg (V2 0 0) (V2 10 10) (V2 11 10) 0.9 @?= False , testCase "circOnSeg miss mid" $ circOnSeg (V2 0 0) (V2 10 10) (V2 7 3) 0.9 @?= False ] 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) ] --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)]] --