first commit

test/Game-Spec.hs

@@ -0,0 +1,40 @@
+{-# 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 $ newWorld (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 (performAction (Just $ Move d)).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