85 lines
2.5 KiB
Haskell
85 lines
2.5 KiB
Haskell
--import Test.HUnit
|
|
import Test.Tasty
|
|
import Test.Tasty.QuickCheck
|
|
import Test.Tasty.HUnit
|
|
import Dodge.Room.CheckConsistency
|
|
import Geometry
|
|
|
|
import Dodge.LevelGen.StaticWalls
|
|
import Geometry
|
|
|
|
main :: IO ()
|
|
main = defaultMain $
|
|
testGroup "Tests"
|
|
[testGroup "Geometry tests" geometryTests]
|
|
|
|
geometryTests =
|
|
[ 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
|
|
]
|
|
|
|
--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)]]
|
|
--
|