Skip to content
{{ message }}

# Tarrasch / Hong

Switch branches/tags
Nothing to show

Cannot retrieve contributors at this time
70 lines (59 sloc) 2.71 KB
 -- | This module tests the Hong game, all tests are pure (no side effects). -- The reason why the tests take some seconds to run is simply that -- we must have a high sampling rate in order to ensure to logic is -- correct, and thus we also must look at many samples which takes time. {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} module HongTest (specs) where import Test.Hspec import Test.Hspec.HUnit () import Fal import GameState import UserControl import HongConstants run :: State -> [State] run s0 = runBehavior (pong' s0 uc) (repeat Nothing, [0, 0.002..]) ever, never :: (State -> Bool) -> [State] -> Bool ever f ss = any f \$ take 20000 ss never f = not . ever f outside :: State -> Bool outside s = abs (xPosition s) > (planeHalfWidth + epsilon) || abs (yPosition s) > (planeHalfHeight + epsilon) alwaysInside :: [State] -> Bool alwaysInside = never outside specs :: Spec specs = describe "Hong" \$ do it "tests the test framework" True describe "bounces on walls" \$ do let ss = run startState{ xVelocity = 0 } it "always have ball inside" \$ alwaysInside ss it "bounces roof" \$ ever (\s -> yVelocity s < 0) ss it "bounces floor" \$ ever (\s -> yPosition s < 0 && yVelocity s > 0) ss describe "bounces on paddles" \$ do let ss = run startState{ yVelocity = 0 } it "keeps bouncing" \$ alwaysInside ss it "bounces on right paddle" \$ ever (\s -> xVelocity s < 0) ss it "bounces on left paddle" \$ ever (\s -> xPosition s < 0 && xVelocity s > 0) ss describe "avoids bounces when paddle not present" \$ do let s0 = startState { yVelocity = 0 , leftPaddle = 1000 , rightPaddle = (-1000) } let ss = run s0{ xVelocity = 1 } in it "no bounce on right paddle" \$ ever (\s -> xPosition s > 2*planeHalfWidth) ss let ss = run s0{ xVelocity = (-1) } in it "no bounce on left paddle" \$ ever (\s -> xPosition s < (-2)*planeHalfWidth) ss describe "paddles move correctly" \$ do let ts = [0.01..] ucl = lift1 (signum . (10-)) time ucr = lift1 (negate . signum . (10-)) time uc = lift2 UserControl ucl ucr ss = runBehavior (pong' startState uc) (repeat Nothing, ts) maxHeight = highestPaddlePoint + epsilon it "can move left paddle" \$ ever (\s -> leftPaddle s > planeHalfHeight/2) ss it "can move right paddle" \$ ever (\s -> rightPaddle s > planeHalfHeight/2) ss it "has bounded left paddle" \$ never (\s -> abs (leftPaddle s) > maxHeight) ss it "has bounded right paddle" \$ never (\s -> abs (rightPaddle s) > maxHeight) ss