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