1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
open Riot
type Message.t += Timer of unit Ref.t | Shutdown
type 'model t = { app : 'model App.t; fps : int }
let make ~app ~fps = { app; fps }
exception Exit
let rec loop renderer (app : 'model App.t) (model : 'model) =
let event =
match receive () with
| Timer ref -> Event.Timer ref
| Io_loop.Input event -> event
| message -> Event.Custom message
in
handle_input renderer app model event
and handle_input renderer app model event =
let model, cmd = app.update event model in
let view = app.view model in
match handle_cmd cmd renderer with
| exception Exit ->
Renderer.render renderer view;
Renderer.exit_alt_screen renderer;
Renderer.shutdown renderer;
wait_pids [ renderer ]
| () ->
Renderer.render renderer view;
loop renderer app model
and handle_cmd cmd renderer =
match cmd with
| Quit -> raise Exit
| Noop -> ()
| Hide_cursor -> Renderer.hide_cursor renderer
| Show_cursor -> Renderer.show_cursor renderer
| Enter_alt_screen -> Renderer.enter_alt_screen renderer
| Exit_alt_screen -> Renderer.exit_alt_screen renderer
| Seq cmds -> List.iter (fun cmd -> handle_cmd cmd renderer) cmds
| Set_timer (ref, after) ->
let _ = Timer.send_after (self ()) (Timer ref) ~after |> Result.get_ok in
()
let init { app; _ } initial_model renderer =
let init_cmd = app.init initial_model in
handle_cmd init_cmd renderer;
let view = app.view initial_model in
Renderer.render renderer view;
loop renderer app initial_model
let run ({ fps; _ } as t) initial_model =
Printexc.record_backtrace true;
let renderer = spawn (fun () -> Renderer.run ~fps) in
let runner =
spawn (fun () ->
register "Minttea.runner" (self ());
init t initial_model renderer)
in
let io = spawn (fun () -> Io_loop.run runner) in
wait_pids [ runner; io ];
shutdown ()