feat(fsharp): m11 pong capstone (model, rules, view, app) with tests
Co-Authored-By: Claude Opus 5.5 <[email protected]>
This commit is contained in:
co-authored by
Claude Opus 5.5
parent
038a375027
commit
1d0b8c3a5c
@@ -0,0 +1,36 @@
|
|||||||
|
/// m11 pong app: the same wiring as App.fs (streams in, drawings out), reusing the course's modules.
|
||||||
|
module Snake.Pong.App
|
||||||
|
|
||||||
|
open Snake
|
||||||
|
open Snake.IO
|
||||||
|
open Snake.Stream
|
||||||
|
open Snake.Pong.Model
|
||||||
|
open Snake.Pong.Rules
|
||||||
|
open Snake.Pong.View
|
||||||
|
|
||||||
|
let FRAME_MS_PONG = 30L
|
||||||
|
|
||||||
|
let private paddleKey (key: string) : Paddle option =
|
||||||
|
match key with
|
||||||
|
| "ArrowUp" | "w" | "W" -> Some Paddle.Up
|
||||||
|
| "ArrowDown" | "s" | "S" -> Some Paddle.Down
|
||||||
|
| _ -> None
|
||||||
|
|
||||||
|
let pongKey (isDown: bool) (key: string) : PongAction option =
|
||||||
|
match paddleKey key with
|
||||||
|
| Some p -> Some(if isDown then PongAction.Press p else PongAction.Release p)
|
||||||
|
| None -> if isDown && (key = "r" || key = "R") then Some PongAction.Restart else None
|
||||||
|
|
||||||
|
let pongActions: Stream<PongAction> =
|
||||||
|
Stream.merge
|
||||||
|
(Stream.merge
|
||||||
|
(Stream.interval FRAME_MS_PONG |> Stream.map (fun _ -> PongAction.Frame))
|
||||||
|
(Stream.keyDowns |> Stream.choose (pongKey true)))
|
||||||
|
(Stream.keyUps |> Stream.choose (pongKey false))
|
||||||
|
|
||||||
|
let pongStates (seed: uint32) (actions: Stream<PongAction>) : Stream<PongState> =
|
||||||
|
actions |> Stream.scan pongUpdate (initialPong seed) |> Stream.startWith (initialPong seed)
|
||||||
|
|
||||||
|
let pongMain () : IO<Stream<IO<unit>>> =
|
||||||
|
IO.randomSeed ()
|
||||||
|
|> IO.map (fun seed -> pongStates seed pongActions |> Stream.map (fun state -> IO.drawScene (pongView state)))
|
||||||
@@ -0,0 +1,75 @@
|
|||||||
|
/// m11 pong model: the same ideas as the snake model, for a different game.
|
||||||
|
module Snake.Pong.Model
|
||||||
|
|
||||||
|
open Snake.Model
|
||||||
|
|
||||||
|
/// The ball's direction of travel, one cell per frame on each axis.
|
||||||
|
type Velocity = { Dx: int; Dy: int }
|
||||||
|
|
||||||
|
/// Which of the player's two keys are being held down right now.
|
||||||
|
type Held = { Up: bool; Down: bool }
|
||||||
|
|
||||||
|
type Score = { Player: int; Cpu: int }
|
||||||
|
|
||||||
|
// RequireQualifiedAccess: write `PongStatus.Playing`, `Paddle.Up`, `PongAction.Frame`, so these cases never get
|
||||||
|
// mixed up with the snake's `Playing`, `Up` and `Frame`.
|
||||||
|
[<RequireQualifiedAccess>]
|
||||||
|
type PongStatus =
|
||||||
|
| Playing
|
||||||
|
| Over
|
||||||
|
|
||||||
|
/// The two keys that move the player's paddle.
|
||||||
|
[<RequireQualifiedAccess>]
|
||||||
|
type Paddle =
|
||||||
|
| Up
|
||||||
|
| Down
|
||||||
|
|
||||||
|
/// A whole match. Positions are in cells: `Ball` is a cell of the 80x50 court; `Player` and `Cpu` are the y of the
|
||||||
|
/// top cell of each paddle. `Seed` is the unsigned 32-bit random seed used to pick the direction of each serve.
|
||||||
|
type PongState =
|
||||||
|
{ Ball: Point
|
||||||
|
Vel: Velocity
|
||||||
|
Player: int
|
||||||
|
Cpu: int
|
||||||
|
Held: Held
|
||||||
|
Score: Score
|
||||||
|
Status: PongStatus
|
||||||
|
Seed: uint32
|
||||||
|
Frame: int }
|
||||||
|
|
||||||
|
/// Everything that can happen in a match, as data.
|
||||||
|
[<RequireQualifiedAccess>]
|
||||||
|
type PongAction =
|
||||||
|
| Press of Paddle
|
||||||
|
| Release of Paddle
|
||||||
|
| Frame
|
||||||
|
| Restart
|
||||||
|
|
||||||
|
// The court, in cells.
|
||||||
|
let W = 80
|
||||||
|
let H = 50
|
||||||
|
|
||||||
|
/// Pixels per cell.
|
||||||
|
let PCELL = 8
|
||||||
|
|
||||||
|
/// Paddle height in cells.
|
||||||
|
let PADDLE = 8
|
||||||
|
|
||||||
|
/// Column of the player's paddle (left) and of the cpu's paddle (right).
|
||||||
|
let PLAYER_X = 2
|
||||||
|
let CPU_X = 77
|
||||||
|
|
||||||
|
/// Points needed to win the match.
|
||||||
|
let WIN = 5
|
||||||
|
|
||||||
|
let initialPong (seed: uint32) : PongState =
|
||||||
|
{ Ball = { X = 40; Y = 25 }
|
||||||
|
Vel = { Dx = 1; Dy = 1 }
|
||||||
|
Player = 21
|
||||||
|
Cpu = 21
|
||||||
|
Held = { Up = false; Down = false }
|
||||||
|
// `Score.Player` says which record is meant: PongState has Player and Cpu fields too.
|
||||||
|
Score = { Score.Player = 0; Cpu = 0 }
|
||||||
|
Status = PongStatus.Playing
|
||||||
|
Seed = seed
|
||||||
|
Frame = 0 }
|
||||||
@@ -0,0 +1,93 @@
|
|||||||
|
/// m11 pong rules: one pure `pongUpdate`, built from small steps that each return a new piece of state.
|
||||||
|
module Snake.Pong.Rules
|
||||||
|
|
||||||
|
open Snake
|
||||||
|
open Snake.Model
|
||||||
|
open Snake.Pong.Model
|
||||||
|
|
||||||
|
let clamp (lo: int) (hi: int) (x: int) : int = min hi (max lo x)
|
||||||
|
|
||||||
|
let private clampPaddle y = clamp 0 (H - PADDLE) y
|
||||||
|
|
||||||
|
let private movePlayer (state: PongState) : int =
|
||||||
|
clampPaddle (state.Player + (if state.Held.Down then 1 else 0) - (if state.Held.Up then 1 else 0))
|
||||||
|
|
||||||
|
// The cpu chases the middle of its paddle toward the ball, one cell every other frame.
|
||||||
|
let private moveCpu (state: PongState) (frame: int) : int =
|
||||||
|
if frame % 2 = 0 then
|
||||||
|
clampPaddle (state.Cpu + sign (state.Ball.Y - PADDLE / 2 - state.Cpu))
|
||||||
|
else
|
||||||
|
state.Cpu
|
||||||
|
|
||||||
|
let private hits (paddle: int) (y: int) = paddle <= y && y < paddle + PADDLE
|
||||||
|
|
||||||
|
type private Scorer =
|
||||||
|
| PlayerScored
|
||||||
|
| CpuScored
|
||||||
|
|
||||||
|
// Where the ball goes next, given the paddles' new positions, and who scored, if anyone.
|
||||||
|
let private moveBall (state: PongState) (player: int) (cpu: int) : Point * Velocity * Scorer option =
|
||||||
|
let ball, vel = state.Ball, state.Vel
|
||||||
|
let wall = ball.Y + vel.Dy < 0 || ball.Y + vel.Dy >= H
|
||||||
|
let dy = if wall then -vel.Dy else vel.Dy
|
||||||
|
let ny = ball.Y + dy
|
||||||
|
let nx = ball.X + vel.Dx
|
||||||
|
|
||||||
|
let bounce =
|
||||||
|
(nx = PLAYER_X && vel.Dx < 0 && hits player ny) || (nx = CPU_X && vel.Dx > 0 && hits cpu ny)
|
||||||
|
|
||||||
|
let scorer =
|
||||||
|
if nx < 0 then Some CpuScored
|
||||||
|
elif nx >= W then Some PlayerScored
|
||||||
|
else None
|
||||||
|
|
||||||
|
({ X = (if bounce then ball.X else nx); Y = ny }, { Dx = (if bounce then -vel.Dx else vel.Dx); Dy = dy }, scorer)
|
||||||
|
|
||||||
|
// After a point the ball restarts in the middle, heading toward whoever conceded; the seed picks up or down.
|
||||||
|
let private serve (state: PongState) (scorer: Scorer) : PongState =
|
||||||
|
let r, seed = Random.run state.Seed Random.nextUint32
|
||||||
|
|
||||||
|
let score =
|
||||||
|
match scorer with
|
||||||
|
| PlayerScored -> { state.Score with Player = state.Score.Player + 1 }
|
||||||
|
| CpuScored -> { state.Score with Cpu = state.Score.Cpu + 1 }
|
||||||
|
|
||||||
|
{ state with
|
||||||
|
Ball = { X = 40; Y = 25 }
|
||||||
|
Vel = { Dx = (if scorer = CpuScored then -1 else 1); Dy = (if r % 2u = 0u then 1 else -1) }
|
||||||
|
Score = score
|
||||||
|
Seed = seed
|
||||||
|
Status = if max score.Player score.Cpu >= WIN then PongStatus.Over else PongStatus.Playing }
|
||||||
|
|
||||||
|
let private frame (state: PongState) : PongState =
|
||||||
|
if state.Status <> PongStatus.Playing then
|
||||||
|
state
|
||||||
|
else
|
||||||
|
let n = state.Frame + 1
|
||||||
|
let player = movePlayer state
|
||||||
|
let cpu = moveCpu state n
|
||||||
|
let ball, vel, scorer = moveBall state player cpu
|
||||||
|
|
||||||
|
let next =
|
||||||
|
{ state with
|
||||||
|
Ball = ball
|
||||||
|
Vel = vel
|
||||||
|
Player = player
|
||||||
|
Cpu = cpu
|
||||||
|
Frame = n }
|
||||||
|
|
||||||
|
match scorer with
|
||||||
|
| Some side -> serve next side
|
||||||
|
| None -> next
|
||||||
|
|
||||||
|
let private setHeld (state: PongState) (key: Paddle) (value: bool) : PongState =
|
||||||
|
match key with
|
||||||
|
| Paddle.Up -> { state with Held = { state.Held with Up = value } }
|
||||||
|
| Paddle.Down -> { state with Held = { state.Held with Down = value } }
|
||||||
|
|
||||||
|
let pongUpdate (state: PongState) (action: PongAction) : PongState =
|
||||||
|
match action with
|
||||||
|
| PongAction.Press key -> setHeld state key true
|
||||||
|
| PongAction.Release key -> setHeld state key false
|
||||||
|
| PongAction.Restart -> initialPong state.Seed
|
||||||
|
| PongAction.Frame -> frame state
|
||||||
@@ -0,0 +1,24 @@
|
|||||||
|
/// m11 pong view: the same Scene shapes as the snake view, so the same drawScene and runtime draw it.
|
||||||
|
module Snake.Pong.View
|
||||||
|
|
||||||
|
open Snake.View
|
||||||
|
open Snake.Pong.Model
|
||||||
|
|
||||||
|
let private text x y str size = Text(x, y, str, "#ffffff", size, "center")
|
||||||
|
|
||||||
|
let private paddle column y = Rect(column * PCELL, y * PCELL, PCELL, PADDLE * PCELL, "#ffffff")
|
||||||
|
|
||||||
|
let private overlay (state: PongState) : Scene =
|
||||||
|
match state.Status with
|
||||||
|
| PongStatus.Over ->
|
||||||
|
[ text 320 200 (if state.Score.Player > state.Score.Cpu then "You Win!" else "CPU Wins") 32
|
||||||
|
text 320 230 "Press R to restart" 16 ]
|
||||||
|
| PongStatus.Playing -> []
|
||||||
|
|
||||||
|
let pongView (state: PongState) : Scene =
|
||||||
|
[ Rect(0, 0, 640, 400, "#111111")
|
||||||
|
paddle PLAYER_X state.Player
|
||||||
|
paddle CPU_X state.Cpu
|
||||||
|
Rect(state.Ball.X * PCELL, state.Ball.Y * PCELL, PCELL, PCELL, "#ffeb3b")
|
||||||
|
text 320 30 $"{state.Score.Player} {state.Score.Cpu}" 24 ]
|
||||||
|
@ overlay state
|
||||||
@@ -18,5 +18,9 @@
|
|||||||
<Compile Include="Input.fs" />
|
<Compile Include="Input.fs" />
|
||||||
<Compile Include="App.fs" />
|
<Compile Include="App.fs" />
|
||||||
<Compile Include="Runtime.fs" />
|
<Compile Include="Runtime.fs" />
|
||||||
|
<Compile Include="Pong/Model.fs" />
|
||||||
|
<Compile Include="Pong/Rules.fs" />
|
||||||
|
<Compile Include="Pong/View.fs" />
|
||||||
|
<Compile Include="Pong/App.fs" />
|
||||||
</ItemGroup>
|
</ItemGroup>
|
||||||
</Project>
|
</Project>
|
||||||
|
|||||||
@@ -0,0 +1,29 @@
|
|||||||
|
/// m11 pong app: the same wiring as App.fs (streams in, drawings out), reusing the course's modules.
|
||||||
|
module Snake.Pong.App
|
||||||
|
|
||||||
|
open Snake
|
||||||
|
open Snake.IO
|
||||||
|
open Snake.Stream
|
||||||
|
open Snake.Pong.Model
|
||||||
|
open Snake.Pong.Rules
|
||||||
|
open Snake.Pong.View
|
||||||
|
|
||||||
|
/// Milliseconds between frames of the match.
|
||||||
|
let FRAME_MS_PONG = 30L
|
||||||
|
|
||||||
|
/// Translate a key event into a `PongAction`, if any. `isDown` is true for a key press, false for a release.
|
||||||
|
/// "ArrowUp"/"w"/"W" -> `Press Paddle.Up` / `Release Paddle.Up`, "ArrowDown"/"s"/"S" -> `Press Paddle.Down` /
|
||||||
|
/// `Release Paddle.Down`, "r"/"R" -> `Restart` (on press only; releasing r does nothing). Any other key -> `None`.
|
||||||
|
let pongKey (isDown: bool) (key: string) : PongAction option = failwith "TODO m11"
|
||||||
|
|
||||||
|
/// Everything that can happen in a match: `Frame` every FRAME_MS_PONG (from `Stream.interval`), merged with the
|
||||||
|
/// `pongKey true key` of every key press and the `pongKey false key` of every key release.
|
||||||
|
/// (The stub is wrapped in `Stream` so the TODO only fires when the stream is stepped.)
|
||||||
|
let pongActions: Stream<PongAction> = Stream(fun _ -> failwith "TODO m11")
|
||||||
|
|
||||||
|
/// Fold the actions into a stream of states: start from `initialPong seed`, `pongUpdate` for each action, emit the initial state first.
|
||||||
|
let pongStates (seed: uint32) (actions: Stream<PongAction>) : Stream<PongState> = failwith "TODO m11"
|
||||||
|
|
||||||
|
/// The whole program as a value, like `App.main`: ask for a seed, turn the stream of states into a stream of drawings
|
||||||
|
/// of `pongView`. A function of `unit`, like `App.main`.
|
||||||
|
let pongMain () : IO<Stream<IO<unit>>> = failwith "TODO m11"
|
||||||
@@ -0,0 +1,68 @@
|
|||||||
|
/// m11 pong model: the same ideas as the snake model, for a different game.
|
||||||
|
module Snake.Pong.Model
|
||||||
|
|
||||||
|
open Snake.Model
|
||||||
|
|
||||||
|
/// The ball's direction of travel, one cell per frame on each axis.
|
||||||
|
type Velocity = { Dx: int; Dy: int }
|
||||||
|
|
||||||
|
/// Which of the player's two keys are being held down right now.
|
||||||
|
type Held = { Up: bool; Down: bool }
|
||||||
|
|
||||||
|
type Score = { Player: int; Cpu: int }
|
||||||
|
|
||||||
|
// RequireQualifiedAccess: write `PongStatus.Playing`, `Paddle.Up`, `PongAction.Frame`, so these cases never get
|
||||||
|
// mixed up with the snake's `Playing`, `Up` and `Frame`.
|
||||||
|
[<RequireQualifiedAccess>]
|
||||||
|
type PongStatus =
|
||||||
|
| Playing
|
||||||
|
| Over
|
||||||
|
|
||||||
|
/// The two keys that move the player's paddle.
|
||||||
|
[<RequireQualifiedAccess>]
|
||||||
|
type Paddle =
|
||||||
|
| Up
|
||||||
|
| Down
|
||||||
|
|
||||||
|
/// A whole match. Positions are in cells: `Ball` is a cell of the 80x50 court; `Player` and `Cpu` are the y of the
|
||||||
|
/// top cell of each paddle. `Seed` is the unsigned 32-bit random seed used to pick the direction of each serve.
|
||||||
|
type PongState =
|
||||||
|
{ Ball: Point
|
||||||
|
Vel: Velocity
|
||||||
|
Player: int
|
||||||
|
Cpu: int
|
||||||
|
Held: Held
|
||||||
|
Score: Score
|
||||||
|
Status: PongStatus
|
||||||
|
Seed: uint32
|
||||||
|
Frame: int }
|
||||||
|
|
||||||
|
/// Everything that can happen in a match, as data.
|
||||||
|
[<RequireQualifiedAccess>]
|
||||||
|
type PongAction =
|
||||||
|
| Press of Paddle
|
||||||
|
| Release of Paddle
|
||||||
|
| Frame
|
||||||
|
| Restart
|
||||||
|
|
||||||
|
// The court, in cells.
|
||||||
|
let W = 80
|
||||||
|
let H = 50
|
||||||
|
|
||||||
|
/// Pixels per cell.
|
||||||
|
let PCELL = 8
|
||||||
|
|
||||||
|
/// Paddle height in cells.
|
||||||
|
let PADDLE = 8
|
||||||
|
|
||||||
|
/// Column of the player's paddle (left) and of the cpu's paddle (right).
|
||||||
|
let PLAYER_X = 2
|
||||||
|
let CPU_X = 77
|
||||||
|
|
||||||
|
/// Points needed to win the match.
|
||||||
|
let WIN = 5
|
||||||
|
|
||||||
|
/// A fresh match: ball at (40, 25) moving `{ Dx = 1; Dy = 1 }`, both paddles at y 21, no keys held,
|
||||||
|
/// score 0 to 0, status Playing, the given seed, frame 0.
|
||||||
|
/// (Hint: PongState also has `Player` and `Cpu` fields, so write the score as `{ Score.Player = 0; Cpu = 0 }`.)
|
||||||
|
let initialPong (seed: uint32) : PongState = failwith "TODO m11"
|
||||||
@@ -0,0 +1,29 @@
|
|||||||
|
/// m11 pong rules: one pure `pongUpdate`.
|
||||||
|
module Snake.Pong.Rules
|
||||||
|
|
||||||
|
open Snake
|
||||||
|
open Snake.Model
|
||||||
|
open Snake.Pong.Model
|
||||||
|
|
||||||
|
/// Keep `x` inside `[lo, hi]`.
|
||||||
|
let clamp (lo: int) (hi: int) (x: int) : int = failwith "TODO m11"
|
||||||
|
|
||||||
|
/// The one function that says how a match changes: `state -> action -> state`.
|
||||||
|
///
|
||||||
|
/// - `Press key` / `Release key`: set `Held.Up` or `Held.Down` to true / false (even when the match is over).
|
||||||
|
/// - `Restart`: `initialPong state.Seed`.
|
||||||
|
/// - `Frame`: unchanged unless status is Playing. Otherwise, in this order:
|
||||||
|
/// 1. `Frame + 1`.
|
||||||
|
/// 2. The player moves one cell down for `Held.Down` and one up for `Held.Up` (both cancel out),
|
||||||
|
/// kept within `[0, H - PADDLE]`.
|
||||||
|
/// 3. When the new `Frame` is even, the cpu moves one cell toward `Ball.Y - PADDLE / 2` (it stays put when it is
|
||||||
|
/// already there), kept within `[0, H - PADDLE]`. It looks at the ball before the ball moves.
|
||||||
|
/// 4. The ball moves vertically: `ny = y + dy`; if `ny < 0 || ny >= H` then `dy` flips and `ny = y + dy`.
|
||||||
|
/// 5. Horizontally: `nx = x + dx`. It bounces (`dx` flips, `nx = x`) when `nx = PLAYER_X`, `dx < 0` and
|
||||||
|
/// `player <= ny < player + PADDLE` (using the player's new position), or when `nx = CPU_X`, `dx > 0` and
|
||||||
|
/// `cpu <= ny < cpu + PADDLE`.
|
||||||
|
/// 6. If `nx < 0` the cpu scores; if `nx >= W` the player scores. A point serves a new ball: position (40, 25),
|
||||||
|
/// `Dx` toward the side that conceded (cpu scored -> -1, player scored -> +1), `Dy = 1` when the value of
|
||||||
|
/// `Random.run seed Random.nextUint32` is even and `-1` otherwise, and the seed advances.
|
||||||
|
/// 7. A score of `WIN` ends the match: status Over.
|
||||||
|
let pongUpdate (state: PongState) (action: PongAction) : PongState = failwith "TODO m11"
|
||||||
@@ -0,0 +1,13 @@
|
|||||||
|
/// m11 pong view: the same Scene shapes as the snake view, so the same drawScene and runtime draw it.
|
||||||
|
module Snake.Pong.View
|
||||||
|
|
||||||
|
open Snake.View
|
||||||
|
open Snake.Pong.Model
|
||||||
|
|
||||||
|
/// Describe the match as shapes, drawn in order (all text is "#ffffff", align "center"):
|
||||||
|
/// background `Rect(0, 0, 640, 400, "#111111")`; the player paddle `Rect(PLAYER_X*8, Player*8, 8, 64, "#ffffff")`,
|
||||||
|
/// then the cpu paddle the same way at CPU_X; the ball `Rect(x*8, y*8, 8, 8, "#ffeb3b")`;
|
||||||
|
/// the score `Text(320, 30, "<player> <cpu>" (three spaces), size 24)`.
|
||||||
|
/// When Over: `Text(320, 200, "You Win!" if the player has more points, else "CPU Wins", size 32)` and
|
||||||
|
/// `Text(320, 230, "Press R to restart", size 16)`.
|
||||||
|
let pongView (state: PongState) : Scene = failwith "TODO m11"
|
||||||
@@ -18,5 +18,9 @@
|
|||||||
<Compile Include="Input.fs" />
|
<Compile Include="Input.fs" />
|
||||||
<Compile Include="App.fs" />
|
<Compile Include="App.fs" />
|
||||||
<Compile Include="Runtime.fs" />
|
<Compile Include="Runtime.fs" />
|
||||||
|
<Compile Include="Pong/Model.fs" />
|
||||||
|
<Compile Include="Pong/Rules.fs" />
|
||||||
|
<Compile Include="Pong/View.fs" />
|
||||||
|
<Compile Include="Pong/App.fs" />
|
||||||
</ItemGroup>
|
</ItemGroup>
|
||||||
</Project>
|
</Project>
|
||||||
|
|||||||
@@ -0,0 +1,148 @@
|
|||||||
|
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")
|
||||||
|
]
|
||||||
@@ -22,6 +22,7 @@
|
|||||||
<Compile Include="M09App.fs" />
|
<Compile Include="M09App.fs" />
|
||||||
<Compile Include="M09Runtime.fs" />
|
<Compile Include="M09Runtime.fs" />
|
||||||
<Compile Include="M10Extensions.fs" />
|
<Compile Include="M10Extensions.fs" />
|
||||||
|
<Compile Include="M11Pong.fs" />
|
||||||
<Compile Include="Purity.fs" />
|
<Compile Include="Purity.fs" />
|
||||||
<Compile Include="Main.fs" />
|
<Compile Include="Main.fs" />
|
||||||
</ItemGroup>
|
</ItemGroup>
|
||||||
|
|||||||
Reference in New Issue
Block a user