functional-programming-snake/fsharp/solutions/Replay.fs

/// 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
    )