41 lines
1.4 KiB
Haskell
41 lines
1.4 KiB
Haskell
{-# Language TypeSynonymInstances #-}
|
|
{-# Language FlexibleInstances #-}
|
|
import GameLogic
|
|
import GameTypes
|
|
import Test.QuickCheck
|
|
import Test.Framework.Providers.QuickCheck2 (testProperty)
|
|
import Test.Framework.Runners.Console (defaultMain)
|
|
import Linear
|
|
import Control.Monad
|
|
import Data.Map
|
|
import Control.Lens hiding (elements)
|
|
import Data.Maybe
|
|
|
|
instance Arbitrary World where
|
|
arbitrary = do
|
|
dx <- choose (4, 100)
|
|
dy <- choose (4, 100)
|
|
my <- choose (1, dy-1)
|
|
mx <- choose (1, dx-1)
|
|
hy <- choose (1, dy-1)
|
|
hx <- choose (1, dx-1) `suchThat` (\hx -> mx /= hx || my /= hy)
|
|
return $ newWorldWithBoss (V2 hx hy) (V2 mx my) (dx, dy)
|
|
|
|
type Step = V2 Integer
|
|
|
|
instance Arbitrary Step where
|
|
arbitrary = elements (V2 <$> [-1,0,1] <*> [-1,0,1]) `suchThat` ((==1).quadrance)
|
|
|
|
bewegungProp1 :: World -> Step -> Property
|
|
bewegungProp1 world d =
|
|
and ((world^.entities.to findMax._1.to (subtract d) - world^.heroPos)^..each.to (> 0)) &&
|
|
(world^.entities.at (world^.heroPos + d)^?_Just._Floor)^.to isJust ==>
|
|
world^.to (flip performAction (Move $ d^.to fromVector)).heroPos == (world^.heroPos)
|
|
|
|
bewegungTest1 = testProperty "Bewegung Test 1" bewegungProp1 -- FIXME: I think I'm broken. What's wrong with me?
|
|
|
|
tests = [bewegungTest1]
|
|
|
|
main :: IO ()
|
|
main = defaultMain tests
|