implement gl pipeline with ability to draw a rectangle

This commit is contained in:
tali 2024-01-15 14:19:44 -05:00
parent 4746d0f897
commit 192074f7eb
6 changed files with 340 additions and 3 deletions

View File

@ -0,0 +1,9 @@
#version 150 core
uniform vec4 Fill;
out vec4 FragColor;
void main() {
FragColor = Fill;
}

View File

@ -0,0 +1,18 @@
#version 150 core
uniform ivec2 Viewport;
uniform mat3 Transform;
uniform vec4 BoundingBox;
uniform int Border;
in vec2 Vert;
in vec2 Norm;
void main() {
vec2 vert = mix(BoundingBox.xy, BoundingBox.zw, Vert) + Border * Norm;
vec3 pos = Transform * vec3(vert, 1.0);
gl_Position.xy = pos.xy * vec2(2.0, -2.0) / Viewport + vec2(-1.0, 1.0);
gl_Position.z = 0.0;
gl_Position.w = 1.0;
}

43
src/gl.ml Normal file
View File

@ -0,0 +1,43 @@
open! Import
include Tgl4.Gl
exception Error of string * string
let error_names = [
invalid_enum, "Invalid enum";
invalid_value, "Invalid value";
invalid_operation, "Invalid operation";
invalid_framebuffer_operation, "Invalid framebuffer operation";
out_of_memory, "Out of memory";
stack_underflow, "Stack underflow";
stack_overflow, "Stack overflow";
]
let check_error why =
let err = get_error () in
if err <> no_error then
raise (Error (why, List.assoc err error_names))
let _i32 = Array1.create Int32 C_layout 1
let get_integer param =
get_integerv param _i32;
Int32.to_int _i32.{0}
let gen_get_status gen_get gen_get_info_log status_enum obj =
gen_get obj status_enum _i32;
if Int32.to_int _i32.{0} = true_ then Ok ()
else
let len =
gen_get obj info_log_length _i32;
Int32.to_int _i32.{0}
in
let buf = Array1.create Char C_layout len in
gen_get_info_log obj len None buf;
Error (String.init (len - 1) (fun i -> buf.{i}))
let get_shader_compile_status obj =
gen_get_status get_shaderiv get_shader_info_log compile_status obj
let get_program_link_status obj =
gen_get_status get_programiv get_program_info_log link_status obj

View File

@ -1,4 +1,5 @@
include Adam include Adam
module Array1 = Bigarray.Array1
module Sdl = struct module Sdl = struct
include Tsdl.Sdl include Tsdl.Sdl

View File

@ -33,7 +33,11 @@ let main () =
(* let time = Sdl.get_ticks () |> Int32.to_int in *) (* let time = Sdl.get_ticks () |> Int32.to_int in *)
Renderer.pre_draw ren; Renderer.pre_draw ren;
Renderer.clear ren (rgb24 0xff8833); Renderer.clear ren (rgb24 0x000000);
Renderer.draw_rect ren
~tf:(mat2a 100.0 50.0 1.0 1.0)
~bb:(aabb (-5.0) (-10.0) 50.0 200.0)
~fill:(rgb24 0xff0000);
Renderer.post_draw ren; Renderer.post_draw ren;
done done
with Quit -> with Quit ->
@ -48,4 +52,5 @@ let () =
try main () with try main () with
| Failure msg -> error (fun m -> m "%s" msg) | Failure msg -> error (fun m -> m "%s" msg)
| Sdl.Error msg -> error (fun m -> m "SDL error: %s" msg) | Sdl.Error msg -> error (fun m -> m "SDL error: %s" msg)
| Gl.Error (why, msg) -> error (fun m -> m "OpenGL error (%s): %s" why msg)
| Asset.Error (path, msg) -> error (fun m -> m "failed to load %S: %s" path msg) | Asset.Error (path, msg) -> error (fun m -> m "failed to load %S: %s" path msg)

View File

