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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
external init : unit -> unit = "caml_usdl_init"
external quit : unit -> unit = "caml_usdl_quit"
type renderer
type surface
type texture
module Window = struct
type t
external create : title:string -> w:int -> h:int -> t
= "caml_usdl_window_create"
external destroy : t -> unit = "caml_usdl_window_destroy"
end
module Renderer = struct
type t = renderer
external create : Window.t -> t = "caml_usdl_renderer_create"
external output_size : t -> int * int = "caml_usdl_renderer_output_size"
external clear : t -> unit = "caml_usdl_renderer_clear"
external copy : t -> texture -> unit = "caml_usdl_renderer_copy"
external present : t -> unit = "caml_usdl_renderer_present"
external destroy : t -> unit = "caml_usdl_renderer_destroy"
end
module Surface = struct
type t = surface
external create_argb8888 : w:int -> h:int -> t
= "caml_usdl_surface_create_argb8888"
external pitch : t -> int = "caml_usdl_surface_pitch"
external pixels :
t -> (int, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
= "caml_usdl_surface_pixels"
external destroy : t -> unit = "caml_usdl_surface_destroy"
end
module Texture = struct
type t = texture
external of_surface : Renderer.t -> Surface.t -> t
= "caml_usdl_texture_of_surface"
external destroy : t -> unit = "caml_usdl_texture_destroy"
end
module Event = struct
type t
type event_type = [ `Quit | `Window_event | `Key_down | `Unknown of int ]
type window_event =
[ `Resized | `Size_changed | `Exposed | `Close | `Unknown of int ]
external create : unit -> t = "caml_usdl_event_create"
external wait : t -> bool = "caml_usdl_event_wait"
external raw_type : t -> int = "caml_usdl_event_type" [@@noalloc]
external raw_window_id : t -> int = "caml_usdl_event_window_id" [@@noalloc]
external keycode : t -> int = "caml_usdl_event_keycode" [@@noalloc]
let typ t =
match raw_type t with
| 0x100 -> `Quit
| 0x200 -> `Window_event
| 0x300 -> `Key_down
| n -> `Unknown n
let window_event_id t =
match raw_window_id t with
| 5 -> `Resized
| 6 -> `Size_changed
| 2 -> `Exposed
| 14 -> `Close
| n -> `Unknown n
end
module Keycode = struct
let escape = 27
let q = Char.code 'q'
end