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