149 lines
6.7 KiB
FSharp
149 lines
6.7 KiB
FSharp
module Snake.Tests.M11Pong
|
|
|
|
open System.Text.Json
|
|
open Expecto
|
|
open Snake
|
|
open Snake.Model
|
|
open Snake.Stream
|
|
open Snake.Pong.Model
|
|
open Snake.Pong.Rules
|
|
open Snake.Pong.View
|
|
open Snake.Pong.App
|
|
open Snake.Tests.Fixtures
|
|
open Snake.Tests.M09Helpers
|
|
|
|
let private pongStatus (v: JsonElement) : PongStatus =
|
|
match str v with
|
|
| "Playing" -> PongStatus.Playing
|
|
| "Over" -> PongStatus.Over
|
|
| other -> failwith $"unknown pong status: {other}"
|
|
|
|
let private pongState (v: JsonElement) : PongState =
|
|
let vel = prop "vel" v
|
|
let held = prop "held" v
|
|
let score = prop "score" v
|
|
|
|
{ Ball = point (prop "ball" v)
|
|
Vel = { Dx = num (prop "dx" vel); Dy = num (prop "dy" vel) }
|
|
Player = num (prop "player" v)
|
|
Cpu = num (prop "cpu" v)
|
|
Held = { Up = bool (prop "up" held); Down = bool (prop "down" held) }
|
|
Score = { Score.Player = num (prop "player" score); Cpu = num (prop "cpu" score) }
|
|
Status = pongStatus (prop "status" v)
|
|
Seed = u32 (prop "seed" v)
|
|
Frame = num (prop "frame" v) }
|
|
|
|
// `Paddle` only has Up and Down, so a JSON key like "constructor" decodes to None instead of crashing.
|
|
let private paddle (v: JsonElement) : Paddle option =
|
|
match str v with
|
|
| "Up" -> Some Paddle.Up
|
|
| "Down" -> Some Paddle.Down
|
|
| _ -> None
|
|
|
|
/// Decode a PongAction; `None` when its key is not a `Paddle` (such an action cannot even be built in F#).
|
|
let private pongAction (v: JsonElement) : PongAction option =
|
|
match str (prop "tag" v) with
|
|
| "Press" -> paddle (prop "key" v) |> Option.map PongAction.Press
|
|
| "Release" -> paddle (prop "key" v) |> Option.map PongAction.Release
|
|
| "Frame" -> Some PongAction.Frame
|
|
| "Restart" -> Some PongAction.Restart
|
|
| other -> failwith $"unknown pong action tag: {other}"
|
|
|
|
let private undecodable (e: JsonElement) : PongAction = failwith $"undecodable expected action: {e}"
|
|
|
|
[<Tests>]
|
|
let tests =
|
|
testList "M11 Pong" [
|
|
yield! fixtureTests "m11-pong-update" "pongUpdate" (fun c ->
|
|
let state = pongState (arg 0 c)
|
|
|
|
match pongAction (arg 1 c) with
|
|
| Some action -> Expect.equal (pongUpdate state action) (pongState (expected c)) "pongUpdate"
|
|
// An unknown key is ruled out by the types: Paddle has no such case. What the fixture asks for
|
|
// (state unchanged) therefore holds by construction; check that it says so.
|
|
| None -> Expect.equal (pongState (expected c)) state "an unknown key changes nothing")
|
|
|
|
yield! fixtureTests "m11-pong-view" "pongView" (fun c ->
|
|
Expect.equal (pongView (pongState (arg 0 c))) (list shape (expected c)) "pongView")
|
|
|
|
yield! fixtureTests "m11-pong-key" "pongKey" (fun c ->
|
|
let expectedAction = opt (fun e -> pongAction e |> Option.defaultWith (fun () -> undecodable e)) (expected c)
|
|
Expect.equal (pongKey (bool (arg 0 c)) (str (arg 1 c))) expectedAction "pongKey")
|
|
|
|
testCase "the court is 80 by 50 cells of 8 pixels, with 8-cell paddles" (fun () ->
|
|
Expect.equal [ W; H; PCELL; PADDLE; PLAYER_X; CPU_X; WIN ] [ 80; 50; 8; 8; 2; 77; 5 ] "constants")
|
|
|
|
testCase "initialPong puts the ball in the middle, both paddles centred, and nobody ahead" (fun () ->
|
|
Expect.equal
|
|
(initialPong 5u)
|
|
{ Ball = { X = 40; Y = 25 }
|
|
Vel = { Dx = 1; Dy = 1 }
|
|
Player = 21
|
|
Cpu = 21
|
|
Held = { Up = false; Down = false }
|
|
Score = { Score.Player = 0; Cpu = 0 }
|
|
Status = PongStatus.Playing
|
|
Seed = 5u
|
|
Frame = 0 }
|
|
"initialPong")
|
|
|
|
testCase "clamp keeps a number inside [lo, hi]" (fun () ->
|
|
Expect.equal [ clamp 0 42 -1; clamp 0 42 17; clamp 0 42 43 ] [ 0; 17; 42 ] "clamp")
|
|
|
|
testCase "pongUpdate does not modify the state it is given" (fun () ->
|
|
let s = initialPong 0u
|
|
pongUpdate s PongAction.Frame |> ignore
|
|
Expect.equal s (initialPong 0u) "unchanged")
|
|
|
|
// 3000 frames with no one touching the keys: the ball must always stay on the court and the match must end.
|
|
testCase "an idle match stays on the court and ends once someone reaches five" (fun () ->
|
|
let states = List.replicate 3000 PongAction.Frame |> List.scan pongUpdate (initialPong 3u)
|
|
|
|
Expect.all states (fun s -> s.Ball.Y >= 0 && s.Ball.Y < H && s.Ball.X >= 0 && s.Ball.X < W) "ball on court"
|
|
|
|
Expect.all
|
|
states
|
|
(fun s -> s.Player >= 0 && s.Player <= H - PADDLE && s.Cpu >= 0 && s.Cpu <= H - PADDLE)
|
|
"paddles on court"
|
|
|
|
let last = List.last states
|
|
Expect.equal last.Status PongStatus.Over "match over"
|
|
Expect.equal (max last.Score.Player last.Score.Cpu) WIN "winner has five")
|
|
|
|
testCase "the clock runs every 30 ms" (fun () -> Expect.equal FRAME_MS_PONG 30L "FRAME_MS_PONG")
|
|
|
|
testCase "pongActions turns the clock into Frames and keys into Press, Release and Restart" (fun () ->
|
|
Expect.equal
|
|
(Stream.run
|
|
[ Time 30L; KeyDown "ArrowUp"; KeyUp "ArrowUp"; KeyDown "s"; KeyDown "r"; KeyUp "r"; KeyDown "x"; Time 90L ]
|
|
pongActions)
|
|
[ PongAction.Frame
|
|
PongAction.Press Paddle.Up
|
|
PongAction.Release Paddle.Up
|
|
PongAction.Press Paddle.Down
|
|
PongAction.Restart
|
|
PongAction.Frame
|
|
PongAction.Frame ]
|
|
"actions")
|
|
|
|
testCase "pongStates starts with the new match, then yields one state per action" (fun () ->
|
|
let out = pongStates 42u pongActions |> Stream.run [ Time 30L; KeyDown "w"; Time 60L ]
|
|
Expect.equal (List.length out) 4 "length"
|
|
Expect.equal (List.head out) (initialPong 42u) "first state"
|
|
Expect.equal (out |> List.map (fun s -> s.Frame)) [ 0; 1; 1; 2 ] "frames"
|
|
Expect.equal (out |> List.map (fun s -> s.Held.Up)) [ false; false; true; true ] "held up"
|
|
Expect.equal out[3].Player 20 "player moved up")
|
|
|
|
testCase "pongMain asks for a seed, draws the new match first, and then the updated one" (fun () ->
|
|
let traced = IO.trace 42u (pongMain ())
|
|
Expect.equal traced.Ops [ IO.RandomSeed ] "ops"
|
|
let first, next = Stream.step (Time 0L) traced.Result
|
|
let second, _ = Stream.step (Time 30L) next
|
|
Expect.equal (drawn (List.head first)) (pongView (initialPong 42u)) "first drawing"
|
|
|
|
Expect.equal
|
|
(drawn (List.head second))
|
|
(pongView (pongUpdate (initialPong 42u) PongAction.Frame))
|
|
"second drawing")
|
|
]
|