58 lines
1.5 KiB
Haskell
58 lines
1.5 KiB
Haskell
import Test.QuickCheck
|
|
import Test.HUnit
|
|
import Dodge.Room.CheckConsistency
|
|
|
|
import Dodge.LevelGen.StaticWalls
|
|
import Geometry
|
|
|
|
main :: IO ()
|
|
main = do
|
|
putStrLn "Running tests:"
|
|
quickCheck prop_looping
|
|
|
|
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
|
|
|
|
--prop_looping :: [Point2] -> [WallP] -> Bool
|
|
|
|
prop_looping = forAllShrink genTris shrinkTris $ \tris ->
|
|
not (any ( \[a,b,c] -> isOnSeg a b c
|
|
|| isOnSeg a c b
|
|
|| isOnSeg b c a
|
|
) tris)
|
|
==> isLooping' (foldr cutWalls' [] tris)
|
|
|
|
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)]]
|
|
--
|
|
testRoom rm = TestCase "Room links connected" (linksOnPath rm)
|