gdritter repos reason-gl-basic / master
Update for Reason 3 Getty Ritter 6 years ago
2 changed file(s) with 103 addition(s) and 102 deletion(s). Collapse all Expand all
+1
-1
ReasonGLBasic.opam less more
1414 ]
1515 depends: [
1616 "jbuilder" {build}
17 "reason" {= "2.0.0"}
17 "reason" {= "3.0.0"}
1818 "tsdl"
1919 "tgls"
2020 ]
+102
-101
bin/main.re less more
44
55 /* the bind operator for the exception monad, for quick error
66 handling */
7 let (>>=) = fun x f => switch x {
8 | Ok v => f v
9 | Error e => Error e
7 let (>>=) = (x, f) => switch x {
8 | Ok(v) => f(v)
9 | Error(e) => Error(e)
1010 };
1111
1212 /* our vertex shader takes a 2d position and renders it on the screen,
3030
3131 /* we use a lot of Bigarrays, which are contiguous chunks of memory
3232 that we can hand off to C */
33 let bigarray_create k len => Bigarray.(Array1.create k c_layout len);
33 let bigarray_create = (k, len) => Bigarray.(Array1.create(k, c_layout, len));
3434
3535 /* our vertex data is [0.0, 0.5, 0.5, -0.5, -0.5, -0.5], but in a
3636 contiguous array of memory */
3737 let vertices = {
3838 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);
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);
4646 arr
4747 };
4848
4949 /* This takes a function which expects to fill a buffer with a single
5050 32-bit integer; this will call that function and then conver it to an
5151 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)
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))
5656 };
5757
5858 /* This takes a function that expects to use a buffer containing a
5959 single 32-bit integer as well as an integer itself; this will
6060 convert the integer into a buffer and then call the function on
6161 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
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)
6666 };
6767
6868 /* 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
69 let get_string = (len, f) => {
70 let a = bigarray_create(Bigarray.char, len);
71 f(a);
72 Gl.string_of_bigarray(a)
7373 };
7474
7575
7676
7777 /* The first thing to do is to get a new window from SDL and then
7878 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)
79 let window = () => {
80 Sdl.init(Sdl.Init.video) >>= () =>
81 Sdl.create_window(~w=640, ~h=480, "test", Sdl.Window.opengl) >>= (w) =>
82 Sdl.gl_create_context(w) >>= (ctx) =>
83 Sdl.gl_make_current(w, ctx) >>= () =>
84 Ok((w, ctx))
8585 };
8686
8787 /* This compiles a shader, producing an informative error message if
8888 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
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)
9595 } 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)
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))
100100 }
101101 };
102102
103103 /* This links our two shaders together into a single OpenGL program,
104104 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
105 let create_program = () => {
106 compile_shader(Gl.vertex_shader, vertex_shader) >>= (vertex) =>
107 compile_shader(Gl.fragment_shader, fragment_shader) >>= (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)
114114 } 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)
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))
119119 }
120120 }
121121 };
123123
124124 /* This initializes a vertex array and a vertex buffer using our
125125 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;
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 );
137138
138139 /* This bit is first telling OpenGL where our fragment data can be
139140 found */
140 Gl.bind_frag_data_location program 0 "out_color";
141 Gl.bind_frag_data_location(program, 0, "out_color");
141142 /* and then asking it the location of the position attribute */
142 let pos_attr = Gl.get_attrib_location program "position";
143 let pos_attr = Gl.get_attrib_location(program, "position");
143144 /* and finally telling OpenGL that the stuff in our vertex buffer
144145 corresponds to the aforementioned "position" attribute */
145 Gl.enable_vertex_attrib_array pos_attr;
146 Gl.enable_vertex_attrib_array(pos_attr);
146147 /* and tells OpenGL that it consists of two floats with no stride
147148 and no offset. */
148 Gl.vertex_attrib_pointer pos_attr 2 Gl.float false 0 (`Offset 0);
149 Gl.vertex_attrib_pointer(pos_attr, 2, Gl.float, false, 0, `Offset(0));
149150
150151 /* We return these for later use! */
151152 (array, buffer)
152153 };
153154
154155
155 let draw program buffer w => {
156 let draw = (program, buffer, w) => {
156157 /* 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;
158 Gl.clear_color(0.3, 0.6, 0.9, 1.0);
159 Gl.clear(Gl.color_buffer_bit);
159160
160161 /* we tell OpenGL we want to use that program we made earlier, and
161162 the array buffer we created earlier, too */
162 Gl.use_program program;
163 Gl.bind_buffer Gl.array_buffer buffer;
163 Gl.use_program(program);
164 Gl.bind_buffer(Gl.array_buffer, buffer);
164165 /* and tell it to draw the first 3 things in that array buffer as
165166 triangles */
166 Gl.draw_arrays Gl.triangles 0 3;
167 Gl.draw_arrays(Gl.triangles, 0, 3);
167168 /* and then clear that shit out. (We can skip this step, to be fair,
168169 but it's good to get in the habit for later.) */
169 Gl.bind_buffer Gl.array_buffer 0;
170 Gl.use_program 0;
170 Gl.bind_buffer(Gl.array_buffer, 0);
171 Gl.use_program(0);
171172
172173 /* and finally swap the window! */
173 Sdl.gl_swap_window w
174 Sdl.gl_swap_window(w)
174175 };
175176
176177
177178 /* The drawing function here is of type () -> () so we can pass in a
178179 closure and not have to pass other data down the chain */
179 let event_loop draw w => {
180 let event_loop = (draw, w) => {
180181 let e = Sdl.Event.create();
181182 /* these helper functions are just to reduce the verbosity down
182183 below */
183 let keycode e => Sdl.Scancode.enum Sdl.Event.(get e keyboard_scancode);
184 let event e => Sdl.Event.(enum (get e typ));
184 let keycode = (e) => Sdl.Scancode.enum(Sdl.Event.(get(e, keyboard_scancode)));
185 let event = (e) => Sdl.Event.(enum (get(e, typ)));
185186 /* the crunchy center is a loop that draws and then dispatches on
186187 the relevant events */
187 let rec loop () => {
188 let rec loop = () => {
188189 draw ();
189 Sdl.wait_event (Some e) >>= fun () =>
190 switch (event e) {
190 Sdl.wait_event(Some(e)) >>= () =>
191 switch (event(e)) {
191192 | `Quit => Ok ()
192 | `Key_down when keycode e == `Escape => Ok ()
193 | `Key_down when keycode e == `Q => Ok ()
193 | `Key_down when keycode(e) == `Escape => Ok ()
194 | `Key_down when keycode(e) == `Q => Ok ()
194195 | _ => loop ()
195196 }
196197 };
199200
200201
201202 /* and the main function! */
202 let main () => {
203 let main = () => {
203204 /* create the window */
204 window () >>= fun (w, ctx) =>
205 window () >>= ((w, ctx)) =>
205206 /* create the program */
206 create_program () >>= fun program => {
207 create_program () >>= (program) => {
207208 /* create the vertex data */
208 let (array, buffer) = init_scene program;
209 let (array, buffer) = init_scene(program);
209210 /* run the event loop with the relevant drawing function */
210 event_loop (fun () => draw program array w) w >>= fun () => {
211 event_loop(() => draw(program,array, w), w) >>= () => {
211212 /* 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 ();
213 int_as_buf(Gl.delete_vertex_arrays(1), array);
214 int_as_buf(Gl.delete_buffers(1), buffer);
215 Gl.delete_program(program);
216 Sdl.gl_delete_context(ctx);
217 Sdl.destroy_window(w);
218 Sdl.quit();
218219 /* s'all good yo */
219 Ok ()
220 Ok()
220221 }
221222 }
222223 };
223224
224225 /* and, at the top-level, run it and print any error messages we
225226 get. */
226 switch (main ()) {
227 | Ok () => ()
228 | Error (`Msg e) => {
229 Sdl.log "%s" e;
230 exit 1
227 switch (main()) {
228 | Ok() => ()
229 | Error(`Msg(e)) => {
230 Sdl.log("%s", e);
231 exit(1)
231232 };
232233 };