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="App.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>
|
||||
</Project>
|
||||
|
||||
Reference in New Issue
Block a user