@ -1,37 +1,298 @@
open! Import open! Import
include (val Ohlog.sublogs logger "Ren") include (val Ohlog.sublogs logger "Ren")
(* Buffer *)
type buffer = {
bo : int;
} [@@unboxed]
let set_buffer_data ?(usage = Gl.stream_draw) {bo} data =
let size = Array1.size_in_bytes data in
Gl.bind_buffer Gl.array_buffer bo;
Gl.buffer_data Gl.array_buffer size (Some data) usage
let make_buffer ?data () =
let bo = Gl.gen_buffers 1 Gl._i32; Int32.to_int Gl._i32.{0} in
let buf = {bo} in
Option.iter (set_buffer_data buf ~usage:Gl.static_draw) data;
buf
let buffer_size_in_bytes { bo } =
Gl.get_named_buffer_parameteriv bo Gl.buffer_size Gl._i32;
Int32.to_int Gl._i32.{0}
(* Vertex buffer attributes *)
type attr = {
aidx : int;
atype : [`float];
asize : int;
}
let attr_type at = match at.atype with
| `float -> Gl.float
let attr_size_in_bytes at = match at.atype with
| `float -> at.asize * 4
type vertex_buffer = {
vbuf : buffer;
vats : attr list;
vdiv : int;
}
let make_static_vertex_buffer data vats =
let vbuf = make_buffer () ~data in
{ vbuf; vats; vdiv = 0 }
(* let make_instance_vertex_buffer vats = *)
(* let vbuf = make_buffer () in *)
(* {vbuf; vats; vdiv = 1} *)
let bind_vertex_buffer { vbuf; vdiv; vats } =
Gl.bind_buffer Gl.array_buffer vbuf.bo;
let stride =
List.fold_left (fun n at -> n + attr_size_in_bytes at) 0 vats
in
let enable ofs at =
Gl.vertex_attrib_pointer
at.aidx at.asize (attr_type at)
false stride (`Offset ofs);
Gl.vertex_attrib_divisor at.aidx vdiv;
Gl.enable_vertex_attrib_array at.aidx;
ofs + attr_size_in_bytes at
in
ignore (List.fold_left enable 0 vats : int)
(* Shaders *)
type shader = {
spo : int;
} [@@unboxed]
type 'a uniform = U : int -> 'a uniform [@@unboxed]
let compile_shader ~vert ~frag =
let spo = Gl.create_program () in
let compile type_ name src =
let so = Gl.create_shader type_ in
Gl.attach_shader spo so;
(* "If a shader object to be deleted is attached to a program object, it will be
* flagged for deletion, but it will not be deleted until it is no longer attached
* to any program object" *)
Gl.delete_shader so;
Gl.shader_source so src;
Gl.compile_shader so;
match Gl.get_shader_compile_status so with
| Ok () -> ()
| Error info_log ->
Gl.delete_program spo;
Printf.ksprintf failwith "Error compiling %s shader: %s" name info_log
in
let link () =
Gl.link_program spo;
match Gl.get_program_link_status spo with
| Ok () -> { spo }
| Error info_log ->
Gl.delete_program spo;
Printf.ksprintf failwith "Error linking shader: %s" info_log
in
compile Gl.vertex_shader "vertex" vert;
compile Gl.fragment_shader "fragment" frag;
link ()
let load_shader ~name =
let shd =
compile_shader
~vert:(Printf.ksprintf Asset.load_file "shaders/%s.vert" name)
~frag:(Printf.ksprintf Asset.load_file "shaders/%s.frag" name)
in
debug (fun m -> m "loaded shader %S" name); shd
let use {spo} =
Gl.use_program spo
let attr {spo} aname atype asize =
match Gl.get_attrib_location spo aname with
| -1 -> Printf.ksprintf failwith "No such attribute %S" aname
| aidx -> { aidx; atype; asize }
let uniform {spo} name =
match Gl.get_uniform_location spo name with
| -1 -> Printf.ksprintf failwith "No such uniform: %S" name
| loc -> U loc
type 'a set_fn = 'a uniform -> 'a -> unit
let set_int : int set_fn = fun (U l) x -> Gl.uniform1i l x
let set_ivec2 : (int*int) set_fn = fun (U l) (x, y) -> Gl.uniform2i l x y
let set_color : color set_fn = fun (U l) c -> Gl.uniform4f l c.r c.g c.b c.a
let set_aabb : aabb set_fn = fun (U l) b -> Gl.uniform4f l b.x0 b.y0 b.x1 b.y1
let set_mat2a : mat2a set_fn =
let _mat3x3 = Array1.create Float32 C_layout 9 in
_mat3x3.{6} <- 0.0;
_mat3x3.{7} <- 0.0;
_mat3x3.{8} <- 1.0;
fun (U l) mat ->
_mat3x3.{0} <- mat.a0;
_mat3x3.{1} <- mat.a1;
_mat3x3.{2} <- mat.a2;
_mat3x3.{3} <- mat.a3;
_mat3x3.{4} <- mat.a4;
_mat3x3.{5} <- mat.a5;
Gl.uniform_matrix3fv l 1 true _mat3x3
(* Geometry *)
type geometry = {
vao : int;
draw_mode : Gl.enum;
indices : [`count of int | `elems of int];
}
let make_geometry
~draw_mode
~index
vertex_buffers
=
let vao = Gl.gen_vertex_arrays 1 Gl._i32; Int32.to_int Gl._i32.{0} in
Gl.bind_vertex_array vao;
let indices = match index with
| `count n ->
Gl.bind_buffer Gl.element_array_buffer 0;
`count n
| `elems ibuf ->
Gl.bind_buffer Gl.element_array_buffer ibuf.bo;
(* divide by 2 since the buffer should contain int16_unsigned *)
`elems (buffer_size_in_bytes ibuf / 2)
in
List.iter bind_vertex_buffer vertex_buffers;
{
vao;
draw_mode;
indices
}
let draw_geometry ?(instances = 1) { vao; draw_mode; indices } =
Gl.bind_vertex_array vao;
match indices with
| `count n ->
Gl.draw_arrays_instanced draw_mode 0 n instances
| `elems n ->
let offset = `Offset 0 in
let type_ = Gl.unsigned_short in
Gl.draw_elements_instanced draw_mode n type_ offset instances
(* Renderer *)
type t = { type t = {
window : Sdl.window; window : Sdl.window;
gl_ctx : Sdl.gl_context; gl_ctx : Sdl.gl_context;
polygon : shader;
rect : geometry;
} }
let unit_square =
(* 1--0
* | |
* 3--2
*)
Array1.of_array Float32 C_layout @@
Array.concat [
[| 1.; 0.; |];
[| 0.; 0.; |];
[| 1.; 1.; |];
[| 0.; 1.; |];
]
let unit_square_with_norm =
(* 5 4
* 1--0
* | |
* 3--2
* 7 6
*)
Array1.of_array Float32 C_layout @@
Array.concat [
[| 1.; 0.; 0.; 0. |];
[| 0.; 0.; 0.; 0. |];
[| 1.; 1.; 0.; 0. |];
[| 0.; 1.; 0.; 0. |];
[| 1.; 0.; 1.; -1. |];
[| 0.; 0.; -1.; -1. |];
[| 1.; 1.; 1.; 1. |];
[| 0.; 1.; -1.; 1. |];
]
let make ~(window : Sdl.window) : t = let make ~(window : Sdl.window) : t =
debug (fun m -> m "initializing"); debug (fun m -> m "initializing");
let gl_ctx = Sdl.gl_create_context_exn window in let gl_ctx = Sdl.gl_create_context_exn window in
Sdl.gl_make_current_exn window gl_ctx; Sdl.gl_make_current_exn window gl_ctx;
Sdl.gl_set_swap_interval_exn 1; Sdl.gl_set_swap_interval_exn 1;
Gl.enable Gl.blend;
Gl.blend_func Gl.one Gl.one_minus_src_alpha;
Gl.check_error "setup";
let polygon =
load_shader
~name:"polygon"
in
let rect =
make_geometry [
make_static_vertex_buffer unit_square_with_norm [
attr polygon "Vert" `float 2;
attr polygon "Norm" `float 2;
]
]
~draw_mode:Gl.triangle_strip
~index:(`count 4)
in
{ {
window; window;
gl_ctx; gl_ctx;
polygon;
rect;
} }
let destroy t = let destroy t =
Sdl.gl_delete_context t.gl_ctx Sdl.gl_delete_context t.gl_ctx
let pre_draw t = let pre_draw t =
let viewport = Sdl.get_window_size t.window in
begin begin
Sdl.gl_make_current_exn t.window t.gl_ctx; Sdl.gl_make_current_exn t.window t.gl_ctx;
(* let size = Sdl.get_window_size t.window in *) set_ivec2 (uniform t.polygon "Viewport") viewport;
end end
let clear (_t : t) (bg : color) = let clear _t (bg : color) =
begin begin
Gl.clear_color bg.r bg.g bg.b bg.a; Gl.clear_color bg.r bg.g bg.b bg.a;
Gl.clear Gl.color_buffer_bit; Gl.clear Gl.color_buffer_bit;
end end
let draw_rect t ~(tf : mat2a) ~(bb : aabb) ~(fill : color) =
let sh = t.polygon in
begin
(* TODO: cache/store uniform locations in some way *)
use sh;
set_mat2a (uniform sh "Transform") tf;
set_aabb (uniform sh "BoundingBox") bb;
set_int (uniform sh "Border") 0;
set_color (uniform sh "Fill") fill;
draw_geometry t.rect;
end
let post_draw t = let post_draw t =
begin begin
Sdl.gl_swap_window t.window; Sdl.gl_swap_window t.window;