feat(course): audit fixes and twelve extensions (Modules 7b, 12, 13)
Audit pass: - Frame rule counts frames since the last move, so every step lasts exactly movesEvery(score) frames, also right after a speed-up - clampTime + MAX_GAP_MS: a hidden tab no longer replays the whole gap - Pong Restart keeps held keys - Fact corrections (mulberry32 output coverage, Haskell IO, uniform) - New fixture cases from a mutation analysis Extensions (all three tracks, shared fixtures, course text): - Turn queue (Exercise 10.6), persisted high score (10.7), replay viewer (10.8), play() end-to-end helper (9.5) - Optional State (4.7) and optional Module 7b, stack-safe IO - Module 12, property-based testing with generators, shrinking, invariants and a model-based oracle - Module 13, Conway's Life with a Click event - JS type checking via jsconfig, JSDoc and types.d.ts - Maintainer tools: scripts/mutate.mjs, scripts/typecheck-js.sh, Playwright end-to-end suite (e2e/, scripts/e2e.sh) Docs: docs/contract.md is the canonical contract; specs and build log under docs/superpowers. Verified: JS 728, Scala 689, F# 691 unit tests; stubs and progression M01-M13 and M07b; 176 end-to-end tests on Chromium and WebKit. Co-Authored-By: Claude Fable 5.2 <noreply@anthropic.com>
This commit is contained in:
1 parent
876f5aabb1
commit
edd57f0148
253 files changed
+21753
-503
No files matched your search
+2
-1
@@ -1,7 +1,8 @@
|
||||
#!/usr/bin/env bash
|
||||
# Usage: ./build-web.sh
|
||||
# Compiles src/ + web/ to JavaScript with Fable (a local dotnet tool, see .config/dotnet-tools.json) into web/dist/.
|
||||
# index.html loads the Snake entry module, pong.html the Pong one.
|
||||
# index.html loads the Snake entry module (web/dist/SnakeMain.js), pong.html the Pong one (PongMain.js), replay.html the
|
||||
# replay viewer (ReplayMain.js, m10) and life.html Conway's Life (LifeMain.js, m13).
|
||||
# Then serve the repo root (node scripts/serve.mjs) and open http://localhost:8000/fsharp/index.html.
|
||||
set -euo pipefail
|
||||
cd "$(dirname "$0")"
|
||||
|
||||
@@ -0,0 +1,22 @@
|
||||
<!doctype html>
|
||||
<html lang="en">
|
||||
<head>
|
||||
<meta charset="utf-8">
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1">
|
||||
<title>Pure Life</title>
|
||||
<link rel="icon" href="data:,">
|
||||
<style>
|
||||
body { margin: 0; min-height: 100vh; display: flex; flex-direction: column; align-items: center;
|
||||
justify-content: center; gap: 12px; background: #1b1b1b; color: #ddd; font: 14px system-ui, sans-serif; }
|
||||
h1 { margin: 0; font-size: 20px; }
|
||||
canvas { background: #111111; border: 2px solid #333; cursor: crosshair; }
|
||||
p { margin: 0; color: #999; }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<h1>Pure Life</h1>
|
||||
<canvas id="game" width="640" height="504"></canvas>
|
||||
<p>Click a cell to switch it on or off. Space runs and pauses, N steps one generation, R fills the board at random, C clears it.</p>
|
||||
<script type="module" src="web/dist/LifeMain.js"></script>
|
||||
</body>
|
||||
</html>
|
||||
@@ -0,0 +1,22 @@
|
||||
<!doctype html>
|
||||
<html lang="en">
|
||||
<head>
|
||||
<meta charset="utf-8">
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1">
|
||||
<title>Pure Snake replay</title>
|
||||
<link rel="icon" href="data:,">
|
||||
<style>
|
||||
body { margin: 0; min-height: 100vh; display: flex; flex-direction: column; align-items: center;
|
||||
justify-content: center; gap: 12px; background: #1b1b1b; color: #ddd; font: 14px system-ui, sans-serif; }
|
||||
h1 { margin: 0; font-size: 20px; }
|
||||
canvas { background: #111111; border: 2px solid #333; }
|
||||
p { margin: 0; color: #999; }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<h1>Pure Snake: replay</h1>
|
||||
<canvas id="game" width="400" height="400"></canvas>
|
||||
<p>Right / D next step, Left / A previous, Home / End first / last, Space plays (Module 10, Exercise 10.8).</p>
|
||||
<script type="module" src="web/dist/ReplayMain.js"></script>
|
||||
</body>
|
||||
</html>
|
||||
+45
-2
@@ -2,11 +2,14 @@
|
||||
module Snake.App
|
||||
|
||||
open Snake.Model
|
||||
open Snake.View
|
||||
open Snake.IO
|
||||
open Snake.Stream
|
||||
|
||||
let TICK_MS = 150L
|
||||
let FRAME_MS = 25L
|
||||
// m10: the longest step of time the game accepts at once; a longer silence (a background tab) counts as this much.
|
||||
let MAX_GAP_MS = 250L
|
||||
|
||||
// Everything that can happen to the game: a Tick every TICK_MS, and an action for each bound key.
|
||||
let classicActions: Stream<Action> =
|
||||
@@ -22,7 +25,47 @@ let states (seed: uint32) (actions: Stream<Action>) : Stream<GameState> =
|
||||
|
||||
let render (state: GameState) : IO<unit> = IO.drawScene (View.view state)
|
||||
|
||||
// The whole program as a value: get a seed, then turn the stream of states into a stream of drawings.
|
||||
// m10: a session wraps the game with the best score so far. GameState, update and view do not know about it.
|
||||
// `Improved` says whether the action that produced this session raised the best, which is when it must be saved.
|
||||
type Session = { Game: GameState; Best: int; Improved: bool }
|
||||
|
||||
let sessionUpdate (session: Session) (action: Action) : Session =
|
||||
let game = Game.update session.Game action
|
||||
let best = max session.Best game.Score
|
||||
{ Game = game; Best = best; Improved = best > session.Best }
|
||||
|
||||
// The same running fold as `states`, one level up.
|
||||
let sessions (seed: uint32) (best: int) (actions: Stream<Action>) : Stream<Session> =
|
||||
let s0 = { Game = Spawn.newGame seed; Best = best; Improved = false }
|
||||
actions |> Stream.scan sessionUpdate s0 |> Stream.startWith s0
|
||||
|
||||
// The game's picture with the best score at the top right, level with the score on the left.
|
||||
let sessionView (session: Session) : Scene =
|
||||
View.view session.Game
|
||||
@ [ Text(session.Game.Width * CELL - 6, 18, $"Best: {session.Best}", "#ffffff", 16, "right") ]
|
||||
|
||||
// Draw, and save the best only on the action that raised it.
|
||||
let renderSession (session: Session) : IO<unit> =
|
||||
if session.Improved then
|
||||
IO.sequence [ IO.drawScene (sessionView session); IO.saveBest session.Best ]
|
||||
else
|
||||
IO.drawScene (sessionView session)
|
||||
|
||||
// The whole program as a value: get a seed, then the stored best, then turn the stream of sessions into a stream
|
||||
// of drawings. clampTime wraps the whole stream, so everything inside it sees the clamped clock.
|
||||
// Nothing runs here; Runtime interprets it.
|
||||
let main () : IO<Stream<IO<unit>>> =
|
||||
IO.randomSeed () |> IO.map (fun seed -> states seed speedActions |> Stream.map render)
|
||||
IO.randomSeed ()
|
||||
|> IO.bind (fun seed ->
|
||||
IO.loadBest ()
|
||||
|> IO.map (fun best -> sessions seed best speedActions |> Stream.map renderSession |> Stream.clampTime MAX_GAP_MS))
|
||||
|
||||
// m09: the whole program in one equality. For each drawing that `main` emits while fed `events`, the ops it
|
||||
// performs, answered by the pure interpreter (`seed` for RandomSeed, and from m10 `best` for LoadBest).
|
||||
let playWith (seed: uint32) (best: int) (events: Event list) (main: IO<Stream<IO<unit>>>) : Op list list =
|
||||
(IO.traceWith seed best main).Result
|
||||
|> Stream.run events
|
||||
|> List.map (fun io -> (IO.traceWith seed best io).Ops)
|
||||
|
||||
// The Module 9 helper is the "no stored best" case.
|
||||
let play (seed: uint32) (events: Event list) (main: IO<Stream<IO<unit>>>) : Op list list = playWith seed 0 events main
|
||||
@@ -0,0 +1,170 @@
|
||||
/// m12 check: property-based testing built from the course's own parts.
|
||||
/// A generator of test data is nothing new: it is a `Random<'a>` from Random.fs (`seed -> (value, nextSeed)`).
|
||||
module Snake.Check
|
||||
|
||||
open Snake.Model
|
||||
open Snake.Random
|
||||
|
||||
/// What `forAll` reports: every value passed, or the first one that did not.
|
||||
type CheckResult<'a> =
|
||||
| Passed of runs: int
|
||||
| Failed of run: int * seed: uint32 * value: 'a
|
||||
|
||||
/// One of the elements of the non-empty list `xs`: the one at index `intBelow (List.length xs)`.
|
||||
let elementOf (xs: 'a list) : Random<'a> =
|
||||
Random.intBelow (List.length xs) |> Random.map (fun i -> List.item i xs)
|
||||
|
||||
/// `n` values drawn from `gen`, one after another; the seed is threaded from each draw to the next.
|
||||
let rec listOf (n: int) (gen: Random<'a>) : Random<'a list> =
|
||||
if n <= 0 then
|
||||
Random.pure []
|
||||
else
|
||||
gen |> Random.bind (fun a -> listOf (n - 1) gen |> Random.map (fun rest -> a :: rest))
|
||||
|
||||
// Ticks appear three times so that the snake moves more often than it turns.
|
||||
let private actionPool: Action list =
|
||||
[ Tick; Tick; Tick; Turn Up; Turn Down; Turn Left; Turn Right ]
|
||||
|
||||
/// A generator of `n` random actions (given).
|
||||
let genActions (n: int) : Random<Action list> = listOf n (elementOf actionPool)
|
||||
|
||||
/// Check `prop` on `runs` values drawn from `gen`, starting from `seed`; stop at the first value that fails.
|
||||
/// Recursion carries the seed: no counter, no loop variable. `go` calls itself last, so it runs in constant stack.
|
||||
let forAll (runs: int) (seed: uint32) (prop: 'a -> bool) (gen: Random<'a>) : CheckResult<'a> =
|
||||
let rec go (i: int) (s: uint32) : CheckResult<'a> =
|
||||
if i >= runs then
|
||||
Passed runs
|
||||
else
|
||||
let value, next = Random.run s gen
|
||||
if prop value then go (i + 1) next else Failed(i, s, value)
|
||||
|
||||
go 0 seed
|
||||
|
||||
/// Every list that is `xs` with exactly one element removed, in the order of the removed index.
|
||||
let removals (xs: 'a list) : 'a list list = xs |> List.mapi (fun i _ -> List.removeAt i xs)
|
||||
|
||||
/// Keep removing one element for as long as the list still fails; the result is 1-minimal.
|
||||
let rec minimize (fails: 'a list -> bool) (xs: 'a list) : 'a list =
|
||||
match List.tryFind fails (removals xs) with
|
||||
| Some smaller -> minimize fails smaller
|
||||
| None -> xs
|
||||
|
||||
let private neighbours (a: Point, b: Point) : bool = abs (a.X - b.X) + abs (a.Y - b.Y) = 1
|
||||
|
||||
let rec private allDifferent (ps: Point list) : bool =
|
||||
match ps with
|
||||
| [] -> true
|
||||
| p :: rest -> not (Util.contains rest p (=)) && allDifferent rest
|
||||
|
||||
// Each invariant: its name, and a predicate that is true when the state is fine.
|
||||
// `Option.forall` is true for `None`: no apple breaks nothing.
|
||||
let private invariants: (string * (GameState -> bool)) list =
|
||||
[ "snake-not-empty", (fun s -> not (List.isEmpty s.Snake))
|
||||
"snake-in-bounds", (fun s -> s.Snake |> List.forall (Rules.inBounds s))
|
||||
"snake-no-overlap", (fun s -> allDifferent s.Snake)
|
||||
"snake-connected", (fun s -> s.Snake |> List.pairwise |> List.forall neighbours)
|
||||
"apple-in-bounds", (fun s -> s.Apple |> Option.forall (Rules.inBounds s))
|
||||
"apple-not-on-snake", (fun s -> s.Apple |> Option.forall (fun a -> not (Util.contains s.Snake a (=))))
|
||||
"turn-not-reversed", (fun s -> s.NextDir <> opposite s.Dir)
|
||||
"queued-not-reversed", (fun s -> s.Queued |> Option.forall (fun q -> q <> opposite s.NextDir)) ]
|
||||
|
||||
/// The names of the invariants that `state` breaks, in the order of the table above.
|
||||
let violations (state: GameState) : string list =
|
||||
invariants |> List.filter (fun (_, holds) -> not (holds state)) |> List.map fst
|
||||
|
||||
/// The numbers of states between consecutive moves of the snake's head.
|
||||
let moveGaps (states: GameState list) : int list =
|
||||
let moved =
|
||||
states
|
||||
|> List.pairwise
|
||||
|> List.indexed
|
||||
|> List.filter (fun (_, (before, after)) -> List.tryHead after.Snake <> List.tryHead before.Snake)
|
||||
|> List.map (fun (i, _) -> i + 1)
|
||||
|
||||
moved |> List.pairwise |> List.map (fun (a, b) -> b - a)
|
||||
|
||||
// ---- random states (Exercise 12.6) and a second implementation of the step as an oracle (Exercise 12.7)
|
||||
|
||||
let private directions: Direction list = [ Up; Down; Left; Right ]
|
||||
|
||||
// The direction the head moved in to get from the second cell to the first (`Right` for a one-cell snake).
|
||||
let private headingOf (snake: Point list) : Direction =
|
||||
match snake with
|
||||
| head :: second :: _ -> directions |> List.find (fun d -> Rules.move second d = head)
|
||||
| _ -> Right
|
||||
|
||||
/// A random snake, head first: a random head, then a random walk that never leaves the board or crosses itself.
|
||||
let genSnake (width: int) (height: int) (maxLen: int) : Random<Point list> =
|
||||
// Extend `snake` at its tail by up to `left` more cells, each a random free in-bounds neighbour of the last cell.
|
||||
let rec grow (snake: Point list) (left: int) : Random<Point list> =
|
||||
if left <= 0 then
|
||||
Random.pure snake
|
||||
else
|
||||
let last = List.last snake
|
||||
|
||||
let options =
|
||||
directions
|
||||
|> List.map (Rules.move last)
|
||||
|> List.filter (fun p ->
|
||||
p.X >= 0 && p.X < width && p.Y >= 0 && p.Y < height && not (Util.contains snake p (=)))
|
||||
|
||||
if List.isEmpty options then
|
||||
Random.pure snake
|
||||
else
|
||||
elementOf options |> Random.bind (fun p -> grow (snake @ [ p ]) (left - 1))
|
||||
|
||||
Random.intBelow width
|
||||
|> Random.bind (fun x -> Random.intBelow height |> Random.bind (fun y -> grow [ { X = x; Y = y } ] (maxLen - 1)))
|
||||
|
||||
/// A random sane Playing state on a `width` x `height` board (given).
|
||||
let genState (width: int) (height: int) : Random<GameState> =
|
||||
Random.intBelow (width * height)
|
||||
|> Random.bind (fun n ->
|
||||
genSnake width height (n + 1)
|
||||
|> Random.bind (fun snake ->
|
||||
let dir = headingOf snake
|
||||
|
||||
let state =
|
||||
{ Width = width
|
||||
Height = height
|
||||
Snake = snake
|
||||
Dir = dir
|
||||
NextDir = dir
|
||||
Apple = None
|
||||
Seed = 0u
|
||||
Score = 0
|
||||
Status = Playing
|
||||
Frame = 0
|
||||
Queued = None }
|
||||
|
||||
let free = Spawn.freeCells state
|
||||
|
||||
elementOf (directions |> List.filter (fun d -> d <> opposite dir))
|
||||
|> Random.bind (fun nextDir ->
|
||||
Random.intBelow 2
|
||||
|> Random.bind (fun coin ->
|
||||
(if coin = 0 || List.isEmpty free then Random.pure None else elementOf free |> Random.map Some)
|
||||
|> Random.map (fun apple -> { state with NextDir = nextDir; Apple = apple })))))
|
||||
|
||||
/// The step of m03, written from the rules instead of from `advance`: build the snake the step would give,
|
||||
/// then ask `violations` whether that snake is on the board and does not overlap itself.
|
||||
let advanceSpec (state: GameState) : GameState =
|
||||
if state.Status <> Playing then
|
||||
state
|
||||
else
|
||||
let head = Rules.move (List.head state.Snake) state.NextDir
|
||||
let eating = state.Apple = Some head
|
||||
let snake = head :: (if eating then state.Snake else Util.dropLast state.Snake)
|
||||
|
||||
let broken =
|
||||
violations { state with Snake = snake }
|
||||
|> List.exists (fun v -> v = "snake-in-bounds" || v = "snake-no-overlap")
|
||||
|
||||
if broken then
|
||||
{ state with Dir = state.NextDir; Status = GameOver }
|
||||
else
|
||||
{ state with
|
||||
Snake = snake
|
||||
Dir = state.NextDir
|
||||
Apple = if eating then None else state.Apple
|
||||
Score = state.Score + (if eating then 1 else 0) }
|
||||
@@ -1,19 +1,40 @@
|
||||
/// m05 game: one `update` turns every action into a new state; replaying a game is a fold over its actions.
|
||||
/// m10 adds pause, restart and a frame clock that speeds up as the score grows.
|
||||
/// m10 adds pause, restart, a frame counter that makes the snake speed up as the score grows, and a turn queue.
|
||||
module Snake.Game
|
||||
|
||||
open Snake.Model
|
||||
|
||||
/// What `update` does with `Turn dir` from m10 on. With no turn pending (`NextDir = Dir`) it is the m03 `Rules.turn`.
|
||||
/// With a turn pending, a key that is neither `NextDir` nor its opposite is remembered in `Queued`
|
||||
/// (replacing an earlier one) and taken on the step after; any other key changes nothing.
|
||||
let steer (state: GameState) (dir: Direction) : GameState =
|
||||
if state.Status <> Playing then state
|
||||
elif state.NextDir = state.Dir then Rules.turn state dir
|
||||
elif dir <> state.NextDir && dir <> opposite state.NextDir then { state with Queued = Some dir }
|
||||
else state
|
||||
|
||||
// After a step: a game still in play takes the queued turn, if there is one. It is always a legal turn, because the
|
||||
// step just made `Dir` equal to the old `NextDir`, and `Queued` is neither that nor its opposite.
|
||||
let private takeQueued (state: GameState) : GameState =
|
||||
match state.Queued with
|
||||
| Some d when state.Status = Playing -> { state with NextDir = d; Queued = None }
|
||||
| _ -> state
|
||||
|
||||
// One game step as `update` takes it: `Spawn.tick`, then the queued turn.
|
||||
let private step (state: GameState) : GameState = takeQueued (Spawn.tick state)
|
||||
|
||||
/// How many frames pass between game steps: 8 at first, one fewer every 3 points, never fewer than 2.
|
||||
let movesEvery (score: int) : int = max 2 (8 - score / 3)
|
||||
|
||||
// One animation frame: count it, and every `movesEvery score`-th frame run a game step.
|
||||
// One animation frame. `Frame` counts the frames since the snake last moved; when it reaches
|
||||
// `movesEvery Score` the count starts again and the game takes a step. Counting from the last move
|
||||
// (not from the start of the game) keeps every step exactly `movesEvery` frames long, also right after a speed-up.
|
||||
let private frame (state: GameState) : GameState =
|
||||
if state.Status <> Playing then
|
||||
state
|
||||
else
|
||||
let counted = { state with Frame = state.Frame + 1 }
|
||||
if counted.Frame % movesEvery counted.Score = 0 then Spawn.tick counted else counted
|
||||
let n = state.Frame + 1
|
||||
if n >= movesEvery state.Score then step { state with Frame = 0 } else { state with Frame = n }
|
||||
|
||||
// Pause and resume only make sense in those two statuses; a finished game stays finished.
|
||||
let private togglePause (state: GameState) : GameState =
|
||||
@@ -26,8 +47,8 @@ let private togglePause (state: GameState) : GameState =
|
||||
// Every case is listed (no `| _ ->`): adding an Action later makes the compiler point here.
|
||||
let update (state: GameState) (action: Action) : GameState =
|
||||
match action with
|
||||
| Tick -> Spawn.tick state
|
||||
| Turn dir -> Rules.turn state dir
|
||||
| Tick -> step state
|
||||
| Turn dir -> steer state dir
|
||||
| TogglePause -> togglePause state
|
||||
| Restart -> Spawn.newGame state.Seed
|
||||
| Frame -> frame state
|
||||
|
||||
+25
-4
@@ -9,11 +9,16 @@ open Snake.View
|
||||
type Op =
|
||||
| Draw of Shape
|
||||
| RandomSeed
|
||||
// m10: the stored best score, read and written.
|
||||
| LoadBest
|
||||
| SaveBest of int
|
||||
|
||||
/// What the outside world answers: `Done` for a `Draw`, `Seed value` for a `RandomSeed`.
|
||||
/// What the outside world answers: `Done` for a `Draw` or a `SaveBest`, `Seed value` for a `RandomSeed`,
|
||||
/// `Best value` for a `LoadBest`.
|
||||
type OpResult =
|
||||
| Done
|
||||
| Seed of uint32
|
||||
| Best of int
|
||||
|
||||
type IO<'a> =
|
||||
| Pure of 'a
|
||||
@@ -47,13 +52,24 @@ let randomSeed () : IO<uint32> =
|
||||
|> map (fun result ->
|
||||
match result with
|
||||
| Seed value -> value
|
||||
| Done -> failwith "RandomSeed must be answered with a Seed")
|
||||
| _ -> failwith "RandomSeed must be answered with a Seed")
|
||||
|
||||
let drawScene (scene: Scene) : IO<unit> = sequence (List.map draw scene)
|
||||
|
||||
// m10: the stored best score. Reading it answers a number (built like randomSeed); saving answers Done, like a draw.
|
||||
let loadBest () : IO<int> =
|
||||
effect LoadBest
|
||||
|> map (fun result ->
|
||||
match result with
|
||||
| Best value -> value
|
||||
| _ -> failwith "LoadBest must be answered with a Best")
|
||||
|
||||
let saveBest (score: int) : IO<unit> = effect (SaveBest score) |> map ignore
|
||||
|
||||
// Answer each op with a canned result, collecting the ops as we go. Tail recursion: the compiler turns it
|
||||
// into a loop, so long programs cannot overflow the stack, and still nothing is mutated.
|
||||
let trace (seed: uint32) (io: IO<'a>) : Traced<'a> =
|
||||
// `best` (m10) answers LoadBest, the way `seed` answers RandomSeed.
|
||||
let traceWith (seed: uint32) (best: int) (io: IO<'a>) : Traced<'a> =
|
||||
let rec go io performed =
|
||||
match io with
|
||||
| Pure a -> { Result = a; Ops = List.rev performed }
|
||||
@@ -61,8 +77,13 @@ let trace (seed: uint32) (io: IO<'a>) : Traced<'a> =
|
||||
let answer =
|
||||
match op with
|
||||
| RandomSeed -> Seed seed
|
||||
| Draw _ -> Done
|
||||
| LoadBest -> Best best
|
||||
| Draw _
|
||||
| SaveBest _ -> Done
|
||||
|
||||
go (k answer) (op :: performed)
|
||||
|
||||
go io []
|
||||
|
||||
// The Module 7 interpreter is the "no stored best" case.
|
||||
let trace (seed: uint32) (io: IO<'a>) : Traced<'a> = traceWith seed 0 io
|
||||
@@ -0,0 +1,44 @@
|
||||
/// m13 life app: the same wiring as Snake and Pong, with a third kind of input, the mouse.
|
||||
module Snake.Life.App
|
||||
|
||||
open Snake
|
||||
open Snake.Model
|
||||
open Snake.IO
|
||||
open Snake.Stream
|
||||
open Snake.Life.Model
|
||||
open Snake.Life.Rules
|
||||
open Snake.Life.View
|
||||
|
||||
let GEN_MS = 150L
|
||||
|
||||
let lifeKey (key: string) : LifeAction option =
|
||||
match key with
|
||||
| " " -> Some LifeAction.TogglePause
|
||||
| "n" | "N" -> Some LifeAction.Step
|
||||
| "c" | "C" -> Some LifeAction.Clear
|
||||
| "r" | "R" -> Some LifeAction.Randomize
|
||||
| _ -> None
|
||||
|
||||
// Integer division rounds towards zero (-1 / 16 = 0), so the pixel is checked before dividing.
|
||||
let lifeClick (x: int) (y: int) : LifeAction option =
|
||||
if x >= 0 && y >= 0 && x / LCELL < LW && y / LCELL < LH then
|
||||
Some(LifeAction.Toggle { X = x / LCELL; Y = y / LCELL })
|
||||
else
|
||||
None
|
||||
|
||||
let lifeActions: Stream<LifeAction> =
|
||||
Stream.merge
|
||||
(Stream.merge
|
||||
(Stream.interval GEN_MS |> Stream.map (fun _ -> LifeAction.Frame))
|
||||
(Stream.keyDowns |> Stream.choose lifeKey))
|
||||
(Stream.clicks |> Stream.choose (fun (x, y) -> lifeClick x y))
|
||||
|
||||
let lifeStates (seed: uint32) (actions: Stream<LifeAction>) : Stream<LifeState> =
|
||||
actions |> Stream.scan lifeUpdate (initialLife seed) |> Stream.startWith (initialLife seed)
|
||||
|
||||
let lifeMain () : IO<Stream<IO<unit>>> =
|
||||
IO.randomSeed ()
|
||||
|> IO.map (fun seed ->
|
||||
lifeStates seed lifeActions
|
||||
|> Stream.map (fun state -> IO.drawScene (lifeView state))
|
||||
|> Stream.clampTime App.MAX_GAP_MS)
|
||||
@@ -0,0 +1,32 @@
|
||||
/// m13 life model: the whole world is one value, like the snake and the match.
|
||||
module Snake.Life.Model
|
||||
|
||||
open Snake.Model
|
||||
|
||||
/// `Cells` is canonical: sorted row-major (by `Y`, then `X`), no duplicates, all on the board.
|
||||
type LifeState =
|
||||
{ Cells: Point list
|
||||
Running: bool
|
||||
Seed: uint32
|
||||
Generation: int }
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
type LifeAction =
|
||||
| Frame
|
||||
| Toggle of Point
|
||||
| TogglePause
|
||||
| Step
|
||||
| Clear
|
||||
| Randomize
|
||||
|
||||
// The board, in cells: LW columns, LH rows, LCELL pixels per cell. Below it the page shows a status strip.
|
||||
let LW = 40
|
||||
let LH = 30
|
||||
let LCELL = 16
|
||||
let STRIP = 24
|
||||
|
||||
let initialLife (seed: uint32) : LifeState =
|
||||
{ Cells = []
|
||||
Running = false
|
||||
Seed = seed
|
||||
Generation = 0 }
|
||||
@@ -0,0 +1,71 @@
|
||||
/// m13 life rules: the next generation is a function of the whole old board, and nothing else.
|
||||
module Snake.Life.Rules
|
||||
|
||||
open Snake
|
||||
open Snake.Model
|
||||
open Snake.Life.Model
|
||||
|
||||
// Every cell of the board, row-major (y, then x). Filtering this list keeps any result in canonical order for free.
|
||||
let private board: Point list =
|
||||
[ for y in 0 .. LH - 1 do
|
||||
for x in 0 .. LW - 1 -> { X = x; Y = y } ]
|
||||
|
||||
let private onBoard (p: Point) : bool = p.X >= 0 && p.X < LW && p.Y >= 0 && p.Y < LH
|
||||
|
||||
// A cell's position in row-major order: the order the canonical list is sorted by.
|
||||
let private index (p: Point) : int = p.Y * LW + p.X
|
||||
|
||||
let private offsets = [ (-1, -1); (0, -1); (1, -1); (-1, 0); (1, 0); (-1, 1); (0, 1); (1, 1) ]
|
||||
|
||||
// The up to eight neighbours of `p` that are on the board (the edges are dead: nothing wraps around).
|
||||
let private neighbours (p: Point) : Point list =
|
||||
offsets |> List.map (fun (dx, dy) -> { X = p.X + dx; Y = p.Y + dy }) |> List.filter onBoard
|
||||
|
||||
// B3/S23, every cell judged on the *old* list only. A Set of the old cells makes "is this neighbour alive?" one
|
||||
// lookup, so a generation is 1200 x 8 lookups however many cells live. The set is built once and only read.
|
||||
let lifeStep (cells: Point list) : Point list =
|
||||
let alive = Set.ofList cells
|
||||
let count p = neighbours p |> List.filter alive.Contains |> List.length
|
||||
|
||||
board
|
||||
|> List.filter (fun p ->
|
||||
let n = count p
|
||||
n = 3 || (n = 2 && alive.Contains p))
|
||||
|
||||
// Add a dead cell or remove a live one, keeping the list sorted row-major without duplicates. Off the board: unchanged.
|
||||
let private toggle (cells: Point list) (p: Point) : Point list =
|
||||
if not (onBoard p) then
|
||||
cells
|
||||
elif List.contains p cells then
|
||||
List.filter (fun c -> c <> p) cells
|
||||
else
|
||||
List.filter (fun c -> index c < index p) cells
|
||||
@ [ p ]
|
||||
@ List.filter (fun c -> index c > index p) cells
|
||||
|
||||
// A random board: one `intBelow 4` per cell in row-major order, the cell alive when the draw is 0 (about one cell in
|
||||
// four). mapFold threads the seed through the 1200 draws; the result is the cells and the seed after the last draw.
|
||||
let private randomCells (seed: uint32) : Point list * uint32 =
|
||||
let draws, next = List.mapFold (fun s _ -> Random.run s (Random.intBelow 4)) seed board
|
||||
List.zip board draws |> List.filter (fun (_, d) -> d = 0) |> List.map fst, next
|
||||
|
||||
let private nextGeneration (state: LifeState) : LifeState =
|
||||
{ state with
|
||||
Cells = lifeStep state.Cells
|
||||
Generation = state.Generation + 1 }
|
||||
|
||||
let lifeUpdate (state: LifeState) (action: LifeAction) : LifeState =
|
||||
match action with
|
||||
| LifeAction.Frame -> if state.Running then nextGeneration state else state
|
||||
| LifeAction.Step -> if state.Running then state else nextGeneration state
|
||||
| LifeAction.TogglePause -> { state with Running = not state.Running }
|
||||
// Clicking edits the world whether it runs or not: the click is one action between two generations.
|
||||
| LifeAction.Toggle p -> { state with Cells = toggle state.Cells p }
|
||||
| LifeAction.Clear -> { state with Cells = []; Generation = 0 }
|
||||
| LifeAction.Randomize ->
|
||||
let cells, seed = randomCells state.Seed
|
||||
|
||||
{ state with
|
||||
Cells = cells
|
||||
Seed = seed
|
||||
Generation = 0 }
|
||||
@@ -0,0 +1,17 @@
|
||||
/// m13 life view: live cells as squares, and a status strip under the board.
|
||||
module Snake.Life.View
|
||||
|
||||
open Snake.View
|
||||
open Snake.Life.Model
|
||||
|
||||
let private text x y str align = Text(x, y, str, "#ffffff", 14, align)
|
||||
|
||||
let private W = LW * LCELL
|
||||
let private H = LH * LCELL
|
||||
|
||||
let lifeView (state: LifeState) : Scene =
|
||||
[ Rect(0, 0, W, H, "#111111") ]
|
||||
@ (state.Cells |> List.map (fun p -> Rect(p.X * LCELL + 1, p.Y * LCELL + 1, LCELL - 2, LCELL - 2, "#7cb342")))
|
||||
@ [ Rect(0, H, W, STRIP, "#222222")
|
||||
text 6 (H + 17) $"Generation {state.Generation}" "left"
|
||||
text (W - 6) (H + 17) (if state.Running then "Running: Space pauses" else "Paused: Space runs, N steps") "right" ]
|
||||
@@ -25,6 +25,7 @@ type Action =
|
||||
| Frame
|
||||
|
||||
/// The whole game. `Snake` is head first; `Seed` is the unsigned 32-bit random seed.
|
||||
/// `Frame` and `Queued` stay unused until m10 (`Queued` holds a turn waiting for the next step).
|
||||
type GameState =
|
||||
{ Width: int
|
||||
Height: int
|
||||
@@ -35,7 +36,8 @@ type GameState =
|
||||
Seed: uint32
|
||||
Score: int
|
||||
Status: Status
|
||||
Frame: int }
|
||||
Frame: int
|
||||
Queued: Direction option }
|
||||
|
||||
let delta (dir: Direction) : Point =
|
||||
match dir with
|
||||
@@ -61,4 +63,5 @@ let initialState (seed: uint32) : GameState =
|
||||
Seed = seed
|
||||
Score = 0
|
||||
Status = Playing
|
||||
Frame = 0 }
|
||||
Frame = 0
|
||||
Queued = None }
|
||||
@@ -33,4 +33,7 @@ let pongStates (seed: uint32) (actions: Stream<PongAction>) : Stream<PongState>
|
||||
|
||||
let pongMain () : IO<Stream<IO<unit>>> =
|
||||
IO.randomSeed ()
|
||||
|> IO.map (fun seed -> pongStates seed pongActions |> Stream.map (fun state -> IO.drawScene (pongView state)))
|
||||
|> IO.map (fun seed ->
|
||||
pongStates seed pongActions
|
||||
|> Stream.map (fun state -> IO.drawScene (pongView state))
|
||||
|> Stream.clampTime App.MAX_GAP_MS)
|
||||
@@ -89,5 +89,6 @@ 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
|
||||
// A new match, but the keys are still where the player's fingers are.
|
||||
| PongAction.Restart -> { initialPong state.Seed with Held = state.Held }
|
||||
| PongAction.Frame -> frame state
|
||||
@@ -0,0 +1,96 @@
|
||||
/// m10 replay viewer: a recorded game is a seed and a list of actions; watching it is a second, tiny program
|
||||
/// whose state is only a position in the list of the game's states.
|
||||
module Snake.Replay
|
||||
|
||||
open Snake.Model
|
||||
open Snake.View
|
||||
open Snake.IO
|
||||
open Snake.Stream
|
||||
|
||||
type Recording = { Seed: uint32; Actions: Action list }
|
||||
|
||||
type Viewer = { Index: int; Last: int; Playing: bool }
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
type ViewerAction =
|
||||
| Next
|
||||
| Prev
|
||||
| First
|
||||
| Last
|
||||
| TogglePlay
|
||||
| Beat
|
||||
|
||||
let REPLAY_MS = 100L
|
||||
|
||||
// Every state of the recorded game, from the new game to the end: the recording replayed with `history`.
|
||||
let frames (recording: Recording) : GameState list =
|
||||
Game.history (Spawn.newGame recording.Seed) recording.Actions
|
||||
|
||||
let viewerStart (last: int) : Viewer = { Index = 0; Last = last; Playing = false }
|
||||
|
||||
// Where each action moves the viewer, and whether it plays afterwards (before the end-of-recording rule).
|
||||
let private move (v: Viewer) (action: ViewerAction) : Viewer =
|
||||
let clamp i = min v.Last (max 0 i)
|
||||
|
||||
match action with
|
||||
| ViewerAction.Next -> { v with Index = clamp (v.Index + 1) }
|
||||
| ViewerAction.Prev -> { v with Index = clamp (v.Index - 1) }
|
||||
| ViewerAction.First -> { v with Index = 0 }
|
||||
| ViewerAction.Last -> { v with Index = v.Last }
|
||||
// Play from the end means: watch it again from the start.
|
||||
| ViewerAction.TogglePlay ->
|
||||
if v.Playing then
|
||||
{ v with Playing = false }
|
||||
else
|
||||
{ v with
|
||||
Index = (if v.Index = v.Last then 0 else v.Index)
|
||||
Playing = true }
|
||||
| ViewerAction.Beat -> if v.Playing then { v with Index = clamp (v.Index + 1) } else v
|
||||
|
||||
// The index never leaves [0, Last], and the viewer never plays on the last frame, so autoplay stops by itself.
|
||||
let viewerUpdate (viewer: Viewer) (action: ViewerAction) : Viewer =
|
||||
let next = move viewer action
|
||||
{ next with Playing = next.Playing && next.Index < next.Last }
|
||||
|
||||
let viewerKey (key: string) : ViewerAction option =
|
||||
match key with
|
||||
| "ArrowRight" | "d" | "D" -> Some ViewerAction.Next
|
||||
| "ArrowLeft" | "a" | "A" -> Some ViewerAction.Prev
|
||||
| "Home" -> Some ViewerAction.First
|
||||
| "End" -> Some ViewerAction.Last
|
||||
| " " -> Some ViewerAction.TogglePlay
|
||||
| _ -> None
|
||||
|
||||
// The game's own picture of the current frame, then the position at the top right and a hint at the bottom.
|
||||
let viewerView (frames: GameState list) (viewer: Viewer) : Scene =
|
||||
let game = List.item viewer.Index frames
|
||||
let w = game.Width * CELL
|
||||
|
||||
let hint =
|
||||
if viewer.Playing then
|
||||
"Space: pause"
|
||||
else
|
||||
"Left/Right: step Home/End: jump Space: play"
|
||||
|
||||
View.view game
|
||||
@ [ Text(w - 6, 18, $"step {viewer.Index} / {viewer.Last}", "#ffffff", 16, "right")
|
||||
Text(w / 2, game.Height * CELL - 8, hint, "#aaaaaa", 12, "center") ]
|
||||
|
||||
let replayActions: Stream<ViewerAction> =
|
||||
Stream.merge
|
||||
(Stream.interval REPLAY_MS |> Stream.map (fun _ -> ViewerAction.Beat))
|
||||
(Stream.keyDowns |> Stream.choose viewerKey)
|
||||
|
||||
let viewerStates (last: int) (actions: Stream<ViewerAction>) : Stream<Viewer> =
|
||||
actions |> Stream.scan viewerUpdate (viewerStart last) |> Stream.startWith (viewerStart last)
|
||||
|
||||
// It needs no seed from the world (the recording has one), so it starts with `pure`.
|
||||
// The frames are computed once, here, and every drawing picks one of them.
|
||||
let replayMain (recording: Recording) : IO<Stream<IO<unit>>> =
|
||||
let fs = frames recording
|
||||
|
||||
IO.pure (
|
||||
viewerStates (List.length fs - 1) replayActions
|
||||
|> Stream.map (fun v -> IO.drawScene (viewerView fs v))
|
||||
|> Stream.clampTime App.MAX_GAP_MS
|
||||
)
|
||||
@@ -11,14 +11,23 @@ type Platform =
|
||||
{ FillRect: int -> int -> int -> int -> string -> unit
|
||||
FillText: int -> int -> string -> string -> int -> string -> unit
|
||||
RandomSeed: unit -> uint32
|
||||
// m10: the stored best score; reading must never fail (anything unreadable is 0).
|
||||
LoadBest: unit -> int
|
||||
SaveBest: int -> unit
|
||||
StartClock: (int64 -> unit) -> unit
|
||||
OnKeyDown: (string -> unit) -> unit
|
||||
OnKeyUp: (string -> unit) -> unit }
|
||||
OnKeyUp: (string -> unit) -> unit
|
||||
// m13: clicks on the canvas, in canvas pixels.
|
||||
OnClick: (int -> int -> unit) -> unit }
|
||||
|
||||
// Perform one op on the platform and return its answer.
|
||||
let private perform (p: Platform) (op: Op) : OpResult =
|
||||
match op with
|
||||
| RandomSeed -> Seed(p.RandomSeed())
|
||||
| LoadBest -> Best(p.LoadBest())
|
||||
| SaveBest score ->
|
||||
p.SaveBest score
|
||||
Done
|
||||
| Draw(Rect(x, y, w, h, color)) ->
|
||||
p.FillRect x y w h color
|
||||
Done
|
||||
@@ -43,4 +52,6 @@ let runApp (p: Platform) (main: IO<Stream<IO<unit>>>) : unit =
|
||||
|
||||
p.OnKeyDown(fun key -> feed (KeyDown key))
|
||||
p.OnKeyUp(fun key -> feed (KeyUp key))
|
||||
// m13: a fourth kind of event. Programs that do not listen for clicks simply ignore them.
|
||||
p.OnClick(fun x y -> feed (Click(x, y)))
|
||||
p.StartClock(fun t -> feed (Time t))
|
||||
@@ -0,0 +1,65 @@
|
||||
/// m07b safeio (optional): a stack-safe IO. Same idea as m07's IO, plus one more case, so that `bind` only builds
|
||||
/// data and no program shape can overflow the stack, however deeply its `bind`s are nested.
|
||||
/// - `Pure a` done, with a value
|
||||
/// - `Effect (op, k)` perform `op`, then continue with `k result`
|
||||
/// - `FlatMap (io, f)` run `io`, then continue with `f result`
|
||||
/// The ops, their answers and the result of `trace` are m07's `IO.Op`, `IO.OpResult` and `IO.Traced`.
|
||||
/// (Not `open Snake.IO`: its cases are also called Pure and Effect.)
|
||||
module Snake.SafeIO
|
||||
|
||||
/// `FlatMap`'s inner program produces some type `X` that only its continuation knows. A union case cannot have a
|
||||
/// type parameter of its own, so `X` is erased to `obj`; only `bind` builds a `FlatMap`, and it keeps the two in step.
|
||||
type SafeIO<'a> =
|
||||
| Pure of 'a
|
||||
| Effect of IO.Op * (IO.OpResult -> SafeIO<'a>)
|
||||
| FlatMap of SafeIO<obj> * (obj -> SafeIO<'a>)
|
||||
|
||||
// Given: the same program, seen as a SafeIO<obj>. Constant work: continuations are wrapped, not called.
|
||||
let rec private erase (io: SafeIO<'a>) : SafeIO<obj> =
|
||||
match io with
|
||||
| Pure a -> Pure(box a)
|
||||
| Effect(op, k) -> Effect(op, fun r -> erase (k r))
|
||||
| FlatMap(m, g) -> FlatMap(m, fun x -> erase (g x))
|
||||
|
||||
let pure (a: 'a) : SafeIO<'a> = Pure a
|
||||
|
||||
let effect (op: IO.Op) : SafeIO<IO.OpResult> = Effect(op, pure)
|
||||
|
||||
// Only builds a node: never calls f, not even when io is Pure. The unbox cannot fail: x is the result of `io`.
|
||||
let bind (f: 'a -> SafeIO<'b>) (io: SafeIO<'a>) : SafeIO<'b> = FlatMap(erase io, fun x -> f (unbox<'a> x))
|
||||
|
||||
let map (f: 'a -> 'b) (io: SafeIO<'a>) : SafeIO<'b> = io |> bind (fun a -> Pure(f a))
|
||||
|
||||
// A left fold on purpose: with SafeIO the nesting no longer matters.
|
||||
let sequence (ios: SafeIO<unit> list) : SafeIO<unit> = List.fold (fun acc io -> acc |> bind (fun () -> io)) (pure ()) ios
|
||||
|
||||
// One rewrite towards a program whose top is a Pure or an Effect. Constant work, no recursion.
|
||||
// FlatMap(Pure a, f) -> f a
|
||||
// FlatMap(Effect(op, k), f) -> Effect(op, fun r -> FlatMap(k r, f))
|
||||
// FlatMap(FlatMap(m, g), f) -> FlatMap(m, fun x -> FlatMap(g x, f)) (re-association)
|
||||
// Pure and Effect are already in that shape and come back unchanged.
|
||||
let step (io: SafeIO<'a>) : SafeIO<'a> =
|
||||
match io with
|
||||
| FlatMap(Pure x, f) -> f x
|
||||
| FlatMap(Effect(op, k), f) -> Effect(op, fun r -> FlatMap(k r, f))
|
||||
| FlatMap(FlatMap(m, g), f) -> FlatMap(m, fun x -> FlatMap(g x, f))
|
||||
| other -> other
|
||||
|
||||
// Given: the canned answer of the pure interpreter, as in m07. SafeIO keeps Module 7's two operations; the stored
|
||||
// best score of Module 10 is not part of it, so its operations are refused loudly rather than given a meaning here.
|
||||
let private answer (seed: uint32) (op: IO.Op) : IO.OpResult =
|
||||
match op with
|
||||
| IO.RandomSeed -> IO.Seed seed
|
||||
| IO.Draw _ -> IO.Done
|
||||
| IO.LoadBest
|
||||
| IO.SaveBest _ -> failwith "SafeIO.trace answers only Module 7's operations (Draw and RandomSeed)"
|
||||
|
||||
// `loop` calls itself only in tail position, so the compiler turns it into a loop: the stack stays flat.
|
||||
let trace (seed: uint32) (io: SafeIO<'a>) : IO.Traced<'a> =
|
||||
let rec loop (current: SafeIO<'a>) (performed: IO.Op list) : IO.Traced<'a> =
|
||||
match current with
|
||||
| Pure a -> { IO.Result = a; IO.Ops = List.rev performed }
|
||||
| Effect(op, k) -> loop (k (answer seed op)) (op :: performed)
|
||||
| FlatMap _ -> loop (step current) performed
|
||||
|
||||
loop io []
|
||||
@@ -10,17 +10,25 @@
|
||||
<Compile Include="Model.fs" />
|
||||
<Compile Include="Rules.fs" />
|
||||
<Compile Include="Random.fs" />
|
||||
<Compile Include="State.fs" />
|
||||
<Compile Include="Spawn.fs" />
|
||||
<Compile Include="Game.fs" />
|
||||
<Compile Include="View.fs" />
|
||||
<Compile Include="IO.fs" />
|
||||
<Compile Include="SafeIO.fs" />
|
||||
<Compile Include="Stream.fs" />
|
||||
<Compile Include="Input.fs" />
|
||||
<Compile Include="App.fs" />
|
||||
<Compile Include="Runtime.fs" />
|
||||
<Compile Include="Replay.fs" />
|
||||
<Compile Include="Pong/Model.fs" />
|
||||
<Compile Include="Pong/Rules.fs" />
|
||||
<Compile Include="Pong/View.fs" />
|
||||
<Compile Include="Pong/App.fs" />
|
||||
<Compile Include="Life/Model.fs" />
|
||||
<Compile Include="Life/Rules.fs" />
|
||||
<Compile Include="Life/View.fs" />
|
||||
<Compile Include="Life/App.fs" />
|
||||
<Compile Include="Check.fs" />
|
||||
</ItemGroup>
|
||||
</Project>
|
||||
@@ -0,0 +1,27 @@
|
||||
/// m04 state (optional, Exercise 4.7): the general pattern behind Random. A `State<'s, 'a>` wraps a function
|
||||
/// `s -> (value, nextS)`: it reads a state, produces a value and hands on a new state. `Random<'a>` is
|
||||
/// `State<uint32, 'a>`. Nothing in the game uses this file; it is here to show that Random was one example of a bigger idea.
|
||||
module Snake.State
|
||||
|
||||
type State<'s, 'a> = State of ('s -> 'a * 's)
|
||||
|
||||
let run (s: 's) (State f: State<'s, 'a>) : 'a * 's = f s
|
||||
|
||||
let pure (a: 'a) : State<'s, 'a> = State(fun s -> (a, s))
|
||||
|
||||
let map (f: 'a -> 'b) (st: State<'s, 'a>) : State<'s, 'b> =
|
||||
State(fun s ->
|
||||
let a, next = run s st
|
||||
(f a, next))
|
||||
|
||||
let bind (f: 'a -> State<'s, 'b>) (st: State<'s, 'a>) : State<'s, 'b> =
|
||||
State(fun s ->
|
||||
let a, next = run s st
|
||||
run next (f a))
|
||||
|
||||
// A function of unit: a generic module-level value is not allowed in F#.
|
||||
let get () : State<'s, 's> = State(fun s -> (s, s))
|
||||
|
||||
let put (s: 's) : State<'s, unit> = State(fun _ -> ((), s))
|
||||
|
||||
let modify (f: 's -> 's) : State<'s, unit> = State(fun s -> ((), f s))
|
||||
@@ -2,11 +2,13 @@
|
||||
/// There is no hidden state: whatever a stream "remembers" lives in the next stream it returns.
|
||||
module Snake.Stream
|
||||
|
||||
/// Something that happens to the program: time passing (ms since start) or a key going down or up.
|
||||
/// Something that happens to the program: time passing (ms since start) or a key going down or up, and from
|
||||
/// Module 13 a mouse click at `(x, y)` in canvas pixels. Every stream ignores the kinds of event it does not use.
|
||||
type Event =
|
||||
| Time of int64
|
||||
| KeyDown of string
|
||||
| KeyUp of string
|
||||
| Click of int * int
|
||||
|
||||
type Stream<'a> = Stream of (Event -> 'a list * Stream<'a>)
|
||||
|
||||
@@ -31,6 +33,16 @@ let keyUps: Stream<string> =
|
||||
|
||||
source ()
|
||||
|
||||
// (m13, given in src/) The position of every Click event, in canvas pixels. Like the key sources it remembers nothing.
|
||||
let clicks: Stream<int * int> =
|
||||
let rec source () =
|
||||
Stream(fun e ->
|
||||
match e with
|
||||
| Click(x, y) -> [ (x, y) ], source ()
|
||||
| _ -> [], source ())
|
||||
|
||||
source ()
|
||||
|
||||
// `last` is the time of the previous Time event. Multiples of ms in (last, t] fire, ascending.
|
||||
let rec private intervalFrom (ms: int64) (last: int64) : Stream<int64> =
|
||||
Stream(fun e ->
|
||||
@@ -76,6 +88,23 @@ let startWith (v: 'a) (s: Stream<'a>) : Stream<'a> =
|
||||
let out, next = step e s
|
||||
v :: out, next)
|
||||
|
||||
// (m10) `last` is the previous real time, `clock` the time the inner stream has been told. A long silence
|
||||
// (a background tab) moves `clock` by at most `maxGap`, so the inner stream never has to catch up on minutes of beats.
|
||||
let rec private clampFrom (maxGap: int64) (last: int64) (clock: int64) (s: Stream<'a>) : Stream<'a> =
|
||||
Stream(fun e ->
|
||||
match e with
|
||||
| Time t ->
|
||||
let now = clock + min (max (t - last) 0L) maxGap
|
||||
let out, next = step (Time now) s
|
||||
out, clampFrom maxGap t now next
|
||||
| KeyDown _
|
||||
| KeyUp _
|
||||
| Click _ ->
|
||||
let out, next = step e s
|
||||
out, clampFrom maxGap last clock next)
|
||||
|
||||
let clampTime (maxGap: int64) (s: Stream<'a>) : Stream<'a> = clampFrom maxGap 0L 0L s
|
||||
|
||||
// mapFold threads the stream through the events like fold, and keeps each step's outputs.
|
||||
let run (events: Event list) (s: Stream<'a>) : 'a list =
|
||||
List.mapFold (fun stream e -> step e stream) s events |> fst |> List.concat
|
||||
+39
-2
@@ -2,6 +2,7 @@
|
||||
module Snake.App
|
||||
|
||||
open Snake.Model
|
||||
open Snake.View
|
||||
open Snake.IO
|
||||
open Snake.Stream
|
||||
|
||||
@@ -11,6 +12,9 @@ let TICK_MS = 150L
|
||||
/// Milliseconds between animation frames (m10).
|
||||
let FRAME_MS = 25L
|
||||
|
||||
/// (m10) The longest step of time the game accepts at once, in milliseconds (see `clampTime` in Stream.fs).
|
||||
let MAX_GAP_MS = 250L
|
||||
|
||||
/// Stream of everything that can happen to the game: `Tick` every TICK_MS (from `Stream.interval`),
|
||||
/// merged with the action for each key press that `Input.keyToAction` recognises (from `Stream.keyDowns`).
|
||||
/// (The stub is wrapped in `Stream` so the TODO only fires when the stream is stepped.)
|
||||
@@ -27,7 +31,40 @@ let states (seed: uint32) (actions: Stream<Action>) : Stream<GameState> = failwi
|
||||
/// The drawing of one state, as an IO: `IO.drawScene (View.view state)`.
|
||||
let render (state: GameState) : IO<unit> = failwith "TODO m09"
|
||||
|
||||
/// (m10) A session: the game, the best score so far, and whether the action that produced this session raised the best.
|
||||
type Session = { Game: GameState; Best: int; Improved: bool }
|
||||
|
||||
/// (m10) One action: `game' = Game.update session.Game action`, `best' = max session.Best game'.Score`,
|
||||
/// `improved = best' > session.Best` (strictly greater: equalling the record is not a new record).
|
||||
let sessionUpdate (session: Session) (action: Action) : Session = failwith "TODO m10"
|
||||
|
||||
/// (m10) Like `states`, one level up: scan with `sessionUpdate` from `s0`, and emit `s0` first (startWith),
|
||||
/// with `s0 = { Game = Spawn.newGame seed; Best = best; Improved = false }`.
|
||||
let sessions (seed: uint32) (best: int) (actions: Stream<Action>) : Stream<Session> = failwith "TODO m10"
|
||||
|
||||
/// (m10) `View.view session.Game` followed by one more shape: the text `Best: <best>` at the top right,
|
||||
/// `Text(game.Width * CELL - 6, 18, "Best: 3", "#ffffff", 16, "right")`.
|
||||
let sessionView (session: Session) : Scene = failwith "TODO m10"
|
||||
|
||||
/// (m10) `IO.drawScene (sessionView session)`, followed by `IO.saveBest session.Best` when `session.Improved`
|
||||
/// (and only then).
|
||||
let renderSession (session: Session) : IO<unit> = failwith "TODO m10"
|
||||
|
||||
/// The whole program as a value: ask for a random seed, then turn the stream of states (built from `classicActions`
|
||||
/// in m09, from `speedActions` after m10) into a stream of drawings (`render`). Nothing runs here.
|
||||
/// A function of `unit`, like `IO.randomSeed`.
|
||||
/// in m09, from `speedActions` after m10) into a stream of drawings (`render`).
|
||||
/// (m10) The whole stream is wrapped in `Stream.clampTime MAX_GAP_MS`.
|
||||
/// (m10, Exercise 10.7) After the seed, ask for the stored best (`IO.loadBest ()`), and draw the stream of
|
||||
/// `sessions seed best speedActions` with `renderSession` instead of the states with `render`.
|
||||
/// Nothing runs here. A function of `unit`, like `IO.randomSeed`.
|
||||
let main () : IO<Stream<IO<unit>>> = failwith "TODO m09"
|
||||
|
||||
/// (m10) `play` that also passes `best` to both traces (`IO.traceWith seed best`), so that `LoadBest` is answered
|
||||
/// with it.
|
||||
let playWith (seed: uint32) (best: int) (events: Event list) (main: IO<Stream<IO<unit>>>) : Op list list =
|
||||
failwith "TODO m10"
|
||||
|
||||
/// (m09) The whole program in one equality: for each drawing that `main` emits while it is fed `events` (a list of
|
||||
/// inputs), the list of ops that drawing performs. Interpret `main` with `IO.trace seed`, `Stream.run` the stream it
|
||||
/// produces on `events`, and trace each emitted IO with the same seed, keeping its `Ops`.
|
||||
/// (m10) Once `playWith` (above) is written, `play` becomes its "no stored best" case: `playWith seed 0 events main`.
|
||||
let play (seed: uint32) (events: Event list) (main: IO<Stream<IO<unit>>>) : Op list list = failwith "TODO m09"
|
||||
@@ -0,0 +1,126 @@
|
||||
/// m12 check: property-based testing, built from the course's own parts.
|
||||
/// A generator of test data is nothing new: it is a `Random<'a>` from Random.fs (`seed -> (value, nextSeed)`).
|
||||
module Snake.Check
|
||||
|
||||
open Snake.Model
|
||||
open Snake.Random
|
||||
|
||||
/// What `forAll` reports: every value passed (`Passed runs`), or the first one that did not (`Failed`, see `forAll`).
|
||||
type CheckResult<'a> =
|
||||
| Passed of runs: int
|
||||
| Failed of run: int * seed: uint32 * value: 'a
|
||||
|
||||
/// A Random that gives one of the elements of the non-empty list `xs`: the element at index `i`,
|
||||
/// where `i` is drawn with `Random.intBelow (List.length xs)`.
|
||||
let elementOf (xs: 'a list) : Random<'a> = failwith "TODO m12"
|
||||
|
||||
/// A Random that gives a list of `n` values drawn from `gen`, one after another: the first draw starts from the
|
||||
/// incoming seed, each later draw from the seed the previous one left behind, and the last draw's seed is the result's.
|
||||
/// `listOf 0 gen` gives `[]` and leaves the seed alone. No loop: recursion on `n`, with `Random.bind` and `Random.map`.
|
||||
let listOf (n: int) (gen: Random<'a>) : Random<'a list> = failwith "TODO m12"
|
||||
|
||||
// Ticks appear three times so that the snake moves more often than it turns.
|
||||
let private actionPool: Action list =
|
||||
[ Tick; Tick; Tick; Turn Up; Turn Down; Turn Left; Turn Right ]
|
||||
|
||||
/// A generator of `n` random actions (given; it works once `elementOf` and `listOf` do).
|
||||
let genActions (n: int) : Random<Action list> = listOf n (elementOf actionPool)
|
||||
|
||||
/// Check the property `prop` (a function value -> bool) on `runs` values drawn from `gen`.
|
||||
/// The first value is drawn from `seed`, each later one from the seed the previous draw left behind.
|
||||
/// Stop at the first value for which `prop` is false.
|
||||
/// Result: `Passed runs` when every value passed, otherwise `Failed(run, seed, value)`, where `run` is the 0-based
|
||||
/// number of the failing draw, `value` is the counterexample and `seed` is the seed that draw started from
|
||||
/// (so `Random.run seed gen |> fst` gives `value` again).
|
||||
/// Write it with a tail-recursive helper that carries the run number and the seed.
|
||||
let forAll (runs: int) (seed: uint32) (prop: 'a -> bool) (gen: Random<'a>) : CheckResult<'a> = failwith "TODO m12"
|
||||
|
||||
/// Every list that is `xs` with exactly one element removed, in the order of the removed index:
|
||||
/// `removals [ 1; 2; 3 ]` is `[ [ 2; 3 ]; [ 1; 3 ]; [ 1; 2 ] ]`; `removals []` is `[]`.
|
||||
let removals (xs: 'a list) : 'a list list = failwith "TODO m12"
|
||||
|
||||
/// Shrink a failing list. `fails` is a function list -> bool and `fails xs` is true.
|
||||
/// If some list in `removals xs` still fails, continue with the first one that does; when none fails, return `xs`.
|
||||
/// The result is "1-minimal": it fails, and removing any single element makes it pass.
|
||||
let minimize (fails: 'a list -> bool) (xs: 'a list) : 'a list = failwith "TODO m12"
|
||||
|
||||
/// The names of the invariants that `state` breaks, in this order (an empty list means the state is sane):
|
||||
/// "snake-not-empty" the snake has at least one cell
|
||||
/// "snake-in-bounds" every cell of the snake is on the board
|
||||
/// "snake-no-overlap" no two cells of the snake are equal
|
||||
/// "snake-connected" each cell of the snake is exactly one step (up, down, left or right) from the one before it
|
||||
/// "apple-in-bounds" the apple, if there is one (`Some`), is on the board
|
||||
/// "apple-not-on-snake" the apple, if there is one (`Some`), is not on a cell of the snake
|
||||
/// "turn-not-reversed" `NextDir` is not the opposite of `Dir`
|
||||
/// "queued-not-reversed" `Queued` is `None`, or is not the opposite of `NextDir`
|
||||
/// No apple (`None`) breaks neither apple invariant.
|
||||
let violations (state: GameState) : string list = failwith "TODO m12"
|
||||
|
||||
/// Given the states of a game in order, the snake "moves at index i" (i >= 1) when the head of `states[i]`
|
||||
/// differs from the head of `states[i - 1]`. `moveGaps states` is the list of differences between consecutive
|
||||
/// such indices: moves at 2, 5 and 12 give `[ 3; 7 ]`. Fewer than two moves give `[]`.
|
||||
let moveGaps (states: GameState list) : int list = failwith "TODO m12"
|
||||
|
||||
// ---- random states (Exercise 12.6) and a second implementation of the step as an oracle (Exercise 12.7)
|
||||
|
||||
/// (Exercise 12.6) A Random that gives a snake, head first, on a `width` x `height` board, with at most `maxLen` cells
|
||||
/// (`maxLen >= 1`). The draws, in this exact order (so that every track gets the same snake from the same seed):
|
||||
/// 1. the head: `x` with `Random.intBelow width`, then `y` with `Random.intBelow height`;
|
||||
/// 2. then, while the snake has fewer than `maxLen` cells: look at the neighbours of its *last* cell, in the order
|
||||
/// Up, Down, Left, Right (`Rules.move last dir`), and keep those that are on the board and not yet in the snake.
|
||||
/// If none is left, stop early (with `Random.pure`, no draw). Otherwise append the one picked with
|
||||
/// `elementOf neighbours` and go on.
|
||||
/// So the result is always on the board, connected and free of overlap. No loop: recursion, with `Random.bind`.
|
||||
let genSnake (width: int) (height: int) (maxLen: int) : Random<Point list> = failwith "TODO m12"
|
||||
|
||||
let private directions: Direction list = [ Up; Down; Left; Right ]
|
||||
|
||||
// The direction the head moved in to get from the second cell to the first (`Right` for a one-cell snake).
|
||||
let private headingOf (snake: Point list) : Direction =
|
||||
match snake with
|
||||
| head :: second :: _ -> directions |> List.find (fun d -> Rules.move second d = head)
|
||||
| _ -> Right
|
||||
|
||||
/// A random sane Playing state on a `width` x `height` board (given; it works once `genSnake` does). Draws in order:
|
||||
/// the snake's length limit `n + 1` with `n` from `Random.intBelow (width * height)`; the snake with `genSnake`;
|
||||
/// `NextDir` with `elementOf` among Up, Down, Left, Right without the opposite of `Dir` (so: `Dir` or a perpendicular
|
||||
/// direction); a coin `Random.intBelow 2`: 0 means no apple, 1 means an apple at `elementOf (Spawn.freeCells ...)`
|
||||
/// (no apple if no cell is free). `Dir` is the direction from the snake's second cell to its head (`Right` for a
|
||||
/// one-cell snake); seed, score and frame are 0, `Queued` is `None`.
|
||||
let genState (width: int) (height: int) : Random<GameState> =
|
||||
Random.intBelow (width * height)
|
||||
|> Random.bind (fun n ->
|
||||
genSnake width height (n + 1)
|
||||
|> Random.bind (fun snake ->
|
||||
let dir = headingOf snake
|
||||
|
||||
let state =
|
||||
{ Width = width
|
||||
Height = height
|
||||
Snake = snake
|
||||
Dir = dir
|
||||
NextDir = dir
|
||||
Apple = None
|
||||
Seed = 0u
|
||||
Score = 0
|
||||
Status = Playing
|
||||
Frame = 0
|
||||
Queued = None }
|
||||
|
||||
let free = Spawn.freeCells state
|
||||
|
||||
elementOf (directions |> List.filter (fun d -> d <> opposite dir))
|
||||
|> Random.bind (fun nextDir ->
|
||||
Random.intBelow 2
|
||||
|> Random.bind (fun coin ->
|
||||
(if coin = 0 || List.isEmpty free then Random.pure None else elementOf free |> Random.map Some)
|
||||
|> Random.map (fun apple -> { state with NextDir = nextDir; Apple = apple })))))
|
||||
|
||||
/// (Exercise 12.7) The step of m03, written straight from the rules, as a second opinion on `Rules.advance`.
|
||||
/// Not Playing: the state unchanged. Otherwise build the snake the step would produce: the new head
|
||||
/// (`Rules.move head NextDir`) in front, followed by the old snake, without its last cell unless the new head is on
|
||||
/// the apple. Then ask `violations` about the state with that snake: if the list contains "snake-in-bounds" or
|
||||
/// "snake-no-overlap", the result is m03's game over (`Dir = NextDir`, `Status = GameOver`, nothing else changed);
|
||||
/// otherwise the state with the new snake, `Dir = NextDir`, and, when eating, `Apple = None` and the score one higher.
|
||||
/// Do not call `Rules.advance`. On every sane state the result must equal `Rules.advance state`.
|
||||
let advanceSpec (state: GameState) : GameState = failwith "TODO m12"
|
||||
+14
-2
@@ -3,6 +3,13 @@ module Snake.Game
|
||||
|
||||
open Snake.Model
|
||||
|
||||
/// (m10, Exercise 10.6) What `update` does with `Turn dir` from m10 on (the turn queue).
|
||||
/// - not Playing: the state unchanged;
|
||||
/// - no turn pending (`NextDir = Dir`): `Rules.turn state dir`, the m03 rule;
|
||||
/// - a turn pending (`NextDir <> Dir`): if `dir` is neither `NextDir` nor `opposite NextDir`, the state with
|
||||
/// `Queued = Some dir` (a later key replaces an earlier queued one); otherwise the state unchanged.
|
||||
let steer (state: GameState) (dir: Direction) : GameState = failwith "TODO m10"
|
||||
|
||||
/// How many frames pass between game steps (m10): `max 2 (8 - score / 3)` (integer division).
|
||||
/// Score 0-2 -> 8, 3-5 -> 7, ..., 18 and up -> 2.
|
||||
let movesEvery (score: int) : int = failwith "TODO m10"
|
||||
@@ -14,8 +21,13 @@ let movesEvery (score: int) : int = failwith "TODO m10"
|
||||
///
|
||||
/// (m10) `TogglePause` switches Playing <-> Paused and does nothing in any other status.
|
||||
/// (m10) `Restart` gives `Spawn.newGame state.Seed`, whatever the status.
|
||||
/// (m10) `Frame` does nothing unless Playing; otherwise it adds 1 to `Frame`, and when the new `Frame` is a multiple of
|
||||
/// `movesEvery Score` it also runs a game step (`Spawn.tick`) on that incremented state.
|
||||
/// (m10) `Frame` does nothing unless Playing. Otherwise it counts the frame: `n = Frame + 1`. While `n` is below
|
||||
/// `movesEvery Score` the result is the state with `Frame = n`. When `n` reaches `movesEvery Score` (`n >= ...`),
|
||||
/// the count starts again and the game takes a step: the result is `Spawn.tick` of the state with `Frame = 0`.
|
||||
/// So `Frame` is the number of frames since the snake last moved.
|
||||
/// (m10, Exercise 10.6) The turn queue: `Turn` uses `steer` instead of `Rules.turn`, and after every game step `update`
|
||||
/// takes (the `Tick` case and the stepping branch of `Frame`), if the result is Playing and `Queued` is `Some d`,
|
||||
/// the result gets `NextDir = d` and `Queued = None`. A result that is not Playing keeps `Queued` as it is.
|
||||
/// In m10, match every case of `Action` explicitly (no `| _ ->`), so the compiler tells you if one is forgotten.
|
||||
let update (state: GameState) (action: Action) : GameState = failwith "TODO m05"
|
||||
|
||||
|
||||
+20
-1
@@ -1,6 +1,8 @@
|
||||
/// m07 io: effects as values. An `IO<'a>` is a description of a program that, when interpreted, produces an `'a`:
|
||||
/// - `Pure a` finished, nothing left to do
|
||||
/// - `Effect (op, k)` perform `op`, then continue with `k result` (which returns another IO)
|
||||
/// (m10) Two more operations, for a best score that survives a reload: `LoadBest` (answered with `Best value`, the
|
||||
/// stored best) and `SaveBest score` (answered with `Done`).
|
||||
/// Building an IO never performs anything; only an interpreter (`trace` here, `Runtime.runIO` in m09) does.
|
||||
module Snake.IO
|
||||
|
||||
@@ -10,11 +12,17 @@ open Snake.View
|
||||
type Op =
|
||||
| Draw of Shape
|
||||
| RandomSeed
|
||||
/// (m10) Read the stored best score.
|
||||
| LoadBest
|
||||
/// (m10) Store `score` as the new best.
|
||||
| SaveBest of int
|
||||
|
||||
/// What the outside world answers: `Done` for a `Draw`, `Seed value` (an unsigned 32-bit number) for a `RandomSeed`.
|
||||
/// What the outside world answers: `Done` for a `Draw`, `Seed value` (an unsigned 32-bit number) for a `RandomSeed`;
|
||||
/// (m10) `Best value` for a `LoadBest`, `Done` for a `SaveBest`.
|
||||
type OpResult =
|
||||
| Done
|
||||
| Seed of uint32
|
||||
| Best of int
|
||||
|
||||
type IO<'a> =
|
||||
| Pure of 'a
|
||||
@@ -50,7 +58,18 @@ let randomSeed () : IO<uint32> = failwith "TODO m07"
|
||||
/// Draw every shape of a scene in order: `sequence (List.map draw scene)`.
|
||||
let drawScene (scene: Scene) : IO<unit> = failwith "TODO m07"
|
||||
|
||||
/// (m10) An IO that reads the stored best score and produces it (the `value` of the `Best` answer).
|
||||
/// A function of `unit`, like `randomSeed ()`; an answer other than `Best` is a broken interpreter: fail loudly.
|
||||
let loadBest () : IO<int> = failwith "TODO m10"
|
||||
|
||||
/// (m10) An IO that stores `score` as the new best and produces `()`: built like `draw`, from `SaveBest score`.
|
||||
let saveBest (score: int) : IO<unit> = failwith "TODO m10"
|
||||
|
||||
/// (m10) `trace` that also answers every `LoadBest` with `Best best` and every `SaveBest` with `Done`.
|
||||
let traceWith (seed: uint32) (best: int) (io: IO<'a>) : Traced<'a> = failwith "TODO m10"
|
||||
|
||||
/// A pure interpreter for tests. Answers every `RandomSeed` with `Seed seed` and every `Draw` with `Done`.
|
||||
/// Returns the final value and the operations in the order they were executed.
|
||||
/// Implemented by recursion, with no mutation.
|
||||
/// (m10) Once `traceWith` (above) is written, `trace` becomes its "no stored best" case: `traceWith seed 0 io`.
|
||||
let trace (seed: uint32) (io: IO<'a>) : Traced<'a> = failwith "TODO m07"
|
||||
@@ -0,0 +1,34 @@
|
||||
/// m13 life app: the same wiring as Snake and Pong, with a third kind of input, the mouse.
|
||||
module Snake.Life.App
|
||||
|
||||
open Snake
|
||||
open Snake.IO
|
||||
open Snake.Stream
|
||||
open Snake.Life.Model
|
||||
open Snake.Life.Rules
|
||||
open Snake.Life.View
|
||||
|
||||
/// Milliseconds between two generations while the world runs.
|
||||
let GEN_MS = 150L
|
||||
|
||||
/// A key press to a `LifeAction`, if any: " " -> TogglePause, "n"/"N" -> Step, "c"/"C" -> Clear,
|
||||
/// "r"/"R" -> Randomize. Any other key -> `None`.
|
||||
let lifeKey (key: string) : LifeAction option = failwith "TODO m13"
|
||||
|
||||
/// A click at canvas pixel `(x, y)` to `Toggle` of the cell under it (`x / LCELL` and `y / LCELL`, rounded down),
|
||||
/// or `None` when the pixel is not on the board (left of it, above it, right of it, or in the status strip below it).
|
||||
/// Careful: F# integer division rounds towards zero, so `-1 / 16` is 0. Check the pixel before you divide.
|
||||
let lifeClick (x: int) (y: int) : LifeAction option = failwith "TODO m13"
|
||||
|
||||
/// Everything that can happen to the world: `Frame` every GEN_MS (from `Stream.interval`), merged with `lifeKey` of
|
||||
/// every key press, merged with `lifeClick` of every click (`Stream.clicks`), in that order.
|
||||
/// (The stub is wrapped in `Stream` so the TODO only fires when the stream is stepped.)
|
||||
let lifeActions: Stream<LifeAction> = Stream(fun _ -> failwith "TODO m13")
|
||||
|
||||
/// Fold the actions into a stream of states: start from `initialLife seed`, `lifeUpdate` for each action, emit the
|
||||
/// initial state first.
|
||||
let lifeStates (seed: uint32) (actions: Stream<LifeAction>) : Stream<LifeState> = failwith "TODO m13"
|
||||
|
||||
/// The whole program as a value, like `App.main`: ask for a seed, turn the stream of states into a stream of drawings
|
||||
/// of `lifeView`, and wrap that stream in `Stream.clampTime App.MAX_GAP_MS`. A function of `unit`, like `App.main`.
|
||||
let lifeMain () : IO<Stream<IO<unit>>> = failwith "TODO m13"
|
||||
@@ -0,0 +1,38 @@
|
||||
/// m13 life model: the whole world is one value, like the snake and the match.
|
||||
module Snake.Life.Model
|
||||
|
||||
open Snake.Model
|
||||
|
||||
/// The whole world. `Cells` are the live cells, always canonical: sorted row-major (by `Y`, then by `X`), each cell
|
||||
/// at most once, all on the board. `Running` says whether generations follow each other on their own; `Seed` is the
|
||||
/// unsigned 32-bit random seed used by `Randomize`; `Generation` counts the generations since the last Clear or
|
||||
/// Randomize.
|
||||
type LifeState =
|
||||
{ Cells: Point list
|
||||
Running: bool
|
||||
Seed: uint32
|
||||
Generation: int }
|
||||
|
||||
/// Everything that can happen to the world, as data. `Toggle` carries the cell that was clicked.
|
||||
/// (RequireQualifiedAccess: Snake's `Action` also has `Frame` and `TogglePause`.)
|
||||
[<RequireQualifiedAccess>]
|
||||
type LifeAction =
|
||||
| Frame
|
||||
| Toggle of Point
|
||||
| TogglePause
|
||||
| Step
|
||||
| Clear
|
||||
| Randomize
|
||||
|
||||
// The board, in cells: LW columns, LH rows. Below it the page shows a status strip.
|
||||
let LW = 40
|
||||
let LH = 30
|
||||
|
||||
/// Pixels per cell.
|
||||
let LCELL = 16
|
||||
|
||||
/// Height of the status strip under the board, in pixels.
|
||||
let STRIP = 24
|
||||
|
||||
/// A fresh world: no live cells (`Cells = []`), paused (`Running = false`), the given seed, generation 0.
|
||||
let initialLife (seed: uint32) : LifeState = failwith "TODO m13"
|
||||
@@ -0,0 +1,27 @@
|
||||
/// m13 life rules: the next generation is a function of the whole old board, and nothing else.
|
||||
module Snake.Life.Rules
|
||||
|
||||
open Snake
|
||||
open Snake.Model
|
||||
open Snake.Life.Model
|
||||
|
||||
/// One generation of Conway's Life on the LW x LH board (B3/S23), from a canonical list of live cells to a canonical
|
||||
/// list (sorted row-major: by `Y`, then `X`; no duplicates).
|
||||
/// - A live cell with 2 or 3 live neighbours stays alive; a dead cell with exactly 3 live neighbours is born;
|
||||
/// every other cell is dead in the next generation.
|
||||
/// - The neighbours of a cell are the up to 8 cells around it that are on the board: the edges are dead,
|
||||
/// nothing wraps around.
|
||||
/// - Every cell is judged by the *old* board only.
|
||||
let lifeStep (cells: Point list) : Point list = failwith "TODO m13"
|
||||
|
||||
/// The one function that says how the world changes.
|
||||
/// - `Frame`: when running, the next generation (`lifeStep`) and `Generation + 1`; when paused, unchanged.
|
||||
/// - `Step`: when paused, the next generation and `Generation + 1`; when running, unchanged.
|
||||
/// - `TogglePause`: `Running` flips.
|
||||
/// - `Toggle cell`: a dead cell becomes alive, a live one dead, whether the world runs or not; `Cells` stays canonical
|
||||
/// (insert the new cell at its row-major place). A cell off the board changes nothing. `Generation` is unchanged.
|
||||
/// - `Clear`: no live cells, generation 0; `Running` and `Seed` are kept.
|
||||
/// - `Randomize`: draw `Random.intBelow 4` (Module 4) once for every cell of the board, in row-major order
|
||||
/// (y = 0..LH-1, and within a row x = 0..LW-1), threading the seed from `state.Seed`; a cell is alive when its draw
|
||||
/// is 0. The state gets those cells, the seed after the last draw, and generation 0; `Running` is kept.
|
||||
let lifeUpdate (state: LifeState) (action: LifeAction) : LifeState = failwith "TODO m13"
|
||||
@@ -0,0 +1,11 @@
|
||||
/// m13 life view: live cells as squares, and a status strip under the board.
|
||||
module Snake.Life.View
|
||||
|
||||
open Snake.View
|
||||
open Snake.Life.Model
|
||||
|
||||
/// Describe the world as shapes, drawn in order (all text "#ffffff", size 14):
|
||||
/// the board `Rect(0, 0, 640, 480, "#111111")`; one `Rect(x*16+1, y*16+1, 14, 14, "#7cb342")` per live cell, in the
|
||||
/// order of `Cells`; the status strip `Rect(0, 480, 640, 24, "#222222")`; `Text(6, 497, "Generation <n>", align "left")`;
|
||||
/// `Text(634, 497, "Running: Space pauses"` when running, else `"Paused: Space runs, N steps", align "right")`.
|
||||
let lifeView (state: LifeState) : Scene = failwith "TODO m13"
|
||||
+4
-2
@@ -25,6 +25,7 @@ type Action =
|
||||
| Frame
|
||||
|
||||
/// The whole game. `Snake` is head first; `Seed` is the unsigned 32-bit random seed.
|
||||
/// `Frame` and `Queued` stay unused until m10 (`Queued` holds a turn waiting for the next step).
|
||||
type GameState =
|
||||
{ Width: int
|
||||
Height: int
|
||||
@@ -35,7 +36,8 @@ type GameState =
|
||||
Seed: uint32
|
||||
Score: int
|
||||
Status: Status
|
||||
Frame: int }
|
||||
Frame: int
|
||||
Queued: Direction option }
|
||||
|
||||
/// The unit step for a direction: Up (0,-1), Down (0,1), Left (-1,0), Right (1,0). Y grows downward.
|
||||
let delta (dir: Direction) : Point = failwith "TODO m02"
|
||||
@@ -44,5 +46,5 @@ let delta (dir: Direction) : Point = failwith "TODO m02"
|
||||
let opposite (dir: Direction) : Direction = failwith "TODO m02"
|
||||
|
||||
/// A fresh game: 20x20, snake (10,10),(9,10),(8,10) heading Right (`Dir` and `NextDir`),
|
||||
/// no apple, the given seed, score 0, status Playing, frame 0.
|
||||
/// no apple, the given seed, score 0, status Playing, frame 0, nothing queued (`Queued = None`).
|
||||
let initialState (seed: uint32) : GameState = failwith "TODO m02"
|
||||
@@ -25,5 +25,5 @@ let pongActions: Stream<PongAction> = Stream(fun _ -> failwith "TODO m11")
|
||||
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`.
|
||||
/// of `pongView`, and wrap that stream in `Stream.clampTime App.MAX_GAP_MS`. A function of `unit`, like `App.main`.
|
||||
let pongMain () : IO<Stream<IO<unit>>> = failwith "TODO m11"
|
||||
@@ -11,7 +11,7 @@ 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`.
|
||||
/// - `Restart`: `initialPong state.Seed`, except that `Held` is kept (the player may still be holding a key).
|
||||
/// - `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),
|
||||
|
||||
@@ -0,0 +1,66 @@
|
||||
/// m10 replay viewer: a recorded game is a seed and a list of actions; watching it is a second, tiny program
|
||||
/// whose state is only a position in the list of the game's states.
|
||||
module Snake.Replay
|
||||
|
||||
open Snake.Model
|
||||
open Snake.View
|
||||
open Snake.IO
|
||||
open Snake.Stream
|
||||
|
||||
/// A recorded game: the seed of the game and every action, in order (see `fixtures/replay-sample.json`).
|
||||
type Recording = { Seed: uint32; Actions: Action list }
|
||||
|
||||
/// The viewer: which frame is shown (`Index`, 0 = the new game, k = after k actions), the index of the last frame
|
||||
/// (`Last`, the number of actions), and whether autoplay is on (`Playing`).
|
||||
type Viewer = { Index: int; Last: int; Playing: bool }
|
||||
|
||||
/// Everything the viewer can be asked to do, as data. `Beat` is one beat of the autoplay clock.
|
||||
/// (RequireQualifiedAccess: `ViewerAction.Last` must never be confused with anything else in scope.)
|
||||
[<RequireQualifiedAccess>]
|
||||
type ViewerAction =
|
||||
| Next
|
||||
| Prev
|
||||
| First
|
||||
| Last
|
||||
| TogglePlay
|
||||
| Beat
|
||||
|
||||
/// Milliseconds between two frames of autoplay.
|
||||
let REPLAY_MS = 100L
|
||||
|
||||
/// Every state of the recorded game: `Game.history (Spawn.newGame seed) actions`. Its length is the number of
|
||||
/// actions + 1.
|
||||
let frames (recording: Recording) : GameState list = failwith "TODO m10"
|
||||
|
||||
/// The viewer at the first frame, not playing: `{ Index = 0; Last = last; Playing = false }`.
|
||||
let viewerStart (last: int) : Viewer = failwith "TODO m10"
|
||||
|
||||
/// One step of the viewer; total, for every action and every viewer.
|
||||
/// - `Next` / `Prev`: one frame forward / back, never past `Last` or below 0.
|
||||
/// - `First` / `Last`: frame 0 / frame `Last`.
|
||||
/// - `TogglePlay`: playing -> not playing. Not playing -> playing; at the last frame it starts again from frame 0.
|
||||
/// - `Beat`: when playing, one frame forward (never past `Last`); when not playing, unchanged.
|
||||
/// - After every action: a viewer at the last frame is not playing (so autoplay stops at the end by itself).
|
||||
let viewerUpdate (viewer: Viewer) (action: ViewerAction) : Viewer = failwith "TODO m10"
|
||||
|
||||
/// A key to a viewer action, or `None`: "ArrowRight"/"d"/"D" -> Next, "ArrowLeft"/"a"/"A" -> Prev, "Home" -> First,
|
||||
/// "End" -> Last, " " -> TogglePlay. Any other key -> `None`.
|
||||
let viewerKey (key: string) : ViewerAction option = failwith "TODO m10"
|
||||
|
||||
/// The picture: `View.view` of the frame at `Index`, followed by two texts. With `w = Width * CELL` of that frame:
|
||||
/// `Text(w - 6, 18, "step <index> / <last>", "#ffffff", 16, "right")` and
|
||||
/// `Text(w / 2, Height * CELL - 8, <hint>, "#aaaaaa", 12, "center")`, where the hint is "Space: pause" while playing
|
||||
/// and "Left/Right: step Home/End: jump Space: play" (three spaces between the parts) otherwise.
|
||||
let viewerView (frames: GameState list) (viewer: Viewer) : Scene = failwith "TODO m10"
|
||||
|
||||
/// `Beat` every REPLAY_MS (from `Stream.interval`), merged with `viewerKey` of every key press (the beats first).
|
||||
/// (The stub is wrapped in `Stream` so the TODO only fires when the stream is stepped.)
|
||||
let replayActions: Stream<ViewerAction> = Stream(fun _ -> failwith "TODO m10")
|
||||
|
||||
/// Fold the actions into viewers with `viewerUpdate`, starting from `viewerStart last`, which is emitted first.
|
||||
let viewerStates (last: int) (actions: Stream<ViewerAction>) : Stream<Viewer> = failwith "TODO m10"
|
||||
|
||||
/// The whole viewer as a value: `IO.pure` of the stream of drawings of `viewerView (frames recording) viewer` over
|
||||
/// `viewerStates <last index> replayActions`, wrapped in `Stream.clampTime App.MAX_GAP_MS`.
|
||||
/// No seed is asked for: the recording carries its own. Compute the frames once, not for every drawing.
|
||||
let replayMain (recording: Recording) : IO<Stream<IO<unit>>> = failwith "TODO m10"
|
||||
@@ -13,14 +13,21 @@ type Platform =
|
||||
FillText: int -> int -> string -> string -> int -> string -> unit
|
||||
/// A random unsigned 32-bit seed.
|
||||
RandomSeed: unit -> uint32
|
||||
/// (m10) The stored best score; 0 when there is none or it cannot be read. Never throws.
|
||||
LoadBest: unit -> int
|
||||
/// (m10) Store a new best score.
|
||||
SaveBest: int -> unit
|
||||
/// Call `onTime t` again and again, `t` = milliseconds since the clock started.
|
||||
StartClock: (int64 -> unit) -> unit
|
||||
OnKeyDown: (string -> unit) -> unit
|
||||
OnKeyUp: (string -> unit) -> unit }
|
||||
OnKeyUp: (string -> unit) -> unit
|
||||
/// (m13, given) Call `cb x y` for every click on the canvas, `x` and `y` in canvas pixels.
|
||||
OnClick: (int -> int -> unit) -> unit }
|
||||
|
||||
/// Interpret an IO against a platform and return its final value.
|
||||
/// `Draw` of a Rect -> `p.FillRect x y w h color` and of a Text -> `p.FillText x y text color size align`,
|
||||
/// both answered with `Done`; `RandomSeed` -> `Seed (p.RandomSeed ())`. Each answer is passed to `k`.
|
||||
/// (m10) `LoadBest` -> `Best (p.LoadBest ())`; `SaveBest score` -> `p.SaveBest score`, answered with `Done`.
|
||||
/// Must not grow the stack with the number of ops: a loop, or a tail-recursive `let rec` (which the compiler
|
||||
/// turns into a loop).
|
||||
let runIO (p: Platform) (io: IO<'a>) : 'a = failwith "TODO m09"
|
||||
@@ -29,4 +36,5 @@ let runIO (p: Platform) (io: IO<'a>) : 'a = failwith "TODO m09"
|
||||
/// (F# closures cannot capture a `let mutable`, so use a ref cell: `let stream = ref ...`, `stream.Value <- next`).
|
||||
/// Register `p.OnKeyDown` / `p.OnKeyUp` / `p.StartClock` so that each event steps the stream with the matching
|
||||
/// `Event` (`KeyDown key`, `KeyUp key`, `Time t`), stores the next stream, and runs every IO the step emitted, in order.
|
||||
/// (m13) Also register `p.OnClick` so that each click steps the stream with `Click(x, y)`.
|
||||
let runApp (p: Platform) (main: IO<Stream<IO<unit>>>) : unit = failwith "TODO m09"
|
||||
@@ -0,0 +1,63 @@
|
||||
/// m07b (optional): a stack-safe IO. The same idea as m07's IO, with one more case:
|
||||
/// - `Pure a` finished, with a value
|
||||
/// - `Effect (op, k)` perform `op`, then continue with `k result` (which returns another SafeIO)
|
||||
/// - `FlatMap (io, f)` run `io`, then continue with `f result` (which returns another SafeIO)
|
||||
/// The ops, their answers and the result of `trace` are m07's: write them `IO.Op`, `IO.OpResult`, `IO.Traced`
|
||||
/// (do not `open Snake.IO`: its cases are also called Pure and Effect). This module does not use m07's `IO` type;
|
||||
/// it is a second, independent IO. Building a SafeIO never performs anything and never calls a function given to
|
||||
/// `map` or `bind`.
|
||||
module Snake.SafeIO
|
||||
|
||||
/// `FlatMap`'s inner program produces some type `X` that only its continuation knows. A union case cannot have a
|
||||
/// type parameter of its own, so `X` is erased to `obj`; only `bind` builds a `FlatMap`, and it keeps the two in step.
|
||||
type SafeIO<'a> =
|
||||
| Pure of 'a
|
||||
| Effect of IO.Op * (IO.OpResult -> SafeIO<'a>)
|
||||
| FlatMap of SafeIO<obj> * (obj -> SafeIO<'a>)
|
||||
|
||||
// Given: the same program, seen as a SafeIO<obj>. Constant work: continuations are wrapped, not called.
|
||||
let rec private erase (io: SafeIO<'a>) : SafeIO<obj> =
|
||||
match io with
|
||||
| Pure a -> Pure(box a)
|
||||
| Effect(op, k) -> Effect(op, fun r -> erase (k r))
|
||||
| FlatMap(m, g) -> FlatMap(m, fun x -> erase (g x))
|
||||
|
||||
/// A SafeIO that does nothing and produces `a`: `Pure a`.
|
||||
let pure (a: 'a) : SafeIO<'a> = failwith "TODO m07b"
|
||||
|
||||
/// A SafeIO that performs the single operation `op` and produces its answer: `Effect (op, pure)`.
|
||||
let effect (op: IO.Op) : SafeIO<IO.OpResult> = failwith "TODO m07b"
|
||||
|
||||
/// "Run `io`, then continue with `f result`": only builds a node, `FlatMap (erase io, fun x -> f (unbox<'a> x))`.
|
||||
/// Never calls `f`, and never looks inside `io`.
|
||||
let bind (f: 'a -> SafeIO<'b>) (io: SafeIO<'a>) : SafeIO<'b> = failwith "TODO m07b"
|
||||
|
||||
/// Transform the result of `io` with `f`, built from `bind` and `pure`. Never calls `f` while building.
|
||||
let map (f: 'a -> 'b) (io: SafeIO<'a>) : SafeIO<'b> = failwith "TODO m07b"
|
||||
|
||||
/// Run the SafeIOs one after another, left to right, producing `()`. Either fold is fine here.
|
||||
let sequence (ios: SafeIO<unit> list) : SafeIO<unit> = failwith "TODO m07b"
|
||||
|
||||
/// One rewrite towards a program whose top is a `Pure` or an `Effect`, with a constant amount of work:
|
||||
/// FlatMap(Pure a, f) becomes f a
|
||||
/// FlatMap(Effect(op, k), f) becomes Effect(op, fun r -> FlatMap(k r, f))
|
||||
/// FlatMap(FlatMap(m, g), f) becomes FlatMap(m, fun x -> FlatMap(g x, f)) (re-association)
|
||||
/// A `Pure` or an `Effect` is returned unchanged. No recursion: `step` looks at most two levels deep and calls no
|
||||
/// function except `f` in the first rule. (The inner parts already have the erased types, so no `erase` is needed.)
|
||||
let step (io: SafeIO<'a>) : SafeIO<'a> = failwith "TODO m07b"
|
||||
|
||||
// Given: the canned answer of the pure interpreter, as in m07. SafeIO keeps Module 7's two operations; the stored
|
||||
// best score of Module 10 is not part of it, so its operations are refused loudly rather than given a meaning here.
|
||||
let private answer (seed: uint32) (op: IO.Op) : IO.OpResult =
|
||||
match op with
|
||||
| IO.RandomSeed -> IO.Seed seed
|
||||
| IO.Draw _ -> IO.Done
|
||||
| IO.LoadBest
|
||||
| IO.SaveBest _ -> failwith "SafeIO.trace answers only Module 7's operations (Draw and RandomSeed)"
|
||||
|
||||
/// The pure interpreter for tests. Answers every `RandomSeed` with `IO.Seed seed` and every `Draw` with `IO.Done`
|
||||
/// (`answer seed op`). Returns the final value and the operations in the order they were performed.
|
||||
/// Write it with an inner `let rec` that calls itself only in tail position (so the stack stays flat), one case per
|
||||
/// constructor: a `Pure` is finished; an `Effect` is answered and continues with `k answer`, recording its op; a
|
||||
/// `FlatMap` is rewritten once with `step`. Collect the ops at the front of a list and reverse it once at the end.
|
||||
let trace (seed: uint32) (io: SafeIO<'a>) : IO.Traced<'a> = failwith "TODO m07b"
|
||||
@@ -10,17 +10,25 @@
|
||||
<Compile Include="Model.fs" />
|
||||
<Compile Include="Rules.fs" />
|
||||
<Compile Include="Random.fs" />
|
||||
<Compile Include="State.fs" />
|
||||
<Compile Include="Spawn.fs" />
|
||||
<Compile Include="Game.fs" />
|
||||
<Compile Include="View.fs" />
|
||||
<Compile Include="IO.fs" />
|
||||
<Compile Include="SafeIO.fs" />
|
||||
<Compile Include="Stream.fs" />
|
||||
<Compile Include="Input.fs" />
|
||||
<Compile Include="App.fs" />
|
||||
<Compile Include="Runtime.fs" />
|
||||
<Compile Include="Replay.fs" />
|
||||
<Compile Include="Pong/Model.fs" />
|
||||
<Compile Include="Pong/Rules.fs" />
|
||||
<Compile Include="Pong/View.fs" />
|
||||
<Compile Include="Pong/App.fs" />
|
||||
<Compile Include="Life/Model.fs" />
|
||||
<Compile Include="Life/Rules.fs" />
|
||||
<Compile Include="Life/View.fs" />
|
||||
<Compile Include="Life/App.fs" />
|
||||
<Compile Include="Check.fs" />
|
||||
</ItemGroup>
|
||||
</Project>
|
||||
@@ -0,0 +1,28 @@
|
||||
/// m04 state (optional, Exercise 4.7). A `State<'s, 'a>` wraps a plain function from a state to a pair:
|
||||
/// `s -> (value, nextS)`. It is `Random<'a>` with the seed replaced by any state type `'s`.
|
||||
/// Nothing in the game uses this file.
|
||||
module Snake.State
|
||||
|
||||
type State<'s, 'a> = State of ('s -> 'a * 's)
|
||||
|
||||
/// Run `st` from the initial state `s`: the value it produces and the final state.
|
||||
let run (s: 's) (st: State<'s, 'a>) : 'a * 's = failwith "TODO m04"
|
||||
|
||||
/// A State that gives `a` and leaves the state untouched: `s -> (a, s)`.
|
||||
let pure (a: 'a) : State<'s, 'a> = failwith "TODO m04"
|
||||
|
||||
/// Transform the value a State produces; the state threading is unchanged.
|
||||
let map (f: 'a -> 'b) (st: State<'s, 'a>) : State<'s, 'b> = failwith "TODO m04"
|
||||
|
||||
/// Run `st`, feed its value to `f` to pick the next State, and run that with the state `st` left behind.
|
||||
let bind (f: 'a -> State<'s, 'b>) (st: State<'s, 'a>) : State<'s, 'b> = failwith "TODO m04"
|
||||
|
||||
/// A State whose value is the current state, which it leaves untouched: `s -> (s, s)`.
|
||||
/// A function of unit (use it as `get ()`), because F# does not allow a generic module-level value.
|
||||
let get () : State<'s, 's> = failwith "TODO m04"
|
||||
|
||||
/// A State that replaces the state with `s` and gives `()`: whatever the old state, `((), s)`.
|
||||
let put (s: 's) : State<'s, unit> = failwith "TODO m04"
|
||||
|
||||
/// A State that replaces the state `s` with `f s` and gives `()`.
|
||||
let modify (f: 's -> 's) : State<'s, unit> = failwith "TODO m04"
|
||||
+22
-1
@@ -3,11 +3,13 @@
|
||||
/// the next event. Nothing is mutated, so a stream value can be run any number of times with the same results.
|
||||
module Snake.Stream
|
||||
|
||||
/// Something that happens to the program: time passing (ms since start) or a key going down or up.
|
||||
/// Something that happens to the program: time passing (ms since start) or a key going down or up, and from
|
||||
/// Module 13 a mouse click at `(x, y)` in canvas pixels. Every stream ignores the kinds of event it does not use.
|
||||
type Event =
|
||||
| Time of int64
|
||||
| KeyDown of string
|
||||
| KeyUp of string
|
||||
| Click of int * int
|
||||
|
||||
type Stream<'a> = Stream of (Event -> 'a list * Stream<'a>)
|
||||
|
||||
@@ -21,6 +23,17 @@ let keyDowns: Stream<string> = Stream(fun _ -> failwith "TODO m08")
|
||||
/// Emits the `key` of every KeyUp event; ignores everything else.
|
||||
let keyUps: Stream<string> = Stream(fun _ -> failwith "TODO m08")
|
||||
|
||||
/// (m13) Emits the position `(x, y)` of every Click event; ignores everything else.
|
||||
/// Given: nothing to write here. It is the third source, built exactly like your `keyDowns`.
|
||||
let clicks: Stream<int * int> =
|
||||
let rec source () =
|
||||
Stream(fun e ->
|
||||
match e with
|
||||
| Click(x, y) -> [ (x, y) ], source ()
|
||||
| _ -> [], source ())
|
||||
|
||||
source ()
|
||||
|
||||
/// On `Time t`, emits every multiple `k*ms` with `last < k*ms <= t`, ascending, where `last` starts at 0
|
||||
/// and becomes `t` afterwards. A big time jump can emit several values. Ignores key events.
|
||||
/// Hint: write a private helper that carries `last`.
|
||||
@@ -45,5 +58,13 @@ let scan (f: 'b -> 'a -> 'b) (z: 'b) (s: Stream<'a>) : Stream<'b> = failwith "TO
|
||||
/// Note: streams only act when an event arrives, so if no event ever arrives, `v` is never emitted.
|
||||
let startWith (v: 'a) (s: Stream<'a>) : Stream<'a> = failwith "TODO m08"
|
||||
|
||||
/// (m10) Limit how far one Time event can move the clock that `s` sees, so a long silence (a background tab)
|
||||
/// does not turn into hundreds of beats at once.
|
||||
/// `s` gets a clock of its own, starting at 0. On `Time t` that clock advances by `t - last`, but by at most `maxGap`
|
||||
/// and never by less than 0 (time does not run backwards), where `last` is the `t` of the previous Time event
|
||||
/// (0 at the start). `s` is then stepped with `Time clock`. Key and click events are passed to `s` unchanged.
|
||||
/// Hint: a private helper that carries `last` and `clock`, like the one for `interval`.
|
||||
let clampTime (maxGap: int64) (s: Stream<'a>) : Stream<'a> = failwith "TODO m10"
|
||||
|
||||
/// Feed all events through the stream and collect every output, in order. A pure fold.
|
||||
let run (events: Event list) (s: Stream<'a>) : 'a list = failwith "TODO m08"
|
||||
+4
-2
@@ -1,11 +1,13 @@
|
||||
#!/usr/bin/env bash
|
||||
# Usage: ./test.sh [MNN] (no arg = all tests)
|
||||
# Usage: ./test.sh [MNN] (no arg = all tests; e.g. ./test.sh M04, ./test.sh M07b)
|
||||
# Every test list is named "MNN Name" (tag, a space, a name). Expecto's --filter-test-list matches a substring, so the
|
||||
# tag is passed with its trailing space: "M07 " selects "M07 IO" but not "M07b SafeIO".
|
||||
set -euo pipefail
|
||||
cd "$(dirname "$0")"
|
||||
export PATH="$HOME/.dotnet:$PATH"
|
||||
export DOTNET_NOLOGO=1 DOTNET_CLI_TELEMETRY_OPTOUT=1
|
||||
if [ $# -ge 1 ]; then
|
||||
exec dotnet run --project tests -- --filter-test-list "$1"
|
||||
exec dotnet run --project tests -- --filter-test-list "$1 "
|
||||
else
|
||||
exec dotnet run --project tests
|
||||
fi
|
||||
@@ -72,7 +72,8 @@ let gameState (v: JsonElement) : GameState =
|
||||
Seed = u32 (prop "seed" v)
|
||||
Score = num (prop "score" v)
|
||||
Status = status (prop "status" v)
|
||||
Frame = num (prop "frame" v) }
|
||||
Frame = num (prop "frame" v)
|
||||
Queued = opt direction (prop "queued" v) }
|
||||
|
||||
let shape (v: JsonElement) : Shape =
|
||||
let n key = num (prop key v)
|
||||
|
||||
@@ -16,7 +16,8 @@ let private eating: GameState =
|
||||
Seed = 0u
|
||||
Score = 0
|
||||
Status = Playing
|
||||
Frame = 0 }
|
||||
Frame = 0
|
||||
Queued = None }
|
||||
|
||||
[<Tests>]
|
||||
let tests =
|
||||
|
||||
@@ -0,0 +1,83 @@
|
||||
module Snake.Tests.M04State
|
||||
|
||||
open Expecto
|
||||
open Snake
|
||||
open Snake.State
|
||||
|
||||
// Small initial states for the "behaves like" checks: two States behave alike when they give the same pair from each.
|
||||
let private starts = [ 0; 1; 7; 42 ]
|
||||
|
||||
let private sameOnAll (st1: State<int, 'a>) (st2: State<int, 'a>) : unit =
|
||||
for s in starts do
|
||||
Expect.equal (State.run s st1) (State.run s st2) $"from state {s}"
|
||||
|
||||
// A counter step: gives the current number times 10 and adds 1 to the state. A function of unit, so that a stub
|
||||
// that throws fails each test on its own instead of the whole file at load time.
|
||||
let private step () : State<int, int> =
|
||||
State.get () |> State.bind (fun n -> State.put (n + 1) |> State.map (fun () -> n * 10))
|
||||
|
||||
let private f (a: int) : State<int, int> = State.modify (fun s -> s * 2) |> State.map (fun () -> a + 1)
|
||||
let private g (b: int) : State<int, int * int> = State.get () |> State.bind (fun s -> State.pure (b, s))
|
||||
|
||||
[<Tests>]
|
||||
let tests =
|
||||
testList "M04 State" [
|
||||
testCase "State pure gives its value and leaves the state alone" (fun () ->
|
||||
Expect.equal (State.run 99 (State.pure "x")) ("x", 99) "pure")
|
||||
|
||||
testCase "State map applies f to the value and keeps the state from the underlying step" (fun () ->
|
||||
Expect.equal (State.run 4 (State.map (fun v -> v + 1) (step ()))) (41, 5) "map")
|
||||
|
||||
testCase "State bind threads the state through both steps" (fun () ->
|
||||
let both = step () |> State.bind (fun a -> step () |> State.map (fun b -> (a, b)))
|
||||
Expect.equal (State.run 4 both) ((40, 50), 6) "bind")
|
||||
|
||||
testCase "State get gives the state as the value and leaves it alone" (fun () ->
|
||||
Expect.equal (State.run "board" (State.get ())) ("board", "board") "get")
|
||||
|
||||
testCase "State put replaces the state and gives unit" (fun () ->
|
||||
Expect.equal (State.run 99 (State.put 5)) ((), 5) "put")
|
||||
|
||||
testCase "State modify applies f to the state and gives unit" (fun () ->
|
||||
Expect.equal (State.run 21 (State.modify (fun s -> s * 2))) ((), 42) "modify")
|
||||
|
||||
testCase "State law: left identity, bind f (pure a) behaves like f a" (fun () ->
|
||||
sameOnAll (State.pure 3 |> State.bind f) (f 3))
|
||||
|
||||
testCase "State law: right identity, bind pure m behaves like m" (fun () ->
|
||||
sameOnAll (step () |> State.bind State.pure) (step ()))
|
||||
|
||||
testCase "State law: associativity, the grouping of bind does not matter" (fun () ->
|
||||
sameOnAll (step () |> State.bind f |> State.bind g) (step () |> State.bind (fun a -> f a |> State.bind g)))
|
||||
|
||||
testCase "State a counter hands out fresh labels in order" (fun () ->
|
||||
let fresh = State.get () |> State.bind (fun n -> State.put (n + 1) |> State.map (fun () -> $"L{n}"))
|
||||
|
||||
let three =
|
||||
fresh
|
||||
|> State.bind (fun a -> fresh |> State.bind (fun b -> fresh |> State.map (fun c -> [ a; b; c ])))
|
||||
|
||||
Expect.equal (State.run 0 three) ([ "L0"; "L1"; "L2" ], 3) "from 0"
|
||||
Expect.equal (State.run 7 three) ([ "L7"; "L8"; "L9" ], 10) "from 7")
|
||||
|
||||
testCase "State Random is State with the seed as S: the dice give the same values and seeds" (fun () ->
|
||||
// One draw written only with State's get and put: read the seed, compute, store the next seed.
|
||||
let draw: State<uint32, uint32> =
|
||||
State.get ()
|
||||
|> State.bind (fun seed ->
|
||||
let v, next = Random.run seed Random.nextUint32
|
||||
State.put next |> State.map (fun () -> v))
|
||||
|
||||
// The same draw, by turning a Random step into a State by hand.
|
||||
let wrapped: State<uint32, uint32> = State(fun seed -> Random.run seed Random.nextUint32)
|
||||
let d6State = draw |> State.map (fun v -> 1u + v % 6u)
|
||||
let twoDiceState = d6State |> State.bind (fun a -> d6State |> State.map (fun b -> a + b))
|
||||
let d6Random = Random.nextUint32 |> Random.map (fun v -> 1u + v % 6u)
|
||||
let twoDiceRandom = d6Random |> Random.bind (fun a -> d6Random |> Random.map (fun b -> a + b))
|
||||
|
||||
for seed in [ 0u; 1u; 42u; 4294967295u ] do
|
||||
Expect.equal (State.run seed draw) (Random.run seed Random.nextUint32) $"draw from {seed}"
|
||||
Expect.equal (State.run seed wrapped) (Random.run seed Random.nextUint32) $"wrapped from {seed}"
|
||||
Expect.equal (State.run seed d6State) (Random.run seed d6Random) $"d6 from {seed}"
|
||||
Expect.equal (State.run seed twoDiceState) (Random.run seed twoDiceRandom) $"twoDice from {seed}")
|
||||
]
|
||||
@@ -0,0 +1,293 @@
|
||||
module Snake.Tests.M07bSafeIO
|
||||
|
||||
// The JS tests check that a node holds the very same function; functions cannot be compared, so these tests check
|
||||
// each node's shape (its case) and then observe the program through `trace`. `traceStep` and `drive` are JS-only.
|
||||
|
||||
open Expecto
|
||||
open Snake
|
||||
open Snake.View
|
||||
open Snake.SafeIO
|
||||
|
||||
let private rectAt (x: int) : Shape = Rect(x, 0, 1, 1, "#000000")
|
||||
let private r1 = rectAt 0
|
||||
let private t1 = Text(1, 2, "hi", "#ffffff", 16, "left")
|
||||
let private boom (_: 'a) : SafeIO<'b> = failwith "boom"
|
||||
let private N = 100000
|
||||
|
||||
// The value of a RandomSeed answer (the same job as IO.randomSeed does for m07's IO).
|
||||
let private seedValue (r: IO.OpResult) : uint32 =
|
||||
match r with
|
||||
| IO.Seed s -> s
|
||||
| _ -> failwith "RandomSeed must be answered with a Seed"
|
||||
|
||||
// SafeIO versions of m07's `draw` and `randomSeed`, built the same way.
|
||||
let private draw (shape: Shape) : SafeIO<unit> = SafeIO.effect (IO.Draw shape) |> SafeIO.map ignore
|
||||
let private randomSeed () : SafeIO<uint32> = SafeIO.effect IO.RandomSeed |> SafeIO.map seedValue
|
||||
|
||||
let private leftDraws (n: int) : SafeIO<unit> =
|
||||
List.fold (fun acc i -> acc |> SafeIO.bind (fun () -> draw (rectAt i))) (SafeIO.pure ()) [ 0 .. n - 1 ]
|
||||
|
||||
let private rightDraws (n: int) : SafeIO<unit> =
|
||||
List.foldBack (fun i rest -> draw (rectAt i) |> SafeIO.bind (fun () -> rest)) [ 0 .. n - 1 ] (SafeIO.pure ())
|
||||
|
||||
let private firstAndLast (ops: IO.Op list) : IO.Op list = [ List.head ops; List.last ops ]
|
||||
|
||||
// ---- the monad laws, observed through trace
|
||||
|
||||
let private programs: (string * (unit -> SafeIO<uint32>)) list =
|
||||
[ "a pure value", (fun () -> SafeIO.pure 4u)
|
||||
"one effect", (fun () -> randomSeed ())
|
||||
"a draw followed by reading the seed", (fun () -> draw r1 |> SafeIO.bind (fun () -> randomSeed ())) ]
|
||||
|
||||
let private f (n: uint32) : SafeIO<uint32> = draw (rectAt (int n)) |> SafeIO.bind (fun () -> SafeIO.pure (n * 2u))
|
||||
let private g (n: uint32) : SafeIO<uint32> = randomSeed () |> SafeIO.map (fun s -> s + n)
|
||||
|
||||
// ---- the same programs under m07's IO. F# cannot pass "an IO module" as a parameter, so each program is written
|
||||
// twice, line for line the same, once with each IO.
|
||||
|
||||
let private shared: (string * (unit -> IO.Traced<int>) * (unit -> IO.Traced<int>)) list =
|
||||
[ "seed, then a draw that depends on it",
|
||||
(fun () ->
|
||||
randomSeed ()
|
||||
|> SafeIO.bind (fun s -> draw (rectAt (int (s % 20u))) |> SafeIO.map (fun () -> int s))
|
||||
|> SafeIO.trace 7u),
|
||||
(fun () ->
|
||||
IO.randomSeed ()
|
||||
|> IO.bind (fun s -> IO.draw (rectAt (int (s % 20u))) |> IO.map (fun () -> int s))
|
||||
|> IO.trace 7u)
|
||||
|
||||
"a sequence of three effects",
|
||||
(fun () ->
|
||||
SafeIO.sequence [ draw t1; randomSeed () |> SafeIO.map ignore; draw r1 ]
|
||||
|> SafeIO.map (fun () -> 0)
|
||||
|> SafeIO.trace 7u),
|
||||
(fun () ->
|
||||
IO.sequence [ IO.draw t1; IO.randomSeed () |> IO.map ignore; IO.draw r1 ]
|
||||
|> IO.map (fun () -> 0)
|
||||
|> IO.trace 7u)
|
||||
|
||||
"200 left-nested binds",
|
||||
(fun () ->
|
||||
List.fold
|
||||
(fun acc i -> acc |> SafeIO.bind (fun n -> draw (rectAt i) |> SafeIO.map (fun () -> n + 1)))
|
||||
(SafeIO.pure 0)
|
||||
[ 0..199 ]
|
||||
|> SafeIO.trace 7u),
|
||||
(fun () ->
|
||||
List.fold (fun acc i -> acc |> IO.bind (fun n -> IO.draw (rectAt i) |> IO.map (fun () -> n + 1))) (IO.pure 0) [ 0..199 ]
|
||||
|> IO.trace 7u)
|
||||
|
||||
"nested on both sides",
|
||||
(fun () ->
|
||||
randomSeed ()
|
||||
|> SafeIO.bind (fun s -> draw r1 |> SafeIO.bind (fun () -> SafeIO.pure (int s + 1)))
|
||||
|> SafeIO.bind (fun n ->
|
||||
SafeIO.sequence [ draw t1; randomSeed () |> SafeIO.map ignore ] |> SafeIO.map (fun () -> n * 3))
|
||||
|> SafeIO.trace 7u),
|
||||
(fun () ->
|
||||
IO.randomSeed ()
|
||||
|> IO.bind (fun s -> IO.draw r1 |> IO.bind (fun () -> IO.pure (int s + 1)))
|
||||
|> IO.bind (fun n -> IO.sequence [ IO.draw t1; IO.randomSeed () |> IO.map ignore ] |> IO.map (fun () -> n * 3))
|
||||
|> IO.trace 7u) ]
|
||||
|
||||
[<Tests>]
|
||||
let tests =
|
||||
testList "M07b SafeIO" [
|
||||
// ---- building
|
||||
|
||||
testCase "pure builds a Pure" (fun () ->
|
||||
match SafeIO.pure 3 with
|
||||
| Pure 3 -> ()
|
||||
| _ -> failtest "expected Pure 3")
|
||||
|
||||
testCase "effect op is an Effect whose continuation is pure" (fun () ->
|
||||
match SafeIO.effect IO.RandomSeed with
|
||||
| Effect(op, k) ->
|
||||
Expect.equal op IO.RandomSeed "op"
|
||||
|
||||
match k (IO.Seed 5u) with
|
||||
| Pure(IO.Seed 5u) -> ()
|
||||
| _ -> failtest "expected the continuation to give Pure (Seed 5u)"
|
||||
| _ -> failtest "expected an Effect")
|
||||
|
||||
testCase "bind only builds a FlatMap node" (fun () ->
|
||||
match SafeIO.pure 1 |> SafeIO.bind (fun n -> SafeIO.pure (n + 1)) with
|
||||
| FlatMap(inner, k) ->
|
||||
match inner with
|
||||
| Pure x -> Expect.equal (unbox<int> x) 1 "the inner program is the Pure 1 it was given"
|
||||
| _ -> failtest "expected the inner program to be a Pure"
|
||||
|
||||
Expect.equal (SafeIO.trace 0u (k (box 1))).Result 2 "the continuation is f"
|
||||
| _ -> failtest "expected a FlatMap")
|
||||
|
||||
testCase "building bind throwingF (pure 1) does not throw" (fun () ->
|
||||
SafeIO.pure 1 |> SafeIO.bind boom |> ignore<SafeIO<int>>)
|
||||
|
||||
testCase "building map throwingF io does not throw" (fun () ->
|
||||
SafeIO.effect IO.RandomSeed |> SafeIO.map (fun _ -> failwith "boom") |> ignore<SafeIO<int>>)
|
||||
|
||||
testCase "tracing map throwingF io runs f and throws" (fun () ->
|
||||
Expect.throwsC
|
||||
(fun () ->
|
||||
SafeIO.effect IO.RandomSeed
|
||||
|> SafeIO.map (fun _ -> failwith "boom")
|
||||
|> SafeIO.trace 0u
|
||||
|> ignore<IO.Traced<int>>)
|
||||
(fun e -> Expect.equal e.Message "boom" "f runs when the program is traced"))
|
||||
|
||||
// ---- step: the three rewrite rules
|
||||
|
||||
testCase "step leaves a Pure unchanged" (fun () ->
|
||||
match SafeIO.step (SafeIO.pure 1) with
|
||||
| Pure 1 -> ()
|
||||
| _ -> failtest "expected Pure 1")
|
||||
|
||||
testCase "step leaves an Effect unchanged" (fun () ->
|
||||
match SafeIO.step (SafeIO.effect IO.RandomSeed) with
|
||||
| Effect(IO.RandomSeed, k) ->
|
||||
match k (IO.Seed 5u) with
|
||||
| Pure(IO.Seed 5u) -> ()
|
||||
| _ -> failtest "expected the same continuation (pure)"
|
||||
| _ -> failtest "expected an Effect with the same op")
|
||||
|
||||
testCase "step of FlatMap(Pure a, f) is f a" (fun () ->
|
||||
match SafeIO.step (SafeIO.pure 3 |> SafeIO.bind (fun n -> SafeIO.pure (n * 2))) with
|
||||
| Pure 6 -> ()
|
||||
| _ -> failtest "expected Pure 6")
|
||||
|
||||
testCase "step of FlatMap(Effect(op, k), f) is an Effect with the same op that continues with FlatMap(k r, f)" (fun () ->
|
||||
let f (r: IO.OpResult) = SafeIO.pure (int (seedValue r) * 2)
|
||||
|
||||
match SafeIO.step (SafeIO.effect IO.RandomSeed |> SafeIO.bind f) with
|
||||
| Effect(op, k) ->
|
||||
Expect.equal op IO.RandomSeed "op"
|
||||
|
||||
match k (IO.Seed 5u) with
|
||||
| FlatMap(Pure x, _) as next ->
|
||||
Expect.equal (unbox<IO.OpResult> x) (IO.Seed 5u) "FlatMap(k r, _): k r is Pure (Seed 5u)"
|
||||
Expect.equal (SafeIO.trace 0u next) { IO.Result = 10; IO.Ops = [] } "then f"
|
||||
| _ -> failtest "expected the continuation to give FlatMap(Pure _, _)"
|
||||
| _ -> failtest "expected an Effect")
|
||||
|
||||
testCase "step re-associates FlatMap(FlatMap(m, g), f) into FlatMap(m, fun x -> FlatMap(g x, f))" (fun () ->
|
||||
let g (r: IO.OpResult) = SafeIO.pure (int (seedValue r) + 1)
|
||||
let f (n: int) = SafeIO.pure (n * 2)
|
||||
|
||||
match SafeIO.step (SafeIO.effect IO.RandomSeed |> SafeIO.bind g |> SafeIO.bind f) with
|
||||
| FlatMap(Effect(IO.RandomSeed, _), k) ->
|
||||
match k (box (IO.Seed 4u)) with
|
||||
| FlatMap(Pure x, _) as inner ->
|
||||
Expect.equal (unbox<int> x) 5 "g x is Pure 5"
|
||||
Expect.equal (SafeIO.trace 0u inner) { IO.Result = 10; IO.Ops = [] } "then f"
|
||||
| _ -> failtest "expected the continuation to give FlatMap(g x, f)"
|
||||
| _ -> failtest "expected FlatMap(m, _) with m the Effect")
|
||||
|
||||
testCase "step does not call the functions it re-associates" (fun () ->
|
||||
SafeIO.effect IO.RandomSeed
|
||||
|> SafeIO.bind boom
|
||||
|> SafeIO.bind boom
|
||||
|> SafeIO.step
|
||||
|> ignore<SafeIO<int>>)
|
||||
|
||||
testCase "step of a left-nested chain is one rewrite, not a whole walk" (fun () ->
|
||||
// After one step, the top is still a FlatMap: step did constant work, the rest is left for later steps.
|
||||
let chain = List.fold (fun acc _ -> acc |> SafeIO.bind (fun n -> SafeIO.pure (n + 1))) (SafeIO.pure 0) [ 1..N ]
|
||||
|
||||
match SafeIO.step chain with
|
||||
| FlatMap _ -> ()
|
||||
| _ -> failtest "expected a FlatMap")
|
||||
|
||||
// ---- the interpreter
|
||||
|
||||
testCase "trace of pure 3 has result 3 and no ops" (fun () ->
|
||||
Expect.equal (SafeIO.trace 0u (SafeIO.pure 3)) { IO.Result = 3; IO.Ops = [] } "trace")
|
||||
|
||||
testCase "trace answers RandomSeed with the seed and Draw with Done" (fun () ->
|
||||
let program =
|
||||
SafeIO.effect IO.RandomSeed
|
||||
|> SafeIO.bind (fun s -> SafeIO.effect (IO.Draw r1) |> SafeIO.map (fun d -> (s, d)))
|
||||
|
||||
Expect.equal
|
||||
(SafeIO.trace 9u program)
|
||||
{ IO.Result = (IO.Seed 9u, IO.Done); IO.Ops = [ IO.RandomSeed; IO.Draw r1 ] }
|
||||
"trace")
|
||||
|
||||
// The stub throws too, so the test also checks that the failure is not the stub's TODO.
|
||||
testCase "trace refuses operations of later modules" (fun () ->
|
||||
Expect.throwsC
|
||||
(fun () -> SafeIO.trace 0u (SafeIO.effect IO.LoadBest) |> ignore)
|
||||
(fun e -> Expect.isFalse (e.Message.Contains "TODO") $"refused by the interpreter, not the stub: {e.Message}"))
|
||||
|
||||
testCase "sequence of nothing has no ops" (fun () ->
|
||||
Expect.equal (SafeIO.trace 0u (SafeIO.sequence [])) { IO.Result = (); IO.Ops = [] } "trace")
|
||||
|
||||
testCase "sequence runs effects left to right" (fun () ->
|
||||
Expect.equal
|
||||
(SafeIO.trace 0u (SafeIO.sequence [ randomSeed () |> SafeIO.map ignore; draw t1; draw r1 ])).Ops
|
||||
[ IO.RandomSeed; IO.Draw t1; IO.Draw r1 ]
|
||||
"ops")
|
||||
|
||||
// ---- stack safety
|
||||
|
||||
testCase "100 000 left-nested binds of draws run, in order" (fun () ->
|
||||
let traced = SafeIO.trace 0u (leftDraws N)
|
||||
Expect.equal traced.Result () "result"
|
||||
Expect.equal (List.length traced.Ops) N "ops"
|
||||
Expect.equal (firstAndLast traced.Ops) [ IO.Draw(rectAt 0); IO.Draw(rectAt (N - 1)) ] "order")
|
||||
|
||||
testCase "100 000 right-nested binds of draws run, in order" (fun () ->
|
||||
let traced = SafeIO.trace 0u (rightDraws N)
|
||||
Expect.equal (List.length traced.Ops) N "ops"
|
||||
Expect.equal (firstAndLast traced.Ops) [ IO.Draw(rectAt 0); IO.Draw(rectAt (N - 1)) ] "order")
|
||||
|
||||
testCase "100 000 left-nested maps run without any op" (fun () ->
|
||||
let program = List.fold (fun acc _ -> acc |> SafeIO.map (fun n -> n + 1)) (SafeIO.pure 0) [ 1..N ]
|
||||
Expect.equal (SafeIO.trace 0u program) { IO.Result = N; IO.Ops = [] } "trace")
|
||||
|
||||
testCase "sequence of 100 000 draws runs" (fun () ->
|
||||
let program = SafeIO.sequence [ for i in 0 .. N - 1 -> draw (rectAt i) ]
|
||||
Expect.equal (List.length (SafeIO.trace 0u program).Ops) N "ops")
|
||||
|
||||
testCase "a while loop over step is a complete interpreter for 100 000 left-nested binds" (fun () ->
|
||||
// What an impure runtime would do (a loop is allowed there): rewrite until the top is Pure or Effect, perform.
|
||||
let mutable performed = 0
|
||||
let mutable current = leftDraws N
|
||||
let isPure p = match p with Pure _ -> true | _ -> false
|
||||
|
||||
while not (isPure current) do
|
||||
current <- SafeIO.step current
|
||||
|
||||
match current with
|
||||
| Effect(_, k) ->
|
||||
performed <- performed + 1
|
||||
current <- k IO.Done
|
||||
| _ -> ()
|
||||
|
||||
Expect.equal performed N "performed")
|
||||
|
||||
// ---- the monad laws, observed through trace
|
||||
|
||||
yield!
|
||||
[ for name, program in programs do
|
||||
testCase $"left identity holds for {name}" (fun () ->
|
||||
let a = (SafeIO.trace 5u (program ())).Result
|
||||
Expect.equal (SafeIO.trace 5u (SafeIO.pure a |> SafeIO.bind f)) (SafeIO.trace 5u (f a)) "left identity")
|
||||
|
||||
testCase $"right identity holds for {name}" (fun () ->
|
||||
Expect.equal
|
||||
(SafeIO.trace 5u (program () |> SafeIO.bind SafeIO.pure))
|
||||
(SafeIO.trace 5u (program ()))
|
||||
"right identity")
|
||||
|
||||
testCase $"associativity holds for {name}" (fun () ->
|
||||
Expect.equal
|
||||
(SafeIO.trace 5u (program () |> SafeIO.bind f |> SafeIO.bind g))
|
||||
(SafeIO.trace 5u (program () |> SafeIO.bind (fun x -> f x |> SafeIO.bind g)))
|
||||
"associativity") ]
|
||||
|
||||
// ---- the same programs under Module 7's IO
|
||||
|
||||
yield!
|
||||
[ for name, safe, simple in shared ->
|
||||
testCase $"trace equals Module 7's trace for {name}" (fun () -> Expect.equal (safe ()) (simple ()) "trace") ]
|
||||
]
|
||||
@@ -24,6 +24,9 @@ let tests =
|
||||
testCase "interval emits several multiples after one big time jump" (fun () ->
|
||||
Expect.equal (Stream.run [ Time 35L ] (Stream.interval 10L)) [ 10L; 20L; 30L ] "ticks")
|
||||
|
||||
testCase "interval 1 emits every millisecond crossed" (fun () ->
|
||||
Expect.equal (Stream.run [ Time 1L; Time 3L ] (Stream.interval 1L)) [ 1L; 2L; 3L ] "ticks")
|
||||
|
||||
testCase "interval ignores key events" (fun () ->
|
||||
Expect.equal (Stream.run [ KeyDown "a"; KeyUp "a" ] (Stream.interval 10L)) [] "ticks")
|
||||
|
||||
|
||||
+25
-2
@@ -7,6 +7,9 @@ open Snake.IO
|
||||
open Snake.Stream
|
||||
open Snake.Tests.M09Helpers
|
||||
|
||||
// The ops of drawing one state's view.
|
||||
let private drawOps (state: GameState) : Op list = View.view state |> List.map Draw
|
||||
|
||||
[<Tests>]
|
||||
let tests =
|
||||
testList "M09 App" [
|
||||
@@ -37,12 +40,19 @@ let tests =
|
||||
(View.view (Spawn.newGame 42u) |> List.map Draw)
|
||||
"ops")
|
||||
|
||||
// Module 10 (Exercise 10.7) makes `main` also load the stored best and draw one more shape after the game's
|
||||
// view, so this test accepts both versions; M10 pins the final one exactly.
|
||||
testCase "main asks for a random seed, then builds the stream from it" (fun () ->
|
||||
let traced = IO.trace 42u (App.main ())
|
||||
Expect.equal traced.Ops [ RandomSeed ] "ops"
|
||||
|
||||
Expect.isTrue
|
||||
(traced.Ops = [ RandomSeed ] || traced.Ops = [ RandomSeed; LoadBest ])
|
||||
$"main may only ask for the seed (and, from m10 on, the stored best); it asked for %A{traced.Ops}"
|
||||
|
||||
let outs, _ = Stream.step (Time 0L) traced.Result
|
||||
Expect.equal (List.length outs) 1 "one drawing"
|
||||
Expect.equal (drawn (List.head outs)) (View.view (Spawn.newGame 42u)) "drawing")
|
||||
let expected = View.view (Spawn.newGame 42u)
|
||||
Expect.equal (drawn (List.head outs) |> List.truncate (List.length expected)) expected "drawing")
|
||||
|
||||
// `main` itself switches to speedActions in m10, so the 150 ms behaviour is checked on the same program built from classicActions.
|
||||
testCase "the program built from classicActions draws the new game first, then the ticked game after 150 ms" (fun () ->
|
||||
@@ -60,4 +70,17 @@ let tests =
|
||||
let later, _ = Stream.step (Time 150L) next
|
||||
Expect.equal (List.length first) 1 "one drawing"
|
||||
Expect.isNonEmpty later "more drawings")
|
||||
|
||||
// ---- play: the whole program in one equality (Exercise 9.5)
|
||||
|
||||
testCase "play on the classic program equals the scenes of the expected states" (fun () ->
|
||||
let events = [ Time 150L; KeyDown "ArrowUp"; KeyDown "x"; Time 300L; Time 310L ]
|
||||
let expectedStates = Game.history (Spawn.newGame 42u) [ Tick; Turn Up; Tick ]
|
||||
Expect.equal (App.play 42u events (classicMain ())) (List.map drawOps expectedStates) "drawings")
|
||||
|
||||
testCase "play with no events gives no drawings" (fun () ->
|
||||
Expect.equal (App.play 42u [] (classicMain ())) [] "drawings")
|
||||
|
||||
testCase "play uses the seed for the program's RandomSeed" (fun () ->
|
||||
Expect.equal (App.play 7u [ Time 0L ] (classicMain ())) [ drawOps (Spawn.newGame 7u) ] "drawings")
|
||||
]
|
||||
@@ -16,4 +16,4 @@ let drawn (io: IO<unit>) : Shape list =
|
||||
|> List.choose (fun op ->
|
||||
match op with
|
||||
| Draw shape -> Some shape
|
||||
| RandomSeed -> None)
|
||||
| _ -> None)
|
||||
@@ -8,17 +8,25 @@ open Snake.Runtime
|
||||
open Snake.Tests.M09Helpers
|
||||
|
||||
/// A fake platform: records every call and lets the test fire events by hand. (Tests may mutate; src/ may not.)
|
||||
type FakePlatform(seed: uint32) =
|
||||
type FakePlatform(seed: uint32, best: int) =
|
||||
let calls = ResizeArray<obj list>()
|
||||
let mutable onTime: int64 -> unit = ignore
|
||||
let mutable onDown: string -> unit = ignore
|
||||
let mutable onUp: string -> unit = ignore
|
||||
// m13: a runtime from Module 9 does not register this yet; nothing in m09 fires a click.
|
||||
let mutable onClick: int -> int -> unit = fun _ _ -> ()
|
||||
let registered = ResizeArray<string>()
|
||||
|
||||
new(seed: uint32) = FakePlatform(seed, 0)
|
||||
|
||||
member _.Calls: obj list list = List.ofSeq calls
|
||||
member _.Clear() = calls.Clear()
|
||||
member _.FireTime(t: int64) = onTime t
|
||||
member _.FireKey(key: string) = onDown key
|
||||
member _.FireKeyUp(key: string) = onUp key
|
||||
member _.FireClick(x: int, y: int) = onClick x y
|
||||
/// The names of the handlers the runtime registered ("click", "down", "time", "up"), sorted.
|
||||
member _.Registered: string list = registered |> Seq.distinct |> Seq.sort |> List.ofSeq
|
||||
|
||||
member _.Platform: Platform =
|
||||
{ FillRect = fun x y w h color -> calls.Add [ box "fillRect"; box x; box y; box w; box h; box color ]
|
||||
@@ -29,9 +37,27 @@ type FakePlatform(seed: uint32) =
|
||||
fun () ->
|
||||
calls.Add [ box "randomSeed" ]
|
||||
seed
|
||||
StartClock = fun cb -> onTime <- cb
|
||||
OnKeyDown = fun cb -> onDown <- cb
|
||||
OnKeyUp = fun cb -> onUp <- cb }
|
||||
LoadBest =
|
||||
fun () ->
|
||||
calls.Add [ box "loadBest" ]
|
||||
best
|
||||
SaveBest = fun n -> calls.Add [ box "saveBest"; box n ]
|
||||
StartClock =
|
||||
fun cb ->
|
||||
registered.Add "time"
|
||||
onTime <- cb
|
||||
OnKeyDown =
|
||||
fun cb ->
|
||||
registered.Add "down"
|
||||
onDown <- cb
|
||||
OnKeyUp =
|
||||
fun cb ->
|
||||
registered.Add "up"
|
||||
onUp <- cb
|
||||
OnClick =
|
||||
fun cb ->
|
||||
registered.Add "click"
|
||||
onClick <- cb }
|
||||
|
||||
// What the platform should have been asked to draw for a scene.
|
||||
let private expectedCalls (scene: Scene) : obj list list =
|
||||
|
||||
@@ -1,15 +1,47 @@
|
||||
module Snake.Tests.M10Extensions
|
||||
|
||||
open System.Text.Json
|
||||
open Expecto
|
||||
open Snake
|
||||
open Snake.Model
|
||||
open Snake.View
|
||||
open Snake.IO
|
||||
open Snake.Stream
|
||||
open Snake.App
|
||||
open Snake.Tests.Fixtures
|
||||
open Snake.Tests.M09Helpers
|
||||
open Snake.Tests.M09Runtime
|
||||
|
||||
let private frameTimes = [ 25L; 50L; 75L; 100L; 125L; 150L; 175L; 200L ]
|
||||
|
||||
// Sessions in the fixtures use the keys game, best and improved.
|
||||
let private session (v: JsonElement) : Session =
|
||||
{ Game = gameState (prop "game" v); Best = num (prop "best" v); Improved = bool (prop "improved" v) }
|
||||
|
||||
// Events in the golden fixture: {tag:'Time', t} and {tag:'KeyDown', key}.
|
||||
let private event (v: JsonElement) : Event =
|
||||
match str (prop "tag" v) with
|
||||
| "Time" -> Time((prop "t" v).GetInt64())
|
||||
| "KeyDown" -> KeyDown(str (prop "key" v))
|
||||
| "KeyUp" -> KeyUp(str (prop "key" v))
|
||||
| other -> failwith $"unknown event tag: {other}"
|
||||
|
||||
// The drawings are compared by their first shapes, the game's view: Exercise 10.7 adds the best score after it.
|
||||
let private startsWithView (io: IO<unit>) (state: GameState) (label: string) =
|
||||
let expected = View.view state
|
||||
Expect.equal (drawn io |> List.truncate (List.length expected)) expected label
|
||||
|
||||
let private newSession (game: GameState) (best: int) : Session = { Game = game; Best = best; Improved = false }
|
||||
|
||||
let private drawOps (scene: Scene) : Op list = List.map Draw scene
|
||||
|
||||
let private saves (ops: Op list) : int list =
|
||||
ops
|
||||
|> List.choose (fun op ->
|
||||
match op with
|
||||
| SaveBest n -> Some n
|
||||
| _ -> None)
|
||||
|
||||
[<Tests>]
|
||||
let tests =
|
||||
testList "M10 Extensions" [
|
||||
@@ -22,6 +54,31 @@ let tests =
|
||||
yield! fixtureTests "m10-input" "keyToAction" (fun c ->
|
||||
Expect.equal (Input.keyToAction (str (arg 0 c))) (opt action (expected c)) "keyToAction")
|
||||
|
||||
yield! fixtureTests "m10-session-update" "sessionUpdate" (fun c ->
|
||||
Expect.equal (App.sessionUpdate (session (arg 0 c)) (action (arg 1 c))) (session (expected c)) "sessionUpdate")
|
||||
|
||||
yield! fixtureTests "m10-session-view" "sessionView" (fun c ->
|
||||
Expect.equal (App.sessionView (session (arg 0 c))) (list shape (expected c)) "sessionView")
|
||||
|
||||
// ---- the turn queue (Exercise 10.6)
|
||||
|
||||
testCase "steer is what update does with a Turn" (fun () ->
|
||||
for c in cases "m10-update" do
|
||||
match action (arg 1 c) with
|
||||
| Turn dir -> Expect.equal (Game.steer (gameState (arg 0 c)) dir) (gameState (expected c)) (name c)
|
||||
| _ -> ())
|
||||
|
||||
testCase "Turn Up then Turn Left within one step: the snake goes Up on the next step and Left on the one after" (fun () ->
|
||||
let start = Spawn.newGame 42u // heading Right from (10, 10); the apple is far away
|
||||
let states = List.scan Game.update start [ Turn Up; Turn Left; Tick; Tick ]
|
||||
|
||||
Expect.equal
|
||||
(states |> List.skip 2 |> List.map (fun s -> List.head s.Snake))
|
||||
[ { X = 10; Y = 10 }; { X = 10; Y = 9 }; { X = 9; Y = 9 } ]
|
||||
"head path"
|
||||
|
||||
Expect.equal (states |> List.map (fun s -> s.Queued)) [ None; None; Some Left; None; None ] "queued")
|
||||
|
||||
testCase "the animation clock runs every 25 ms" (fun () -> Expect.equal App.FRAME_MS 25L "FRAME_MS")
|
||||
|
||||
testCase "speedActions turns the clock into Frame actions every 25 ms" (fun () ->
|
||||
@@ -35,9 +92,9 @@ let tests =
|
||||
|
||||
testCase "main (seed 42) draws a moved snake after eight 25 ms frames" (fun () ->
|
||||
let traced = IO.trace 42u (App.main ())
|
||||
Expect.equal traced.Ops [ RandomSeed ] "ops"
|
||||
Expect.equal (List.head traced.Ops) RandomSeed "first op"
|
||||
let first, afterFirst = Stream.step (Time 0L) traced.Result
|
||||
Expect.equal (drawn (List.head first)) (View.view (Spawn.newGame 42u)) "first drawing"
|
||||
startsWithView (List.head first) (Spawn.newGame 42u) "first drawing"
|
||||
let drawings = Stream.run (List.map Time frameTimes) afterFirst
|
||||
Expect.equal (List.length drawings) 8 "eight drawings"
|
||||
let start = Spawn.newGame 42u
|
||||
@@ -45,7 +102,153 @@ let tests =
|
||||
let moved =
|
||||
{ start with
|
||||
Snake = start.Snake |> List.map (fun p -> { p with X = p.X + 1 })
|
||||
Frame = 8 }
|
||||
Frame = 0 }
|
||||
|
||||
Expect.equal (drawn drawings[7]) (View.view moved) "moved snake")
|
||||
startsWithView drawings[7] moved "moved snake")
|
||||
|
||||
// ---- clampTime: a long silence from the clock (a background tab) must not turn into hundreds of frames
|
||||
|
||||
testCase "clampTime passes small steps of time through unchanged" (fun () ->
|
||||
Expect.equal
|
||||
(Stream.interval 10L |> Stream.clampTime 100L |> Stream.run (List.map Time [ 5L; 10L; 35L ]))
|
||||
[ 10L; 20L; 30L ]
|
||||
"outputs")
|
||||
|
||||
testCase "clampTime lets a long gap count as maxGap, and carries on from there" (fun () ->
|
||||
Expect.equal
|
||||
(Stream.interval 10L |> Stream.clampTime 25L |> Stream.run (List.map Time [ 10L; 5000L; 5010L ]))
|
||||
[ 10L; 20L; 30L; 40L ]
|
||||
"outputs")
|
||||
|
||||
testCase "clampTime clamps the very first step too (the clock starts at 0)" (fun () ->
|
||||
Expect.equal (Stream.interval 10L |> Stream.clampTime 25L |> Stream.run [ Time 1000L ]) [ 10L; 20L ] "outputs")
|
||||
|
||||
testCase "clampTime never moves the clock backwards" (fun () ->
|
||||
Expect.equal
|
||||
(Stream.interval 10L |> Stream.clampTime 100L |> Stream.run (List.map Time [ 30L; 10L; 40L ]))
|
||||
[ 10L; 20L; 30L; 40L; 50L; 60L ]
|
||||
"outputs")
|
||||
|
||||
testCase "clampTime passes key events through, and they do not disturb the clock" (fun () ->
|
||||
Expect.equal
|
||||
(Stream.keyDowns |> Stream.clampTime 5L |> Stream.run [ KeyDown "a"; Time 50L; KeyDown "b" ])
|
||||
[ "a"; "b" ]
|
||||
"keys"
|
||||
|
||||
Expect.equal
|
||||
(Stream.interval 10L |> Stream.clampTime 25L |> Stream.run [ Time 10L; KeyDown "a"; Time 20L ])
|
||||
[ 10L; 20L ]
|
||||
"clock")
|
||||
|
||||
testCase "clampTime tells the inner stream exactly the clamped time, and a repeated time adds nothing" (fun () ->
|
||||
Expect.equal
|
||||
(Stream.interval 1L |> Stream.clampTime 100L |> Stream.run [ Time 5L; Time 5L; Time 6L ])
|
||||
[ 1L; 2L; 3L; 4L; 5L; 6L ]
|
||||
"outputs")
|
||||
|
||||
testCase "running the same clamped stream twice gives the same outputs" (fun () ->
|
||||
let s = Stream.interval 10L |> Stream.clampTime 25L
|
||||
let events = List.map Time [ 10L; 5000L; 5010L ]
|
||||
Expect.equal (Stream.run events s) (Stream.run events s) "same outputs")
|
||||
|
||||
testCase "the game accepts at most 250 ms of time at once" (fun () -> Expect.equal App.MAX_GAP_MS 250L "MAX_GAP_MS")
|
||||
|
||||
testCase "main: after ten seconds in a background tab the game advances by 250 ms, not by ten seconds" (fun () ->
|
||||
let _, afterFirst = Stream.step (Time 0L) (IO.trace 42u (App.main ())).Result
|
||||
let drawings, next = Stream.step (Time 10000L) afterFirst
|
||||
Expect.equal (List.length drawings) (int (App.MAX_GAP_MS / App.FRAME_MS)) "ten drawings"
|
||||
Expect.equal (List.length (fst (Stream.step (Time 10025L) next))) 1 "one more drawing")
|
||||
|
||||
// ---- a high score that survives a reload (Exercise 10.7)
|
||||
|
||||
testCase "loadBest records a LoadBest op and is answered with the best given to traceWith" (fun () ->
|
||||
Expect.equal (IO.traceWith 0u 17 (IO.loadBest ())) { Result = 17; Ops = [ LoadBest ] } "traceWith")
|
||||
|
||||
testCase "trace answers LoadBest with 0 (no best given)" (fun () ->
|
||||
Expect.equal (IO.trace 9u (IO.loadBest ())).Result 0 "result")
|
||||
|
||||
testCase "saveBest records a SaveBest op with the score and produces ()" (fun () ->
|
||||
Expect.equal (IO.trace 0u (IO.saveBest 7)) { Result = (); Ops = [ SaveBest 7 ] } "trace")
|
||||
|
||||
testCase "a program can load the best, then save a higher one" (fun () ->
|
||||
Expect.equal
|
||||
(IO.traceWith 0u 4 (IO.loadBest () |> IO.bind (fun b -> IO.saveBest (b + 1)))).Ops
|
||||
[ LoadBest; SaveBest 5 ]
|
||||
"ops")
|
||||
|
||||
testCase "sessions starts with the new game and the stored best, then yields one session per action" (fun () ->
|
||||
let out = App.sessions 42u 3 App.speedActions |> Stream.run [ Time 25L; KeyDown " " ]
|
||||
let s0 = newSession (Spawn.newGame 42u) 3
|
||||
let s1 = App.sessionUpdate s0 Frame
|
||||
Expect.equal out [ s0; s1; App.sessionUpdate s1 TogglePause ] "sessions")
|
||||
|
||||
testCase "renderSession draws the session view and saves nothing when the best did not improve" (fun () ->
|
||||
let s = newSession (Spawn.newGame 42u) 5
|
||||
Expect.equal (IO.trace 0u (App.renderSession s)).Ops (drawOps (App.sessionView s)) "ops")
|
||||
|
||||
testCase "renderSession draws the session view, then saves the best, when the best improved" (fun () ->
|
||||
let s = { Game = { Spawn.newGame 42u with Score = 6 }; Best = 6; Improved = true }
|
||||
Expect.equal (IO.trace 0u (App.renderSession s)).Ops (drawOps (App.sessionView s) @ [ SaveBest 6 ]) "ops")
|
||||
|
||||
testCase "main asks for the seed, then the stored best, and draws the first session" (fun () ->
|
||||
let traced = IO.traceWith 42u 9 (App.main ())
|
||||
Expect.equal traced.Ops [ RandomSeed; LoadBest ] "ops"
|
||||
let first, _ = Stream.step (Time 0L) traced.Result
|
||||
Expect.equal (drawn (List.head first)) (App.sessionView (newSession (Spawn.newGame 42u) 9)) "drawing")
|
||||
|
||||
testCase "playWith passes the best to the program: the first scene shows it" (fun () ->
|
||||
Expect.equal
|
||||
(App.playWith 42u 9 [ Time 0L ] (App.main ()))
|
||||
[ drawOps (App.sessionView (newSession (Spawn.newGame 42u) 9)) ]
|
||||
"drawings")
|
||||
|
||||
// The golden fixture: a seed, a scripted list of inputs, a stored best, and the scene of the last drawing.
|
||||
yield!
|
||||
[ for c in cases "m10-golden" do
|
||||
let seed = u32 (arg 0 c)
|
||||
let events = list event (arg 1 c)
|
||||
let best = num (arg 2 c)
|
||||
let expectedScene = list shape (expected c)
|
||||
|
||||
yield
|
||||
testCase $"play(main): {name c}" (fun () ->
|
||||
let lastScene = App.playWith seed best events (App.main ()) |> List.last
|
||||
Expect.equal (lastScene |> List.choose (fun op -> match op with Draw s -> Some s | _ -> None)) expectedScene "last scene")
|
||||
|
||||
yield
|
||||
testCase $"play(main) saves once per improvement: {name c}" (fun () ->
|
||||
let saved = App.playWith seed best events (App.main ()) |> List.collect saves
|
||||
|
||||
let finalBest =
|
||||
expectedScene
|
||||
|> List.pick (fun s ->
|
||||
match s with
|
||||
| Text(_, _, text, _, _, _) when text.StartsWith "Best: " -> Some(int (text.Substring 6))
|
||||
| _ -> None)
|
||||
|
||||
Expect.equal saved [ best + 1 .. finalBest ] "saves") ]
|
||||
|
||||
// ---- the runtime with a fake platform that records the two new calls
|
||||
|
||||
testCase "runIO answers LoadBest with platform.LoadBest () and continues with it" (fun () ->
|
||||
let p = FakePlatform(42u, 11)
|
||||
Expect.equal (Runtime.runIO p.Platform (IO.loadBest () |> IO.map (fun b -> b + 1))) 12 "result"
|
||||
Expect.equal p.Calls [ [ box "loadBest" ] ] "calls")
|
||||
|
||||
testCase "runIO maps SaveBest to platform.SaveBest score" (fun () ->
|
||||
let p = FakePlatform 42u
|
||||
Expect.equal (Runtime.runIO p.Platform (IO.saveBest 8 |> IO.bind (fun () -> IO.pure "done"))) "done" "result"
|
||||
Expect.equal p.Calls [ [ box "saveBest"; box 8 ] ] "calls")
|
||||
|
||||
testCase "runApp asks for the seed and loads the best once, at start, and draws nothing before the first event" (fun () ->
|
||||
let p = FakePlatform(42u, 3)
|
||||
Runtime.runApp p.Platform (App.main ())
|
||||
Expect.equal p.Calls [ [ box "randomSeed" ]; [ box "loadBest" ] ] "calls at start"
|
||||
p.FireTime 0L
|
||||
p.FireTime 25L
|
||||
Expect.equal (p.Calls |> List.filter (fun c -> List.head c = box "loadBest") |> List.length) 1 "one load"
|
||||
|
||||
Expect.isTrue
|
||||
(p.Calls |> List.exists (fun c -> List.head c = box "fillText" && c[3] = box "Best: 3"))
|
||||
"draws Best: 3")
|
||||
]
|
||||
@@ -0,0 +1,180 @@
|
||||
module Snake.Tests.M10Replay
|
||||
|
||||
open System.Text.Json
|
||||
open Expecto
|
||||
open Snake
|
||||
open Snake.Model
|
||||
open Snake.View
|
||||
open Snake.IO
|
||||
open Snake.Stream
|
||||
open Snake.Replay
|
||||
open Snake.Tests.Fixtures
|
||||
open Snake.Tests.M09Helpers
|
||||
|
||||
// Viewers in the fixtures use the keys index, last and playing.
|
||||
let private viewer (v: JsonElement) : Viewer =
|
||||
{ Index = num (prop "index" v); Last = num (prop "last" v); Playing = bool (prop "playing" v) }
|
||||
|
||||
let private viewerAction (v: JsonElement) : ViewerAction =
|
||||
match str (prop "tag" v) with
|
||||
| "Next" -> ViewerAction.Next
|
||||
| "Prev" -> ViewerAction.Prev
|
||||
| "First" -> ViewerAction.First
|
||||
| "Last" -> ViewerAction.Last
|
||||
| "TogglePlay" -> ViewerAction.TogglePlay
|
||||
| "Beat" -> ViewerAction.Beat
|
||||
| other -> failwith $"unknown viewer action tag: {other}"
|
||||
|
||||
// The sample recording, as the page loads it. Not a fixture of cases: a recording {seed, actions}.
|
||||
let private sample: Recording =
|
||||
let v = load "replay-sample"
|
||||
{ Seed = u32 (prop "seed" v); Actions = list action (prop "actions" v) }
|
||||
|
||||
[<Tests>]
|
||||
let tests =
|
||||
testList "M10 Replay" [
|
||||
yield! fixtureTests "m10-viewer-update" "viewerUpdate" (fun c ->
|
||||
Expect.equal (viewerUpdate (viewer (arg 0 c)) (viewerAction (arg 1 c))) (viewer (expected c)) "viewerUpdate")
|
||||
|
||||
yield! fixtureTests "m10-viewer-key" "viewerKey" (fun c ->
|
||||
Expect.equal (viewerKey (str (arg 0 c))) (opt viewerAction (expected c)) "viewerKey")
|
||||
|
||||
yield! fixtureTests "m10-viewer-view" "viewerView" (fun c ->
|
||||
Expect.equal (viewerView (list gameState (arg 0 c)) (viewer (arg 1 c))) (list shape (expected c)) "viewerView")
|
||||
|
||||
yield!
|
||||
[ testCase
|
||||
"the sample recording is worth watching: Tick and Turn only, under 400 actions, at least five apples, then game over"
|
||||
(fun () ->
|
||||
Expect.all
|
||||
sample.Actions
|
||||
(fun a ->
|
||||
match a with
|
||||
| Tick
|
||||
| Turn _ -> true
|
||||
| _ -> false)
|
||||
"Tick and Turn only"
|
||||
|
||||
let n = List.length sample.Actions
|
||||
Expect.isTrue (n >= 150 && n <= 400) $"{n} actions"
|
||||
let fs = Game.history (Spawn.newGame sample.Seed) sample.Actions
|
||||
let last = List.last fs
|
||||
Expect.isGreaterThanOrEqual last.Score 5 "score"
|
||||
Expect.equal last.Status GameOver "last frame"
|
||||
Expect.equal (List.item (List.length fs - 2) fs).Status Playing "frame before the last")
|
||||
|
||||
testCase "frames replays the recording with history, from the new game of its seed" (fun () ->
|
||||
let recording = { Seed = 42u; Actions = [ Tick; Turn Up; Tick ] }
|
||||
Expect.equal (frames recording) (Game.history (Spawn.newGame 42u) recording.Actions) "frames"
|
||||
Expect.equal (List.length (frames sample)) (List.length sample.Actions + 1) "length")
|
||||
|
||||
testCase "viewerStart is the first frame, not playing" (fun () ->
|
||||
Expect.equal (viewerStart 12) { Index = 0; Last = 12; Playing = false } "viewerStart")
|
||||
|
||||
testCase "viewerUpdate keeps the index in [0, last] whatever the actions" (fun () ->
|
||||
let actions =
|
||||
[ ViewerAction.Prev
|
||||
ViewerAction.Next
|
||||
ViewerAction.Last
|
||||
ViewerAction.Next
|
||||
ViewerAction.TogglePlay
|
||||
ViewerAction.Beat
|
||||
ViewerAction.Beat
|
||||
ViewerAction.First
|
||||
ViewerAction.Prev
|
||||
ViewerAction.Beat ]
|
||||
|
||||
let viewers = List.scan viewerUpdate (viewerStart 3) actions
|
||||
|
||||
Expect.all
|
||||
viewers
|
||||
(fun v -> v.Index >= 0 && v.Index <= 3 && not (v.Playing && v.Index = 3))
|
||||
"in range, never playing at the end")
|
||||
|
||||
testCase "the autoplay clock beats every 100 ms" (fun () -> Expect.equal REPLAY_MS 100L "REPLAY_MS")
|
||||
|
||||
testCase "replayActions turns the clock into Beats and keys into viewer actions" (fun () ->
|
||||
Expect.equal
|
||||
(run [ Time 100L; KeyDown "ArrowRight"; KeyDown "x"; KeyDown " "; Time 300L ] replayActions)
|
||||
[ ViewerAction.Beat
|
||||
ViewerAction.Next
|
||||
ViewerAction.TogglePlay
|
||||
ViewerAction.Beat
|
||||
ViewerAction.Beat ]
|
||||
"actions")
|
||||
|
||||
testCase "autoplay: Space, then the clock steps one frame per 100 ms and stops at the end" (fun () ->
|
||||
let out =
|
||||
viewerStates 3 replayActions
|
||||
|> run [ Time 0L; KeyDown " "; Time 100L; Time 200L; Time 300L; Time 400L; Time 500L ]
|
||||
|
||||
Expect.equal (out |> List.map (fun v -> v.Index)) [ 0; 0; 1; 2; 3; 3; 3 ] "indices"
|
||||
|
||||
Expect.equal
|
||||
(out |> List.map (fun v -> v.Playing))
|
||||
[ false; true; true; true; false; false; false ]
|
||||
"playing")
|
||||
|
||||
testCase "without Space nothing plays: the clock alone never moves the viewer" (fun () ->
|
||||
Expect.all
|
||||
(viewerStates 3 replayActions |> run [ Time 0L; Time 1000L; Time 2000L ])
|
||||
(fun v -> v.Index = 0)
|
||||
"index 0")
|
||||
|
||||
testCase "replayMain asks for nothing and draws the first frame of the recording first" (fun () ->
|
||||
let traced = IO.trace 0u (replayMain sample)
|
||||
Expect.equal traced.Ops [] "ops"
|
||||
let drawings, _ = Stream.step (Time 0L) traced.Result
|
||||
Expect.equal (List.length drawings) 1 "one drawing"
|
||||
|
||||
Expect.equal
|
||||
(drawn (List.head drawings))
|
||||
(viewerView (frames sample) (viewerStart (List.length sample.Actions)))
|
||||
"first scene"
|
||||
|
||||
let start = View.view (Spawn.newGame sample.Seed)
|
||||
|
||||
Expect.equal
|
||||
(drawn (List.head drawings) |> List.truncate (List.length start))
|
||||
start
|
||||
"the game's own view first")
|
||||
|
||||
testCase "replayMain: End shows the last frame of the game, the game over" (fun () ->
|
||||
let out = (IO.trace 0u (replayMain sample)).Result |> run [ Time 0L; KeyDown "End" ]
|
||||
let fs = frames sample
|
||||
let last = List.length fs - 1
|
||||
let scene = drawn (List.last out)
|
||||
Expect.equal scene (viewerView fs { Index = last; Last = last; Playing = false }) "last scene"
|
||||
|
||||
Expect.exists
|
||||
scene
|
||||
(fun s ->
|
||||
match s with
|
||||
| Text(_, _, "Game Over", _, _, _) -> true
|
||||
| _ -> false)
|
||||
"Game Over")
|
||||
|
||||
testCase "stepping back shows exactly the earlier scene" (fun () ->
|
||||
let out =
|
||||
(IO.trace 0u (replayMain sample)).Result
|
||||
|> run
|
||||
[ Time 0L
|
||||
KeyDown "ArrowRight"
|
||||
KeyDown "ArrowRight"
|
||||
KeyDown "ArrowRight"
|
||||
KeyDown "ArrowLeft"
|
||||
KeyDown "d"
|
||||
KeyDown "a"
|
||||
KeyDown "a" ]
|
||||
|
||||
let scenes = List.map drawn out
|
||||
Expect.equal scenes[4] scenes[2] "back one"
|
||||
Expect.equal scenes[6] scenes[4] "forward and back"
|
||||
Expect.equal scenes[7] scenes[1] "back to frame 1"
|
||||
Expect.notEqual scenes[3] scenes[2] "frames differ")
|
||||
|
||||
testCase "replayMain: after ten seconds in a background tab autoplay moves 2 frames (250 ms), not 100" (fun () ->
|
||||
let _, afterPlay = Stream.step (KeyDown " ") (IO.trace 0u (replayMain sample)).Result
|
||||
let _, afterFirst = Stream.step (Time 0L) afterPlay
|
||||
Expect.equal (List.length (fst (Stream.step (Time 10000L) afterFirst))) 2 "two drawings") ]
|
||||
]
|
||||
@@ -134,6 +134,10 @@ let tests =
|
||||
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: after ten seconds in a background tab the match advances by 250 ms, not by ten seconds" (fun () ->
|
||||
let _, afterFirst = Stream.step (Time 0L) (IO.trace 42u (pongMain ())).Result
|
||||
Expect.equal (List.length (fst (Stream.step (Time 10000L) afterFirst))) 8 "eight drawings")
|
||||
|
||||
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"
|
||||
|
||||
@@ -0,0 +1,442 @@
|
||||
module Snake.Tests.M12Check
|
||||
|
||||
open Expecto
|
||||
open Snake
|
||||
open Snake.Model
|
||||
open Snake.Check
|
||||
open Snake.Tests.Fixtures
|
||||
|
||||
// ---- helpers for moveGaps: a state whose snake has its head at (x, y); nothing else matters there
|
||||
|
||||
let private at (x: int) (y: int) : GameState =
|
||||
{ Width = 20
|
||||
Height = 20
|
||||
Snake = [ { X = x; Y = y }; { X = x - 1; Y = y } ]
|
||||
Dir = Right
|
||||
NextDir = Right
|
||||
Apple = None
|
||||
Seed = 0u
|
||||
Score = 0
|
||||
Status = Playing
|
||||
Frame = 0
|
||||
Queued = None }
|
||||
|
||||
// ---- the payoff: properties of the game, and deliberately broken games ("mutants") that they must catch
|
||||
|
||||
// Every state of the game played with `upd` from `start`. (For the real `Game.update` this is `Game.history`.)
|
||||
let private statesWith (upd: GameState -> Action -> GameState) (start: GameState) (actions: Action list) : GameState list =
|
||||
List.scan upd start actions
|
||||
|
||||
let private sane (upd: GameState -> Action -> GameState) (actions: Action list) : bool =
|
||||
statesWith upd (Spawn.newGame 1u) actions |> List.forall (fun s -> List.isEmpty (violations s))
|
||||
|
||||
// Mutant 1: `turn` checks against NextDir instead of Dir (version A of Puzzle 2 in Module 3).
|
||||
let private turnAgainstNextDir (state: GameState) (action: Action) : GameState =
|
||||
match action with
|
||||
| Turn dir -> if state.Status = Playing && dir <> opposite state.NextDir then { state with NextDir = dir } else state
|
||||
| _ -> Game.update state action
|
||||
|
||||
// Mutant 2: `advance` forgets to check the walls.
|
||||
let private advanceWithoutWalls (state: GameState) : GameState =
|
||||
if state.Status <> Playing then
|
||||
state
|
||||
else
|
||||
let head = Rules.move (List.head state.Snake) state.NextDir
|
||||
let eating = state.Apple = Some head
|
||||
let body = if eating then state.Snake else Util.dropLast state.Snake
|
||||
|
||||
if Util.contains body head (=) then
|
||||
{ state with Dir = state.NextDir; Status = GameOver }
|
||||
else
|
||||
{ state with
|
||||
Snake = head :: body
|
||||
Dir = state.NextDir
|
||||
Apple = if eating then None else state.Apple
|
||||
Score = state.Score + (if eating then 1 else 0) }
|
||||
|
||||
// What `update` does after a step since Exercise 10.6: take the queued turn. The mutants below that replace `Tick`
|
||||
// do the same, so that each one differs from the real game in exactly one thing.
|
||||
let private takeQueued (s: GameState) : GameState =
|
||||
match s.Queued with
|
||||
| Some d when s.Status = Playing -> { s with NextDir = d; Queued = None }
|
||||
| _ -> s
|
||||
|
||||
let private noWalls (state: GameState) (action: Action) : GameState =
|
||||
match action with
|
||||
| Tick -> takeQueued (Spawn.spawnApple (advanceWithoutWalls state))
|
||||
| _ -> Game.update state action
|
||||
|
||||
// Mutant 4: a `Tick` that forgets the turn queue of Exercise 10.6 (the `Frame` step still takes it).
|
||||
let private tickForgetsQueue (state: GameState) (action: Action) : GameState =
|
||||
match action with
|
||||
| Tick -> Spawn.tick state
|
||||
| _ -> Game.update state action
|
||||
|
||||
// Mutant 5: the queue accepts any key that differs from the pending turn, even the one straight back from it.
|
||||
let private queueAnyKey (state: GameState) (action: Action) : GameState =
|
||||
match action with
|
||||
| Turn dir when state.Status = Playing && state.NextDir <> state.Dir && dir <> state.NextDir ->
|
||||
{ state with Queued = Some dir }
|
||||
| _ -> Game.update state action
|
||||
|
||||
// Mutant 3: the frame rule this course used at first: step whenever the *total* frame count is a multiple of movesEvery.
|
||||
let private totalFrameCount (state: GameState) (action: Action) : GameState =
|
||||
match action with
|
||||
| Frame ->
|
||||
if state.Status <> Playing then
|
||||
state
|
||||
else
|
||||
let counted = { state with Frame = state.Frame + 1 }
|
||||
if counted.Frame % Game.movesEvery counted.Score = 0 then Spawn.tick counted else counted
|
||||
| _ -> Game.update state action
|
||||
|
||||
// A long corridor: the snake is one step from its third apple (score 2 -> 3, so the speed changes), `frame` frames into the game.
|
||||
let private corridor (frame: int) : GameState =
|
||||
{ Width = 60
|
||||
Height = 1
|
||||
Snake = [ { X = 1; Y = 0 }; { X = 0; Y = 0 } ]
|
||||
Dir = Right
|
||||
NextDir = Right
|
||||
Apple = Some { X = 2; Y = 0 }
|
||||
Seed = 0u
|
||||
Score = 2
|
||||
Status = Playing
|
||||
Frame = frame
|
||||
Queued = None }
|
||||
|
||||
let private frames = List.replicate 40 Frame
|
||||
|
||||
// Every gap between two moves is exactly `movesEvery` of the score the snake had after the first of the two.
|
||||
let private steady (upd: GameState -> Action -> GameState) (frame: int) : bool =
|
||||
let states = statesWith upd (corridor frame) frames
|
||||
|
||||
let scoreAtMove =
|
||||
states
|
||||
|> List.pairwise
|
||||
|> List.filter (fun (before, after) -> List.head after.Snake <> List.head before.Snake)
|
||||
|> List.map (fun (_, after) -> after.Score)
|
||||
|
||||
let gaps = moveGaps states
|
||||
List.forall2 (fun gap score -> gap = Game.movesEvery score) gaps (List.truncate (List.length gaps) scoreAtMove)
|
||||
|
||||
// ---- random states and the oracle
|
||||
|
||||
let private connected (snake: Point list) : bool =
|
||||
snake |> List.pairwise |> List.forall (fun (a, b) -> abs (a.X - b.X) + abs (a.Y - b.Y) = 1)
|
||||
|
||||
let private board (width: int) (height: int) : GameState = { at 0 0 with Width = width; Height = height }
|
||||
|
||||
// Mutant 6: Puzzle 1 of Module 3, "the new head must not be on the old snake" (it forgets that the tail moves away).
|
||||
let private advanceOldSnakeCheck (state: GameState) : GameState =
|
||||
if state.Status <> Playing then
|
||||
state
|
||||
else
|
||||
let head = Rules.move (List.head state.Snake) state.NextDir
|
||||
let eating = state.Apple = Some head
|
||||
let body = if eating then state.Snake else Util.dropLast state.Snake
|
||||
|
||||
if not (Rules.inBounds state head) || Util.contains state.Snake head (=) then
|
||||
{ state with Dir = state.NextDir; Status = GameOver }
|
||||
else
|
||||
{ state with
|
||||
Snake = head :: body
|
||||
Dir = state.NextDir
|
||||
Apple = if eating then None else state.Apple
|
||||
Score = state.Score + (if eating then 1 else 0) }
|
||||
|
||||
let private pt (x: int) (y: int) : Point = { X = x; Y = y }
|
||||
|
||||
[<Tests>]
|
||||
let tests =
|
||||
testList "M12 Check" [
|
||||
// ---- generators
|
||||
|
||||
testCase "elementOf picks the element at the index drawn by intBelow" (fun () ->
|
||||
let xs = [ "a"; "b"; "c"; "d"; "e" ]
|
||||
let i, seed = Random.run 0u (Random.intBelow 5)
|
||||
Expect.equal (Random.run 0u (elementOf xs)) (xs[i], seed) "elementOf")
|
||||
|
||||
testCase "elementOf of a one-element list always gives that element, and still uses up a draw" (fun () ->
|
||||
Expect.equal (Random.run 0u (elementOf [ "only" ])) ("only", 1831565813u) "elementOf")
|
||||
|
||||
testCase "listOf 0 gen is the empty list and leaves the seed alone" (fun () ->
|
||||
Expect.equal (Random.run 99u (listOf 0 Random.nextUint32)) ([], 99u) "listOf 0")
|
||||
|
||||
testCase "listOf threads the seed from each draw to the next" (fun () ->
|
||||
Expect.equal
|
||||
(Random.run 0u (listOf 3 Random.nextUint32))
|
||||
([ 1144304738u; 1416247u; 958946056u ], 1199730143u)
|
||||
"listOf 3")
|
||||
|
||||
testCase "listOf of a constant generator repeats the value and leaves the seed alone" (fun () ->
|
||||
Expect.equal (Random.run 7u (listOf 4 (Random.pure "x"))) ([ "x"; "x"; "x"; "x" ], 7u) "listOf pure")
|
||||
|
||||
testCase "genActions n gives n actions, the same ones for the same seed" (fun () ->
|
||||
let actions, _ = Random.run 5u (genActions 30)
|
||||
Expect.equal (List.length actions) 30 "length"
|
||||
|
||||
Expect.all
|
||||
actions
|
||||
(fun a ->
|
||||
match a with
|
||||
| Tick
|
||||
| Turn _ -> true
|
||||
| TogglePause
|
||||
| Restart
|
||||
| Frame -> false)
|
||||
"only Tick and Turn"
|
||||
|
||||
Expect.equal (Random.run 5u (genActions 30)) (Random.run 5u (genActions 30)) "same seed, same actions")
|
||||
|
||||
// ---- forAll
|
||||
|
||||
testCase "forAll reports success with the number of runs" (fun () ->
|
||||
Expect.equal (forAll 200 1u (fun x -> x >= 0 && x < 10) (Random.intBelow 10)) (Passed 200) "forAll")
|
||||
|
||||
testCase "forAll with zero runs succeeds without drawing anything" (fun () ->
|
||||
Expect.equal (forAll 0 1u (fun _ -> false) Random.nextUint32) (Passed 0) "forAll")
|
||||
|
||||
testCase "forAll reports the first failing draw, its value and the seed it started from" (fun () ->
|
||||
let gen = Random.intBelow 10
|
||||
let prop x = x <> 7
|
||||
let draws, _ = Random.run 3u (listOf 200 gen)
|
||||
let first = draws |> List.findIndex (fun x -> not (prop x))
|
||||
Expect.isGreaterThan first 0 "the test needs a failure that is not the very first draw"
|
||||
|
||||
match forAll 200 3u prop gen with
|
||||
| Failed(run, seed, value) ->
|
||||
Expect.equal (run, value) (first, 7) "run and value"
|
||||
Expect.equal (fst (Random.run seed gen)) 7 "the reported seed gives the value again"
|
||||
| Passed runs -> failtest $"expected a failure, got Passed {runs}")
|
||||
|
||||
testCase "forAll stops at the first failure: the property is not asked about later values" (fun () ->
|
||||
let gen = Random.intBelow 10
|
||||
let draws, _ = Random.run 3u (listOf 200 gen)
|
||||
let first = draws |> List.findIndex (fun x -> x = 7)
|
||||
let mutable calls = 0 // test code may count; the code under test may not
|
||||
|
||||
let result =
|
||||
forAll
|
||||
200
|
||||
3u
|
||||
(fun x ->
|
||||
calls <- calls + 1
|
||||
x <> 7)
|
||||
gen
|
||||
|
||||
match result with
|
||||
| Failed(run, _, _) -> Expect.equal run first "run"
|
||||
| Passed runs -> failtest $"expected a failure, got Passed {runs}"
|
||||
|
||||
Expect.equal calls (first + 1) "calls")
|
||||
|
||||
testCase "forAll is reproducible: same generator, property, runs and seed give the same report" (fun () ->
|
||||
let check () = forAll 500 11u (fun x -> x % 97 <> 0) (Random.intBelow 1000)
|
||||
Expect.equal (check ()) (check ()) "same report")
|
||||
|
||||
testCase "forAll runs in constant stack: a million runs do not overflow it" (fun () ->
|
||||
Expect.equal (forAll 1000000 1u (fun x -> x < 10) (Random.intBelow 10)) (Passed 1000000) "forAll")
|
||||
|
||||
// ---- shrinking
|
||||
|
||||
testCase "removals lists every way to drop one element, in order" (fun () ->
|
||||
Expect.equal (removals [ 1; 2; 3 ]) [ [ 2; 3 ]; [ 1; 3 ]; [ 1; 2 ] ] "removals")
|
||||
|
||||
testCase "removals of an empty list is empty, and of a single element is one empty list" (fun () ->
|
||||
Expect.equal (removals ([]: int list)) [] "empty"
|
||||
Expect.equal (removals [ "a" ]) [ [] ] "single")
|
||||
|
||||
testCase "minimize keeps exactly the elements the failure needs" (fun () ->
|
||||
Expect.equal
|
||||
(minimize (fun xs -> List.contains 3 xs && List.contains 7 xs) [ 1; 2; 3; 4; 5; 6; 7; 8; 9; 10 ])
|
||||
[ 3; 7 ]
|
||||
"minimize")
|
||||
|
||||
testCase "minimize keeps the order and the duplicates the failure needs" (fun () ->
|
||||
Expect.equal
|
||||
(minimize
|
||||
(fun xs -> (xs |> List.filter (fun x -> x = "a") |> List.length) >= 2 && List.contains "c" xs)
|
||||
[ "b"; "a"; "c"; "a"; "d"; "a" ])
|
||||
[ "c"; "a"; "a" ]
|
||||
"minimize")
|
||||
|
||||
testCase "minimize of a list that fails whatever you remove is the empty list" (fun () ->
|
||||
Expect.equal (minimize (fun _ -> true) [ 1; 2; 3 ]) [] "minimize")
|
||||
|
||||
testCase "minimize returns a list that still fails and has no failing removal (1-minimal)" (fun () ->
|
||||
let fails (xs: int list) = List.sum xs >= 10
|
||||
let small = minimize fails [ 5; 1; 4; 2; 6; 3 ]
|
||||
Expect.isTrue (fails small) "still fails"
|
||||
Expect.all (removals small) (fun ys -> not (fails ys)) "no failing removal")
|
||||
|
||||
// ---- invariants
|
||||
|
||||
yield! fixtureTests "m12-violations" "violations" (fun c ->
|
||||
Expect.equal (violations (gameState (arg 0 c))) (list str (expected c)) "violations")
|
||||
|
||||
// ---- moveGaps
|
||||
|
||||
testCase "moveGaps measures the distance between consecutive moves of the head" (fun () ->
|
||||
Expect.equal
|
||||
(moveGaps [ at 1 0; at 1 0; at 2 0; at 2 0; at 2 0; at 3 0; at 3 1 ])
|
||||
[ 3; 1 ]
|
||||
"moveGaps")
|
||||
|
||||
testCase "moveGaps of fewer than two moves is empty" (fun () ->
|
||||
Expect.equal (moveGaps []) [] "no states"
|
||||
Expect.equal (moveGaps [ at 1 0 ]) [] "one state"
|
||||
Expect.equal (moveGaps [ at 1 0; at 1 0; at 2 0; at 2 0 ]) [] "one move")
|
||||
|
||||
testCase "moveGaps counts a move at index 1" (fun () ->
|
||||
Expect.equal (moveGaps [ at 1 0; at 2 0; at 2 0; at 3 0 ]) [ 2 ] "moveGaps")
|
||||
|
||||
testCase "moveGaps treats an empty snake as a head of its own" (fun () ->
|
||||
let snake (cells: Point list) = { at 1 0 with Snake = cells }
|
||||
|
||||
Expect.equal
|
||||
(moveGaps [ snake []; snake []; snake [ { X = 1; Y = 0 } ]; snake [ { X = 1; Y = 0 } ]; snake [ { X = 2; Y = 0 } ] ])
|
||||
[ 2 ]
|
||||
"moveGaps")
|
||||
|
||||
// ---- properties of the game, and the mutants
|
||||
|
||||
testCase "statesWith Game.update in these tests is the history of Module 5" (fun () ->
|
||||
let actions, _ = Random.run 9u (genActions 25)
|
||||
Expect.equal (statesWith Game.update (Spawn.newGame 1u) actions) (Game.history (Spawn.newGame 1u) actions) "history")
|
||||
|
||||
testCase "the real game keeps every invariant on 300 random games of 40 actions" (fun () ->
|
||||
Expect.equal (forAll 300 2024u (sane Game.update) (genActions 40)) (Passed 300) "forAll")
|
||||
|
||||
testCase "the quick double turn bug is found and shrunk to its two key presses" (fun () ->
|
||||
let prop = sane turnAgainstNextDir
|
||||
|
||||
match forAll 300 2024u prop (genActions 40) with
|
||||
| Passed runs -> failtest $"expected a failure, got Passed {runs}"
|
||||
| Failed(_, _, value) ->
|
||||
match minimize (fun actions -> not (prop actions)) value with
|
||||
| [ Turn first; Turn second ] ->
|
||||
Expect.contains [ Up; Down ] first "first turn"
|
||||
Expect.equal second Left "second turn"
|
||||
| small -> failtest $"expected two turns, got %A{small}")
|
||||
|
||||
testCase "a game without walls is found and shrunk to the shortest way off the board: ten ticks" (fun () ->
|
||||
let prop = sane noWalls
|
||||
|
||||
match forAll 300 2024u prop (genActions 40) with
|
||||
| Passed runs -> failtest $"expected a failure, got Passed {runs}"
|
||||
| Failed(_, _, value) ->
|
||||
Expect.equal (minimize (fun actions -> not (prop actions)) value) (List.replicate 10 Tick) "ten ticks")
|
||||
|
||||
testCase "a Tick that forgets the queued turn is caught by queued-not-reversed and shrunk to four actions" (fun () ->
|
||||
let prop = sane tickForgetsQueue
|
||||
|
||||
match forAll 300 2024u prop (genActions 40) with
|
||||
| Passed runs -> failtest $"expected a failure, got Passed {runs}"
|
||||
| Failed(_, _, value) ->
|
||||
Expect.equal
|
||||
(minimize (fun actions -> not (prop actions)) value)
|
||||
[ Turn Up; Turn Right; Tick; Turn Left ]
|
||||
"four actions")
|
||||
|
||||
testCase "a queue that accepts a reversal is found and shrunk to its two key presses" (fun () ->
|
||||
let prop = sane queueAnyKey
|
||||
|
||||
match forAll 300 2024u prop (genActions 40) with
|
||||
| Passed runs -> failtest $"expected a failure, got Passed {runs}"
|
||||
| Failed(_, _, value) ->
|
||||
Expect.equal (minimize (fun actions -> not (prop actions)) value) [ Turn Up; Turn Down ] "two key presses")
|
||||
|
||||
testCase "the real game moves exactly every movesEvery score frames, also across a speed-up" (fun () ->
|
||||
Expect.equal (forAll 100 7u (steady Game.update) (Random.intBelow 8)) (Passed 100) "forAll")
|
||||
|
||||
testCase "counting frames from the start of the game makes some steps too short, and the property finds one" (fun () ->
|
||||
match forAll 100 7u (steady totalFrameCount) (Random.intBelow 56) with
|
||||
| Passed runs -> failtest $"expected a failure, got Passed {runs}"
|
||||
| Failed(_, _, value) -> Expect.isFalse (steady totalFrameCount value) "the counterexample fails")
|
||||
|
||||
// ---- random states (Exercise 12.6)
|
||||
|
||||
testCase "genSnake draws the head first, then walks from the tail (seed 0, 5x5, at most 6 cells)" (fun () ->
|
||||
Expect.equal
|
||||
(Random.run 0u (genSnake 5 5 6))
|
||||
([ pt 3 2; pt 3 1; pt 3 0; pt 2 0; pt 1 0; pt 0 0 ], 4231026099u)
|
||||
"genSnake")
|
||||
|
||||
testCase "genSnake is pinned for a few more seeds" (fun () ->
|
||||
Expect.equal
|
||||
(fst (Random.run 1u (genSnake 5 5 6)))
|
||||
[ pt 2 3; pt 3 3; pt 4 3; pt 4 4; pt 3 4; pt 2 4 ]
|
||||
"seed 1"
|
||||
|
||||
Expect.equal
|
||||
(fst (Random.run 42u (genSnake 5 5 6)))
|
||||
[ pt 1 0; pt 1 1; pt 2 1; pt 2 0; pt 3 0; pt 3 1 ]
|
||||
"seed 42")
|
||||
|
||||
testCase "genSnake with maxLen 1 is just the head, drawn with two draws" (fun () ->
|
||||
let x, s1 = Random.run 0u (Random.intBelow 5)
|
||||
let y, s2 = Random.run s1 (Random.intBelow 5)
|
||||
Expect.equal (Random.run 0u (genSnake 5 5 1)) ([ pt x y ], s2) "genSnake")
|
||||
|
||||
testCase "genSnake stops early when the walk is stuck: a 1x1 board holds one cell" (fun () ->
|
||||
Expect.equal (fst (Random.run 3u (genSnake 1 1 5))) [ pt 0 0 ] "genSnake")
|
||||
|
||||
testCase "genSnake always gives a snake on the board, connected, without overlap, at most maxLen long" (fun () ->
|
||||
let ok (snake: Point list) =
|
||||
List.length snake >= 1
|
||||
&& List.length snake <= 8
|
||||
&& connected snake
|
||||
&& List.forall (Rules.inBounds (board 4 3)) snake
|
||||
&& List.length (List.distinct snake) = List.length snake
|
||||
|
||||
Expect.equal (forAll 300 5u ok (genSnake 4 3 8)) (Passed 300) "forAll")
|
||||
|
||||
testCase "every generated state is sane: 500 states of a 5x5 board have no violations" (fun () ->
|
||||
Expect.equal (forAll 500 2024u (fun s -> List.isEmpty (violations s)) (genState 5 5)) (Passed 500) "forAll")
|
||||
|
||||
testCase "generated states are Playing, have nothing queued, and vary in length and apple" (fun () ->
|
||||
let states, _ = Random.run 2024u (listOf 500 (genState 5 5))
|
||||
Expect.all states (fun s -> s.Status = Playing && s.Queued = None && s.Width = 5 && s.Height = 5) "shape"
|
||||
|
||||
Expect.all
|
||||
states
|
||||
(fun s ->
|
||||
match s.Snake with
|
||||
| [ _ ] -> s.Dir = Right
|
||||
| head :: second :: _ -> Rules.move second s.Dir = head
|
||||
| [] -> false)
|
||||
"dir"
|
||||
|
||||
Expect.exists states (fun s -> List.length s.Snake = 1) "a one-cell snake"
|
||||
Expect.exists states (fun s -> List.length s.Snake >= 10) "a long snake"
|
||||
Expect.exists states (fun s -> s.Apple = None) "no apple"
|
||||
Expect.exists states (fun s -> s.Apple <> None) "an apple"
|
||||
Expect.exists states (fun s -> s.NextDir <> s.Dir) "a pending turn")
|
||||
|
||||
testCase "generated states start with seed 0, score 0 and frame 0" (fun () ->
|
||||
let states, _ = Random.run 2024u (listOf 50 (genState 5 5))
|
||||
Expect.all states (fun s -> s.Seed = 0u && s.Score = 0 && s.Frame = 0) "seed, score and frame")
|
||||
|
||||
// ---- a second implementation as an oracle (Exercise 12.7)
|
||||
|
||||
yield! fixtureTests "m03-advance" "advanceSpec agrees with Module 3's advance fixture" (fun c ->
|
||||
Expect.equal (advanceSpec (gameState (arg 0 c))) (gameState (expected c)) "advanceSpec")
|
||||
|
||||
testCase "advance and advanceSpec agree on 500 generated states of a 5x5 board" (fun () ->
|
||||
Expect.equal (forAll 500 2024u (fun s -> Rules.advance s = advanceSpec s) (genState 5 5)) (Passed 500) "forAll")
|
||||
|
||||
testCase "no invariant sees the wrong collision check of Puzzle 1: every state it produces is sane" (fun () ->
|
||||
Expect.equal
|
||||
(forAll 500 2024u (fun s -> List.isEmpty (violations (advanceOldSnakeCheck s))) (genState 5 5))
|
||||
(Passed 500)
|
||||
"forAll")
|
||||
|
||||
testCase "comparing with advanceSpec catches the wrong collision check: the head was moving onto the tail" (fun () ->
|
||||
match forAll 500 2024u (fun s -> advanceOldSnakeCheck s = advanceSpec s) (genState 5 5) with
|
||||
| Passed runs -> failtest $"expected a failure, got Passed {runs}"
|
||||
| Failed(run, _, s) ->
|
||||
Expect.equal run 21 "run"
|
||||
Expect.equal (Rules.move (List.head s.Snake) s.NextDir) (List.last s.Snake) "onto the tail"
|
||||
Expect.equal (advanceOldSnakeCheck s).Status GameOver "the mutant ends the game"
|
||||
Expect.equal (advanceSpec s).Status Playing "the rules do not")
|
||||
]
|
||||
@@ -0,0 +1,268 @@
|
||||
module Snake.Tests.M13Life
|
||||
|
||||
open System.Diagnostics
|
||||
open System.Text.Json
|
||||
open Expecto
|
||||
open Snake
|
||||
open Snake.Model
|
||||
open Snake.Stream
|
||||
open Snake.Life.Model
|
||||
open Snake.Life.Rules
|
||||
open Snake.Life.View
|
||||
open Snake.Life.App
|
||||
open Snake.Tests.Fixtures
|
||||
open Snake.Tests.M09Helpers
|
||||
open Snake.Tests.M09Runtime
|
||||
|
||||
let private lifeState (v: JsonElement) : LifeState =
|
||||
{ Cells = list point (prop "cells" v)
|
||||
Running = bool (prop "running" v)
|
||||
Seed = u32 (prop "seed" v)
|
||||
Generation = num (prop "generation" v) }
|
||||
|
||||
let private lifeAction (v: JsonElement) : LifeAction =
|
||||
match str (prop "tag" v) with
|
||||
| "Frame" -> LifeAction.Frame
|
||||
| "Toggle" -> LifeAction.Toggle(point (prop "cell" v))
|
||||
| "TogglePause" -> LifeAction.TogglePause
|
||||
| "Step" -> LifeAction.Step
|
||||
| "Clear" -> LifeAction.Clear
|
||||
| "Randomize" -> LifeAction.Randomize
|
||||
| other -> failwith $"unknown life action tag: {other}"
|
||||
|
||||
let private cell (x: int) (y: int) : Point = { X = x; Y = y }
|
||||
|
||||
let private rowMajor (cells: Point list) : bool =
|
||||
cells |> List.pairwise |> List.forall (fun (a, b) -> a.Y < b.Y || (a.Y = b.Y && a.X < b.X))
|
||||
|
||||
// n generations after `cells`, the start included: n + 1 boards.
|
||||
let private generations (n: int) (cells: Point list) : Point list list =
|
||||
List.scan (fun cs _ -> lifeStep cs) cells [ 1..n ]
|
||||
|
||||
[<Tests>]
|
||||
let tests =
|
||||
testList "M13 Life" [
|
||||
yield! fixtureTests "m13-life-step" "lifeStep" (fun c ->
|
||||
Expect.equal (lifeStep (list point (arg 0 c))) (list point (expected c)) "lifeStep")
|
||||
|
||||
yield! fixtureTests "m13-life-update" "lifeUpdate" (fun c ->
|
||||
Expect.equal (lifeUpdate (lifeState (arg 0 c)) (lifeAction (arg 1 c))) (lifeState (expected c)) "lifeUpdate")
|
||||
|
||||
yield! fixtureTests "m13-life-view" "lifeView" (fun c ->
|
||||
Expect.equal (lifeView (lifeState (arg 0 c))) (list shape (expected c)) "lifeView")
|
||||
|
||||
yield! fixtureTests "m13-life-key" "lifeKey" (fun c ->
|
||||
Expect.equal (lifeKey (str (arg 0 c))) (opt lifeAction (expected c)) "lifeKey")
|
||||
|
||||
yield! fixtureTests "m13-life-click" "lifeClick" (fun c ->
|
||||
Expect.equal (lifeClick (num (arg 0 c)) (num (arg 1 c))) (opt lifeAction (expected c)) "lifeClick")
|
||||
|
||||
yield!
|
||||
[ // ---- the model and the rules
|
||||
|
||||
testCase "the board is 40 by 30 cells of 16 pixels, with a 24-pixel status strip below" (fun () ->
|
||||
Expect.equal [ LW; LH; LCELL; STRIP ] [ 40; 30; 16; 24 ] "constants")
|
||||
|
||||
testCase "initialLife is an empty, paused world at generation 0 with the given seed" (fun () ->
|
||||
Expect.equal
|
||||
(initialLife 9u)
|
||||
{ Cells = []
|
||||
Running = false
|
||||
Seed = 9u
|
||||
Generation = 0 }
|
||||
"initialLife")
|
||||
|
||||
testCase "lifeUpdate does not modify the state it is given" (fun () ->
|
||||
let make () =
|
||||
{ Cells = [ cell 4 5; cell 5 5; cell 6 5 ]
|
||||
Running = true
|
||||
Seed = 3u
|
||||
Generation = 0 }
|
||||
|
||||
let s = make ()
|
||||
|
||||
[ LifeAction.Frame
|
||||
LifeAction.Toggle(cell 0 0)
|
||||
LifeAction.Toggle(cell 5 5)
|
||||
LifeAction.Randomize
|
||||
LifeAction.Clear ]
|
||||
|> List.iter (fun a -> lifeUpdate s a |> ignore)
|
||||
|
||||
Expect.equal s (make ()) "unchanged")
|
||||
|
||||
testCase "a glider moves one cell diagonally every four generations" (fun () ->
|
||||
let glider = [ cell 1 0; cell 2 1; cell 0 2; cell 1 2; cell 2 2 ]
|
||||
|
||||
Expect.equal
|
||||
(List.last (generations 4 glider))
|
||||
[ cell 2 1; cell 3 2; cell 1 3; cell 2 3; cell 3 3 ]
|
||||
"after four generations")
|
||||
|
||||
testCase "the next generation is computed from the whole old board: a blinker blinks forever" (fun () ->
|
||||
let horizontal = [ cell 9 10; cell 10 10; cell 11 10 ]
|
||||
let gens = generations 6 horizontal
|
||||
Expect.equal gens[2] horizontal "two generations"
|
||||
Expect.equal gens[6] horizontal "six generations"
|
||||
Expect.equal gens[1] [ cell 10 9; cell 10 10; cell 10 11 ] "vertical in between")
|
||||
|
||||
testCase "Randomize draws one intBelow 4 per cell in row-major order, alive when the draw is 0" (fun () ->
|
||||
let seed = 2024u
|
||||
|
||||
// The same draws, written the long way round with the Module 4 generator.
|
||||
let draws, next =
|
||||
List.fold
|
||||
(fun (ds, s) _ ->
|
||||
let d, s2 = Random.run s (Random.intBelow 4)
|
||||
ds @ [ d ], s2)
|
||||
([], seed)
|
||||
[ 1 .. LW * LH ]
|
||||
|
||||
let expectedCells =
|
||||
draws
|
||||
|> List.indexed
|
||||
|> List.choose (fun (i, d) -> if d = 0 then Some(cell (i % LW) (i / LW)) else None)
|
||||
|
||||
let result = lifeUpdate (initialLife seed) LifeAction.Randomize
|
||||
Expect.equal result.Cells expectedCells "cells"
|
||||
Expect.equal result.Seed next "seed"
|
||||
let n = List.length result.Cells
|
||||
Expect.isTrue (n > 200 && n < 400) $"{n} live cells")
|
||||
|
||||
testCase "every generation of a random board stays sorted row-major, on the board and without duplicates" (fun () ->
|
||||
let start = (lifeUpdate (initialLife 5u) LifeAction.Randomize).Cells
|
||||
|
||||
generations 20 start
|
||||
|> List.iter (fun cells ->
|
||||
Expect.isTrue (rowMajor cells) "sorted row-major, no duplicates"
|
||||
Expect.all cells (fun c -> c.X >= 0 && c.X < LW && c.Y >= 0 && c.Y < LH) "on the board"))
|
||||
|
||||
// Generous on purpose (and more so than in JS, for an unoptimised Debug build): a straightforward
|
||||
// lifeStep takes a few milliseconds per generation. This only catches a generation that is far slower
|
||||
// than the 150 ms between two of them.
|
||||
testCase "lifeStep keeps up: 50 generations of a quarter-full board take well under 50 x 150 ms" (fun () ->
|
||||
let start = (lifeUpdate (initialLife 11u) LifeAction.Randomize).Cells
|
||||
let watch = Stopwatch.StartNew()
|
||||
generations 50 start |> ignore
|
||||
let ms = watch.ElapsedMilliseconds
|
||||
Expect.isLessThan ms 5000L $"{ms} ms")
|
||||
|
||||
// ---- the fourth kind of event
|
||||
|
||||
testCase "clicks emits the position of every Click event and ignores everything else" (fun () ->
|
||||
Expect.equal
|
||||
(Stream.clicks |> Stream.run [ Time 10L; Click(3, 4); KeyDown "a"; Click(0, 479); KeyUp "a" ])
|
||||
[ (3, 4); (0, 479) ]
|
||||
"positions")
|
||||
|
||||
testCase "the other sources ignore clicks" (fun () ->
|
||||
let events = [ Click(5, 5); Time 100L; Click(6, 6) ]
|
||||
Expect.equal (Stream.run events Stream.keyDowns) [] "keyDowns"
|
||||
Expect.equal (Stream.run events Stream.keyUps) [] "keyUps"
|
||||
Expect.equal (Stream.run events (Stream.interval 50L)) [ 50L; 100L ] "interval"
|
||||
|
||||
Expect.equal
|
||||
(Stream.run events (Stream.clampTime 250L Stream.clicks))
|
||||
[ (5, 5); (6, 6) ]
|
||||
"clampTime passes clicks through")
|
||||
|
||||
testCase "a generation every 150 ms" (fun () -> Expect.equal GEN_MS 150L "GEN_MS")
|
||||
|
||||
testCase "lifeActions turns the clock into Frames, keys into actions and clicks on the board into Toggles" (fun () ->
|
||||
Expect.equal
|
||||
(lifeActions
|
||||
|> Stream.run
|
||||
[ Time 150L; KeyDown " "; Click(20, 40); KeyDown "x"; Click(700, 10); KeyDown "n"; Time 450L ])
|
||||
[ LifeAction.Frame
|
||||
LifeAction.TogglePause
|
||||
LifeAction.Toggle(cell 1 2)
|
||||
LifeAction.Step
|
||||
LifeAction.Frame
|
||||
LifeAction.Frame ]
|
||||
"actions")
|
||||
|
||||
testCase "lifeStates starts with the new world, then yields one state per action" (fun () ->
|
||||
let out =
|
||||
lifeStates 7u lifeActions
|
||||
|> Stream.run [ Time 0L; Click(16, 16); Click(32, 16); Click(48, 16); KeyDown " "; Time 150L ]
|
||||
|
||||
Expect.equal (List.head out) (initialLife 7u) "first state"
|
||||
Expect.equal (out |> List.map (fun s -> List.length s.Cells)) [ 0; 1; 2; 3; 3; 3 ] "live cells"
|
||||
|
||||
Expect.equal
|
||||
(List.last out)
|
||||
{ Cells = [ cell 2 0; cell 2 1; cell 2 2 ]
|
||||
Running = true
|
||||
Seed = 7u
|
||||
Generation = 1 }
|
||||
"last state")
|
||||
|
||||
testCase "lifeMain asks for a seed, draws the empty world first, and then a click as a live cell" (fun () ->
|
||||
let traced = IO.trace 42u (lifeMain ())
|
||||
Expect.equal traced.Ops [ IO.RandomSeed ] "ops"
|
||||
let first, next = Stream.step (Time 0L) traced.Result
|
||||
let second, _ = Stream.step (Click(17, 33)) next
|
||||
Expect.equal (drawn (List.head first)) (lifeView (initialLife 42u)) "first drawing"
|
||||
|
||||
Expect.equal
|
||||
(drawn (List.head second))
|
||||
(lifeView { initialLife 42u with Cells = [ cell 1 2 ] })
|
||||
"second drawing")
|
||||
|
||||
testCase "lifeMain: after ten seconds in a background tab the world advances by 250 ms, not by ten seconds" (fun () ->
|
||||
let _, afterFirst = Stream.step (Time 0L) (IO.trace 42u (lifeMain ())).Result
|
||||
Expect.equal (List.length (fst (Stream.step (Time 10000L) afterFirst))) 1 "one drawing")
|
||||
|
||||
// ---- the runtime (step 7 of the module); the browser glue in web/ is given
|
||||
|
||||
testCase "runApp registers a click handler with the platform" (fun () ->
|
||||
let p = FakePlatform 42u
|
||||
Runtime.runApp p.Platform (IO.pure (Stream.clicks |> Stream.map (fun _ -> IO.pure ())))
|
||||
Expect.equal p.Registered [ "click"; "down"; "time"; "up" ] "registered")
|
||||
|
||||
testCase "runApp feeds clicks to the stream" (fun () ->
|
||||
let p = FakePlatform 42u
|
||||
|
||||
let program =
|
||||
IO.pure (Stream.clicks |> Stream.map (fun (x, y) -> IO.draw (View.Rect(x, y, 1, 1, "#ffffff"))))
|
||||
|
||||
Runtime.runApp p.Platform program
|
||||
p.FireClick(33, 47)
|
||||
p.FireClick(0, 2)
|
||||
|
||||
Expect.equal
|
||||
p.Calls
|
||||
[ [ box "fillRect"; box 33; box 47; box 1; box 1; box "#ffffff" ]
|
||||
[ box "fillRect"; box 0; box 2; box 1; box 1; box "#ffffff" ] ]
|
||||
"calls")
|
||||
|
||||
testCase "runApp runs Life: a click on the canvas draws the world with that cell alive" (fun () ->
|
||||
let p = FakePlatform 42u
|
||||
Runtime.runApp p.Platform (lifeMain ())
|
||||
p.FireTime 0L
|
||||
p.Clear()
|
||||
p.FireClick(100, 250)
|
||||
|
||||
Expect.contains
|
||||
p.Calls
|
||||
[ box "fillRect"; box (6 * 16 + 1); box (15 * 16 + 1); box 14; box 14; box "#7cb342" ]
|
||||
"the live cell")
|
||||
|
||||
testCase "Snake and Pong ignore clicks: their actions and drawings are the same with and without them" (fun () ->
|
||||
let withClicks = [ Time 0L; Click(5, 5); Time 25L; KeyDown "ArrowUp"; Click(300, 300); Time 200L ]
|
||||
|
||||
let without =
|
||||
withClicks
|
||||
|> List.filter (fun e ->
|
||||
match e with
|
||||
| Click _ -> false
|
||||
| _ -> true)
|
||||
|
||||
Expect.equal (Stream.run withClicks App.speedActions) (Stream.run without App.speedActions) "speedActions"
|
||||
|
||||
Expect.equal
|
||||
(Stream.run withClicks Pong.App.pongActions)
|
||||
(Stream.run without Pong.App.pongActions)
|
||||
"pongActions"
|
||||
|
||||
Expect.equal (App.play 42u withClicks (App.main ())) (App.play 42u without (App.main ())) "play main") ]
|
||||
]
|
||||
@@ -13,16 +13,21 @@
|
||||
<Compile Include="M03Rules.fs" />
|
||||
<Compile Include="M04Random.fs" />
|
||||
<Compile Include="M04Spawn.fs" />
|
||||
<Compile Include="M04State.fs" />
|
||||
<Compile Include="M05Game.fs" />
|
||||
<Compile Include="M06View.fs" />
|
||||
<Compile Include="M07IO.fs" />
|
||||
<Compile Include="M07bSafeIO.fs" />
|
||||
<Compile Include="M08Stream.fs" />
|
||||
<Compile Include="M09Helpers.fs" />
|
||||
<Compile Include="M09Input.fs" />
|
||||
<Compile Include="M09App.fs" />
|
||||
<Compile Include="M09Runtime.fs" />
|
||||
<Compile Include="M10Extensions.fs" />
|
||||
<Compile Include="M10Replay.fs" />
|
||||
<Compile Include="M11Pong.fs" />
|
||||
<Compile Include="M12Check.fs" />
|
||||
<Compile Include="M13Life.fs" />
|
||||
<Compile Include="Purity.fs" />
|
||||
<Compile Include="Main.fs" />
|
||||
</ItemGroup>
|
||||
|
||||
@@ -41,7 +41,48 @@ let private randomSeed () : uint32 =
|
||||
crypto?getRandomValues (buf)
|
||||
buf[0]
|
||||
|
||||
/// A Platform drawing on `canvas` (an HTML canvas element) and listening to the window's keys and frames.
|
||||
// m10: where the best score survives a reload.
|
||||
let private bestKey = "pure-snake-best"
|
||||
|
||||
// Storage can be missing, blocked (privacy settings; some browsers throw as soon as localStorage is touched) or hold
|
||||
// anything: all of that reads as 0, and nothing throws. Only a non-negative whole number counts.
|
||||
let private loadBest () : int =
|
||||
try
|
||||
let raw: string = window?localStorage?getItem (bestKey)
|
||||
|
||||
if isNull raw then
|
||||
0
|
||||
else
|
||||
// Only what saveBest writes counts: decimal digits, at most 2147483647 (so all three tracks read alike).
|
||||
let digits = raw.Length >= 1 && raw.Length <= 10 && Seq.forall (fun c -> c >= '0' && c <= '9') raw
|
||||
|
||||
if digits && float raw <= 2147483647.0 then int (float raw) else 0
|
||||
with _ ->
|
||||
0
|
||||
|
||||
// A record that cannot be stored is lost; the game goes on.
|
||||
let private saveBest (score: int) : unit =
|
||||
try
|
||||
window?localStorage?setItem (bestKey, string score)
|
||||
with _ ->
|
||||
()
|
||||
|
||||
// m13: a click on the canvas, in canvas pixels. The page may show the canvas larger or smaller than its width and
|
||||
// height (CSS, zoom) and draws a border round it, so the window coordinates of the mouse are made relative to the
|
||||
// drawing area (inside the border) and then scaled. The listener is added when the runtime asks, not before.
|
||||
let private onClick (canvas: obj) (cb: int -> int -> unit) : unit =
|
||||
canvas?addEventListener ("click",
|
||||
fun (e: obj) ->
|
||||
let r = canvas?getBoundingClientRect ()
|
||||
let scale (client: float) (start: float) (border: float) (size: float) (shown: float) =
|
||||
int (System.Math.Floor((client - start - border) * size / shown))
|
||||
|
||||
cb
|
||||
(scale e?clientX r?left canvas?clientLeft canvas?width canvas?clientWidth)
|
||||
(scale e?clientY r?top canvas?clientTop canvas?height canvas?clientHeight))
|
||||
|
||||
/// A Platform drawing on `canvas` (an HTML canvas element) and listening to the window's keys and frames, and from
|
||||
/// m13 to clicks on the canvas.
|
||||
let create (canvas: obj) : Platform =
|
||||
let ctx = canvas?getContext ("2d")
|
||||
|
||||
@@ -56,9 +97,12 @@ let create (canvas: obj) : Platform =
|
||||
ctx?textAlign <- align
|
||||
ctx?fillText (text, x, y)
|
||||
RandomSeed = randomSeed
|
||||
LoadBest = loadBest
|
||||
SaveBest = saveBest
|
||||
StartClock = startClock
|
||||
OnKeyDown = listen "keydown"
|
||||
OnKeyUp = listen "keyup" }
|
||||
OnKeyUp = listen "keyup"
|
||||
OnClick = onClick canvas }
|
||||
|
||||
/// The page's `<canvas id="game">`.
|
||||
let gameCanvas () : obj = window?document?getElementById ("game")
|
||||
@@ -0,0 +1,7 @@
|
||||
/// fsharp/life.html loads this module (web/dist/LifeMain.js): one call runs Conway's Life (m13).
|
||||
module Snake.Web.LifeMain
|
||||
|
||||
open Snake
|
||||
|
||||
// The same Platform as Snake's; Life listens to its clicks, and never asks for LoadBest or SaveBest.
|
||||
Runtime.runApp (BrowserPlatform.create (BrowserPlatform.gameCanvas ())) (Life.App.lifeMain ())
|
||||
@@ -3,4 +3,5 @@ module Snake.Web.PongMain
|
||||
|
||||
open Snake
|
||||
|
||||
// The same Platform as Snake's; pongMain () never asks for LoadBest or SaveBest, so the stored best is untouched.
|
||||
Runtime.runApp (BrowserPlatform.create (BrowserPlatform.gameCanvas ())) (Pong.App.pongMain ())
|
||||
@@ -0,0 +1,39 @@
|
||||
/// fsharp/replay.html loads this module (web/dist/ReplayMain.js): the replay viewer of m10.
|
||||
/// The recording is plain JSON next to the test fixtures; the page is served from the repository root by
|
||||
/// scripts/serve.mjs, so it can be fetched (relative to the page, fsharp/replay.html). It is decoded with plain
|
||||
/// JavaScript interop, without a JSON library, and the viewer starts once it has arrived.
|
||||
module Snake.Web.ReplayMain
|
||||
|
||||
open Fable.Core
|
||||
open Fable.Core.JsInterop
|
||||
open Snake
|
||||
open Snake.Model
|
||||
open Snake.Replay
|
||||
|
||||
[<Global>]
|
||||
let private window: obj = jsNative
|
||||
|
||||
let private direction (dir: string) : Direction =
|
||||
match dir with
|
||||
| "Up" -> Up
|
||||
| "Down" -> Down
|
||||
| "Left" -> Left
|
||||
| "Right" -> Right
|
||||
| other -> failwith $"unknown direction in the recording: {other}"
|
||||
|
||||
// A recording holds only Tick and Turn: {"tag":"Tick"} or {"tag":"Turn","dir":"Up"}.
|
||||
let private action (a: obj) : Action =
|
||||
match (a?tag: string) with
|
||||
| "Tick" -> Tick
|
||||
| "Turn" -> Turn(direction a?dir)
|
||||
| other -> failwith $"unknown action in the recording: {other}"
|
||||
|
||||
let private recording (data: obj) : Recording =
|
||||
{ Seed = uint32 (data?seed: float)
|
||||
Actions = (data?actions: obj[]) |> Array.map action |> List.ofArray }
|
||||
|
||||
let private start (data: obj) : unit =
|
||||
Runtime.runApp (BrowserPlatform.create (BrowserPlatform.gameCanvas ())) (replayMain (recording data))
|
||||
|
||||
window?fetch("../fixtures/replay-sample.json")?``then``(fun (response: obj) -> response?json ())?``then``(start)
|
||||
|> ignore
|
||||
@@ -19,13 +19,20 @@
|
||||
<Compile Include="../src/Input.fs" />
|
||||
<Compile Include="../src/App.fs" />
|
||||
<Compile Include="../src/Runtime.fs" />
|
||||
<Compile Include="../src/Replay.fs" />
|
||||
<Compile Include="../src/Pong/Model.fs" />
|
||||
<Compile Include="../src/Pong/Rules.fs" />
|
||||
<Compile Include="../src/Pong/View.fs" />
|
||||
<Compile Include="../src/Pong/App.fs" />
|
||||
<Compile Include="../src/Life/Model.fs" />
|
||||
<Compile Include="../src/Life/Rules.fs" />
|
||||
<Compile Include="../src/Life/View.fs" />
|
||||
<Compile Include="../src/Life/App.fs" />
|
||||
<Compile Include="BrowserPlatform.fs" />
|
||||
<Compile Include="SnakeMain.fs" />
|
||||
<Compile Include="PongMain.fs" />
|
||||
<Compile Include="ReplayMain.fs" />
|
||||
<Compile Include="LifeMain.fs" />
|
||||
</ItemGroup>
|
||||
<ItemGroup>
|
||||
<PackageReference Include="Fable.Core" Version="5.6.0" />
|
||||
|
||||
Reference in new issue
Block a user