module Snake.Tests.M09Runtime open Expecto open Snake open Snake.Model open Snake.View 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) = let calls = ResizeArray() let mutable onTime: int64 -> unit = ignore let mutable onDown: string -> unit = ignore let mutable onUp: string -> unit = ignore 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 _.Platform: Platform = { FillRect = fun x y w h color -> calls.Add [ box "fillRect"; box x; box y; box w; box h; box color ] FillText = fun x y text color size align -> calls.Add [ box "fillText"; box x; box y; box text; box color; box size; box align ] RandomSeed = fun () -> calls.Add [ box "randomSeed" ] seed StartClock = fun cb -> onTime <- cb OnKeyDown = fun cb -> onDown <- cb OnKeyUp = fun cb -> onUp <- cb } // What the platform should have been asked to draw for a scene. let private expectedCalls (scene: Scene) : obj list list = scene |> List.map (fun shape -> match shape with | Rect(x, y, w, h, color) -> [ box "fillRect"; box x; box y; box w; box h; box color ] | Text(x, y, text, color, size, align) -> [ box "fillText"; box x; box y; box text; box color; box size; box align ]) let private rect = Rect(1, 2, 3, 4, "#abcdef") let private text = Text(5, 6, "hi", "#fff", 16, "center") [] let tests = testList "M09 Runtime" [ testCase "runIO of a pure value returns it without touching the platform" (fun () -> let p = FakePlatform 42u Expect.equal (Runtime.runIO p.Platform (IO.pure 7)) 7 "result" Expect.equal p.Calls [] "calls") testCase "runIO maps Draw Rect to FillRect x y w h color" (fun () -> let p = FakePlatform 42u Runtime.runIO p.Platform (IO.draw rect) Expect.equal p.Calls [ [ box "fillRect"; box 1; box 2; box 3; box 4; box "#abcdef" ] ] "calls") testCase "runIO maps Draw Text to FillText x y text color size align" (fun () -> let p = FakePlatform 42u Runtime.runIO p.Platform (IO.draw text) Expect.equal p.Calls [ [ box "fillText"; box 5; box 6; box "hi"; box "#fff"; box 16; box "center" ] ] "calls") testCase "runIO answers RandomSeed with platform.RandomSeed () and continues with it" (fun () -> let p = FakePlatform 99u Expect.equal (Runtime.runIO p.Platform (IO.randomSeed () |> IO.map (fun s -> s + 1u))) 100u "result" Expect.equal p.Calls [ [ box "randomSeed" ] ] "calls") testCase "runIO performs effects in order" (fun () -> let p = FakePlatform 42u Runtime.runIO p.Platform (IO.sequence [ IO.draw rect; IO.draw text; IO.draw rect ]) Expect.equal (p.Calls |> List.map List.head) [ box "fillRect"; box "fillText"; box "fillRect" ] "order") testCase "runIO handles 100000 effects without overflowing the stack" (fun () -> let p = FakePlatform 42u let n = 100000 Runtime.runIO p.Platform (IO.sequence (List.replicate n (IO.draw rect))) Expect.equal (List.length p.Calls) n "calls") testCase "runApp asks the platform for a seed once, at start, and draws nothing before the first event" (fun () -> let p = FakePlatform 42u Runtime.runApp p.Platform (classicMain ()) Expect.equal p.Calls [ [ box "randomSeed" ] ] "calls") testCase "runApp draws the initial scene on the first clock tick, then the ticked scene after 150 ms" (fun () -> let p = FakePlatform 42u Runtime.runApp p.Platform (classicMain ()) p.Clear() p.FireTime 150L Expect.equal p.Calls (expectedCalls (View.view (Spawn.newGame 42u)) @ expectedCalls (View.view (Spawn.tick (Spawn.newGame 42u)))) "calls") testCase "runApp feeds key presses to the game" (fun () -> let p = FakePlatform 42u Runtime.runApp p.Platform (classicMain ()) p.FireTime 0L p.Clear() p.FireKey "ArrowUp" p.FireTime 150L let turned = { Spawn.newGame 42u with NextDir = Up } Expect.equal p.Calls (expectedCalls (View.view turned) @ expectedCalls (View.view (Spawn.tick turned))) "calls") testCase "runApp ignores key releases and unmapped keys (no redraw)" (fun () -> let p = FakePlatform 42u Runtime.runApp p.Platform (classicMain ()) p.FireTime 0L p.Clear() p.FireKeyUp "ArrowUp" p.FireKey "x" Expect.equal p.Calls [] "calls") ]