functional-programming-snake/fsharp/web/BrowserPlatform.fs

/// Browser glue: turns a canvas into a Platform. Impure by nature; not part of the exercises' logic.
/// `?` (Fable.Core.JsInterop dynamic access) calls browser APIs by name, without type bindings or extra packages.
module Snake.Web.BrowserPlatform

open Fable.Core
open Fable.Core.JsInterop
open Snake.Runtime

[<Global>]
let private window: obj = jsNative

[<Global>]
let private crypto: obj = jsNative

// Keys that scroll the page should only steer the game.
let private prevent = [ "ArrowUp"; "ArrowDown"; "ArrowLeft"; "ArrowRight"; " " ]

let private listen (kind: string) (cb: string -> unit) : unit =
    window?addEventListener (kind,
                             fun (e: obj) ->
                                 let key: string = e?key

                                 if List.contains key prevent then
                                     e?preventDefault ()

                                 cb key)

// t is the number of milliseconds since the first animation frame.
let private startClock (onTime: int64 -> unit) : unit =
    let rec frame (start: float option) : float -> unit =
        fun now ->
            let t0 = defaultArg start now
            onTime (int64 (now - t0))
            window?requestAnimationFrame (frame (Some t0))

    window?requestAnimationFrame (frame None)

// Fable compiles a uint32 array to a Uint32Array, which is what crypto.getRandomValues fills.
let private randomSeed () : uint32 =
    let buf: uint32[] = Array.zeroCreate 1
    crypto?getRandomValues (buf)
    buf[0]

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

    { FillRect =
        fun x y w h color ->
            ctx?fillStyle <- color
            ctx?fillRect (x, y, w, h)
      FillText =
        fun x y text color size align ->
            ctx?fillStyle <- color
            ctx?font <- $"{size}px monospace"
            ctx?textAlign <- align
            ctx?fillText (text, x, y)
      RandomSeed = randomSeed
      LoadBest = loadBest
      SaveBest = saveBest
      StartClock = startClock
      OnKeyDown = listen "keydown"
      OnKeyUp = listen "keyup"
      OnClick = onClick canvas }

/// The page's `<canvas id="game">`.
let gameCanvas () : obj = window?document?getElementById ("game")