gdritter repos reason-gl-basic / 7c91fbe
Minimal ReasonML OpenGL+SDL example Getty Ritter 6 years ago
5 changed file(s) with 275 addition(s) and 0 deletion(s). Collapse all Expand all
+4
-0
.gitignore less more
1 *.install
2 _build
3 *~
4 .merlin
+10
-0
Makefile less more
1 build:
2 jbuilder build
3
4 run: build
5 ./_build/install/default/bin/reason-gl-test
6
7 clean:
8 rm -rf _build *.install
9
10 .PHONY: build run
+21
-0
ReasonGLBasic.opam less more
1 opam-version: "1.2"
2 name: "ReasonGLBasic"
3 version: "0.0.1"
4 maintainer: "Getty Ritter <samothes@infinitenegativeutility.com>"
5 authors: [
6 "Getty Ritter <samothes@infinitenegativeutility.com>"
7 ]
8 license: "BSD"
9 homepage: "https://git.gdritter.com/ReasonGLBasic"
10 dev-repo: "https://git.gdritter.com/ReasonGLBasic"
11 tags: [ "graphics" ]
12 build: [
13 ["jbuilder" "build" "-p" name "-j" jobs]
14 ]
15 depends: [
16 "jbuilder" {build}
17 "reason" {= "2.0.0"}
18 "tsdl"
19 "tgls"
20 ]
21 available: [ ocaml-version >= "4.02" & ocaml-version < "4.05" ]
+8
-0
bin/jbuild less more
1 (jbuild_version 1)
2
3 (executable
4 ((name main)
5 ; This will be installable as a global binary
6 (public_name reason-gl-test)
7 ; and it depends on 2 local libraries
8 (libraries (tsdl tgls.tgl4))))
+232
-0
bin/main.re less more
1 open Tsdl;
2 open Tgl4;
3 open Result;
4
5 /* the bind operator for the exception monad, for quick error
6 handling */
7 let (>>=) = fun x f => switch x {
8 | Ok v => f v
9 | Error e => Error e
10 };
11
12 /* our vertex shader takes a 2d position and renders it on the screen,
13 and that's it */
14 let vertex_shader =
15 "#version 130
16 in vec2 position;
17 void main() {
18 gl_Position = vec4(position, 0.0, 1.0);
19 }
20 ";
21
22 /* our fragment shader just draws white */
23 let fragment_shader =
24 "#version 130
25 out vec4 out_color;
26 void main() {
27 out_color = vec4(1.0, 1.0, 1.0, 1.0);
28 }
29 ";
30
31 /* we use a lot of Bigarrays, which are contiguous chunks of memory
32 that we can hand off to C */
33 let bigarray_create k len => Bigarray.(Array1.create k c_layout len);
34
35 /* our vertex data is [0.0, 0.5, 0.5, -0.5, -0.5, -0.5], but in a
36 contiguous array of memory */
37 let vertices = {
38 open Bigarray.Array1;
39 let arr = bigarray_create Bigarray.float32 6;
40 set arr 0 0.0;
41 set arr 1 0.5;
42 set arr 2 0.5;
43 set arr 3 (-0.5);
44 set arr 4 (-0.5);
45 set arr 5 (-0.5);
46 arr
47 };
48
49 /* This takes a function which expects to fill a buffer with a single
50 32-bit integer; this will call that function and then conver it to an
51 OCaml integer */
52 let buf_to_int f => {
53 let a = bigarray_create Bigarray.int32 1;
54 f a;
55 Int32.to_int (Bigarray.Array1.get a 0)
56 };
57
58 /* This takes a function that expects to use a buffer containing a
59 single 32-bit integer as well as an integer itself; this will
60 convert the integer into a buffer and then call the function on
61 it */
62 let int_as_buf f i => {
63 let a = bigarray_create Bigarray.int32 1;
64 Bigarray.Array1.set a 0 (Int32.of_int i);
65 f a
66 };
67
68 /* Like buf_to_int, but for an arbitrary-sized string */
69 let get_string len f => {
70 let a = bigarray_create Bigarray.char len;
71 f a;
72 Gl.string_of_bigarray a
73 };
74
75
76
77 /* The first thing to do is to get a new window from SDL and then
78 initialize an OpenGL context in that window. */
79 let window () => {
80 Sdl.init Sdl.Init.video >>= fun () =>
81 Sdl.create_window w::640 h::480 "test" Sdl.Window.opengl >>= fun w =>
82 Sdl.gl_create_context w >>= fun ctx =>
83 Sdl.gl_make_current w ctx >>= fun () =>
84 Ok (w, ctx)
85 };
86
87 /* This compiles a shader, producing an informative error message if
88 the compilation process fails. */
89 let compile_shader typ src => {
90 let shader = Gl.create_shader typ;
91 Gl.shader_source shader src;
92 Gl.compile_shader shader;
93 if (buf_to_int (Gl.get_shaderiv shader Gl.compile_status) == Gl.true_) {
94 Ok shader
95 } else {
96 let len = buf_to_int (Gl.get_shaderiv shader Gl.info_log_length);
97 let log = get_string len (Gl.get_shader_info_log shader len None);
98 Gl.delete_shader shader;
99 Error (`Msg log)
100 }
101 };
102
103 /* This links our two shaders together into a single OpenGL program,
104 again producing an informative error message if it fails. */
105 let create_program () => {
106 compile_shader Gl.vertex_shader vertex_shader >>= fun vertex =>
107 compile_shader Gl.fragment_shader fragment_shader >>= fun fragment => {
108 let program = Gl.create_program ();
109 Gl.attach_shader program vertex;
110 Gl.attach_shader program fragment;
111 Gl.link_program program;
112 if (buf_to_int (Gl.get_programiv program Gl.link_status) == Gl.true_) {
113 Ok program
114 } else {
115 let len = buf_to_int (Gl.get_programiv program Gl.info_log_length);
116 let log = get_string len (Gl.get_program_info_log program len None);
117 Gl.delete_program program;
118 Error (`Msg log)
119 }
120 }
121 };
122
123
124 /* This initializes a vertex array and a vertex buffer using our
125 vertex information above. */
126 let init_scene program => {
127 let array = buf_to_int (Gl.gen_vertex_arrays 1);
128 Gl.bind_vertex_array array;
129
130 let buffer = buf_to_int (Gl.gen_buffers 1);
131 Gl.bind_buffer Gl.array_buffer buffer;
132 Gl.buffer_data
133 Gl.array_buffer
134 (Gl.bigarray_byte_size vertices)
135 (Some vertices)
136 Gl.static_draw;
137
138 /* This bit is first telling OpenGL where our fragment data can be
139 found */
140 Gl.bind_frag_data_location program 0 "out_color";
141 /* and then asking it the location of the position attribute */
142 let pos_attr = Gl.get_attrib_location program "position";
143 /* and finally telling OpenGL that the stuff in our vertex buffer
144 corresponds to the aforementioned "position" attribute */
145 Gl.enable_vertex_attrib_array pos_attr;
146 /* and tells OpenGL that it consists of two floats with no stride
147 and no offset. */
148 Gl.vertex_attrib_pointer pos_attr 2 Gl.float false 0 (`Offset 0);
149
150 /* We return these for later use! */
151 (array, buffer)
152 };
153
154
155 let draw program buffer w => {
156 /* we clear the background color to a pleasing robin's-egg blue */
157 Gl.clear_color 0.3 0.6 0.9 1.;
158 Gl.clear Gl.color_buffer_bit;
159
160 /* we tell OpenGL we want to use that program we made earlier, and
161 the array buffer we created earlier, too */
162 Gl.use_program program;
163 Gl.bind_buffer Gl.array_buffer buffer;
164 /* and tell it to draw the first 3 things in that array buffer as
165 triangles */
166 Gl.draw_arrays Gl.triangles 0 3;
167 /* and then clear that shit out. (We can skip this step, to be fair,
168 but it's good to get in the habit for later.) */
169 Gl.bind_buffer Gl.array_buffer 0;
170 Gl.use_program 0;
171
172 /* and finally swap the window! */
173 Sdl.gl_swap_window w
174 };
175
176
177 /* The drawing function here is of type () -> () so we can pass in a
178 closure and not have to pass other data down the chain */
179 let event_loop draw w => {
180 let e = Sdl.Event.create();
181 /* these helper functions are just to reduce the verbosity down
182 below */
183 let keycode e => Sdl.Scancode.enum Sdl.Event.(get e keyboard_scancode);
184 let event e => Sdl.Event.(enum (get e typ));
185 /* the crunchy center is a loop that draws and then dispatches on
186 the relevant events */
187 let rec loop () => {
188 draw ();
189 Sdl.wait_event (Some e) >>= fun () =>
190 switch (event e) {
191 | `Quit => Ok ()
192 | `Key_down when keycode e == `Escape => Ok ()
193 | `Key_down when keycode e == `Q => Ok ()
194 | _ => loop ()
195 }
196 };
197 loop ()
198 };
199
200
201 /* and the main function! */
202 let main () => {
203 /* create the window */
204 window () >>= fun (w, ctx) =>
205 /* create the program */
206 create_program () >>= fun program => {
207 /* create the vertex data */
208 let (array, buffer) = init_scene program;
209 /* run the event loop with the relevant drawing function */
210 event_loop (fun () => draw program array w) w >>= fun () => {
211 /* and clean it all up! */
212 int_as_buf (Gl.delete_vertex_arrays 1) array;
213 int_as_buf (Gl.delete_buffers 1) buffer;
214 Gl.delete_program program;
215 Sdl.gl_delete_context ctx;
216 Sdl.destroy_window w;
217 Sdl.quit ();
218 /* s'all good yo */
219 Ok ()
220 }
221 }
222 };
223
224 /* and, at the top-level, run it and print any error messages we
225 get. */
226 switch (main ()) {
227 | Ok () => ()
228 | Error (`Msg e) => {
229 Sdl.log "%s" e;
230 exit 1
231 };
232 };