├── src ├── tgl3 │ ├── tgl3.mllib │ ├── libtgl3.clib │ └── tgl3_stub.c ├── tgl4 │ ├── tgl4.mllib │ ├── libtgl4.clib │ └── tgl4_stub.c ├── tgles2 │ ├── libtgles2.clib │ ├── tgles2.mllib │ └── tgles2_stub.c └── tgles3 │ ├── libtgles3.clib │ ├── tgles3.mllib │ └── tgles3_stub.c ├── BRZO ├── .gitignore ├── .merlin ├── doc └── index.mld ├── support ├── manual.mli ├── doc.mli ├── gen.mli ├── genpp.mli ├── README.md ├── fixreg.mli ├── fixreg.ml ├── genpp.ml ├── capi.mli ├── oapi.mli ├── glreg.mli ├── dump.ml ├── apiquery.ml ├── manual.ml ├── capi.ml ├── gen.ml ├── glreg.ml ├── oapi.ml └── doc.ml ├── LICENSE.md ├── test ├── assert_sizes.c ├── linkgles2.ml ├── linkgles3.ml ├── linkgl3.ml ├── linkgl4.ml ├── dbglifetime4.ml ├── trigles2.ml ├── trigles3.ml ├── trigl4.ml └── trigl3.ml ├── DEVEL.md ├── opam ├── _tags ├── pkg ├── META └── pkg.ml ├── README.md ├── CHANGES.md ├── myocamlbuild.ml └── B0.ml /src/tgl3/tgl3.mllib: -------------------------------------------------------------------------------- 1 | Tgl3 2 | -------------------------------------------------------------------------------- /src/tgl4/tgl4.mllib: -------------------------------------------------------------------------------- 1 | Tgl4 2 | -------------------------------------------------------------------------------- /BRZO: -------------------------------------------------------------------------------- 1 | (srcs-x pkg test support) -------------------------------------------------------------------------------- /src/tgl3/libtgl3.clib: -------------------------------------------------------------------------------- 1 | tgl3_stub.o -------------------------------------------------------------------------------- /src/tgl4/libtgl4.clib: -------------------------------------------------------------------------------- 1 | tgl4_stub.o -------------------------------------------------------------------------------- /src/tgles2/libtgles2.clib: -------------------------------------------------------------------------------- 1 | tgles2_stub.o -------------------------------------------------------------------------------- /src/tgles2/tgles2.mllib: -------------------------------------------------------------------------------- 1 | Tgles2 2 | -------------------------------------------------------------------------------- /src/tgles3/libtgles3.clib: -------------------------------------------------------------------------------- 1 | tgles3_stub.o -------------------------------------------------------------------------------- /src/tgles3/tgles3.mllib: -------------------------------------------------------------------------------- 1 | Tgles3 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | _b0 2 | _build 3 | support/gl.xml 4 | tmp 5 | *.install 6 | -------------------------------------------------------------------------------- /.merlin: -------------------------------------------------------------------------------- 1 | PKG b0.kit tsdl 2 | S src 3 | S support 4 | S test 5 | B _b0/** 6 | B _build/** 7 | -------------------------------------------------------------------------------- /src/tgl3/tgl3_stub.c: -------------------------------------------------------------------------------- 1 | /*--------------------------------------------------------------------------- 2 | Copyright (c) 2013 The tgls programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*/ 5 | 6 | /* This is just here for ocamlbuild to generate a correct dlltgl3.so object */ 7 | 8 | void tgl3_nop (void) { return; } 9 | -------------------------------------------------------------------------------- /src/tgl4/tgl4_stub.c: -------------------------------------------------------------------------------- 1 | /*--------------------------------------------------------------------------- 2 | Copyright (c) 2013 The tgls programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*/ 5 | 6 | /* This is just here for ocamlbuild to generate a correct dlltgl4.so object */ 7 | 8 | void tgl4_nop (void) { return; } 9 | -------------------------------------------------------------------------------- /src/tgles2/tgles2_stub.c: -------------------------------------------------------------------------------- 1 | /*--------------------------------------------------------------------------- 2 | Copyright (c) 2013 The tgls programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*/ 5 | 6 | /* This is just here for ocamlbuild to generate a correct dlltgles2.so object */ 7 | 8 | void tgles2_nop (void) { return; } 9 | -------------------------------------------------------------------------------- /src/tgles3/tgles3_stub.c: -------------------------------------------------------------------------------- 1 | /*--------------------------------------------------------------------------- 2 | Copyright (c) 2013 The tgls programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*/ 5 | 6 | /* This is just here for ocamlbuild to generate a correct dlltgles3.so object */ 7 | 8 | void tgles3_nop (void) { return; } 9 | -------------------------------------------------------------------------------- /doc/index.mld: -------------------------------------------------------------------------------- 1 | {0 Tgls {%html: %%VERSION%%%}} 2 | 3 | Tgls is a set of independent OCaml libraries providing thin bindings 4 | to OpenGL libraries. It has support for core OpenGL 3.\{2,3\} and 5 | 4.\{0,1,2,3,4\} and OpenGL ES 2 and 3.\{0,1,2\}. 6 | 7 | {1:library_tgls_tgl3 Library [tgls.tgl3]} 8 | 9 | {!modules: Tgl3} 10 | 11 | {1:library_tgls_tgl4 Library [tgls.tgl4]} 12 | 13 | {!modules: Tgl4} 14 | 15 | {1:library_tgls_tgles2 Library [tgls.tgles2]} 16 | 17 | {!modules: Tgles2} 18 | 19 | {1:library_tgls_tgles3 Library [tgls.tgles3]} 20 | 21 | {!modules: Tgles3} 22 | -------------------------------------------------------------------------------- /support/manual.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2013 The tgls programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** Manual bindings. *) 7 | 8 | (** {1 Manual bindings} *) 9 | 10 | type binding = string * string 11 | (** The type for bindings. An [mli] signature and an [ml] implementation. *) 12 | 13 | val get : Capi.t -> string -> binding option 14 | (** [get api f] is a manual binding, if any, for the C function [f] in 15 | the API [api]. *) 16 | -------------------------------------------------------------------------------- /support/doc.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2013 The tgls programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** URIs to documentation. *) 7 | 8 | (** {1 URIs for APIs and their functions} *) 9 | 10 | val home_uri : Capi.t -> string 11 | (** [home_uri api] is a home page URI for the API [api]. *) 12 | 13 | val man_uri : Capi.t -> string -> string option 14 | (** [man_uri api f] is an URI to a manual page for the C function [f] 15 | in the API [api]. *) 16 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013 The tgls programmers 2 | 3 | Permission to use, copy, modify, and/or distribute this software for any 4 | purpose with or without fee is hereby granted, provided that the above 5 | copyright notice and this permission notice appear in all copies. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 8 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 9 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 10 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 11 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 12 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 13 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 14 | -------------------------------------------------------------------------------- /support/gen.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2013 The tgls programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** Binding generation *) 7 | 8 | (** {1 API binding generation} *) 9 | 10 | val pp_api_mli : log:Format.formatter -> Format.formatter -> Capi.t -> unit 11 | (** [pp_api_mli log ppf api] pretty prints a binding signature for [api] on 12 | [ppf]. Warnings and errors are logged on [log]. *) 13 | 14 | val pp_api_ml : log:Format.formatter -> Format.formatter -> Capi.t -> unit 15 | (** [pp_api_ml log ppf api] pretty prints a binding implementation for [api] 16 | on [ppf]. Warnings and errors are logged on [log]. *) 17 | -------------------------------------------------------------------------------- /support/genpp.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2013 The tgls programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** Binding generation helpers. *) 7 | 8 | (** {1 Documentation generalities for APIs} *) 9 | 10 | val pp_mli_api_header : Format.formatter -> Capi.t -> unit 11 | (** [pp_mli_api_header ppf mli] prints an [.mli] file header for [api] 12 | on [ppf]. *) 13 | 14 | val pp_mli_api_footer : Format.formatter -> Capi.t -> unit 15 | (** [pp_mli_api_footer ppf mli] prints an [.mli] file footer for [api] 16 | on [ppf]. *) 17 | 18 | (** {1 License} *) 19 | 20 | val pp_license_header : Format.formatter -> unit -> unit 21 | (** [pp_license_header ppf ()] prints a license header on [ppf]. *) 22 | -------------------------------------------------------------------------------- /test/assert_sizes.c: -------------------------------------------------------------------------------- 1 | /*--------------------------------------------------------------------------- 2 | Copyright (c) 2013 The tgls programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*/ 5 | 6 | /* Compile with: 7 | gcc -o assert_sizes assert_sizes.c 8 | 9 | The following assertions should hold to be sure that the bindings 10 | work correctly. */ 11 | 12 | #include 13 | #include 14 | 15 | int main (void) 16 | { 17 | 18 | assert (sizeof (int) == 4); 19 | assert (sizeof (unsigned int) == 4); 20 | 21 | if (sizeof (void *) == 4) 22 | { 23 | assert (sizeof (ptrdiff_t) == 4); 24 | } 25 | else if (sizeof (void *) == 8) 26 | { 27 | assert (sizeof (ptrdiff_t) == 8); 28 | } 29 | else 30 | { 31 | assert (0); 32 | } 33 | return 0; 34 | } 35 | -------------------------------------------------------------------------------- /DEVEL.md: -------------------------------------------------------------------------------- 1 | This project uses (perhaps the development version of) [`b0`] for 2 | development. Consult [b0 occasionally] for quick hints on how to 3 | perform common development tasks. 4 | 5 | [`b0`]: https://erratique.ch/software/b0 6 | [b0 occasionally]: https://erratique.ch/software/b0/doc/occasionally.html 7 | 8 | # Generating libraries 9 | 10 | The `tgls*` source files in [`src`][src] are generated. 11 | 12 | For generating them you need to install [xmlm][xmlm] and download a 13 | copy of the [OpenGL XML registry][ogl-reg] to the path 14 | `support/gl.xml` which is ignored by git. This can be done with: 15 | 16 | b0 -- download-glxml 17 | 18 | After this the libraries can be generated with: 19 | 20 | b0 -- generate-libraries 21 | 22 | See also [support/README.md](support/README.md) in the source 23 | repository. 24 | 25 | [xmlm]: http://erratique.ch/software/xmlm 26 | [ogl-reg]: http://www.opengl.org/registry/ 27 | -------------------------------------------------------------------------------- /support/README.md: -------------------------------------------------------------------------------- 1 | 2 | Most bindings in Tgls are automatically generated. The primary source 3 | of data is the XML representation of the [OpenGL registry][1] whose 4 | most (but not all) important bits are decoded by the 5 | [`Glreg`](glreg.mli) module. A few missing things are added with the 6 | [`Fixreg`](fixreg.mli) module. 7 | 8 | From this raw registry information we derive for each feature tag (API 9 | description really) a cleaned up C API model on which we operate 10 | through with the [`Capi`](capi.mli) module. 11 | 12 | Given a C API, we derive an OCaml API with the module 13 | [`Oapi`](oapi.mli), most bindings are automatically derived. The few 14 | ones that are manually made are in the [`Manual`](manual.mli) 15 | module. `mli` and `ml` generation for an OCaml API is handled by the 16 | [`Gen`](gen.mli) module. 17 | 18 | The [`apiquery`](apiquery.ml) command line tool allows to query APIs 19 | and generate the bindings. Invoke with `-h` for more information. 20 | 21 | [1]: http://www.opengl.org/registry/ 22 | -------------------------------------------------------------------------------- /support/fixreg.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2013 The tgls programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** Missing registry data. 7 | 8 | This module provides information that is missing in the OpenGL XML 9 | registry. *) 10 | 11 | (** {1:null NULL arguments or return values} *) 12 | 13 | val is_arg_nullable : string -> string -> bool 14 | (** [is_arg_nullable f arg] is [true] if the argument named [arg] of the C 15 | function [f] can be [NULL]. *) 16 | 17 | val is_ret_nullable : string -> bool 18 | (** [is_ret_nullable f] is [true] if the function named [f] may return 19 | [NULL]. *) 20 | 21 | (** {1:null Void pointer or index arguments} *) 22 | 23 | val is_arg_voidp_or_index : string -> string -> bool 24 | (** [is_voidp_or_index f arg] is [true] if the argument named [arg] of the 25 | C function [f] can be either a pointer or an integer index. *) 26 | -------------------------------------------------------------------------------- /opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "tgls" 3 | synopsis: "Thin bindings to OpenGL {3,4} and OpenGL ES {2,3} for OCaml" 4 | description: """\ 5 | Tgls is a set of independent OCaml libraries providing thin bindings 6 | to OpenGL libraries. It has support for core OpenGL 3.{2,3} and 7 | 4.{0,1,2,3,4} and OpenGL ES 2 and 3.{0,1,2}. 8 | 9 | Tgls depends on [ocaml-ctypes][ctypes] and the C OpenGL library of your 10 | platform. It is distributed under the ISC license. 11 | 12 | [ctypes]: https://github.com/ocamllabs/ocaml-ctypes 13 | 14 | Home page: """ 15 | maintainer: "Daniel Bünzli " 16 | authors: "The tgls programmers" 17 | license: "ISC" 18 | tags: ["bindings" "opengl" "opengl-es" "graphics" "org:erratique"] 19 | homepage: "https://erratique.ch/software/tgls" 20 | doc: "https://erratique.ch/software/tgls/doc/" 21 | bug-reports: "https://github.com/dbuenzli/tgls/issues" 22 | depends: [ 23 | "ocaml" {>= "4.08.0"} 24 | "ocamlfind" {build} 25 | "ocamlbuild" {build} 26 | "topkg" {build & >= "1.1.1"} 27 | "ctypes" {>= "0.21.1"} 28 | "ctypes-foreign" {>= "0.21.1"} 29 | "xmlm" {dev} 30 | ] 31 | build: ["ocaml" "pkg/pkg.ml" "build" "--dev-pkg" "%{dev}%"] 32 | dev-repo: "git+https://erratique.ch/repos/tgls.git" 33 | x-maintenance-intent: ["(latest)"] 34 | -------------------------------------------------------------------------------- /_tags: -------------------------------------------------------------------------------- 1 | true: thread, bin_annot, safe_string 2 | 3 | <_b0> : -traverse 4 | 5 | : include 6 | : package(xmlm) 7 | 8 | : include 9 | : include 10 | : package(ctypes), package(ctypes-foreign) 11 | : custom, thread, \ 12 | package(ctypes), package(ctypes-foreign) 13 | 14 | : use_gl3 15 | : use_gl3 16 | 17 | : use_gl4 18 | : use_gl4 19 | 20 | : use_gles2 21 | : use_gles2 22 | 23 | : use_gles3 24 | : use_gles3 25 | 26 | : include 27 | : package(tsdl) 28 | : use_gl3 29 | : use_gl4 30 | : use_gles2 31 | : use_gles3 32 | 33 | : package(ctypes-foreign) 34 | : use_gl3 35 | : use_gl4 36 | : use_gles2 37 | : use_gles3 38 | 39 | : package(ctypes-foreign), package(tsdl) 40 | : use_gl4 41 | -------------------------------------------------------------------------------- /pkg/META: -------------------------------------------------------------------------------- 1 | description = "Thin bindings to OpenGL {3,4} and OpenGL ES {2,3} for OCaml" 2 | version = "%%VERSION_NUM%%" 3 | requires = "" 4 | 5 | package "tgl3" ( 6 | directory = "tgl3" 7 | description = "The tgls.tgl3 library" 8 | version = "%%VERSION_NUM%%" 9 | requires = "ctypes ctypes-foreign" 10 | archive(byte) = "tgl3.cma" 11 | archive(native) = "tgl3.cmxa" 12 | plugin(byte) = "tgl3.cma" 13 | plugin(native) = "tgl3.cmxs" 14 | exists_if = "tgl3.cma tgl3.cmxa" 15 | ) 16 | 17 | package "tgl4" ( 18 | directory = "tgl4" 19 | description = "The tgls.tgl4 library" 20 | version = "%%VERSION_NUM%%" 21 | requires = "ctypes ctypes-foreign" 22 | archive(byte) = "tgl4.cma" 23 | archive(native) = "tgl4.cmxa" 24 | plugin(byte) = "tgl4.cma" 25 | plugin(native) = "tgl4.cmxs" 26 | exists_if = "tgl4.cma tgl4.cmxa" 27 | ) 28 | 29 | package "tgles2" ( 30 | directory = "tgles2" 31 | description = "The tgls.tgles2 library" 32 | version = "%%VERSION_NUM%%" 33 | requires = "ctypes ctypes-foreign" 34 | archive(byte) = "tgles2.cma" 35 | archive(native) = "tgles2.cmxa" 36 | plugin(byte) = "tgles2.cma" 37 | plugin(native) = "tgles2.cmxs" 38 | exists_if = "tgles2.cma tgles2.cmxa" 39 | ) 40 | 41 | package "tgles3" ( 42 | directory = "tgles3" 43 | description = "The tgls.tgles3 library" 44 | version = "%%VERSION_NUM%%" 45 | requires = "ctypes ctypes-foreign" 46 | archive(byte) = "tgles3.cma" 47 | archive(native) = "tgles3.cmxa" 48 | plugin(byte) = "tgles3.cma" 49 | plugin(native) = "tgles3.cmxs" 50 | exists_if = "tgles3.cma tgles3.cmxa" 51 | ) 52 | -------------------------------------------------------------------------------- /pkg/pkg.ml: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ocaml 2 | #use "topfind" 3 | #require "topkg" 4 | open Topkg 5 | 6 | let with_gl = 7 | Topkg.Conf.(key "with-gl" bool ~absent:true 8 | ~doc:"Include OpenGL (desktop) support") 9 | let with_gles = 10 | Topkg.Conf.(key "with-gles" bool ~absent:true 11 | ~doc:"Include OpenGL ES support") 12 | 13 | let () = 14 | Pkg.describe "tgls" @@ fun c -> 15 | let with_gl = Topkg.Conf.value c with_gl in 16 | let with_gles = Topkg.Conf.value c with_gles in 17 | Ok [ Pkg.mllib ~cond:with_gl ~dst_dir:"tgl3" "src/tgl3/tgl3.mllib"; 18 | Pkg.mllib ~cond:with_gl ~dst_dir:"tgl4" "src/tgl4/tgl4.mllib"; 19 | Pkg.mllib ~cond:with_gles ~dst_dir:"tgles2" "src/tgles2/tgles2.mllib"; 20 | Pkg.mllib ~cond:with_gles ~dst_dir:"tgles3" "src/tgles3/tgles3.mllib"; 21 | Pkg.clib ~cond:with_gl 22 | ~lib_dst_dir:"tgl3" "src/tgl3/libtgl3.clib"; 23 | Pkg.clib ~cond:with_gl 24 | ~lib_dst_dir:"tgl4" "src/tgl4/libtgl4.clib"; 25 | Pkg.clib ~cond:with_gles 26 | ~lib_dst_dir:"tgles2" "src/tgles2/libtgles2.clib"; 27 | Pkg.clib ~cond:with_gles 28 | ~lib_dst_dir:"tgles3" "src/tgles3/libtgles3.clib"; 29 | 30 | Pkg.test ~cond:with_gl ~run:false "test/trigl3"; 31 | Pkg.test ~cond:with_gl ~run:false "test/trigl4"; 32 | Pkg.test ~cond:with_gles ~run:false "test/trigles2"; 33 | Pkg.test ~cond:with_gles ~run:false "test/trigles3"; 34 | Pkg.test ~cond:with_gl ~run:false "test/linkgl3"; 35 | Pkg.test ~cond:with_gl ~run:false "test/linkgl4"; 36 | Pkg.test ~cond:with_gl ~run:false "test/dbglifetime4"; 37 | Pkg.test ~cond:with_gles ~run:false "test/linkgles2"; 38 | Pkg.test ~cond:with_gles ~run:false "test/linkgles3" ] 39 | -------------------------------------------------------------------------------- /test/linkgles2.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2013 The tgls programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (* Tests that the Tgles2 library link flags are correct. 7 | 8 | Compile with: 9 | ocamlfind ocamlc -linkpkg -package ctypes-foreign,tgls.tgles2 \ 10 | -o linkgles2.byte linkgles2.ml 11 | ocamlfind ocamlopt -linkpkg -package ctypes-foreign,tgls.tgles2 \ 12 | -o linkgles2.native linkgles2.ml 13 | 14 | We try to load a symbol that should only be in the corresponding 15 | version. We load directly with ctypes since Tgls functions fail on 16 | use and we cannot use since we don't have any context (and don't 17 | want to setup one as this may automatically link other things 18 | in). *) 19 | 20 | open Tgles2 21 | open Ctypes 22 | open Foreign 23 | 24 | let str = Printf.sprintf 25 | 26 | let lookup symb = 27 | try 28 | ignore (foreign_value symb (ptr void)); 29 | Printf.printf "[OK] Found %s for OpenGL ES 2.0\n" symb; 30 | exit 0 31 | with 32 | | Dl.DL_error _ -> 33 | Printf.eprintf "[FAIL] %s not found for OpenGL ES 2.0\n" symb; 34 | exit 1 35 | 36 | let yes = ref true 37 | let test () = 38 | let link () = if !yes then () else Gl.viewport 0 0 400 400; in 39 | link (); (* just make sure the library is linked *) 40 | lookup "glUseProgram" 41 | 42 | let main () = 43 | let exec = Filename.basename Sys.executable_name in 44 | let usage = str "Usage: %s [OPTION]\n Tests Tgles2 linking.\nOptions:" exec in 45 | let options = [] in 46 | let anon _ = raise (Arg.Bad "no arguments are supported") in 47 | Arg.parse (Arg.align options) anon usage; 48 | test () 49 | 50 | let () = main () 51 | -------------------------------------------------------------------------------- /test/linkgles3.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2013 The tgls programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (* Tests that the Tgles3 library link flags are correct. 7 | 8 | Compile with: 9 | ocamlfind ocamlc -linkpkg -package ctypes-foreign,tgls.tgles3 \ 10 | -o linkgles3.byte linkgles3.ml 11 | ocamlfind ocamlopt -linkpkg -package ctypes-foreign,tgls.tgles3 \ 12 | -o linkgles3.native linkgles3.ml 13 | 14 | We try to load a symbol that should only be in the corresponding 15 | version. We load directly with ctypes since Tgls functions fail on 16 | use and we cannot use since we don't have any context (and don't 17 | want to setup one as this may automatically link other things 18 | in). *) 19 | 20 | open Tgles3 21 | open Ctypes 22 | open Foreign 23 | 24 | let str = Printf.sprintf 25 | 26 | let lookup symb = 27 | try 28 | ignore (foreign_value symb (ptr void)); 29 | Printf.printf "[OK] Found %s for OpenGL ES 3.0\n" symb; 30 | exit 0 31 | with 32 | | Dl.DL_error _ -> 33 | Printf.eprintf "[FAIL] %s not found for OpenGL ES 3.0\n" symb; 34 | exit 1 35 | 36 | let yes = ref true 37 | let test () = 38 | let link () = if !yes then () else Gl.viewport 0 0 400 400; in 39 | link (); (* just make sure the library is linked *) 40 | lookup "glGetProgramBinary" 41 | 42 | let main () = 43 | let exec = Filename.basename Sys.executable_name in 44 | let usage = str "Usage: %s [OPTION]\n Tests Tgles3 linking.\nOptions:" exec in 45 | let options = [] in 46 | let anon _ = raise (Arg.Bad "no arguments are supported") in 47 | Arg.parse (Arg.align options) anon usage; 48 | test () 49 | 50 | let () = main () 51 | -------------------------------------------------------------------------------- /test/linkgl3.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2013 The tgls programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (* Tests that the Tgl3 library link flags are correct. 7 | 8 | Compile with: 9 | ocamlfind ocamlc -linkpkg -package ctypes-foreign,tgls.tgl3 \ 10 | -o linkgl3.byte linkgl3.ml 11 | ocamlfind ocamlopt -linkpkg -package ctypes-foreign,tgls.tgl3 \ 12 | -o linkgl3.native linkgl3.ml 13 | 14 | We try to load a symbol that should only be in the corresponding 15 | version. We load directly with ctypes since Tgls functions fail on 16 | use and we cannot use since we don't have any context (and don't 17 | want to setup one as this may automatically link other things 18 | in). *) 19 | 20 | open Tgl3 21 | open Ctypes 22 | open Foreign 23 | 24 | let str = Printf.sprintf 25 | 26 | let lookup min symb = 27 | try 28 | ignore (foreign_value symb (ptr void)); 29 | Printf.printf "[OK] Found %s for OpenGL 3.%d\n" symb min; 30 | exit 0 31 | with 32 | | Dl.DL_error _ -> 33 | Printf.eprintf "[FAIL] %s not found for OpenGL 3.%d\n" symb min; 34 | exit 1 35 | 36 | let yes = ref true 37 | let test minor = 38 | let link () = if !yes then () else Gl.viewport 0 0 400 400; in 39 | link (); (* just make sure the library is linked *) 40 | match minor with 41 | | 2 -> lookup minor "glProvokingVertex" 42 | | 3 -> lookup minor "glQueryCounter" 43 | | x -> Printf.eprintf "[FAIL] Unsupported OpenGL version: 3.%d\n" x; exit 1 44 | 45 | let main () = 46 | let exec = Filename.basename Sys.executable_name in 47 | let usage = str "Usage: %s [OPTION]\n Tests Tgl3 linking.\nOptions:" exec in 48 | let minor = ref 2 in 49 | let options = 50 | [ "-minor", Arg.Set_int minor, 51 | " use Use an OpenGL 3.x context (default to 3.2)"; ] 52 | in 53 | let anon _ = raise (Arg.Bad "no arguments are supported") in 54 | Arg.parse (Arg.align options) anon usage; 55 | test !minor 56 | 57 | let () = main () 58 | -------------------------------------------------------------------------------- /test/linkgl4.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2013 The tgls programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (* Tests that the Tgl4 library link flags are correct. 7 | 8 | Compile with: 9 | ocamlfind ocamlc -linkpkg -package ctypes-foreign,tgls.tgl4 \ 10 | -o linkgl4.byte linkgl4.ml 11 | ocamlfind ocamlopt -linkpkg -package ctypes-foreign,tgls.tgl4 \ 12 | -o linkgl4.native linkgl4.ml 13 | 14 | We try to load a symbol that should only be in the corresponding 15 | version. We load directly with ctypes since Tgls functions fail on 16 | use and we cannot use since we don't have any context (and don't 17 | want to setup one as this may automatically link other things 18 | in). *) 19 | 20 | open Tgl4 21 | open Ctypes 22 | open Foreign 23 | 24 | let str = Printf.sprintf 25 | 26 | let lookup min symb = 27 | try 28 | ignore (foreign_value symb (ptr void)); 29 | Printf.printf "[OK] Found %s for OpenGL 4.%d\n" symb min; 30 | exit 0 31 | with 32 | | Dl.DL_error _ -> 33 | Printf.eprintf "[FAIL] %s not found for OpenGL 4.%d\n" symb min; 34 | exit 1 35 | 36 | let yes = ref true 37 | let test minor = 38 | let link () = if !yes then () else Gl.viewport 0 0 400 400; in 39 | link (); (* just make sure the library is linked *) 40 | match minor with 41 | | 0 -> lookup minor "glBindTransformFeedback" 42 | | 1 -> lookup minor "glProgramBinary" 43 | | 2 -> lookup minor "glDrawTransformFeedbackInstanced" 44 | | 3 -> lookup minor "glClearBufferData" 45 | | 4 -> lookup minor "glBindBuffersBase" 46 | | x -> Printf.eprintf "[FAIL] Unsupported OpenGL version: 4.%d\n" x; exit 1 47 | 48 | let main () = 49 | let exec = Filename.basename Sys.executable_name in 50 | let usage = str "Usage: %s [OPTION]\n Tests Tgl4 linking.\nOptions:" exec in 51 | let minor = ref 0 in 52 | let options = 53 | [ "-minor", Arg.Set_int minor, 54 | " use Use an OpenGL 4.x context (default to 4.0)"; ] 55 | in 56 | let anon _ = raise (Arg.Bad "no arguments are supported") in 57 | Arg.parse (Arg.align options) anon usage; 58 | test !minor 59 | 60 | let () = main () 61 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Tgls — Thin bindings to OpenGL {3,4} and OpenGL ES {2,3} for OCaml 2 | ================================================================== 3 | 4 | Tgls is a set of independent OCaml libraries providing thin bindings 5 | to OpenGL libraries. It has support for core OpenGL 3.{2,3} and 6 | 4.{0,1,2,3,4} and OpenGL ES 2 and 3.{0,1,2}. 7 | 8 | Tgls depends on [ocaml-ctypes][ctypes] and the C OpenGL library of your 9 | platform. It is distributed under the ISC license. 10 | 11 | [ctypes]: https://github.com/ocamllabs/ocaml-ctypes 12 | 13 | Home page: 14 | 15 | ## Installation 16 | 17 | Tgls can be installed with `opam`: 18 | 19 | opam install tgls 20 | 21 | If you don't use `opam` consult the [`opam`](opam) file for 22 | build instructions and a complete specification of the dependencies. 23 | 24 | ## Supported OpenGL versions 25 | 26 | Tgls provides four libraries: 27 | 28 | * `tgls.tgl3`, supports all functions and enumerants to program with a 29 | core OpenGL 3.2 or OpenGL 3.3 context. 30 | 31 | * `tgls.tgl4`, supports all functions and enumerants to program with a 32 | core OpenGL 4.0 to 4.5 context. 33 | 34 | * `tgls.tgles2`, supports all functions and enumerants to program with an 35 | OpenGL ES 2.0 context. 36 | 37 | * `tgls.tgles3`, supports all functions and enumerants to program with an 38 | OpenGL ES 3.0 to 3.2 context. 39 | 40 | Compatibility contexts are not supported. For extensions, most of them 41 | only add few entry points and/or enumerants, as such it seems the 42 | easiest way to access them is to manually use [ocaml-ctypes][ctypes] and 43 | the appropriate constants (the tools in [support](support/) could be 44 | enhanced to support them but it's not planned to do so). 45 | 46 | ## Documentation 47 | 48 | The documentation can be consulted [online] or via `odig doc tgls`. 49 | 50 | Questions are welcome but better asked on the [OCaml forum] than on the 51 | issue tracker. 52 | 53 | [online]: https://erratique.ch/software/tgls/doc 54 | [OCaml forum]: https://discuss.ocaml.org/ 55 | 56 | ## Sample programs 57 | 58 | A few sample programs can be found in [`test`](test), you need 59 | [`tsdl`] to compile them. 60 | 61 | The C file [`assert_sizes.c`](test/assert_sizes.c) is a program that 62 | should exit with 0 on your platform to ensure the bindings will 63 | work correctly. 64 | 65 | [`tsdl`]: http://erratique.ch/software/tsdl 66 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | v0.9.1 2025-07-23 Zagreb 2 | ------------------------ 3 | 4 | - Each library has now its own `tgl_stub.c` nop stub needed to 5 | correctly generate the `.so` files. In turn this makes `tgls` 6 | compatible with `topkg` >= 1.1.0. 7 | 8 | v0.9.0 2025-06-05 Zagreb 9 | ------------------------ 10 | 11 | * Install each library in its own directory. 12 | * Remove `tgls.*.top` libraries. They were just opening the 13 | API toplevel module. Not worth the maintenance trouble. 14 | * Fix Tgls on Windows + MingW64 15 | * Try to load [opengl32.dll] at startup on Windows. 16 | * Bring 64-bit Windows support by fixing selection of FFI ABI. 17 | * Unlock the full OpenGL API on Windows by implementing indirect 18 | procedure lookup with [wglGetProcAddress]. 19 | Thanks to Benjamin Canou for the patches (#33). 20 | * Fix build system. Explicitely depend on `ctypes-foreign`. 21 | Thanks to Etienne Millon for the patch (#29). 22 | * Fix `Gl.debug_message_callback` raising `Ffi_stubs.CallToExpiredClosure`. 23 | Thanks to Edwin Török for the report and the patch (#6). 24 | 25 | v0.8.6 2022-02-10 La Forclaz (VS) 26 | --------------------------------- 27 | 28 | * Handle `Pervasives` deprecation (and thus support OCaml 5.00). 29 | 30 | v0.8.5 2016-11-25 Zagreb 31 | ------------------------ 32 | 33 | * Allow to optionally build GL and GL ES. Thanks to Peter Zotov for 34 | the patch. 35 | 36 | 37 | v0.8.4 2016-06-03 Cambridge (UK) 38 | ------------------------------- 39 | 40 | * Support for OpenGL ES 3.2 41 | * Safe string support. 42 | * Fix build on 32-bit platforms. 43 | * Build system: allow to override host platform. 44 | * Build system: rpi3 support. 45 | * Untested Windows support. 46 | * FreeBSD support. Thanks to Alexander Diemand for the help. 47 | * Build depend on topkg. 48 | * Relicensed from BSD3 to ISC. 49 | 50 | 51 | v0.8.3 2015-03-15 La Forclaz (VS) 52 | --------------------------------- 53 | 54 | Support for ctypes 0.4.0. Thanks to Peter Zotov for the patch. ctypes 55 | switches from int64 to nativeint for representing pointers. This 56 | impacts a few function signatures that change accordingly. 57 | 58 | 59 | v0.8.2 2014-08-14 Cambridge (UK) 60 | -------------------------------- 61 | 62 | Support for OpenGL 4.5 and OpenGL ES 3.1. 63 | 64 | 65 | v0.8.1 2014-05-22 La Forclaz (VS) 66 | --------------------------------- 67 | 68 | Support for ctypes 0.3. Thanks to Jeremy Yallop for the patch. 69 | 70 | 71 | v0.8.0 2014-05-18 La Forclaz (VS) 72 | --------------------------------- 73 | 74 | First release. 75 | -------------------------------------------------------------------------------- /test/dbglifetime4.ml: -------------------------------------------------------------------------------- 1 | open Tsdl 2 | open Tgl4 3 | let check = function 4 | | Ok r -> r 5 | | Error (`Msg e) -> failwith e 6 | let set attr v = check (Sdl.gl_set_attribute attr v) 7 | 8 | let string_of_source e = 9 | if e = Gl.debug_source_api then "API" 10 | else if e = Gl.debug_source_window_system then "Window System" 11 | else if e = Gl.debug_source_shader_compiler then "Shader Compiler" 12 | else if e = Gl.debug_source_third_party then "Third Party" 13 | else if e = Gl.debug_source_application then "Application" 14 | else if e = Gl.debug_source_other then "Other" 15 | else "??" 16 | 17 | let string_of_type e = 18 | if e = Gl.debug_type_error then "Error" 19 | else if e = Gl.debug_type_deprecated_behavior then "Deprecated Functionality" 20 | else if e = Gl.debug_type_portability then "Portability" 21 | else if e = Gl.debug_type_performance then "Performance" 22 | else if e = Gl.debug_type_other then "Other" 23 | else "??" 24 | 25 | let string_of_severity e = 26 | if e = Gl.debug_severity_high then Sdl.log_error Sdl.Log.category_application 27 | else if e = Gl.debug_severity_medium then Sdl.log_warn Sdl.Log.category_application 28 | else if e = Gl.debug_severity_low then Sdl.log_verbose Sdl.Log.category_application 29 | else Sdl.log 30 | 31 | let debug_func src typ _id severity msg = 32 | let log = string_of_severity severity in 33 | log "%s from %s: %s" (string_of_type typ) (string_of_source src) msg 34 | 35 | let debug_func2 _ _ _ severity msg = 36 | let log = string_of_severity severity in 37 | log "%s" msg 38 | 39 | let () = 40 | check (Sdl.init Sdl.Init.video); 41 | set Sdl.Gl.context_major_version 4; 42 | set Sdl.Gl.context_minor_version 0; 43 | set Sdl.Gl.context_profile_mask Sdl.Gl.context_profile_core; 44 | set Sdl.Gl.context_flags Sdl.Gl.context_debug_flag; 45 | Sdl.log_set_all_priority Sdl.Log.priority_verbose; 46 | let attrs = Sdl.Window.(opengl + resizable) in 47 | let win = check(Sdl.create_window ~w:100 ~h:100 "test" attrs) in 48 | let ctx = check (Sdl.gl_create_context win) in 49 | Gl.enable Gl.debug_output_synchronous; 50 | Gl.debug_message_callback debug_func; 51 | Gl.debug_message_control Gl.dont_care Gl.dont_care Gl.dont_care 0 None 52 | true; 53 | Gc.full_major (); 54 | let msg = "test" in 55 | Gl.debug_message_insert 56 | Gl.debug_source_application Gl.debug_type_other 42 Gl.debug_severity_low 57 | (String.length msg) msg; 58 | Gl.debug_message_callback debug_func2; 59 | let msg = "test" in 60 | Gl.debug_message_insert 61 | Gl.debug_source_application Gl.debug_type_other 42 Gl.debug_severity_low 62 | (String.length msg) msg; 63 | Gc.full_major (); 64 | Sdl.gl_delete_context ctx; 65 | Sdl.destroy_window win; 66 | Sdl.quit (); 67 | -------------------------------------------------------------------------------- /support/fixreg.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2013 The tgls programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (* The registry doesn't provide us that info. *) 7 | 8 | let is_arg_nullable f a = match f with 9 | | "glObjectLabel" -> a = "label" 10 | | "glObjectPtrLabel" -> a = "label" 11 | | "glBindImageTextures" -> a = "textures" 12 | | "glBindBuffersBase" -> a = "buffers" 13 | | "glBindBuffersRange" -> 14 | (match a with "buffers" | "offsets" | "sizes" -> true | _ -> false) 15 | | "glBindSamplers" -> a = "samplers" 16 | | "glBindTextures" -> a = "textures" 17 | | "glBindVertexBuffers" | "glVertexArrayVertexBuffers" -> 18 | (match a with "buffers" | "offsets" | "strides" -> true | _ -> false) 19 | | "glBufferData" 20 | | "glBufferSubData" 21 | | "glBufferStorage" 22 | | "glClearBufferData" 23 | | "glClearBufferSubData" 24 | | "glClearTexImage" 25 | | "glClearTexSubImage" -> a = "data" 26 | | "glDebugMessageControl" -> a = "ids" 27 | | "glGetDebugMessageLog" -> 28 | begin match a with 29 | | "sources" | "types" | "ids" | "severities" | "lengths" 30 | | "messageLog" -> true 31 | | _ -> false 32 | end 33 | | "glGetAttachedShaders" -> a = "count" 34 | | "glGetProgramBinary" | "glGetActiveAttrib" | "glGetActiveSubroutineName" 35 | | "glGetActiveSubroutineUniformName" | "glGetActiveUniform" 36 | | "glGetActiveUniformBlockName" | "glGetActiveUniformName" 37 | | "glGetObjectLabel" | "glGetObjectPtrLabel" | "glGetProgramInfoLog" 38 | | "glGetProgramPipelineInfoLog" | "glGetProgramResourceName" 39 | | "glGetShaderInfoLog" | "glGetShaderSource" | "glGetSynciv" 40 | | "glGetTransformFeedbackVarying" -> 41 | a = "length" 42 | | _ -> false 43 | 44 | let is_ret_nullable = function 45 | | "glGetString" | "glGetStringi" -> true 46 | | _ -> false 47 | 48 | let is_arg_voidp_or_index f a = match f with 49 | | "glTexImage1D" | "glTexImage2D" | "glTexImage3D" 50 | | "glTexSubImage1D" | "glTexSubImage2D" | "glTexSubImage3D" -> 51 | a = "pixels" 52 | | "glCompressedTexImage1D" | "glCompressedTexImage2D" 53 | | "glCompressedTexImage3D" 54 | | "glCompressedTexSubImage1D" | "glCompressedTexSubImage2D" 55 | | "glCompressedTexSubImage3D" -> 56 | a = "data" 57 | | "glDrawElements" | "glDrawElementsBaseVertex" 58 | | "glDrawElementsInstanced" | "glDrawElementsInstancedBaseInstance" 59 | | "glDrawElementsInstancedBaseVertex" 60 | | "glDrawElementsInstancedBaseVertexBaseInstance" 61 | | "glDrawRangeElements" | "glDrawRangeElementsBaseVertex" -> 62 | a = "indices" 63 | | "glDrawArraysIndirect" | "glDrawElementsIndirect" 64 | | "glMultiDrawArraysIndirect" | "glMultiDrawElementsIndirect" -> 65 | a = "indirect" 66 | | "glVertexAttribPointer" | "glVertexAttribIPointer" 67 | | "glVertexAttribLPointer" -> 68 | a = "pointer" 69 | | "glGetCompressedTexImage" | "glGetTexImage" -> a = "img" 70 | | "glReadPixels" -> a = "pixels" 71 | | _ -> false 72 | -------------------------------------------------------------------------------- /support/genpp.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2013 The tgls programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | let pp = Format.fprintf 7 | let pp_str = Format.pp_print_string 8 | let pp_opt pp_v ppf v = match v with 9 | | None -> () | Some v -> pp ppf "%a" pp_v v 10 | 11 | (* mli API Doc *) 12 | 13 | let pp_mli_api_header ppf api = 14 | let syn = Oapi.doc_synopsis api in 15 | let lsyn = Oapi.doc_synopsis_long api in 16 | let profile = Capi.profile api in 17 | let lib_module = Oapi.module_lib api in 18 | let bind_module = Oapi.module_bind api in 19 | pp ppf 20 | "\ 21 | (** %s thin bindings. 22 | 23 | [%s] can program %a %s contexts. 24 | Consult the {{!conventions}binding conventions}. 25 | 26 | Open the module use it, this defines only the module [%s] 27 | in your scope. 28 | 29 | {b References} 30 | {ul 31 | {- {{:%s}%s}}} *) 32 | @\n" 33 | syn lib_module (pp_opt pp_str) profile lsyn bind_module (Doc.home_uri api) syn 34 | 35 | let pp_mli_api_footer ppf api = 36 | let lib_module = Oapi.module_lib api in 37 | let bind_module = Oapi.module_bind api in 38 | pp ppf 39 | "\ 40 | (** {1:conventions Conventions} 41 | 42 | To find the name of an OCaml function corresponding to a C 43 | function name, map the [gl] prefix to the module name 44 | {!%s.%s}, 45 | add an underscore between each minuscule and majuscule and lower 46 | case the result. For example [glGetError] maps to 47 | {!%s.%s.get_error} 48 | 49 | To find the name of an OCaml value corresponding to a C enumerant name, 50 | map the [GL_] prefix to the module name {!%s.%s} 51 | and lower case the rest. For example [GL_COLOR_BUFFER_BIT] maps to 52 | {!%s.%s.color_buffer_bit}. 53 | 54 | The following exceptions occur: 55 | {ul 56 | {- A few enumerant names do clash with functions name. In that case we 57 | postfix the enumerant name with [_enum]. For example we have 58 | {!%s.%s.viewport} and {!%s.%s.viewport_enum}.} 59 | {- If applying the above procedures results in an identifier that 60 | doesn't start with a letter, prefix the identifier with a ['_'].} 61 | {- If applying the above procedures results in an identifier that 62 | is an OCaml keyword, suffix the identifier with a ['_'].}} *)" 63 | lib_module bind_module lib_module bind_module lib_module bind_module 64 | lib_module bind_module lib_module bind_module lib_module bind_module 65 | 66 | (* License *) 67 | 68 | let pp_license_header ppf () = 69 | let exe = Filename.basename Sys.executable_name in 70 | let invocation = exe :: (List.tl (Array.to_list Sys.argv)) in 71 | let invocation = String.concat " " invocation in 72 | pp ppf 73 | "\ 74 | (*--------------------------------------------------------------------------- 75 | Copyright (c) 2013 The tgls programmers. All rights reserved. 76 | SPDX-License-Identifier: ISC 77 | ---------------------------------------------------------------------------*) 78 | 79 | (* WARNING do not edit. This file was automatically generated with: 80 | %s *) 81 | @\n" invocation 82 | -------------------------------------------------------------------------------- /support/capi.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2013 The tgls programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** C APIs. 7 | 8 | A {!t} value represents an C OpenGL API profile or a C OpenGL extension 9 | (roughly a [feature] or [extension] tag in the OpenGL registry). *) 10 | 11 | (** {1:apiid C API identifiers} *) 12 | 13 | type version = int * int 14 | (** The type for version numbers. *) 15 | 16 | type id = [ `Gl of version | `Gles of version | `Ext of string ] 17 | (** The type for API identifiers. *) 18 | 19 | val id_of_string : string -> id 20 | (** [id_of_string s] is an API identifier extracted from [s]. *) 21 | 22 | (** {1:apis C APIs} *) 23 | 24 | type t 25 | (** The type for a C API. *) 26 | 27 | val create : Glreg.t -> id -> string -> [ `Ok of t | `Error of string ] 28 | (** [create registry id profile] is the C API [id] with profile 29 | [profile] as defined in [registry] ([profile] is ignored if 30 | unapplicable). *) 31 | 32 | val id : t -> id 33 | (** [id api] is the identifier of [api]. *) 34 | 35 | val profile : t -> string option 36 | (** [id api] is the profile of [api]. *) 37 | 38 | (** {1:types C types} *) 39 | 40 | type base_type = 41 | [ `GLbitfield | `GLboolean | `GLbyte | `GLchar | `GLclampx | `GLdouble 42 | | `GLenum | `GLfixed | `GLfloat | `GLint | `GLint64 | `GLintptr | `GLshort 43 | | `GLsizei | `GLsizeiptr | `GLsync | `GLubyte | `GLuint | `GLuint64 44 | | `GLushort | `GLDEBUGPROC | `Void | `Void_or_index ] 45 | (** The type for C base types as found in OpenGL APIs. *) 46 | 47 | val base_type_to_string : base_type -> string 48 | (** [base_type_to_string t] is a string representation for [t]. *) 49 | 50 | val base_type_def : t -> base_type -> [ `Def of string | `Builtin ] 51 | (** [base_type_def api t] is the type definition for [t]. Either 52 | [`Def] if [t] is typedef'd or [`Builtin] if [t] is a C base type. *) 53 | 54 | type typ = 55 | [ `Base of base_type 56 | | `Ptr of typ 57 | | `Const of typ 58 | | `Nullable of typ ] 59 | (** The type for C types as found in OpenGL APIs. *) 60 | 61 | val type_to_string : typ -> string 62 | (** [type_to_string t] is a string representation for [t]. *) 63 | 64 | val types : t -> typ list 65 | (** [types api] is the set of C types mentioned in the signatures of 66 | [api]. *) 67 | 68 | (** {1:funs C functions} *) 69 | 70 | type arg_len = [ `Arg of string | `Size of int | `Csize of string 71 | | `Other of string ] 72 | (** The type for argument length specifications as found in the registry. *) 73 | 74 | type arg = 75 | { arg_name : string; (** variable name example *) 76 | arg_type : typ; 77 | arg_group : string option; (** loosely defined enum group. *) 78 | arg_len : arg_len option (** loosely defined length of the argument *) } 79 | (** The type for C function arguments. *) 80 | 81 | type func = string * (arg list * typ) 82 | (** The type for C functions, a name and an argument list tupled with 83 | a return type. *) 84 | 85 | val funs : t -> func list 86 | (** [funs api] are the C functions of [api]. *) 87 | 88 | (** {1:enums C enumerations} *) 89 | 90 | type enum_value = 91 | [ `GLenum of int | `GLenum_max | `GLuint64 of int64 | `GLuint of int32] 92 | (** The type for C enumeration values. *) 93 | 94 | type enum = string * enum_value 95 | (** The type for C enumerations, a name and and a value. *) 96 | 97 | val enums : t -> enum list 98 | (** [enums api] are the C enums of [api]. *) 99 | -------------------------------------------------------------------------------- /support/oapi.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2013 The tgls programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** OCaml APIs. 7 | 8 | An {!t} value represents an OCaml OpenGL API for a C API. *) 9 | 10 | (** {1:api APIs} *) 11 | 12 | type t = Capi.t 13 | 14 | val doc_synopsis : t -> string 15 | (** [doc_synopsis t] is a name to represent the major version of [api] 16 | and all its preceding versions. *) 17 | 18 | val doc_synopsis_long : t -> string 19 | (** [doc_synopis_long t] is like {!doc_synopsis} but longer. *) 20 | 21 | val identifier : string -> string 22 | (** [identifier s] is either [s] or [s] transformed so that it is 23 | an OCaml identifier. *) 24 | 25 | (** {1:modules Modules} *) 26 | 27 | val module_lib : t -> string 28 | (** [module_lib api] is the toplevel OCaml module name for [api]. *) 29 | 30 | val module_bind : t -> string 31 | (** [module_bind api] is the OCaml module name containing the 32 | binding for [api]. *) 33 | 34 | (** {1:types Types} *) 35 | 36 | type ctypes = 37 | [ `Builtin of string 38 | | `View of string * string * string * string 39 | | `Builtin_wrap_in of string * (Format.formatter -> string -> unit) 40 | | `Def of string * string ] 41 | (** The type for a ctypes definition for a type. 42 | {ul 43 | {- [`Builtin ctype] is the builtin ctypes C type [ctype].} 44 | {- [`View (id, read, write, ctype)] is a ctypes view named 45 | [id] for [ctype]; reads with [read], writes with [write].} 46 | {- [`Builtin_wrap_in (ctype, pp_wrap)] is the builtin type [ctype], 47 | [pp_wrap] is a function that given a value name transforms 48 | the value to a value of the type represented by [ctype].} 49 | {- [`Def (id,def)] is a ctype [id] whose definition is [def].}} *) 50 | 51 | type typ = 52 | { type_name : string; 53 | type_def : [ `Alias of string | `Abstract of string | `Builtin ]; 54 | type_ctypes : ctypes; 55 | type_doc : string option; } 56 | (** The type for OCaml types and their definitions. *) 57 | 58 | val type_def : t -> Capi.typ -> [ `Ok of typ | `Unknown of string ] 59 | (** [type_def api t] is the OCaml type definition for the C type [t] 60 | in [api] *) 61 | 62 | val types : t -> typ list 63 | (** [types api] are the OCaml types mentioned in [api]. *) 64 | 65 | (** {1:funs Functions} *) 66 | 67 | type arg = 68 | { arg_name : string; 69 | arg_type : typ } 70 | (** The type for OCaml arguments. A sample argument name and its 71 | type. *) 72 | 73 | type fun_def = 74 | [ `Derived of arg list * typ 75 | | `Manual of string * string 76 | | `Unknown 77 | | `Unbound of string ] 78 | (** The type for OCaml function definitions. 79 | {ul 80 | {- [`Derived]. The binding is automatically derived from the C prototope 81 | of the function. For a few function names the derivation is tweaked 82 | manually} 83 | {- [`Manual (mli, ml)]. The binding is made manually, [mli] is 84 | the function's signature and [ml] its implementation.} 85 | {- [`Unknown]. The function is unknown.} 86 | {- [`Unbound reason]. The function is unbound for [reason].}} *) 87 | 88 | type func = 89 | { fun_name : string; (** Function name *) 90 | fun_c : Capi.func; (** C definition *) 91 | fun_def : fun_def; (** Binding definition *) 92 | fun_doc : string option; (** Additional documentation. *) } 93 | (** The type for an OCaml function specification. *) 94 | 95 | val funs : t -> func list 96 | (** [funs api] are the OCaml functions of [api]. *) 97 | 98 | (** {1:enums Enums} *) 99 | 100 | type enum = 101 | { enum_name : string; 102 | enum_c_name : string; 103 | enum_value : Capi.enum_value } 104 | (** The type for OCaml's representation of C enums. *) 105 | 106 | val enums : t -> enum list 107 | (** [enums api] is the enums of [api]. *) 108 | -------------------------------------------------------------------------------- /myocamlbuild.ml: -------------------------------------------------------------------------------- 1 | open Ocamlbuild_plugin 2 | open Command 3 | 4 | (* Platform detection *) 5 | 6 | let os = 7 | String.trim @@ 8 | try Sys.getenv "TGLS_HOST_OS" 9 | with Not_found -> run_and_read "uname -s" 10 | 11 | let darwin = os = "Darwin" 12 | let linux = os = "Linux" 13 | let freebsd = os = "FreeBSD" 14 | 15 | let rpi = 16 | linux && 17 | try ignore (run_and_read "cat /proc/cpuinfo | grep -q 'BCM270.'"); true 18 | with Failure _ -> false 19 | 20 | (* pkg-config invocation. N.B. we don't fail if we don't have the package. *) 21 | 22 | let pkg_config flags package = 23 | let has_package = 24 | try ignore (run_and_read ("pkg-config --exists " ^ package)); true 25 | with Failure _ -> false 26 | in 27 | let cmd tmp = 28 | Command.execute ~quiet:true & 29 | Cmd( S [ A "pkg-config"; A ("--" ^ flags); A package; Sh ">"; A tmp]); 30 | List.map (fun arg -> A arg) (string_list_of_file tmp) 31 | in 32 | if has_package then with_temp_file "pkgconfig" "pkg-config" cmd else [] 33 | 34 | let use_pkg_config = linux || freebsd 35 | 36 | (* Tags for OpenGL X.Y *) 37 | 38 | let gl_tag ~tag ~lib ~cpkg = 39 | let make_opt o arg = S [ A o; arg ] in 40 | let stub_l = [A (Printf.sprintf "-l%s" lib)] in 41 | let cflags = if use_pkg_config then pkg_config "cflags" cpkg else [] in 42 | let libs_l = if use_pkg_config then pkg_config "libs-only-l" cpkg else [] in 43 | let libs_L = if use_pkg_config then pkg_config "libs-only-L" cpkg else [] in 44 | let linker = if linux then [A "-Wl,-no-as-needed"] else [] in 45 | let mklib_framework = if darwin then [A "-framework"; A "OpenGL" ] else [] in 46 | let lib_framework = if darwin then [A "-framework OpenGL" ] else [] in 47 | let mklib_flags = 48 | (List.map (make_opt "-ldopt") linker) @ libs_l @ libs_L @ mklib_framework 49 | in 50 | let compile_flags = List.map (make_opt "-ccopt") cflags in 51 | let lib_flags = List.map (make_opt "-cclib") (libs_l @ lib_framework) in 52 | let link_flags = List.map (make_opt "-ccopt") (linker @ libs_L) in 53 | let stublib_flags = List.map (make_opt "-dllib") stub_l in 54 | flag ["c"; "ocamlmklib"; tag] (S mklib_flags); 55 | flag ["c"; "compile"; tag] (S compile_flags); 56 | flag ["link"; "ocaml"; tag] (S (link_flags @ lib_flags)); 57 | flag ["link"; "ocaml"; "library"; "byte"; tag] (S stublib_flags) 58 | 59 | (* Tags for OpenGL ES X.Y *) 60 | 61 | let gles_tag ~tag ~lib ~cpkg = 62 | let make_opt o arg = S [ A o; arg ] in 63 | let stub_l = [A (Printf.sprintf "-l%s" lib)] in 64 | let cflags = 65 | if rpi then [] else 66 | if use_pkg_config then pkg_config "cflags" cpkg else [] 67 | in 68 | let libs_l = 69 | if rpi then [A "-lGLESv2"] else 70 | if use_pkg_config then pkg_config "libs-only-l" cpkg else [] 71 | in 72 | let libs_L = 73 | if rpi then [A "-L/opt/vc/lib"] else 74 | if use_pkg_config then pkg_config "libs-only-L" cpkg else [] 75 | in 76 | let linker = 77 | if rpi || linux then [A "-Wl,-no-as-needed"] else [] 78 | in 79 | let mklib_framework = if darwin then [] else [] in 80 | let lib_framework = if darwin then [] else [] in 81 | let mklib_flags = 82 | (List.map (make_opt "-ldopt") linker) @ libs_l @ libs_L @ mklib_framework 83 | in 84 | let compile_flags = List.map (make_opt "-ccopt") cflags in 85 | let lib_flags = List.map (make_opt "-cclib") (libs_l @ lib_framework) in 86 | let link_flags = List.map (make_opt "-ccopt") (linker @ libs_L) in 87 | let stublib_flags = List.map (make_opt "-dllib") stub_l in 88 | flag ["c"; "ocamlmklib"; tag] (S mklib_flags); 89 | flag ["c"; "compile"; tag] (S compile_flags); 90 | flag ["link"; "ocaml"; tag] (S (link_flags @ lib_flags)); 91 | flag ["link"; "ocaml"; "library"; "byte"; tag] (S stublib_flags) 92 | 93 | let () = 94 | dispatch begin function 95 | | After_rules -> 96 | gl_tag ~tag:"use_gl3" ~lib:"tgl3" ~cpkg:"gl"; 97 | gl_tag ~tag:"use_gl4" ~lib:"tgl3" ~cpkg:"gl"; 98 | gles_tag ~tag:"use_gles2" ~lib:"tgles2" ~cpkg:"glesv2"; 99 | gles_tag ~tag:"use_gles3" ~lib:"tgles3" ~cpkg:"glesv3"; 100 | | _ -> () 101 | end 102 | -------------------------------------------------------------------------------- /support/glreg.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2013 The tgls programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** OpenGL registry decoder. 7 | 8 | [Glreg] decodes the data of the 9 | {{:http://www.opengl.org/registry}OpenGL registry} from its 10 | XML representation. 11 | 12 | Release %%VERSION%% – %%MAINTAINER%% *) 13 | 14 | (** {1 Registry representation} *) 15 | 16 | type typ = 17 | { t_name : string; 18 | t_api : string option; 19 | t_requires : string option; 20 | t_def : string; } 21 | (** The type representing the type tag. The [def] string is obtained 22 | from the contents of the tag by concatenating all {e data} sections 23 | and removing any ["typedef"] and [";"] suffix. *) 24 | 25 | type group = 26 | { g_name : string; 27 | g_enums : string list; } 28 | (** The type representing the [group] tag. *) 29 | 30 | type enum = 31 | { e_name : string; 32 | e_p_namespace : string; 33 | e_p_type : string option; 34 | e_p_group : string option; 35 | e_p_vendor : string option; 36 | e_value : string; 37 | e_api : string option; 38 | e_type : string option; 39 | e_alias : string option; } 40 | (** The type representing an enum tag. The [e_p]* fields come from 41 | the parent's [enums] tag. *) 42 | 43 | type param_type = 44 | { p_group : string option; 45 | p_type : string; 46 | p_len : string option; 47 | p_nullable : bool; (** This doesn't exist in the registry. 48 | See {!Fixreg}. *)} 49 | (** The type for representing return types and parameter type of commands. *) 50 | 51 | type command = 52 | { c_name : string; 53 | c_p_namespace : string; 54 | c_ret : param_type; (** group * return type *) 55 | c_params : (string * param_type) list; 56 | c_alias : string option; 57 | c_vec_equiv : string option; } 58 | (** The type representing a command tag. The [c_p]* fields come 59 | from the parent [commands]'s tag. *) 60 | 61 | type i_element = 62 | { i_name : string; 63 | i_type : [ `Enum | `Command | `Type ]; 64 | i_api : string option; 65 | i_profile : string option; } 66 | (** The type for interface elements as described in require and remove 67 | tags. [i_api] comes from the nearest ancestor ([feature], [require] or 68 | [remove] tag). *) 69 | 70 | type feature = 71 | { f_api : string; 72 | f_number : int * int; 73 | f_require : i_element list; 74 | f_remove : i_element list; } 75 | (** The type for representing a [feature] tag. *) 76 | 77 | type extension = 78 | { x_name : string; 79 | x_supported : string option; 80 | x_require : i_element list; 81 | x_remove : i_element list; } 82 | (** The type for repesenting an [extension] tag. *) 83 | 84 | type t = 85 | { types : (string, typ list) Hashtbl.t; 86 | groups : (string, group) Hashtbl.t; 87 | enums : (string, enum list) Hashtbl.t; 88 | commands : (string, command list) Hashtbl.t; 89 | features : (string, feature list) Hashtbl.t; 90 | extensions : (string, extension) Hashtbl.t; } 91 | (** The type for an OpenGL registry. 92 | {ul 93 | {- [types] the contents of types tag represented as a map from 94 | type names to their definition(s).} 95 | {- [groups] the contents of groups tag represented as a map from 96 | group names to their definition.} 97 | {- [enums] the contents of enums tag represented as a map from 98 | {e enum} name to their definition(s).} 99 | {- [commands] the contents of commands tag represented as a map from 100 | {e command} name to their definition(s).} 101 | {- [feature] the contents of feature tags represented as a map from 102 | api name to their definition.} 103 | {- [extensions] the contents of extension tags represented as a map 104 | from extension name to their definition.}} *) 105 | 106 | (** {1:decoder Decoder} *) 107 | 108 | type src = [ `Channel of in_channel | `String of string ] 109 | (** The type for input sources. *) 110 | 111 | type decoder 112 | (** The type for the OpenGL XML registry decoder *) 113 | 114 | val decoder : [< src ] -> decoder 115 | (** [decoder src] is a decoder that inputs from [src]. *) 116 | 117 | val decode : decoder -> [ `Error of string | `Ok of t ] 118 | (** [decode d] decodes an OpenGL XML registry from [d] or returns an 119 | error. *) 120 | 121 | val decoded_range : decoder -> (int * int) * (int * int) 122 | (** [decoded_range d] is the range of characters spanning the [`Error] 123 | decoded by [d]. A pair of line and column numbers respectively 124 | one and zero based. *) 125 | -------------------------------------------------------------------------------- /support/dump.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2013 The tgls programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (* Raw dump of the data read by glreg.mli *) 7 | 8 | let str = Printf.sprintf 9 | let exec = Filename.basename Sys.executable_name 10 | 11 | let pp = Format.fprintf 12 | let rec pp_list ?(pp_sep = Format.pp_print_cut) pp_v ppf = function 13 | | [] -> () 14 | | v :: vs -> 15 | pp_v ppf v; if vs <> [] then (pp_sep ppf (); pp_list ~pp_sep pp_v ppf vs) 16 | 17 | let pp_kv k ppf = function 18 | | None -> () | Some v -> pp ppf "@ %s:'%s'" k v 19 | 20 | let pp_type ppf _ ts = 21 | let pp_type_def ppf t = 22 | Glreg.(pp ppf "@[<2>type '%s' = '%s'%a%a@]@," 23 | t.t_name t.t_def 24 | (pp_kv "api") t.t_api 25 | (pp_kv "requires") t.t_requires) 26 | in 27 | List.iter (pp_type_def ppf) (List.rev ts) 28 | 29 | let pp_group ppf _ g = 30 | let pp_sep ppf () = pp ppf "@ | " in 31 | let pp_enum ppf e = pp ppf "'%s'" e in 32 | Glreg.(pp ppf "@[<2>group '%s' =@ %a@]@," 33 | g.g_name (pp_list ~pp_sep pp_enum) g.g_enums) 34 | 35 | let pp_enum ppf _ es = 36 | let pp_enum_def ppf e = 37 | Glreg.(pp ppf "@[<2>enum '%s' = '%s'@ ns:%s%a%a%a%a%a@]@," 38 | e.e_name e.e_value e.e_p_namespace 39 | (pp_kv "ptype") e.e_p_type 40 | (pp_kv "vendor") e.e_p_vendor 41 | (pp_kv "api") e.e_api 42 | (pp_kv "type") e.e_type 43 | (pp_kv "alias") e.e_alias) 44 | in 45 | List.iter (pp_enum_def ppf) (List.rev es) 46 | 47 | let pp_param_type ppf p = 48 | let pp_group ppf = function None -> () | Some g -> pp ppf "[%s] " g in 49 | let pp_len ppf = function None -> () | Some l -> pp ppf " (len: '%s')" l in 50 | Glreg.(pp ppf "%a'%s'%a" pp_group p.p_group p.p_type pp_len p.p_len) 51 | 52 | let pp_command ppf _ cs = 53 | let pp_param ppf (p, t) = pp ppf "param %s : %a" p pp_param_type t in 54 | let pp_cmd_def ppf c = 55 | Glreg.(pp ppf "@[<2>cmd '%s' ns:%s%a%a@\n@[ret: %a@,%a@]@]@," 56 | c.c_name c.c_p_namespace 57 | (pp_kv "alias") c.c_alias 58 | (pp_kv "vec") c.c_vec_equiv 59 | pp_param_type c.c_ret 60 | (pp_list pp_param) c.c_params) 61 | in 62 | List.iter (pp_cmd_def ppf) (List.rev cs) 63 | 64 | let pp_i_element pre ppf i = 65 | let tstr = function `Command -> "cmd" | `Type -> "type" | `Enum -> "enum" in 66 | Glreg.(pp ppf "@[%s %s '%s'%a%a@]" 67 | pre (tstr i.i_type) i.i_name 68 | (pp_kv "api") i.i_api 69 | (pp_kv "profile") i.i_profile) 70 | 71 | let pp_feature ppf _ fs = 72 | let pp_feat_def ppf f = 73 | Glreg.(pp ppf 74 | "@[<2>feature api:'%s' number:%d.%d@\n@[%a%a@]@]@," 75 | f.f_api (fst f.f_number) (snd f.f_number) 76 | (pp_list (pp_i_element "req")) (List.rev f.f_require) 77 | (pp_list (pp_i_element "rem")) (List.rev f.f_remove)) 78 | in 79 | List.iter (pp_feat_def ppf) (List.rev fs) 80 | 81 | let pp_extension ppf _ x = 82 | Glreg.(pp ppf "@[<2>ext '%s'%a@\n@[%a%a@]@]@," 83 | x.x_name (pp_kv "supported") x.x_supported 84 | (pp_list (pp_i_element "req")) (List.rev x.x_require) 85 | (pp_list (pp_i_element "rem")) (List.rev x.x_remove)) 86 | 87 | let pp_registry ppf r = 88 | pp ppf "@["; 89 | Hashtbl.iter (pp_type ppf) r.Glreg.types; pp ppf "@,"; 90 | Hashtbl.iter (pp_group ppf) r.Glreg.groups; pp ppf "@,"; 91 | Hashtbl.iter (pp_enum ppf) r.Glreg.enums; pp ppf "@,"; 92 | Hashtbl.iter (pp_command ppf) r.Glreg.commands; pp ppf "@,"; 93 | Hashtbl.iter (pp_feature ppf) r.Glreg.features; pp ppf "@,"; 94 | Hashtbl.iter (pp_extension ppf) r.Glreg.extensions; pp ppf "@,"; 95 | pp ppf "@]@?" 96 | 97 | let dump inf = 98 | try 99 | let inf = match inf with None -> "-" | Some inf -> inf in 100 | let ic = if inf = "-" then stdin else open_in inf in 101 | let d = Glreg.decoder (`Channel ic) in 102 | try match Glreg.decode d with 103 | | `Ok r -> close_in ic; pp_registry Format.std_formatter r 104 | | `Error e -> 105 | let (l0, c0), (l1, c1) = Glreg.decoded_range d in 106 | Printf.eprintf "%s:%d.%d-%d.%d: %s\n%!" inf l0 c0 l1 c1 e; 107 | exit 1 108 | with e -> close_in ic; raise e 109 | with Sys_error e -> Printf.eprintf "%s\n%!" e; exit 1 110 | 111 | let main () = 112 | let usage = 113 | str "Usage: %s FILE\n\ 114 | Dumps an OpenGL XML registry file on stdout.\n\ 115 | Options:" exec 116 | in 117 | let inf = ref None in 118 | let set_inf f = 119 | if !inf = None then inf := Some f else 120 | raise (Arg.Bad "only one registry file can be specified") 121 | in 122 | let options = [] in 123 | Arg.parse (Arg.align options) set_inf usage; 124 | dump !inf 125 | 126 | let () = main () 127 | -------------------------------------------------------------------------------- /B0.ml: -------------------------------------------------------------------------------- 1 | open B0_kit.V000 2 | open Result.Syntax 3 | 4 | (* OCaml library names *) 5 | 6 | let ctypes = B0_ocaml.libname "ctypes" 7 | let ctypes_foreign = B0_ocaml.libname "ctypes-foreign" 8 | let integers = B0_ocaml.libname "integers" (* dep of ctypes *) 9 | let bigarray_compat = B0_ocaml.libname "bigarray-compat" (* dep of ctypes *) 10 | let tsdl = B0_ocaml.libname "tsdl" 11 | let xmlm = B0_ocaml.libname "xmlm" 12 | 13 | (* tgls libraries *) 14 | 15 | (* Libraries *) 16 | 17 | let tgl ~id = 18 | (* FIXME this is not ready yet we need the right runes for the C 19 | stubs which are platform dependent, the triangle tests work likely 20 | because of linking against SDL. The link tests do not work with B0. *) 21 | let base = Fmt.str "tgl%s" id in 22 | let tgl_name = B0_ocaml.libname ("tgls." ^ base) in 23 | let srcs = [ `Dir ~/(Fmt.str "src/%s" base) ] in 24 | let tgl = 25 | let requires = [ctypes; ctypes_foreign; integers; bigarray_compat] in 26 | B0_ocaml.lib tgl_name ~srcs ~requires 27 | in 28 | tgl_name, tgl 29 | 30 | let tgl3, tgl3_lib = tgl ~id:"3" 31 | let tgl4, tgl4_lib = tgl ~id:"4" 32 | let tgles2, tgles2_lib = tgl ~id:"es2" 33 | let tgles3, tgles3_lib = tgl ~id:"es3" 34 | 35 | (* API generator *) 36 | 37 | let apiquery = 38 | let srcs = [`Dir ~/"support"; `X ~/"support/dump.ml" ] in 39 | let doc = "Gl OCaml API generation tool" in 40 | B0_ocaml.exe "apiquery" ~srcs ~requires:[xmlm] ~doc 41 | 42 | let apidump = 43 | let srcs = [`Dir ~/"support"; `X ~/"support/apiquery.ml" ] in 44 | B0_ocaml.exe "apidump" ~srcs ~requires:[xmlm] 45 | 46 | let glxml = ~/"support/gl.xml" 47 | let glxml_url = 48 | "https://cvs.khronos.org/svn/repos/ogl/trunk/doc/registry/public/api/gl.xml" 49 | 50 | let download_glxml = 51 | let doc = "Download gl.xml to support/gl.xml" in 52 | B0_unit.of_action "download-glxml" ~doc @@ fun env _ ~args:_ -> 53 | let glxml = B0_env.in_scope_dir env glxml in 54 | (Log.stdout @@ fun m -> 55 | m "@[Downloading %s@,to %a@]" glxml_url Fpath.pp glxml); 56 | let force = true and make_path = true in 57 | let* () = 58 | B0_action_kit.download_url env ~force ~make_path glxml_url ~dst:glxml 59 | in 60 | Ok () 61 | 62 | let generate_libraries = 63 | let doc = "Generate tgls.* libraries" in 64 | let units = [apiquery] in 65 | B0_unit.of_action "generate-libraries" ~units ~doc @@ fun env _ ~args:_ -> 66 | let src = B0_env.in_scope_dir env ~/"src" in 67 | let glxml = B0_env.in_scope_dir env glxml in 68 | let* () = Os.File.must_exist glxml in 69 | let* apiquery = B0_env.unit_exe_file_cmd env apiquery in 70 | let gen_lib glapi lib = 71 | let mli = Fpath.(src / lib / lib + ".mli") in 72 | let ml = Fpath.(src / lib / lib + ".ml") in 73 | let stdout = Os.Cmd.out_file ~force:true ~make_path:false mli in 74 | let* () = Os.Cmd.run Cmd.(apiquery % "-mli" % "-api" % glapi) ~stdout in 75 | let stdout = Os.Cmd.out_file ~force:true ~make_path:false ml in 76 | let* () = Os.Cmd.run Cmd.(apiquery % "-ml" % "-api" % glapi) ~stdout in 77 | Ok () 78 | in 79 | let* () = gen_lib "gl3.3" "tgl3" in 80 | let* () = gen_lib "gl4.5" "tgl4" in 81 | let* () = gen_lib "gles2.0" "tgles2" in 82 | let* () = gen_lib "gles3.2" "tgles3" in 83 | Ok () 84 | 85 | (* Tests *) 86 | 87 | let test kind ?(requires = []) ~id lib = 88 | let src = ~/(Fmt.str "test/%sgl%s.ml" kind id) in 89 | let requires = ctypes :: ctypes_foreign :: lib :: requires in 90 | B0_ocaml.test src ~requires 91 | 92 | let lib_tests ~id lib = 93 | test "tri" ~id lib ~requires:[tsdl], 94 | test "link" ~id lib 95 | 96 | let linktgl3, tritgl3 = lib_tests ~id:"3" tgl3 97 | let linktgl4, tritgl4 = lib_tests ~id:"4" tgl4 98 | let linktgles2, tritgles2 = lib_tests ~id:"es2" tgles2 99 | let linktgles3, tritgles3 = lib_tests ~id:"es3" tgles3 100 | let dbgllifetime4 = 101 | B0_ocaml.test ~/"test/dbglifetime4.ml" ~requires:[tgl4; tsdl] ~run:false 102 | 103 | (* Packs *) 104 | 105 | let default = 106 | let meta = 107 | B0_meta.empty 108 | |> ~~ B0_meta.authors ["The tgls programmers"] 109 | |> ~~ B0_meta.maintainers ["Daniel Bünzli "] 110 | |> ~~ B0_meta.homepage "https://erratique.ch/software/tgls" 111 | |> ~~ B0_meta.online_doc "https://erratique.ch/software/tgls/doc/" 112 | |> ~~ B0_meta.licenses ["ISC"] 113 | |> ~~ B0_meta.repo "git+https://erratique.ch/repos/tgls.git" 114 | |> ~~ B0_meta.issues "https://github.com/dbuenzli/tgls/issues" 115 | |> ~~ B0_meta.description_tags 116 | ["bindings"; "opengl"; "opengl-es"; "graphics"; "org:erratique"] 117 | |> B0_meta.tag B0_opam.tag 118 | |> B0_meta.add B0_opam.depends 119 | [ "ocaml", {|>= "4.08.0"|}; 120 | "ocamlfind", {|build|}; 121 | "ocamlbuild", {|build|}; 122 | "topkg", {|build & >= "1.1.1"|}; 123 | "ctypes", {|>= "0.21.1"|}; 124 | "ctypes-foreign", {|>= "0.21.1"|}; 125 | (* "tsdl", {|with-test|}; *) 126 | "xmlm", {|dev|}; 127 | ] 128 | |> B0_meta.add B0_opam.build 129 | {|[["ocaml" "pkg/pkg.ml" "build" "--dev-pkg" "%{dev}%"]]|} 130 | in 131 | B0_pack.make "default" ~doc:"tgls package" ~meta ~locked:true @@ 132 | B0_unit.list () 133 | -------------------------------------------------------------------------------- /support/apiquery.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2013 The tgls programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | let str = Format.sprintf 7 | let exec = Filename.basename Sys.executable_name 8 | 9 | (* Pretty printers *) 10 | 11 | let pp = Format.fprintf 12 | let pp_str = Format.pp_print_string 13 | let rec pp_list ?(pp_sep = Format.pp_print_cut) pp_v ppf = function 14 | | [] -> () 15 | | v :: vs -> 16 | pp_v ppf v; if vs <> [] then (pp_sep ppf (); pp_list ~pp_sep pp_v ppf vs) 17 | 18 | let pp_base_type ppf b = pp_str ppf (Capi.base_type_to_string b) 19 | let pp_ocaml_type_def ppf = function 20 | | `Unknown _ -> pp ppf "unknown" 21 | | `Ok def -> 22 | let name = def.Oapi.type_name in 23 | let odef = match def.Oapi.type_def with 24 | | `Builtin -> name | `Alias a | `Abstract a -> str "type %s = %s" name a 25 | in 26 | let ctypes = match def.Oapi.type_ctypes with 27 | | `Builtin c | `Builtin_wrap_in (c, _) | `View (c, _, _, _) 28 | | `Def (c, _) -> c 29 | in 30 | pp ppf "%s, %s" odef ctypes 31 | 32 | let pp_base_type_def ppf = function 33 | | `Def d -> pp ppf "typedef %s" d | `Builtin -> () 34 | 35 | let rec pp_type ?(def = true) api ppf = function 36 | | `Base b as t when def -> 37 | let odef = Oapi.type_def api t in 38 | pp ppf "@[%a (%a) %a@]" 39 | pp_base_type b 40 | pp_ocaml_type_def odef 41 | pp_base_type_def (Capi.base_type_def api b) 42 | | t -> 43 | if not def then pp ppf "@[%s@]" (Capi.type_to_string t) else 44 | let odef = Oapi.type_def api t in 45 | pp ppf "@[%s (%a)@]" (Capi.type_to_string t) pp_ocaml_type_def odef 46 | 47 | let pp_arg_len ppf = function 48 | | `Size i -> pp ppf "%d" i 49 | | `Arg a -> pp ppf "arg:%s" a 50 | | `Csize a -> pp ppf "csize:%s" a 51 | | `Other a -> pp ppf "unparsed:%s" a 52 | 53 | let pp_fun_def ppf = function 54 | | `Derived _ -> pp ppf "derived" 55 | | `Unbound _ -> pp ppf "unbound" 56 | | `Manual _ -> pp ppf "manual" 57 | | `Unknown -> pp ppf "unknown" 58 | 59 | let pp_fun api ppf f = 60 | let cname, (cargs, cret) = f.Oapi.fun_c in 61 | let def = false in 62 | let pp_sep ppf () = pp ppf " -> " in 63 | let pp_carg ppf a = match a.Capi.arg_len with 64 | | None -> pp_type ~def api ppf a.Capi.arg_type 65 | | Some l -> pp ppf "%a [%a]" (pp_type ~def api) a.Capi.arg_type pp_arg_len l 66 | in 67 | pp ppf "@[%a %s (%s) : %a -> %a@]" 68 | pp_fun_def f.Oapi.fun_def 69 | cname f.Oapi.fun_name 70 | (pp_list ~pp_sep pp_carg) cargs (pp_type ~def api) cret 71 | 72 | let pp_enum api ppf e = 73 | let v = match e.Oapi.enum_value with 74 | | `GLenum v -> str "@[GLenum 0x%04X@]" v 75 | | `GLenum_max -> str "@[GLenum 0x%04lX@]" 0xFFFF_FFFFl 76 | | `GLuint v -> str "@[GLuint 0x%04lX@]" v 77 | | `GLuint64 v -> str "@[GLuint64 0x%04LX@]" v 78 | in 79 | pp ppf "@[%s %s (%s)@]" v e.Oapi.enum_c_name e.Oapi.enum_name 80 | 81 | let api_query ppf api q = 82 | let log = Format.err_formatter in 83 | let pp_defs pp_v defs = pp ppf "@[%a@,@]" (pp_list (pp_v api)) defs in 84 | match q with 85 | | `Types -> pp_defs pp_type (Capi.types api); `Ok 86 | | `Funs -> pp_defs pp_fun (Oapi.funs api); `Ok 87 | | `Enums -> pp_defs pp_enum (Oapi.enums api); `Ok 88 | | `Mli -> pp ppf "%a" (Gen.pp_api_mli ~log) api; `Ok 89 | | `Ml -> pp ppf "%a" (Gen.pp_api_ml ~log) api; `Ok 90 | | `List -> assert false 91 | 92 | let list_apis reg = 93 | let add_features api features acc = 94 | let api = match api with "gles2" | "gles1" -> "gles" | _ -> api in 95 | let add_feature acc feature = 96 | (str "%s%d.%d" api 97 | (fst feature.Glreg.f_number) (snd feature.Glreg.f_number)) :: acc 98 | in 99 | List.fold_left add_feature acc features 100 | in 101 | let features = Hashtbl.fold add_features reg.Glreg.features [] in 102 | let add_extension ext _ acc = ext :: acc in 103 | let exts = Hashtbl.fold add_extension reg.Glreg.extensions [] in 104 | List.sort compare (List.rev_append exts features) 105 | 106 | let process inf api_id profile query = 107 | try 108 | let inf = match inf with None -> "support/gl.xml" | Some inf -> inf in 109 | let ic = if inf = "-" then stdin else open_in inf in 110 | let d = Glreg.decoder (`Channel ic) in 111 | try match Glreg.decode d with 112 | | `Ok reg -> 113 | close_in ic; 114 | begin match query with 115 | | `List -> 116 | List.iter (pp Format.std_formatter "%s@\n") (list_apis reg); 117 | exit 0 118 | | query -> 119 | begin match Capi.create reg api_id profile with 120 | | `Error e -> Printf.eprintf "%s: %s\n%!" exec e; `Error 121 | | `Ok api -> api_query Format.std_formatter api query 122 | end 123 | end 124 | | `Error e -> 125 | let (l0, c0), (l1, c1) = Glreg.decoded_range d in 126 | Printf.eprintf "%s:%d.%d-%d.%d: %s\n%!" inf l0 c0 l1 c1 e; `Error 127 | with e -> close_in ic; raise e 128 | with Sys_error e -> Printf.eprintf "%s\n%!" e; `Error 129 | 130 | let main () = 131 | let usage = str 132 | "Usage: %s [OPTION]... [INFILE]\n\ 133 | \ Query an OpenGL API from a registry file.\n\ 134 | \ INFILE defaults to support/gl.xml\n\ 135 | Options:" exec 136 | in 137 | let inf = ref None in 138 | let set_inf f = 139 | if !inf = None then inf := Some f else 140 | raise (Arg.Bad "only one registry file can be specified") 141 | in 142 | let query = ref `Funs in 143 | let set_query v () = query := v in 144 | let api_id = ref (`Gl (4, 4)) in 145 | let set_api_id s = api_id := Capi.id_of_string s in 146 | let profile = ref "core" in 147 | let options = [ 148 | "-api", Arg.String set_api_id, 149 | " API to query, see -list (defaults to `gl4.4')"; 150 | "-list", Arg.Unit (set_query `List), 151 | " list the available APIs for the -api option"; 152 | "-profile", Arg.Set_string profile, 153 | " API profile (defaults to `core')"; 154 | "-types", Arg.Unit (set_query `Types), 155 | " print API C types"; 156 | "-funs", Arg.Unit (set_query `Funs), 157 | " print API functions and their signature"; 158 | "-enums", Arg.Unit (set_query `Enums), 159 | " print API enums and their value"; 160 | "-ml", Arg.Unit (set_query `Ml), 161 | " print ml file for binding the API"; 162 | "-mli", Arg.Unit (set_query `Mli), 163 | " print mli file for binding the API"; ] 164 | in 165 | Arg.parse (Arg.align options) set_inf usage; 166 | match process !inf !api_id !profile !query with 167 | | `Ok -> exit 0 | `Error -> exit 1 168 | 169 | let () = main () 170 | -------------------------------------------------------------------------------- /test/trigles2.ml: -------------------------------------------------------------------------------- 1 | (* 2 | Minimal Tgles2 example. This code is in the public domain. 3 | Draws a fantastic tri-colored triangle. 4 | 5 | Compile with: 6 | ocamlfind ocamlc -linkpkg -package result,tsdl,tgls.tgles2 -o trigles2.byte \ 7 | trigles2.ml 8 | ocamlfind ocamlopt -linkpkg -package result,tsdl,tgls.tgles2 -o trigles2.native \ 9 | trigles2.ml 10 | *) 11 | 12 | open Tsdl 13 | open Tgles2 14 | open Result 15 | 16 | let str = Printf.sprintf 17 | 18 | let ( >>= ) x f = match x with Ok v -> f v | Error _ as e -> e 19 | 20 | (* Helper functions. *) 21 | 22 | let bigarray_create k len = Bigarray.(Array1.create k c_layout len) 23 | 24 | let get_int = 25 | let a = bigarray_create Bigarray.int32 1 in 26 | fun f -> f a; Int32.to_int a.{0} 27 | 28 | let set_int = 29 | let a = bigarray_create Bigarray.int32 1 in 30 | fun f i -> a.{0} <- Int32.of_int i; f a 31 | 32 | let get_string len f = 33 | let a = bigarray_create Bigarray.char len in 34 | f a; Gl.string_of_bigarray a 35 | 36 | (* Shaders *) 37 | 38 | let vertex_shader = " 39 | #version 100 40 | attribute vec3 vertex; 41 | attribute vec3 color; 42 | varying vec4 v_color; 43 | void main() 44 | { 45 | v_color = vec4(color, 1.0); 46 | gl_Position = vec4(vertex, 1.0); 47 | }" 48 | 49 | let fragment_shader = " 50 | #version 100 51 | precision highp float; 52 | varying vec4 v_color; 53 | void main() { gl_FragColor = v_color; }" 54 | 55 | (* Geometry *) 56 | 57 | let set_3d ba i x y z = 58 | let start = i * 3 in 59 | ba.{start} <- x; ba.{start + 1} <- y; ba.{start + 2} <- z 60 | 61 | let vertices = 62 | let vs = bigarray_create Bigarray.float32 (3 * 3) in 63 | set_3d vs 0 (-0.8) (-0.8) 0.0; 64 | set_3d vs 1 0.8 (-0.8) 0.0; 65 | set_3d vs 2 0.0 0.8 0.0; 66 | vs 67 | 68 | let colors = 69 | let cs = bigarray_create Bigarray.float32 (3 * 3) in 70 | set_3d cs 0 1.0 0.0 0.0; 71 | set_3d cs 1 0.0 1.0 0.0; 72 | set_3d cs 2 0.0 0.0 1.0; 73 | cs 74 | 75 | let indices = 76 | let is = bigarray_create Bigarray.int8_unsigned 3 in 77 | set_3d is 0 0 1 2; 78 | is 79 | 80 | (* OpenGL setup *) 81 | 82 | let create_buffer b = 83 | let id = get_int (Gl.gen_buffers 1) in 84 | let bytes = Gl.bigarray_byte_size b in 85 | Gl.bind_buffer Gl.array_buffer id; 86 | Gl.buffer_data Gl.array_buffer bytes (Some b) Gl.static_draw; 87 | id 88 | 89 | let delete_buffer bid = 90 | set_int (Gl.delete_buffers 1) bid 91 | 92 | let create_geometry () = 93 | let iid = create_buffer indices in 94 | let vid = create_buffer vertices in 95 | let cid = create_buffer colors in 96 | Ok (iid, vid, cid) 97 | 98 | let delete_geometry (iid, vid, cid) = 99 | delete_buffer iid; delete_buffer vid; delete_buffer cid; 100 | Ok () 101 | 102 | let compile_shader src typ = 103 | let get_shader sid e = get_int (Gl.get_shaderiv sid e) in 104 | let sid = Gl.create_shader typ in 105 | Gl.shader_source sid src; 106 | Gl.compile_shader sid; 107 | if get_shader sid Gl.compile_status = Gl.true_ then Ok sid else 108 | let len = get_shader sid Gl.info_log_length in 109 | let log = get_string len (Gl.get_shader_info_log sid len None) in 110 | (Gl.delete_shader sid; Error (`Msg log)) 111 | 112 | let create_program () = 113 | compile_shader vertex_shader Gl.vertex_shader >>= fun vid -> 114 | compile_shader fragment_shader Gl.fragment_shader >>= fun fid -> 115 | let pid = Gl.create_program () in 116 | let get_program pid e = get_int (Gl.get_programiv pid e) in 117 | Gl.attach_shader pid vid; Gl.delete_shader vid; 118 | Gl.attach_shader pid fid; Gl.delete_shader fid; 119 | Gl.bind_attrib_location pid 0 "vertex"; 120 | Gl.bind_attrib_location pid 1 "color"; 121 | Gl.link_program pid; 122 | if get_program pid Gl.link_status = Gl.true_ then Ok pid else 123 | let len = get_program pid Gl.info_log_length in 124 | let log = get_string len (Gl.get_program_info_log pid len None) in 125 | (Gl.delete_program pid; Error (`Msg log)) 126 | 127 | let delete_program pid = 128 | Gl.delete_program pid; Ok () 129 | 130 | let draw pid (iid, vid, cid) win = 131 | let bind_attrib id loc dim typ = 132 | Gl.bind_buffer Gl.array_buffer id; 133 | Gl.enable_vertex_attrib_array loc; 134 | Gl.vertex_attrib_pointer loc dim typ false 0 (`Offset 0); 135 | in 136 | Gl.clear_color 0. 0. 0. 1.; 137 | Gl.clear Gl.color_buffer_bit; 138 | Gl.use_program pid; 139 | Gl.bind_buffer Gl.element_array_buffer iid; 140 | bind_attrib vid 0 3 Gl.float; 141 | bind_attrib cid 1 3 Gl.float; 142 | Gl.draw_elements Gl.triangles 3 Gl.unsigned_byte (`Offset 0); 143 | Gl.bind_buffer Gl.array_buffer 0; 144 | Gl.bind_buffer Gl.element_array_buffer 0; 145 | Sdl.gl_swap_window win; 146 | Ok () 147 | 148 | let reshape win w h = 149 | Gl.viewport 0 0 w h 150 | 151 | (* Window and OpenGL context *) 152 | 153 | let pp_opengl_info ppf () = 154 | let pp = Format.fprintf in 155 | let pp_opt ppf = function None -> pp ppf "error" | Some s -> pp ppf "%s" s in 156 | pp ppf "@[@,"; 157 | pp ppf "Renderer @[@[%a@]@," pp_opt (Gl.get_string Gl.renderer); 158 | pp ppf "@[OpenGL %a / GLSL %a@]@]@," 159 | pp_opt (Gl.get_string Gl.version) 160 | pp_opt (Gl.get_string Gl.shading_language_version); 161 | pp ppf "@]" 162 | 163 | let create_window ~gl:(maj, min) = 164 | let w_atts = Sdl.Window.(opengl + resizable) in 165 | let w_title = Printf.sprintf "OpenGL %d.%d (core profile)" maj min in 166 | let set a v = Sdl.gl_set_attribute a v in 167 | set Sdl.Gl.context_profile_mask Sdl.Gl.context_profile_es >>= fun () -> 168 | set Sdl.Gl.context_major_version maj >>= fun () -> 169 | set Sdl.Gl.context_minor_version min >>= fun () -> 170 | set Sdl.Gl.doublebuffer 1 >>= fun () -> 171 | Sdl.create_window ~w:640 ~h:480 w_title w_atts >>= fun win -> 172 | Sdl.gl_create_context win >>= fun ctx -> 173 | Sdl.gl_make_current win ctx >>= fun () -> 174 | Sdl.log "%a" pp_opengl_info (); 175 | Ok (win, ctx) 176 | 177 | let destroy_window win ctx = 178 | Sdl.gl_delete_context ctx; 179 | Sdl.destroy_window win; 180 | Ok () 181 | 182 | (* Event loop *) 183 | 184 | let event_loop win draw = 185 | let e = Sdl.Event.create () in 186 | let key_scancode e = Sdl.Scancode.enum Sdl.Event.(get e keyboard_scancode) in 187 | let event e = Sdl.Event.(enum (get e typ)) in 188 | let window_event e = Sdl.Event.(window_event_enum (get e window_event_id)) in 189 | let rec loop () = 190 | Sdl.wait_event (Some e) >>= fun () -> 191 | match event e with 192 | | `Quit -> Ok () 193 | | `Key_down when key_scancode e = `Escape -> Ok () 194 | | `Window_event -> 195 | begin match window_event e with 196 | | `Exposed | `Resized -> 197 | let w, h = Sdl.get_window_size win in 198 | reshape win w h; 199 | draw win; 200 | loop () 201 | | _ -> loop () 202 | end 203 | | _ -> loop () 204 | in 205 | (draw win; loop ()) 206 | 207 | (* Main *) 208 | 209 | let tri ~gl:(maj, min as gl) = 210 | Sdl.init Sdl.Init.video >>= fun () -> 211 | create_window ~gl >>= fun (win, ctx) -> 212 | create_geometry () >>= fun bids -> 213 | create_program () >>= fun pid -> 214 | event_loop win (draw pid bids) >>= fun () -> 215 | delete_program pid >>= fun () -> 216 | delete_geometry bids >>= fun () -> 217 | destroy_window win ctx >>= fun () -> 218 | Sdl.quit (); 219 | Ok () 220 | 221 | let main () = 222 | let exec = Filename.basename Sys.executable_name in 223 | let usage = str "Usage: %s [OPTION]\n Tests Tgles2.\nOptions:" exec in 224 | let options = [] in 225 | let anon _ = raise (Arg.Bad "no arguments are supported") in 226 | Arg.parse (Arg.align options) anon usage; 227 | match tri ~gl:(2, 0) with 228 | | Ok () -> exit 0 229 | | Error (`Msg msg) -> Sdl.log "%s@." msg; exit 1 230 | 231 | let () = main () 232 | -------------------------------------------------------------------------------- /test/trigles3.ml: -------------------------------------------------------------------------------- 1 | (* 2 | Minimal Tgles3 example. This code is in the public domain. 3 | Draws a fantastic tri-colored triangle. 4 | 5 | Compile with: 6 | ocamlfind ocamlc -linkpkg -package result,tsdl,tgls.tgles3 -o trigles3.byte \ 7 | trigles3.ml 8 | ocamlfind ocamlopt -linkpkg -package result,tsdl,tgls.tgles3 -o trigles3.native \ 9 | trigles3.ml 10 | *) 11 | 12 | open Tsdl 13 | open Tgles3 14 | open Result 15 | 16 | let str = Printf.sprintf 17 | 18 | let ( >>= ) x f = match x with Ok v -> f v | Error _ as e -> e 19 | 20 | (* Helper functions. *) 21 | 22 | let bigarray_create k len = Bigarray.(Array1.create k c_layout len) 23 | 24 | let get_int = 25 | let a = bigarray_create Bigarray.int32 1 in 26 | fun f -> f a; Int32.to_int a.{0} 27 | 28 | let set_int = 29 | let a = bigarray_create Bigarray.int32 1 in 30 | fun f i -> a.{0} <- Int32.of_int i; f a 31 | 32 | let get_string len f = 33 | let a = bigarray_create Bigarray.char len in 34 | f a; Gl.string_of_bigarray a 35 | 36 | (* Shaders *) 37 | 38 | let vertex_shader = " 39 | #version 330 es 40 | in vec3 vertex; 41 | in vec3 color; 42 | out vec4 v_color; 43 | void main() 44 | { 45 | v_color = vec4(color, 1.0); 46 | gl_Position = vec4(vertex, 1.0); 47 | }" 48 | 49 | let fragment_shader = " 50 | #version 330 es 51 | precision highp float; 52 | in vec4 v_color; 53 | out vec4 color; 54 | void main() { color = v_color; }" 55 | 56 | (* Geometry *) 57 | 58 | let set_3d ba i x y z = 59 | let start = i * 3 in 60 | ba.{start} <- x; ba.{start + 1} <- y; ba.{start + 2} <- z 61 | 62 | let vertices = 63 | let vs = bigarray_create Bigarray.float32 (3 * 3) in 64 | set_3d vs 0 (-0.8) (-0.8) 0.0; 65 | set_3d vs 1 0.8 (-0.8) 0.0; 66 | set_3d vs 2 0.0 0.8 0.0; 67 | vs 68 | 69 | let colors = 70 | let cs = bigarray_create Bigarray.float32 (3 * 3) in 71 | set_3d cs 0 1.0 0.0 0.0; 72 | set_3d cs 1 0.0 1.0 0.0; 73 | set_3d cs 2 0.0 0.0 1.0; 74 | cs 75 | 76 | let indices = 77 | let is = bigarray_create Bigarray.int8_unsigned 3 in 78 | set_3d is 0 0 1 2; 79 | is 80 | 81 | (* OpenGL setup *) 82 | 83 | let create_buffer b = 84 | let id = get_int (Gl.gen_buffers 1) in 85 | let bytes = Gl.bigarray_byte_size b in 86 | Gl.bind_buffer Gl.array_buffer id; 87 | Gl.buffer_data Gl.array_buffer bytes (Some b) Gl.static_draw; 88 | id 89 | 90 | let delete_buffer bid = 91 | set_int (Gl.delete_buffers 1) bid 92 | 93 | let create_geometry () = 94 | let gid = get_int (Gl.gen_vertex_arrays 1) in 95 | let iid = create_buffer indices in 96 | let vid = create_buffer vertices in 97 | let cid = create_buffer colors in 98 | let bind_attrib id loc dim typ = 99 | Gl.bind_buffer Gl.array_buffer id; 100 | Gl.enable_vertex_attrib_array loc; 101 | Gl.vertex_attrib_pointer loc dim typ false 0 (`Offset 0); 102 | in 103 | Gl.bind_vertex_array gid; 104 | Gl.bind_buffer Gl.element_array_buffer iid; 105 | bind_attrib vid 0 3 Gl.float; 106 | bind_attrib cid 1 3 Gl.float; 107 | Gl.bind_vertex_array 0; 108 | Gl.bind_buffer Gl.array_buffer 0; 109 | Gl.bind_buffer Gl.element_array_buffer 0; 110 | Ok (gid, [iid; vid; cid]) 111 | 112 | let delete_geometry gid bids = 113 | set_int (Gl.delete_vertex_arrays 1) gid; 114 | List.iter delete_buffer bids; 115 | Ok () 116 | 117 | let compile_shader src typ = 118 | let get_shader sid e = get_int (Gl.get_shaderiv sid e) in 119 | let sid = Gl.create_shader typ in 120 | Gl.shader_source sid src; 121 | Gl.compile_shader sid; 122 | if get_shader sid Gl.compile_status = Gl.true_ then Ok sid else 123 | let len = get_shader sid Gl.info_log_length in 124 | let log = get_string len (Gl.get_shader_info_log sid len None) in 125 | (Gl.delete_shader sid; Error (`Msg log)) 126 | 127 | let create_program () = 128 | compile_shader vertex_shader Gl.vertex_shader >>= fun vid -> 129 | compile_shader fragment_shader Gl.fragment_shader >>= fun fid -> 130 | let pid = Gl.create_program () in 131 | let get_program pid e = get_int (Gl.get_programiv pid e) in 132 | Gl.attach_shader pid vid; Gl.delete_shader vid; 133 | Gl.attach_shader pid fid; Gl.delete_shader fid; 134 | Gl.bind_attrib_location pid 0 "vertex"; 135 | Gl.bind_attrib_location pid 1 "color"; 136 | Gl.link_program pid; 137 | if get_program pid Gl.link_status = Gl.true_ then Ok pid else 138 | let len = get_program pid Gl.info_log_length in 139 | let log = get_string len (Gl.get_program_info_log pid len None) in 140 | (Gl.delete_program pid; Error (`Msg log)) 141 | 142 | let delete_program pid = 143 | Gl.delete_program pid; Ok () 144 | 145 | let draw pid gid win = 146 | Gl.clear_color 0. 0. 0. 1.; 147 | Gl.clear Gl.color_buffer_bit; 148 | Gl.use_program pid; 149 | Gl.bind_vertex_array gid; 150 | Gl.draw_elements Gl.triangles 3 Gl.unsigned_byte (`Offset 0); 151 | Gl.bind_vertex_array 0; 152 | Sdl.gl_swap_window win; 153 | Ok () 154 | 155 | let reshape win w h = 156 | Gl.viewport 0 0 w h 157 | 158 | (* Window and OpenGL context *) 159 | 160 | let pp_opengl_info ppf () = 161 | let pp = Format.fprintf in 162 | let pp_opt ppf = function None -> pp ppf "error" | Some s -> pp ppf "%s" s in 163 | pp ppf "@[@,"; 164 | pp ppf "Renderer @[@[%a@]@," pp_opt (Gl.get_string Gl.renderer); 165 | pp ppf "@[OpenGL %a / GLSL %a@]@]@," 166 | pp_opt (Gl.get_string Gl.version) 167 | pp_opt (Gl.get_string Gl.shading_language_version); 168 | pp ppf "@]" 169 | 170 | let create_window ~gl:(maj, min) = 171 | let w_atts = Sdl.Window.(opengl + resizable) in 172 | let w_title = Printf.sprintf "OpenGL %d.%d (core profile)" maj min in 173 | let set a v = Sdl.gl_set_attribute a v in 174 | set Sdl.Gl.context_profile_mask Sdl.Gl.context_profile_es >>= fun () -> 175 | set Sdl.Gl.context_major_version maj >>= fun () -> 176 | set Sdl.Gl.context_minor_version min >>= fun () -> 177 | set Sdl.Gl.doublebuffer 1 >>= fun () -> 178 | Sdl.create_window ~w:640 ~h:480 w_title w_atts >>= fun win -> 179 | Sdl.gl_create_context win >>= fun ctx -> 180 | Sdl.gl_make_current win ctx >>= fun () -> 181 | Sdl.log "%a" pp_opengl_info (); 182 | Ok (win, ctx) 183 | 184 | let destroy_window win ctx = 185 | Sdl.gl_delete_context ctx; 186 | Sdl.destroy_window win; 187 | Ok () 188 | 189 | (* Event loop *) 190 | 191 | let event_loop win draw = 192 | let e = Sdl.Event.create () in 193 | let key_scancode e = Sdl.Scancode.enum Sdl.Event.(get e keyboard_scancode) in 194 | let event e = Sdl.Event.(enum (get e typ)) in 195 | let window_event e = Sdl.Event.(window_event_enum (get e window_event_id)) in 196 | let rec loop () = 197 | Sdl.wait_event (Some e) >>= fun () -> 198 | match event e with 199 | | `Quit -> Ok () 200 | | `Key_down when key_scancode e = `Escape -> Ok () 201 | | `Window_event -> 202 | begin match window_event e with 203 | | `Exposed | `Resized -> 204 | let w, h = Sdl.get_window_size win in 205 | reshape win w h; 206 | draw win; 207 | draw win; (* bug on osx ? *) 208 | loop () 209 | | _ -> loop () 210 | end 211 | | _ -> loop () 212 | in 213 | (draw win; loop ()) 214 | 215 | (* Main *) 216 | 217 | let tri ~gl:(maj, min as gl) = 218 | Sdl.init Sdl.Init.video >>= fun () -> 219 | create_window ~gl >>= fun (win, ctx) -> 220 | create_geometry () >>= fun (gid, bids) -> 221 | create_program () >>= fun pid -> 222 | event_loop win (draw pid gid) >>= fun () -> 223 | delete_program pid >>= fun () -> 224 | delete_geometry gid bids >>= fun () -> 225 | destroy_window win ctx >>= fun () -> 226 | Sdl.quit (); 227 | Ok () 228 | 229 | let main () = 230 | let exec = Filename.basename Sys.executable_name in 231 | let usage = str "Usage: %s [OPTION]\n Tests Tgles3.\nOptions:" exec in 232 | let options = [] in 233 | let anon _ = raise (Arg.Bad "no arguments are supported") in 234 | Arg.parse (Arg.align options) anon usage; 235 | match tri ~gl:(3, 0) with 236 | | Ok () -> exit 0 237 | | Error (`Msg msg) -> Sdl.log "%s@." msg; exit 1 238 | 239 | let () = main () 240 | -------------------------------------------------------------------------------- /support/manual.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2013 The tgls programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | let pp = Format.fprintf 7 | let str = Printf.sprintf 8 | type binding = string * string 9 | 10 | let get_uri api f = match Doc.man_uri api f with 11 | | Some doc -> doc | None -> assert false 12 | 13 | let glCreateShaderProgramv api = str 14 | "\ 15 | val create_shader_programv : enum -> string -> int 16 | (** {{:%s} 17 | [glCreateShaderProgramv]} [type_ source] *) 18 | " 19 | (get_uri api "glCreateShaderProgramv"), 20 | "\ 21 | let create_shader_programv = 22 | foreign ~stub \"glCreateShaderProgramv\" 23 | (int_as_uint @-> int @-> ptr string @-> returning int_as_uint) 24 | 25 | let create_shader_programv type_ src = 26 | let src = allocate string src in 27 | create_shader_programv type_ 1 src 28 | " 29 | 30 | let glDebugMessageCallback api = str 31 | "\ 32 | val debug_message_callback : debug_proc -> unit 33 | (** {{:%s} 34 | [glDebugMessageCallback]} [f] *) 35 | " 36 | (get_uri api "glDebugMessageCallback"), 37 | "\ 38 | module DebugMessageCallback = 39 | (val (dynamic_funptr (int_as_uint @-> int_as_uint @-> int_as_uint @-> 40 | int_as_uint @-> int @-> ptr char @-> ptr void @-> 41 | returning void))) 42 | 43 | let debug_message_callback = 44 | foreign ~stub \"glDebugMessageCallback\" 45 | (DebugMessageCallback.t @-> ptr void @-> returning void) 46 | 47 | let debug_message_callback = 48 | let debug_cb = ref None in 49 | fun f -> 50 | let wrap_cb src typ id sev len msg _ = 51 | let s = Bytes.create len in 52 | for i = 0 to len - 1 do Bytes.set s i (!@ (msg +@ i)) done; 53 | f src typ id sev (Bytes.unsafe_to_string s) 54 | in 55 | let dyn_wrapped_cb = DebugMessageCallback.of_fun wrap_cb in 56 | let old_cb = !debug_cb in 57 | debug_cb := Some dyn_wrapped_cb; 58 | debug_message_callback dyn_wrapped_cb null; 59 | (match old_cb with 60 | | Some old -> DebugMessageCallback.free old 61 | | None -> ()) 62 | " 63 | 64 | let glGetUniformIndices api = str 65 | "\ 66 | val get_uniform_indices : int -> string list -> uint32_bigarray -> unit 67 | (** {{:%s} 68 | [glGetUniformIndices]} [program uniformNames uniformIndices] *)" 69 | (get_uri api "glGetUniformIndices"), 70 | "\ 71 | let get_uniform_indices = 72 | foreign ~stub \"glGetUniformIndices\" 73 | (int_as_uint @-> int @-> ptr string @-> ptr void @-> returning void) 74 | 75 | let get_uniform_indices program names indices = 76 | let count = List.length names in 77 | let names = CArray.(start (of_list string names)) in 78 | let indices = to_voidp (bigarray_start array1 indices) in 79 | get_uniform_indices program count names indices 80 | " 81 | 82 | let glMapBuffer api = str 83 | "\ 84 | val map_buffer : enum -> int -> enum -> ('a, 'b) Bigarray.kind -> 85 | ('a, 'b) bigarray 86 | (** {{:%s} 87 | [glMapBuffer]} [target length access kind] 88 | 89 | {b Note.} [length] is the length, in number of bigarray elements, of the 90 | mapped buffer. 91 | 92 | {b Warning.} The bigarray becomes invalid once the buffer is unmapped and 93 | program termination may happen if you don't respect the access policy. *) 94 | " 95 | (get_uri api "glMapBuffer"), 96 | "\ 97 | let map_buffer = 98 | foreign ~stub \"glMapBuffer\" 99 | (int_as_uint @-> int_as_uint @-> returning (ptr void)) 100 | 101 | let map_buffer target len access kind = 102 | let p = map_buffer target access in 103 | let p = coerce (ptr void) (access_ptr_typ_of_ba_kind kind) p in 104 | bigarray_of_ptr array1 len kind p 105 | " 106 | 107 | let glMapNamedBuffer api = str 108 | "\ 109 | val map_named_buffer : enum -> int -> enum -> ('a, 'b) Bigarray.kind -> 110 | ('a, 'b) bigarray 111 | (** {{:%s} 112 | [glMapNamedBuffer]} [buffer length access kind] 113 | 114 | {b Note.} [length] is the length, in number of bigarray elements, of the 115 | mapped buffer. 116 | 117 | {b Warning.} The bigarray becomes invalid once the buffer is unmapped and 118 | program termination may happen if you don't respect the access policy. *) 119 | " 120 | (get_uri api "glMapNamedBuffer"), 121 | "\ 122 | let map_named_buffer = 123 | foreign ~stub \"glMapNamedBuffer\" 124 | (int_as_uint @-> int_as_uint @-> returning (ptr void)) 125 | 126 | let map_named_buffer buffer len access kind = 127 | let p = map_named_buffer buffer access in 128 | let p = coerce (ptr void) (access_ptr_typ_of_ba_kind kind) p in 129 | bigarray_of_ptr array1 len kind p 130 | " 131 | 132 | let glMapBufferRange api = str 133 | "\ 134 | val map_buffer_range : enum -> int -> int -> enum -> 135 | ('a, 'b) Bigarray.kind -> ('a, 'b) bigarray 136 | (** {{:%s} 137 | [glMapBufferRange]} [target offset length access kind] 138 | 139 | {b Note.} [length] is the length in number of bigarray elements of the 140 | mapped buffer. [offset] is in bytes. 141 | 142 | {b Warning.} The bigarray becomes invalid once the buffer is unmapped and 143 | program termination may happen if you don't respect the access policy. *) 144 | " 145 | (get_uri api "glMapBufferRange"), 146 | "\ 147 | let map_buffer_range = 148 | foreign ~stub \"glMapBufferRange\" 149 | (int_as_uint @-> int @-> int @-> int_as_uint @-> returning (ptr void)) 150 | 151 | let map_buffer_range target offset len access kind = 152 | let len_bytes = ba_kind_byte_size kind * len in 153 | let p = map_buffer_range target offset len_bytes access in 154 | let p = coerce (ptr void) (access_ptr_typ_of_ba_kind kind) p in 155 | bigarray_of_ptr array1 len kind p 156 | " 157 | 158 | let glMapNamedBufferRange api = str 159 | "\ 160 | val map_named_buffer_range : enum -> int -> int -> enum -> 161 | ('a, 'b) Bigarray.kind -> ('a, 'b) bigarray 162 | (** {{:%s} 163 | [glMapNamedBufferRange]} [buffer offset length access kind] 164 | 165 | {b Note.} [length] is the length in number of bigarray elements of the 166 | mapped buffer. [offset] is in bytes. 167 | 168 | {b Warning.} The bigarray becomes invalid once the buffer is unmapped and 169 | program termination may happen if you don't respect the access policy. *) 170 | " 171 | (get_uri api "glMapNamedBufferRange"), 172 | "\ 173 | let map_named_buffer_range = 174 | foreign ~stub \"glMapNamedBufferRange\" 175 | (int_as_uint @-> int @-> int @-> int_as_uint @-> returning (ptr void)) 176 | 177 | let map_named_buffer_range buffer offset len access kind = 178 | let len_bytes = ba_kind_byte_size kind * len in 179 | let p = map_named_buffer_range buffer offset len_bytes access in 180 | let p = coerce (ptr void) (access_ptr_typ_of_ba_kind kind) p in 181 | bigarray_of_ptr array1 len kind p 182 | " 183 | 184 | let glShaderSource api = str 185 | "\ 186 | val shader_source : int -> string -> unit 187 | (** {{:%s} 188 | [glShaderSource]} [shader source] *) 189 | " 190 | (get_uri api "glShaderSource"), 191 | "\ 192 | let shader_source = 193 | foreign ~stub \"glShaderSource\" 194 | (int_as_uint @-> int @-> ptr string @-> ptr void @-> returning void) 195 | 196 | let shader_source sh src = 197 | let src = allocate string src in 198 | shader_source sh 1 src null 199 | " 200 | 201 | let glTransformFeedbackVaryings api = str 202 | "\ 203 | val transform_feedback_varyings : int -> string list -> enum -> unit 204 | (** {{:%s} 205 | [glTransformFeedbackVaryings]} [program varyings bufferMode] *)" 206 | (get_uri api "glTransformFeedbackVaryings"), 207 | "\ 208 | let transform_feedback_varyings = 209 | foreign ~stub \"glTransformFeedbackVaryings\" 210 | (int_as_uint @-> int @-> ptr string @-> int_as_uint @-> returning void) 211 | 212 | let transform_feedback_varyings program varyings mode = 213 | let count = List.length varyings in 214 | let varyings = CArray.(start (of_list string varyings)) in 215 | transform_feedback_varyings program count varyings mode 216 | " 217 | 218 | let get api = function 219 | | "glCreateShaderProgramv" -> Some (glCreateShaderProgramv api) 220 | | "glDebugMessageCallback" -> Some (glDebugMessageCallback api) 221 | | "glGetUniformIndices" -> Some (glGetUniformIndices api) 222 | | "glMapBuffer" -> Some (glMapBuffer api) 223 | | "glMapNamedBuffer" -> Some (glMapNamedBuffer api) 224 | | "glMapBufferRange" -> Some (glMapBufferRange api) 225 | | "glMapNamedBufferRange" -> Some (glMapNamedBufferRange api) 226 | | "glShaderSource" -> Some (glShaderSource api) 227 | | "glTransformFeedbackVaryings" -> Some (glTransformFeedbackVaryings api) 228 | | _ -> None 229 | -------------------------------------------------------------------------------- /test/trigl4.ml: -------------------------------------------------------------------------------- 1 | (* 2 | Minimal Tgl4 example. This code is in the public domain. 3 | Draws a fantastic tri-colored triangle. 4 | 5 | Compile with: 6 | ocamlfind ocamlc -linkpkg -package result,tsdl,tgls.tgl4 -o trigl4.byte trigl4.ml 7 | ocamlfind ocamlopt -linkpkg -package result,tsdl,tgls.tgl4 -o trigl4.native \ 8 | trigl4.ml 9 | *) 10 | 11 | open Tsdl 12 | open Tgl4 13 | open Result 14 | 15 | let str = Printf.sprintf 16 | 17 | let ( >>= ) x f = match x with Ok v -> f v | Error _ as e -> e 18 | 19 | (* Helper functions. *) 20 | 21 | let bigarray_create k len = Bigarray.(Array1.create k c_layout len) 22 | 23 | let get_int = 24 | let a = bigarray_create Bigarray.int32 1 in 25 | fun f -> f a; Int32.to_int a.{0} 26 | 27 | let set_int = 28 | let a = bigarray_create Bigarray.int32 1 in 29 | fun f i -> a.{0} <- Int32.of_int i; f a 30 | 31 | let get_string len f = 32 | let a = bigarray_create Bigarray.char len in 33 | f a; Gl.string_of_bigarray a 34 | 35 | (* Shaders *) 36 | 37 | let glsl_version gl_version = match gl_version with 38 | | 3,2 -> "150" | 3,3 -> "330" 39 | | 4,0 -> "400" | 4,1 -> "410" | 4,2 -> "420" | 4,3 -> "430" | 4,4 -> "440" 40 | | _ -> assert false 41 | 42 | let vertex_shader v = str " 43 | #version %s core 44 | in vec3 vertex; 45 | in vec3 color; 46 | out vec4 v_color; 47 | void main() 48 | { 49 | v_color = vec4(color, 1.0); 50 | gl_Position = vec4(vertex, 1.0); 51 | }" v 52 | 53 | let fragment_shader v = str " 54 | #version %s core 55 | in vec4 v_color; 56 | out vec4 color; 57 | void main() { color = v_color; }" v 58 | 59 | (* Geometry *) 60 | 61 | let set_3d ba i x y z = 62 | let start = i * 3 in 63 | ba.{start} <- x; ba.{start + 1} <- y; ba.{start + 2} <- z 64 | 65 | let vertices = 66 | let vs = bigarray_create Bigarray.float32 (3 * 3) in 67 | set_3d vs 0 (-0.8) (-0.8) 0.0; 68 | set_3d vs 1 0.8 (-0.8) 0.0; 69 | set_3d vs 2 0.0 0.8 0.0; 70 | vs 71 | 72 | let colors = 73 | let cs = bigarray_create Bigarray.float32 (3 * 3) in 74 | set_3d cs 0 1.0 0.0 0.0; 75 | set_3d cs 1 0.0 1.0 0.0; 76 | set_3d cs 2 0.0 0.0 1.0; 77 | cs 78 | 79 | let indices = 80 | let is = bigarray_create Bigarray.int8_unsigned 3 in 81 | set_3d is 0 0 1 2; 82 | is 83 | 84 | (* OpenGL setup *) 85 | 86 | let create_buffer b = 87 | let id = get_int (Gl.gen_buffers 1) in 88 | let bytes = Gl.bigarray_byte_size b in 89 | Gl.bind_buffer Gl.array_buffer id; 90 | Gl.buffer_data Gl.array_buffer bytes (Some b) Gl.static_draw; 91 | id 92 | 93 | let delete_buffer bid = 94 | set_int (Gl.delete_buffers 1) bid 95 | 96 | let create_geometry () = 97 | let gid = get_int (Gl.gen_vertex_arrays 1) in 98 | let iid = create_buffer indices in 99 | let vid = create_buffer vertices in 100 | let cid = create_buffer colors in 101 | let bind_attrib id loc dim typ = 102 | Gl.bind_buffer Gl.array_buffer id; 103 | Gl.enable_vertex_attrib_array loc; 104 | Gl.vertex_attrib_pointer loc dim typ false 0 (`Offset 0); 105 | in 106 | Gl.bind_vertex_array gid; 107 | Gl.bind_buffer Gl.element_array_buffer iid; 108 | bind_attrib vid 0 3 Gl.float; 109 | bind_attrib cid 1 3 Gl.float; 110 | Gl.bind_vertex_array 0; 111 | Gl.bind_buffer Gl.array_buffer 0; 112 | Gl.bind_buffer Gl.element_array_buffer 0; 113 | Ok (gid, [iid; vid; cid]) 114 | 115 | let delete_geometry gid bids = 116 | set_int (Gl.delete_vertex_arrays 1) gid; 117 | List.iter delete_buffer bids; 118 | Ok () 119 | 120 | let compile_shader src typ = 121 | let get_shader sid e = get_int (Gl.get_shaderiv sid e) in 122 | let sid = Gl.create_shader typ in 123 | Gl.shader_source sid src; 124 | Gl.compile_shader sid; 125 | if get_shader sid Gl.compile_status = Gl.true_ then Ok sid else 126 | let len = get_shader sid Gl.info_log_length in 127 | let log = get_string len (Gl.get_shader_info_log sid len None) in 128 | (Gl.delete_shader sid; Error (`Msg log)) 129 | 130 | let create_program glsl_v = 131 | compile_shader (vertex_shader glsl_v) Gl.vertex_shader >>= fun vid -> 132 | compile_shader (fragment_shader glsl_v) Gl.fragment_shader >>= fun fid -> 133 | let pid = Gl.create_program () in 134 | let get_program pid e = get_int (Gl.get_programiv pid e) in 135 | Gl.attach_shader pid vid; Gl.delete_shader vid; 136 | Gl.attach_shader pid fid; Gl.delete_shader fid; 137 | Gl.bind_attrib_location pid 0 "vertex"; 138 | Gl.bind_attrib_location pid 1 "color"; 139 | Gl.link_program pid; 140 | if get_program pid Gl.link_status = Gl.true_ then Ok pid else 141 | let len = get_program pid Gl.info_log_length in 142 | let log = get_string len (Gl.get_program_info_log pid len None) in 143 | (Gl.delete_program pid; Error (`Msg log)) 144 | 145 | let delete_program pid = 146 | Gl.delete_program pid; Ok () 147 | 148 | let draw pid gid win = 149 | Gl.clear_color 0. 0. 0. 1.; 150 | Gl.clear Gl.color_buffer_bit; 151 | Gl.use_program pid; 152 | Gl.bind_vertex_array gid; 153 | Gl.draw_elements Gl.triangles 3 Gl.unsigned_byte (`Offset 0); 154 | Gl.bind_vertex_array 0; 155 | Sdl.gl_swap_window win; 156 | Ok () 157 | 158 | let reshape win w h = 159 | Gl.viewport 0 0 w h 160 | 161 | (* Window and OpenGL context *) 162 | 163 | let pp_opengl_info ppf () = 164 | let pp = Format.fprintf in 165 | let pp_opt ppf = function None -> pp ppf "error" | Some s -> pp ppf "%s" s in 166 | pp ppf "@[@,"; 167 | pp ppf "Renderer @[@[%a@]@," pp_opt (Gl.get_string Gl.renderer); 168 | pp ppf "@[OpenGL %a / GLSL %a@]@]@," 169 | pp_opt (Gl.get_string Gl.version) 170 | pp_opt (Gl.get_string Gl.shading_language_version); 171 | pp ppf "@]" 172 | 173 | let create_window ~gl:(maj, min) = 174 | let w_atts = Sdl.Window.(opengl + resizable) in 175 | let w_title = Printf.sprintf "OpenGL %d.%d (core profile)" maj min in 176 | let set a v = Sdl.gl_set_attribute a v in 177 | set Sdl.Gl.context_profile_mask Sdl.Gl.context_profile_core >>= fun () -> 178 | set Sdl.Gl.context_major_version maj >>= fun () -> 179 | set Sdl.Gl.context_minor_version min >>= fun () -> 180 | set Sdl.Gl.doublebuffer 1 >>= fun () -> 181 | Sdl.create_window ~w:640 ~h:480 w_title w_atts >>= fun win -> 182 | Sdl.gl_create_context win >>= fun ctx -> 183 | Sdl.gl_make_current win ctx >>= fun () -> 184 | Sdl.log "%a" pp_opengl_info (); 185 | Ok (win, ctx) 186 | 187 | let destroy_window win ctx = 188 | Sdl.gl_delete_context ctx; 189 | Sdl.destroy_window win; 190 | Ok () 191 | 192 | (* Event loop *) 193 | 194 | let event_loop win draw = 195 | let e = Sdl.Event.create () in 196 | let key_scancode e = Sdl.Scancode.enum Sdl.Event.(get e keyboard_scancode) in 197 | let event e = Sdl.Event.(enum (get e typ)) in 198 | let window_event e = Sdl.Event.(window_event_enum (get e window_event_id)) in 199 | let rec loop () = 200 | Sdl.wait_event (Some e) >>= fun () -> 201 | match event e with 202 | | `Quit -> Ok () 203 | | `Key_down when key_scancode e = `Escape -> Ok () 204 | | `Window_event -> 205 | begin match window_event e with 206 | | `Exposed | `Resized -> 207 | let w, h = Sdl.get_window_size win in 208 | reshape win w h; 209 | draw win; 210 | draw win; (* bug on osx ? *) 211 | loop () 212 | | _ -> loop () 213 | end 214 | | _ -> loop () 215 | in 216 | (draw win; loop ()) 217 | 218 | (* Main *) 219 | 220 | let tri ~gl:(maj, min as gl) = 221 | Sdl.init Sdl.Init.video >>= fun () -> 222 | create_window ~gl >>= fun (win, ctx) -> 223 | create_geometry () >>= fun (gid, bids) -> 224 | create_program (glsl_version gl) >>= fun pid -> 225 | event_loop win (draw pid gid) >>= fun () -> 226 | delete_program pid >>= fun () -> 227 | delete_geometry gid bids >>= fun () -> 228 | destroy_window win ctx >>= fun () -> 229 | Sdl.quit (); 230 | Ok () 231 | 232 | let main () = 233 | let exec = Filename.basename Sys.executable_name in 234 | let usage = str "Usage: %s [OPTION]\n Tests Tgl4.\nOptions:" exec in 235 | let minor = ref 0 in 236 | let options = 237 | [ "-minor", Arg.Set_int minor, 238 | " use Use an OpenGL 4.x context (defaults to 4.0)"; ] 239 | in 240 | let anon _ = raise (Arg.Bad "no arguments are supported") in 241 | Arg.parse (Arg.align options) anon usage; 242 | match tri ~gl:(4, !minor) with 243 | | Ok () -> exit 0 244 | | Error (`Msg msg) -> Sdl.log "%s@." msg; exit 1 245 | 246 | let () = main () 247 | -------------------------------------------------------------------------------- /test/trigl3.ml: -------------------------------------------------------------------------------- 1 | (* 2 | Minimal Tgl3 example. This code is in the public domain. 3 | Draws a fantastic tri-colored triangle. 4 | 5 | Compile with: 6 | ocamlfind ocamlc -linkpkg -package result,tsdl,tgls.tgl3 -o trigl3.byte trigl3.ml 7 | ocamlfind ocamlopt -linkpkg -package result,tsdl,tgls.tgl3 -o trigl3.native \ 8 | trigl3.ml 9 | *) 10 | 11 | open Tsdl 12 | open Tgl3 13 | open Result 14 | 15 | let str = Printf.sprintf 16 | 17 | let ( >>= ) x f = match x with Ok v -> f v | Error _ as e -> e 18 | 19 | (* Helper functions. *) 20 | 21 | let bigarray_create k len = Bigarray.(Array1.create k c_layout len) 22 | 23 | let get_int = 24 | let a = bigarray_create Bigarray.int32 1 in 25 | fun f -> f a; Int32.to_int a.{0} 26 | 27 | let set_int = 28 | let a = bigarray_create Bigarray.int32 1 in 29 | fun f i -> a.{0} <- Int32.of_int i; f a 30 | 31 | let get_string len f = 32 | let a = bigarray_create Bigarray.char len in 33 | f a; Gl.string_of_bigarray a 34 | 35 | (* Shaders *) 36 | 37 | let glsl_version gl_version = match gl_version with 38 | | 3,2 -> "150" | 3,3 -> "330" 39 | | 4,0 -> "400" | 4,1 -> "410" | 4,2 -> "420" | 4,3 -> "430" | 4,4 -> "440" 40 | | _ -> assert false 41 | 42 | let vertex_shader v = str " 43 | #version %s core 44 | in vec3 vertex; 45 | in vec3 color; 46 | out vec4 v_color; 47 | void main() 48 | { 49 | v_color = vec4(color, 1.0); 50 | gl_Position = vec4(vertex, 1.0); 51 | }" v 52 | 53 | let fragment_shader v = str " 54 | #version %s core 55 | in vec4 v_color; 56 | out vec4 color; 57 | void main() { color = v_color; }" v 58 | 59 | (* Geometry *) 60 | 61 | let set_3d ba i x y z = 62 | let start = i * 3 in 63 | ba.{start} <- x; ba.{start + 1} <- y; ba.{start + 2} <- z 64 | 65 | let vertices = 66 | let vs = bigarray_create Bigarray.float32 (3 * 3) in 67 | set_3d vs 0 (-0.8) (-0.8) 0.0; 68 | set_3d vs 1 0.8 (-0.8) 0.0; 69 | set_3d vs 2 0.0 0.8 0.0; 70 | vs 71 | 72 | let colors = 73 | let cs = bigarray_create Bigarray.float32 (3 * 3) in 74 | set_3d cs 0 1.0 0.0 0.0; 75 | set_3d cs 1 0.0 1.0 0.0; 76 | set_3d cs 2 0.0 0.0 1.0; 77 | cs 78 | 79 | let indices = 80 | let is = bigarray_create Bigarray.int8_unsigned 3 in 81 | set_3d is 0 0 1 2; 82 | is 83 | 84 | (* OpenGL setup *) 85 | 86 | let create_buffer b = 87 | let id = get_int (Gl.gen_buffers 1) in 88 | let bytes = Gl.bigarray_byte_size b in 89 | Gl.bind_buffer Gl.array_buffer id; 90 | Gl.buffer_data Gl.array_buffer bytes (Some b) Gl.static_draw; 91 | id 92 | 93 | let delete_buffer bid = 94 | set_int (Gl.delete_buffers 1) bid 95 | 96 | let create_geometry () = 97 | let gid = get_int (Gl.gen_vertex_arrays 1) in 98 | let iid = create_buffer indices in 99 | let vid = create_buffer vertices in 100 | let cid = create_buffer colors in 101 | let bind_attrib id loc dim typ = 102 | Gl.bind_buffer Gl.array_buffer id; 103 | Gl.enable_vertex_attrib_array loc; 104 | Gl.vertex_attrib_pointer loc dim typ false 0 (`Offset 0); 105 | in 106 | Gl.bind_vertex_array gid; 107 | Gl.bind_buffer Gl.element_array_buffer iid; 108 | bind_attrib vid 0 3 Gl.float; 109 | bind_attrib cid 1 3 Gl.float; 110 | Gl.bind_vertex_array 0; 111 | Gl.bind_buffer Gl.array_buffer 0; 112 | Gl.bind_buffer Gl.element_array_buffer 0; 113 | Ok (gid, [iid; vid; cid]) 114 | 115 | let delete_geometry gid bids = 116 | set_int (Gl.delete_vertex_arrays 1) gid; 117 | List.iter delete_buffer bids; 118 | Ok () 119 | 120 | let compile_shader src typ = 121 | let get_shader sid e = get_int (Gl.get_shaderiv sid e) in 122 | let sid = Gl.create_shader typ in 123 | Gl.shader_source sid src; 124 | Gl.compile_shader sid; 125 | if get_shader sid Gl.compile_status = Gl.true_ then Ok sid else 126 | let len = get_shader sid Gl.info_log_length in 127 | let log = get_string len (Gl.get_shader_info_log sid len None) in 128 | (Gl.delete_shader sid; Error (`Msg log)) 129 | 130 | let create_program glsl_v = 131 | compile_shader (vertex_shader glsl_v) Gl.vertex_shader >>= fun vid -> 132 | compile_shader (fragment_shader glsl_v) Gl.fragment_shader >>= fun fid -> 133 | let pid = Gl.create_program () in 134 | let get_program pid e = get_int (Gl.get_programiv pid e) in 135 | Gl.attach_shader pid vid; Gl.delete_shader vid; 136 | Gl.attach_shader pid fid; Gl.delete_shader fid; 137 | Gl.bind_attrib_location pid 0 "vertex"; 138 | Gl.bind_attrib_location pid 1 "color"; 139 | Gl.link_program pid; 140 | if get_program pid Gl.link_status = Gl.true_ then Ok pid else 141 | let len = get_program pid Gl.info_log_length in 142 | let log = get_string len (Gl.get_program_info_log pid len None) in 143 | (Gl.delete_program pid; Error (`Msg log)) 144 | 145 | let delete_program pid = 146 | Gl.delete_program pid; Ok () 147 | 148 | let draw pid gid win = 149 | Gl.clear_color 0. 0. 0. 1.; 150 | Gl.clear Gl.color_buffer_bit; 151 | Gl.use_program pid; 152 | Gl.bind_vertex_array gid; 153 | Gl.draw_elements Gl.triangles 3 Gl.unsigned_byte (`Offset 0); 154 | Gl.bind_vertex_array 0; 155 | Sdl.gl_swap_window win; 156 | Ok () 157 | 158 | let reshape win w h = 159 | Gl.viewport 0 0 w h 160 | 161 | (* Window and OpenGL context *) 162 | 163 | let pp_opengl_info ppf () = 164 | let pp = Format.fprintf in 165 | let pp_opt ppf = function None -> pp ppf "error" | Some s -> pp ppf "%s" s in 166 | pp ppf "@[@,"; 167 | pp ppf "Renderer @[@[%a@]@," pp_opt (Gl.get_string Gl.renderer); 168 | pp ppf "@[OpenGL %a / GLSL %a@]@]@," 169 | pp_opt (Gl.get_string Gl.version) 170 | pp_opt (Gl.get_string Gl.shading_language_version); 171 | pp ppf "@]" 172 | 173 | let create_window ~gl:(maj, min) = 174 | let w_atts = Sdl.Window.(opengl + resizable) in 175 | let w_title = Printf.sprintf "OpenGL %d.%d (core profile)" maj min in 176 | let set a v = Sdl.gl_set_attribute a v in 177 | set Sdl.Gl.context_profile_mask Sdl.Gl.context_profile_core >>= fun () -> 178 | set Sdl.Gl.context_major_version maj >>= fun () -> 179 | set Sdl.Gl.context_minor_version min >>= fun () -> 180 | set Sdl.Gl.doublebuffer 1 >>= fun () -> 181 | Sdl.create_window ~w:640 ~h:480 w_title w_atts >>= fun win -> 182 | Sdl.gl_create_context win >>= fun ctx -> 183 | Sdl.gl_make_current win ctx >>= fun () -> 184 | Sdl.log "%a" pp_opengl_info (); 185 | Ok (win, ctx) 186 | 187 | let destroy_window win ctx = 188 | Sdl.gl_delete_context ctx; 189 | Sdl.destroy_window win; 190 | Ok () 191 | 192 | (* Event loop *) 193 | 194 | let event_loop win draw = 195 | let e = Sdl.Event.create () in 196 | let key_scancode e = Sdl.Scancode.enum Sdl.Event.(get e keyboard_scancode) in 197 | let event e = Sdl.Event.(enum (get e typ)) in 198 | let window_event e = Sdl.Event.(window_event_enum (get e window_event_id)) in 199 | let rec loop () = 200 | ignore (Sdl.wait_event_timeout (Some e) 1); 201 | match event e with 202 | | `Quit -> Ok () 203 | | `Key_down when key_scancode e = `Escape -> Ok () 204 | | `Window_event -> 205 | begin match window_event e with 206 | | `Exposed | `Resized -> 207 | let w, h = Sdl.get_window_size win in 208 | reshape win w h; 209 | draw win; 210 | draw win; (* bug on osx ? *) 211 | loop () 212 | | _ -> loop () 213 | end 214 | | _ -> loop () 215 | in 216 | (draw win; loop ()) 217 | 218 | (* Main *) 219 | 220 | let tri ~gl:(maj, min as gl) = 221 | Sdl.init Sdl.Init.video >>= fun () -> 222 | create_window ~gl >>= fun (win, ctx) -> 223 | create_geometry () >>= fun (gid, bids) -> 224 | create_program (glsl_version gl) >>= fun pid -> 225 | event_loop win (draw pid gid) >>= fun () -> 226 | delete_program pid >>= fun () -> 227 | delete_geometry gid bids >>= fun () -> 228 | destroy_window win ctx >>= fun () -> 229 | Sdl.quit (); 230 | Ok () 231 | 232 | let main () = 233 | let exec = Filename.basename Sys.executable_name in 234 | let usage = str "Usage: %s [OPTION]\n Tests Tgl3.\nOptions:" exec in 235 | let minor = ref 2 in 236 | let options = 237 | [ "-minor", Arg.Set_int minor, 238 | " use Use an OpenGL 3.x context (defaults to 3.2)"; ] 239 | in 240 | let anon _ = raise (Arg.Bad "no arguments are supported") in 241 | Arg.parse (Arg.align options) anon usage; 242 | match tri ~gl:(3, !minor) with 243 | | Ok () -> exit 0 244 | | Error (`Msg msg) -> Sdl.log "%s@." msg; exit 1 245 | 246 | let () = main () 247 | -------------------------------------------------------------------------------- /support/capi.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2013 The tgls programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | let str = Printf.sprintf 7 | let pp = Format.fprintf 8 | 9 | (* Error strings *) 10 | 11 | let err_ext e = str "unknown extension (%s)" e 12 | let err_no_version api (maj, min) = 13 | let api = match api with 14 | | "gl" -> "OpenGL" | "gles1" | "gles2" -> "OpenGL ES" | api -> api 15 | in 16 | str "Unknown version %s %d.%d" api maj min 17 | 18 | let err_fun_defs f = str "Unsupported: function `%s' has multiple definitions" f 19 | let err_fun_undef f = str "No definition for function `%s'" f 20 | 21 | let err_base_type b = str "Unsupported: base type `%s'" b 22 | let err_base_type_undef b = str "No definition for base type `%s'" b 23 | let err_type t = str "Unsupported: type `%s'" t 24 | 25 | let err_enum_defs e = str "Unsupported: enum `%s' has multiple definitions" e 26 | let err_enum_undef e = str "No definition for enum `%s'" e 27 | let err_enum_parse e v t = str "Could not parse enum `%s' as `%s' (`%s')" e t v 28 | let err_enum_type t e = str "Unsupported: enum type `%s' for `%s'" t e 29 | 30 | (* String maps and sets *) 31 | 32 | module Smap = Map.Make(String) 33 | module Sset = struct 34 | include Set.Make(String) 35 | let map f s = fold (fun e acc -> add (f e) acc) s empty 36 | end 37 | 38 | (* API identifiers *) 39 | 40 | type version = int * int 41 | type id = [ `Gl of version | `Gles of version | `Ext of string ] 42 | 43 | let id_of_string s = 44 | let is_digit c = '0' <= c && c <= '9' in 45 | let int_of_digit c = Char.code c - Char.code '0' in 46 | match String.length s with 47 | | 3 (* glX *) -> 48 | if s.[0] = 'g' && s.[1] = 'l' && is_digit s.[2] 49 | then `Gl (int_of_digit s.[2], 0) 50 | else `Ext s 51 | | 5 (* glX.X or glesX *) -> 52 | if s.[0] = 'g' && s.[1] = 'l' && 53 | is_digit s.[2] && s.[3] = '.' && is_digit s.[4] 54 | then `Gl (int_of_digit s.[2], int_of_digit s.[4]) else 55 | if s.[0] = 'g' && s.[1] = 'l' && s.[2] = 'e' && s.[3] = 's' && 56 | is_digit s.[4] 57 | then `Gles (int_of_digit s.[4], 0) 58 | else `Ext s 59 | | 7 (* glesX.X *) -> 60 | if s.[0] = 'g' && s.[1] = 'l' && s.[2] = 'e' && s.[3] = 's' && 61 | is_digit s.[4] && s.[5] = '.' && is_digit s.[6] 62 | then `Gles (int_of_digit s.[4], int_of_digit s.[6]) 63 | else `Ext s 64 | | _ -> `Ext s 65 | 66 | (* Get C function and enum names for an API in the registry *) 67 | 68 | let with_interface_names op (funs, enums as acc) i = match i.Glreg.i_type with 69 | | `Command -> (op i.Glreg.i_name funs, enums) 70 | | `Enum -> (funs, op i.Glreg.i_name enums) 71 | | `Type (* useless in current registry *) -> acc 72 | 73 | let names_api_profile r ~api profile version = 74 | let features = try Hashtbl.find r.Glreg.features api with 75 | | Not_found -> assert false 76 | in 77 | if not (List.exists (fun f -> f.Glreg.f_number = version) features) 78 | then `Error (err_no_version api version) else 79 | (* Get all features smaller or equal to this version and sort them *) 80 | let keep_feature f = f.Glreg.f_number <= version in 81 | let sort_feature f f' = compare f.Glreg.f_number f'.Glreg.f_number in 82 | let features = List.sort sort_feature (List.filter keep_feature features) in 83 | let keep_interface i = 84 | let keep_for_api = match i.Glreg.i_api with 85 | | None -> true | Some api -> api = api 86 | in 87 | let keep_for_profile = match i.Glreg.i_profile with 88 | | None -> true | Some p -> p = profile 89 | in 90 | keep_for_api && keep_for_profile 91 | in 92 | let add_feature acc f = 93 | let adds = List.filter keep_interface f.Glreg.f_require in 94 | let rems = List.filter keep_interface f.Glreg.f_remove in 95 | let acc = List.fold_left (with_interface_names Sset.add) acc adds in 96 | let acc = List.fold_left (with_interface_names Sset.remove) acc rems in 97 | acc 98 | in 99 | `Ok (List.fold_left add_feature (Sset.empty, Sset.empty) features) 100 | 101 | let names_ext r ext profile = 102 | try 103 | (* doc says no removes in exts, altough this is allowed by the schema *) 104 | let x = Hashtbl.find r.Glreg.extensions ext in 105 | let acc = (Sset.empty, Sset.empty) in 106 | `Ok (List.fold_left (with_interface_names Sset.add) acc x.Glreg.x_require) 107 | with Not_found -> `Error (err_ext ext) 108 | 109 | let registry_api r id = match id with 110 | | `Gl _ -> "gl" 111 | | `Gles (1, _) -> "gles1" 112 | | `Gles _ -> "gles2" 113 | | `Ext e -> failwith "Extension support is TODO" 114 | 115 | let names r id profile = 116 | let api = registry_api r id in 117 | match id with 118 | | `Gl version -> names_api_profile r ~api profile version 119 | | `Gles (1, _ as version) -> names_api_profile r ~api profile version 120 | | `Gles version -> names_api_profile r ~api profile version 121 | | `Ext ext -> names_ext r ext profile 122 | 123 | (* Apis *) 124 | 125 | type t = 126 | { registry : Glreg.t; 127 | registry_api : string; 128 | id : id; 129 | profile : string option; 130 | fun_names : Sset.t; (* C functions names in the API. *) 131 | enum_names : Sset.t; (* C enumerants names in the API. *) } 132 | 133 | let create registry id profile = 134 | let registry_api = registry_api registry id in 135 | match names registry id profile with 136 | | `Error _ as e -> e 137 | | `Ok (fun_names, enum_names) -> 138 | let profile = match id with 139 | | `Ext _ | `Gles _ -> None | _ -> Some profile 140 | in 141 | `Ok { registry; registry_api; id; profile; fun_names; enum_names; } 142 | 143 | let id api = api.id 144 | let profile api = api.profile 145 | 146 | let lookup_fun registry f = 147 | try match Hashtbl.find registry.Glreg.commands f with 148 | | [cmd] -> cmd 149 | | _ -> failwith (err_fun_defs f) 150 | with Not_found -> failwith (err_fun_undef f) 151 | 152 | (* C types *) 153 | 154 | type base_type = 155 | [ `GLbitfield | `GLboolean | `GLbyte | `GLchar | `GLclampx | `GLdouble 156 | | `GLenum | `GLfixed | `GLfloat | `GLint | `GLint64 | `GLintptr | `GLshort 157 | | `GLsizei | `GLsizeiptr | `GLsync | `GLubyte | `GLuint | `GLuint64 158 | | `GLushort | `GLDEBUGPROC | `Void | `Void_or_index ] 159 | 160 | let base_type_to_string = function 161 | | `GLbitfield -> "GLbitfield" | `GLboolean -> "GLboolean" | `GLbyte -> "GLbyte" 162 | | `GLchar -> "GLchar" | `GLclampx -> "GLclampx" | `GLdouble -> "GLdouble" 163 | | `GLenum -> "GLenum" | `GLfixed -> "GLfixed" | `GLfloat -> "GLfloat" 164 | | `GLint -> "GLint" | `GLint64 -> "GLint64" | `GLintptr -> "GLintptr" 165 | | `GLshort -> "GLshort" | `GLsizei -> "GLsizei" | `GLsizeiptr -> "GLsizeiptr" 166 | | `GLsync -> "GLsync" | `GLubyte -> "GLubyte" | `GLuint -> "GLuint" 167 | | `GLuint64 -> "GLuint64" | `GLushort -> "GLushort" 168 | | `GLDEBUGPROC -> "GLDEBUGPROC" | `Void -> "void" 169 | | `Void_or_index -> "void_or_index" 170 | 171 | let base_type_of_string = function 172 | | "GLbitfield" -> `GLbitfield | "GLboolean" -> `GLboolean | "GLbyte" -> `GLbyte 173 | | "GLchar" -> `GLchar | "GLclampx" -> `GLclampx | "GLdouble" -> `GLdouble 174 | | "GLenum" -> `GLenum | "GLfixed" -> `GLfixed | "GLfloat" -> `GLfloat 175 | | "GLint" -> `GLint | "GLint64" -> `GLint64 | "GLintptr" -> `GLintptr 176 | | "GLshort" -> `GLshort | "GLsizei" -> `GLsizei | "GLsizeiptr" -> `GLsizeiptr 177 | | "GLsync" -> `GLsync | "GLubyte" -> `GLubyte | "GLuint" -> `GLuint 178 | | "GLuint64" -> `GLuint64 | "GLushort" -> `GLushort 179 | | "GLDEBUGPROC" -> `GLDEBUGPROC | "void" -> `Void 180 | | "void_or_index" -> `Void_or_index 181 | | b -> failwith (err_base_type b) 182 | 183 | let base_type_def api base = 184 | let b = base_type_to_string base in 185 | let defs = try Hashtbl.find api.registry.Glreg.types b with Not_found -> [] in 186 | let match_api t = t.Glreg.t_api = Some api.registry_api in 187 | match try Some (List.find match_api defs) with Not_found -> None with 188 | | Some d -> `Def d.Glreg.t_def 189 | | None -> 190 | let no_api t = t.Glreg.t_api = None in 191 | match try Some (List.find no_api defs) with Not_found -> None with 192 | | Some d -> `Def d.Glreg.t_def 193 | | None -> 194 | match base with 195 | | `Void -> `Builtin 196 | | _ -> failwith (err_base_type_undef b) 197 | 198 | type typ = 199 | [ `Base of base_type 200 | | `Ptr of typ 201 | | `Const of typ 202 | | `Nullable of typ ] 203 | 204 | let type_to_string t = 205 | let rec loop acc = function 206 | | `Base b -> acc ^ (base_type_to_string b) 207 | | `Ptr t -> (loop acc t) ^ " *" 208 | | `Const t -> "const " ^ (loop acc t) 209 | | `Nullable t -> "nullable " ^ (loop acc t) 210 | in 211 | loop "" t 212 | 213 | let typ nullable t = 214 | let const, typ = (* extract a possible const *) 215 | if String.length t <= 6 then `None, t else 216 | match String.sub t 0 6 with 217 | | "const " -> `Const, String.sub t 6 (String.length t - 6) 218 | | _ -> `None, t 219 | in 220 | let ptr, base = (* extract possible pointers. *) 221 | try 222 | let star = String.index typ '*' in 223 | let base = String.trim (String.sub typ 0 star) in 224 | match String.sub typ star (String.length typ - star) with 225 | | "*" -> `Ptr, base 226 | | "**" -> `Ptr_ptr, base 227 | | "*const*" -> `Ptr_const_ptr, base 228 | | _ -> failwith (err_type t) 229 | with Not_found -> `None, typ 230 | in 231 | let base = base_type_of_string base in 232 | let t = match const, ptr with 233 | | `None, `None -> `Base base 234 | | `None, `Ptr -> `Ptr (`Base base) 235 | | `None, `Ptr_ptr -> `Ptr (`Ptr (`Base base)) 236 | | `Const, `None -> `Base base 237 | | `Const, `Ptr -> `Const (`Ptr (`Base base)) 238 | | `Const, `Ptr_const_ptr -> `Const (`Ptr (`Const (`Ptr (`Base base)))) 239 | | _ -> failwith (err_type t) 240 | in 241 | if nullable then `Nullable t else t 242 | 243 | let types api = 244 | let fun_types api f = 245 | let cmd = lookup_fun api.registry f in 246 | let add_param acc (_, t) = Glreg.((t.p_nullable, t.p_type) :: acc) in 247 | let params = List.fold_left add_param [] cmd.Glreg.c_params in 248 | let params = if params = [] then [(false, "void")] else params in 249 | let ret = Glreg.(cmd.c_ret.p_nullable, cmd.c_ret.p_type) in 250 | List.rev (ret :: params) 251 | in 252 | let add_type acc t = if List.mem t acc then acc else t :: acc in 253 | let add_fun_types f acc = List.fold_left add_type acc (fun_types api f) in 254 | let types = List.sort compare (Sset.fold add_fun_types api.fun_names []) in 255 | List.map (fun (nullable, t) -> typ nullable t) types 256 | 257 | (* C functions *) 258 | 259 | type arg_len = 260 | [ `Arg of string | `Size of int | `Csize of string | `Other of string] 261 | 262 | type arg = 263 | { arg_name : string; 264 | arg_type : typ; 265 | arg_group : string option; 266 | arg_len : arg_len option } 267 | 268 | type func = string * (arg list * typ) 269 | 270 | let void_arg = 271 | { arg_name = ""; arg_type = `Base `Void; arg_group = None; arg_len = None } 272 | 273 | let parse_arg_len = function 274 | | None -> None 275 | | Some s -> 276 | try Some (`Size (int_of_string s)) with (* try with an integer *) 277 | | Failure _ -> 278 | try 279 | let lpar = String.index s '(' in (* COMPSIZE(...) *) 280 | let rpar = String.index s ')' in 281 | Some (`Csize (String.sub s (lpar + 1) (rpar - lpar - 1))) 282 | with Not_found -> 283 | try 284 | (* sometimes we have arg*{2,3,4} *) 285 | let _ = String.index s '*' in 286 | Some (`Other s) 287 | with 288 | | Not_found -> Some (`Arg s) 289 | 290 | let funs api = 291 | let open Glreg in (* only for record field access. *) 292 | let func f = 293 | let add_arg acc (arg_name, param) = 294 | let arg_type = typ param.p_nullable param.p_type in 295 | let arg_group = param.p_group in 296 | let arg_len = parse_arg_len (param.p_len) in 297 | { arg_name; arg_type; arg_group; arg_len } :: acc 298 | in 299 | let cmd = lookup_fun api.registry f in 300 | let args = List.fold_left add_arg [] cmd.c_params in 301 | let args = if args = [] then [ void_arg ] else args in 302 | let ret = typ cmd.c_ret.p_nullable cmd.c_ret.p_type in 303 | f, (List.rev args, ret) 304 | in 305 | List.map func (Sset.elements api.fun_names) 306 | 307 | (* C enumerations *) 308 | 309 | type enum_value = 310 | [ `GLenum of int | `GLenum_max | `GLuint64 of int64 | `GLuint of int32] 311 | 312 | type enum = string * enum_value 313 | 314 | let enums api = 315 | let enum e = 316 | let e_def = try begin match Hashtbl.find api.registry.Glreg.enums e with 317 | | [e] -> e 318 | | _ -> failwith (err_enum_defs e) 319 | end with Not_found -> failwith (err_enum_undef e) 320 | in 321 | let get f v t = try f v with Failure _ -> failwith (err_enum_parse e t v) in 322 | let v = e_def.Glreg.e_value in 323 | let v = match e_def.Glreg.e_type with 324 | | None -> 325 | (* FIXME (or not): hack for compiling on 32 bits platforms *) 326 | if v = "0xFFFFFFFF" && 327 | (e_def.Glreg.e_name = "GL_ALL_BARRIER_BITS" || 328 | e_def.Glreg.e_name = "GL_ALL_SHADER_BITS") 329 | then `GLenum_max 330 | else 331 | `GLenum (get int_of_string v "") 332 | | Some ("ull" as t) -> `GLuint64 (get Int64.of_string v t) 333 | | Some ("u" as t) -> `GLuint (get Int32.of_string v t) 334 | | Some t -> failwith (err_enum_type t e) 335 | in 336 | e, v 337 | in 338 | List.map enum (Sset.elements api.enum_names) 339 | -------------------------------------------------------------------------------- /support/gen.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2013 The tgls programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | let str = Printf.sprintf 7 | let pp = Format.fprintf 8 | let pp_nop ppf () = () 9 | let rec pp_list ?(pp_sep = Format.pp_print_cut) pp_v ppf = function 10 | | [] -> () 11 | | v :: vs -> 12 | pp_v ppf v; if vs <> [] then (pp_sep ppf (); pp_list ~pp_sep pp_v ppf vs) 13 | 14 | let pp_text ?(verb = false) ppf s = 15 | (* hint spaces and new lines with Format's funs *) 16 | let len = String.length s in 17 | let left = ref 0 in 18 | let right = ref 0 in 19 | let flush () = 20 | Format.pp_print_string ppf (String.sub s !left (!right - !left)); 21 | incr right; left := !right; 22 | in 23 | while (!right <> len) do 24 | if s.[!right] = '\n' then (flush (); Format.pp_force_newline ppf ()) else 25 | if s.[!right] = ' ' && not verb then 26 | (flush (); Format.pp_print_space ppf ()) 27 | else 28 | incr right 29 | done; 30 | if !left <> len then flush () 31 | 32 | (* Type generation. *) 33 | 34 | let pp_mli_type api ppf t = 35 | let pp_doc () = match t.Oapi.type_doc with 36 | | None -> () 37 | | Some t -> pp ppf "@[(** %s *)@]@,@," t 38 | in 39 | begin match t.Oapi.type_def with 40 | | `Builtin -> () 41 | | `Alias a -> pp ppf "@[type %s = %s@]@," t.Oapi.type_name a; pp_doc () 42 | | `Abstract _ -> pp ppf "@[type %s@]@," t.Oapi.type_name; pp_doc () 43 | end 44 | 45 | let pp_ml_type acc api ppf t = (* [acc] remembers views already printed *) 46 | begin match t.Oapi.type_def with 47 | | `Builtin -> () 48 | | `Alias a | `Abstract a -> 49 | pp ppf "@[type %s = %s@]@," t.Oapi.type_name a; 50 | end; 51 | begin match t.Oapi.type_ctypes with 52 | | `Builtin _ | `Builtin_wrap_in _ -> acc 53 | | `Def (n, s) -> 54 | if List.mem n acc then acc else (pp ppf "@[%s@]@,@," s; n :: acc) 55 | | `View (n, r, w, t) -> 56 | if List.mem n acc then acc else 57 | (pp ppf "@[let %s =@\n\ 58 | \ view ~read:%s@\n\ 59 | \ ~write:%s@\n\ 60 | \ %s@]@,@," n r w t; n :: acc) 61 | end 62 | 63 | let pp_ml_types api ppf l = 64 | let rec loop acc = function 65 | | t :: ts -> loop (pp_ml_type acc api ppf t) ts 66 | | [] -> () 67 | in 68 | loop [] l 69 | 70 | let sort_types ts = 71 | let compare t t' = 72 | (* Only [debug_proc] depends on the others, put it at the end. 73 | We then generate defs in the order given by this function. *) 74 | if t.Oapi.type_name = "debug_proc" then 1 else 75 | if t'.Oapi.type_name = "debug_proc" then -1 else 76 | compare t t' 77 | in 78 | List.sort compare ts 79 | 80 | (* Function generation. *) 81 | 82 | let pp_linked_fun_name ~log api ppf f = match Doc.man_uri api f with 83 | | Some uri -> pp ppf "@[{{:%s}@,[%s]}@]" uri f 84 | | None -> 85 | pp log "W: No documentation URI for function `%s'@." f; 86 | pp ppf "[%s]" f 87 | 88 | let pp_mli_fun ~log api ppf f = match f.Oapi.fun_def with 89 | | `Manual (mli, _) -> pp ppf "@[%a@]" (pp_text ~verb:true) mli 90 | | `Unbound _ -> assert false 91 | | `Unknown -> 92 | let cname, _ = f.Oapi.fun_c in 93 | pp log "W: `%s` unknown, generating failing stub.@\n" cname; 94 | pp ppf "@[val %s@ : unit@ -> unit@]@," f.Oapi.fun_name; 95 | pp ppf "(** @[\xE2\x9C\x98 %a *)@]@," (pp_linked_fun_name ~log api) cname 96 | | `Derived (args, ret) -> 97 | let pp_arg_typ ppf a = pp ppf "%s" Oapi.(a.arg_type.type_name) in 98 | let pp_arg_typ_sep ppf () = pp ppf " ->@ " in 99 | let pp_arg ppf a = match a.Oapi.arg_name with 100 | | "" -> pp ppf "()" 101 | | a -> pp ppf "%s" (Oapi.identifier a) 102 | in 103 | let pp_arg_sep ppf () = pp ppf "@ " in 104 | let pp_doc ppf d = match d with 105 | | None -> () | Some d -> pp ppf "@,@,@[%a@]" (pp_text ~verb:false) d 106 | in 107 | let fname = f.Oapi.fun_name in 108 | let cname, _ = f.Oapi.fun_c in 109 | pp ppf "@[<2>val %s@ : %a ->@ %s@]@," 110 | fname (pp_list ~pp_sep:pp_arg_typ_sep pp_arg_typ) args 111 | ret.Oapi.type_name; 112 | pp ppf "(** @[@[<2>%a@ [%a]@]%a *)@]@," 113 | (pp_linked_fun_name ~log api) cname 114 | (pp_list ~pp_sep:pp_arg_sep pp_arg) args 115 | pp_doc f.Oapi.fun_doc 116 | 117 | let ctypes_name t = match t.Oapi.type_ctypes with 118 | | `Builtin c | `Builtin_wrap_in (c, _) | `Def (c, _) | `View (c, _, _, _) -> c 119 | 120 | let must_wrap args = 121 | let must_wrap a = match Oapi.(a.arg_type.type_ctypes) with 122 | | `Builtin_wrap_in (c, _) -> true | _ -> false 123 | in 124 | List.exists must_wrap args 125 | 126 | let pp_arg_wrap ppf a = match Oapi.(a.arg_type.type_ctypes) with 127 | | `Builtin_wrap_in (_, pp_wrap) -> 128 | pp ppf "%a@," pp_wrap Oapi.(identifier a.arg_name) 129 | | _ -> () 130 | 131 | let pp_ml_fun ~log api ppf f = match f.Oapi.fun_def with 132 | | `Manual (_, ml) -> pp ppf "@[%a@]" (pp_text ~verb:true) ml 133 | | `Unbound _ -> assert false 134 | | `Unknown -> 135 | let cname, _ = f.Oapi.fun_c in 136 | pp ppf "@[<2>let %s _ =@ failwith \"%s\"@]@," f.Oapi.fun_name cname 137 | | `Derived (args, ret) -> 138 | let pp_arg_ctype ppf a = pp ppf "%s" (ctypes_name a.Oapi.arg_type) in 139 | let pp_sep ppf () = pp ppf " @@->@ " in 140 | let fname = f.Oapi.fun_name in 141 | let cname, _ = f.Oapi.fun_c in 142 | pp ppf "@[<2>let %s =@\n@[<2>foreign ~stub \"%s\"@ \ 143 | @[<1>(%a @@->@ returning %s)@]@]@]@," 144 | fname cname (pp_list ~pp_sep pp_arg_ctype) args (ctypes_name ret); 145 | if not (must_wrap args) then () else 146 | let pp_arg_name ppf a = pp ppf "%s" Oapi.(identifier a.arg_name) in 147 | pp ppf "@,@[<2>let %s @[%a@] =@\n@[%a@]@[<2>%s %a@]@]@," 148 | fname 149 | (pp_list ~pp_sep:Format.pp_print_space pp_arg_name) args 150 | (pp_list ~pp_sep:(fun ppf () -> ()) pp_arg_wrap) args 151 | fname 152 | (pp_list ~pp_sep:Format.pp_print_space pp_arg_name) args 153 | 154 | (* Enum generation *) 155 | 156 | let pp_ml_enum_value ppf = function 157 | | `GLenum e -> pp ppf "0x%X" e 158 | | `GLenum_max -> pp ppf "Int32.to_int 0xFFFF_FFFFl" 159 | | `GLuint i -> pp ppf "0x%lXl" i 160 | | `GLuint64 i -> pp ppf "0x%LXL" i 161 | 162 | let pp_mli_enum_type ppf = function 163 | | `GLenum e -> pp ppf "enum" 164 | | `GLenum_max -> pp ppf "enum" 165 | | `GLuint i -> pp ppf "int32" 166 | | `GLuint64 i -> pp ppf "int64" 167 | 168 | let pp_mli_enum api ppf e = 169 | pp ppf "@[val %s : %a@]@," 170 | e.Oapi.enum_name pp_mli_enum_type e.Oapi.enum_value 171 | 172 | let pp_ml_enum api ppf e = 173 | pp ppf "@[<2>let %s =@ %a@]" 174 | e.Oapi.enum_name pp_ml_enum_value e.Oapi.enum_value 175 | 176 | (* Module signature generation *) 177 | 178 | let pp_mli_module ~log ppf api = 179 | let synopsis = Oapi.doc_synopsis api in 180 | pp ppf 181 | "@[\ 182 | (** {1 %s} *)@,@,\ 183 | (** @[%s bindings.@,@,\ 184 | @[{{!%s.types}Types},@ {{!%s.funs}functions}@ and@ \ 185 | {{!%s.enums}enumerants}. *)\ 186 | @]@]@,\ 187 | module %s : sig@,@,\ 188 | \ (** {1:ba Bigarrays} *)@,@,\ 189 | \ type ('a, 'b) bigarray = ('a,'b, Bigarray.c_layout) \ 190 | Bigarray.Array1.t@,@,\ 191 | \ val bigarray_byte_size : ('a, 'b) bigarray -> int@,\ 192 | \ (** [bigarray_byte_size ba] is the size of [ba] in bytes. *)@,@,\ 193 | \ val string_of_bigarray : \ 194 | (char, Bigarray.int8_unsigned_elt) bigarray -> string@,\ 195 | \ (** [string_of_bigarray ba] is [ba] until the first ['\\x00'], as a \ 196 | string. *)@,@,\ 197 | \ (** {1:types Types} *)@,@,\ 198 | \ @[%a@]@,\ 199 | \ (** {1:funs Functions} *)@,@,\ 200 | \ @[%a@]@,\ 201 | \ (** {1:enums Enums} *)@,@,\ 202 | \ @[%a@]@,\ 203 | end@,@,@]" 204 | synopsis synopsis (Oapi.module_bind api) 205 | (Oapi.module_bind api) (Oapi.module_bind api) (Oapi.module_bind api) 206 | (pp_list ~pp_sep:pp_nop (pp_mli_type api)) 207 | (sort_types (Oapi.types api)) 208 | (pp_list (pp_mli_fun ~log api)) 209 | (Oapi.funs api) 210 | (pp_list (pp_mli_enum api)) 211 | (Oapi.enums api) 212 | 213 | let pp_api_mli ~log ppf api = 214 | Genpp.pp_license_header ppf (); 215 | Genpp.pp_mli_api_header ppf api; 216 | pp_mli_module ~log ppf api; 217 | Genpp.pp_mli_api_footer ppf api; 218 | () 219 | 220 | (* Module implementation generation *) 221 | 222 | let pp_ml_module ~log ppf api = 223 | pp ppf 224 | "@[\ 225 | open Ctypes@,\ 226 | open Foreign@,@,\ 227 | let from =@,\ 228 | \ if Sys.win32 then@,\ 229 | \ try@,\ 230 | \ Some (Dl.(dlopen ~filename:\"opengl32.dll\" ~flags:[ RTLD_NOW ]))@,\ 231 | \ with _ ->@,\ 232 | \ (* In case some setups don't have the standard [opengl32.dll],@,\ 233 | \ don't prevent running by failing at toplevel. *)@,\ 234 | \ None@,\ 235 | \ else None@,@,\ 236 | let abi =@,\ 237 | \ if Sys.win32 && Sys.word_size = 32 then@,\ 238 | \ (* On X86 (32-bit) under Windows, [opengl32.dll] uses the [__stdcall] FFI ABI.@,\ 239 | \ This is not the default for [libffi], so it may require passing a [~abi] paraameter.@,\ 240 | \ Just in case, we try to look for one procedure, and revert to default if it fails.@,\ 241 | \ In all other situations, we use the default FFI ABI. *)@,\ 242 | \ try@,\ 243 | \ ignore (foreign ?from ~abi:Libffi_abi.stdcall \"glClear\" (int @-> returning void))@,\ 244 | \ [@warning \"-5\"];@,\ 245 | \ Libffi_abi.stdcall@,\ 246 | \ with _ -> Libffi_abi.default_abi@,\ 247 | \ else Libffi_abi.default_abi@,@,\ 248 | let foreign ?stub ?check_errno ?release_runtime_lock f fn =@,\ 249 | \ if Sys.win32 then@,\ 250 | \ (* In [opengl32.dll], non OpenGL 1.1 procedures must be looked up up via [wglGetProcAddress].@,\ 251 | \ To simplify things, we don't hardcode the list but do a two-step auto-detection.@,\ 252 | \ Some functions can only be resolved after OpenGL is initialized, so we delay the@,\ 253 | \ lookup until the first call and cache the lookup result.*)@,\ 254 | \ let cache = ref None in@,\ 255 | \ fun x -> @,\ 256 | \ match !cache with@,\ 257 | \ | Some f -> f x@,\ 258 | \ | None ->@,\ 259 | \ try@,\ 260 | \ let fp = foreign ~abi ?from ~stub:false ?check_errno ?release_runtime_lock f fn in@,\ 261 | \ cache := Some fp;@,\ 262 | \ fp x@,\ 263 | \ with Dl.DL_error _ ->@,\ 264 | \ let ftyp = funptr_opt fn in@,\ 265 | \ match foreign ~abi ?from \"wglGetProcAddress\" (string @-> returning ftyp) f with@,\ 266 | \ | None -> failwith (\"Could not resolve OpenGL procedure \" ^ f)@,\ 267 | \ | Some fpp ->@,\ 268 | \ cache := Some fpp ;@,\ 269 | \ fpp x@,\ 270 | \ else foreign ~abi ?from ?stub ?check_errno ?release_runtime_lock f fn @,@,\ 271 | (* %s bindings *)@,@,\ 272 | module %s = struct@,@,\ 273 | \ (* Bigarrays *)@,@,\ 274 | \ type ('a, 'b) bigarray = ('a,'b, Bigarray.c_layout) \ 275 | Bigarray.Array1.t@,@,\ 276 | \ let ba_kind_byte_size : ('a, 'b) Bigarray.kind -> int = fun k ->@,\ 277 | \ let open Bigarray in@,\ 278 | \ (* FIXME: see http://caml.inria.fr/mantis/view.php?id=6263 *)@,\ 279 | \ match Obj.magic k with@,\ 280 | \ | k when k = char || k = int8_signed || k = int8_unsigned -> 1@,\ 281 | \ | k when k = int16_signed || k = int16_unsigned -> 2@,\ 282 | \ | k when k = int32 || k = float32 -> 4@,\ 283 | \ | k when k = float64 || k = int64 || k = complex32 -> 8@,\ 284 | \ | k when k = complex64 -> 16@,\ 285 | \ | k when k = int || k = nativeint -> Sys.word_size / 8@,\ 286 | \ | k -> assert false@,@,\ 287 | \ let bigarray_byte_size ba =@,\ 288 | \ let el_size = ba_kind_byte_size (Bigarray.Array1.kind ba) in@,\ 289 | \ el_size * Bigarray.Array1.dim ba@,@,\ 290 | \ let access_ptr_typ_of_ba_kind : ('a, 'b) Bigarray.kind -> 'a ptr typ =@,\ 291 | \ fun k ->@,\ 292 | \ let open Bigarray in@,\ 293 | \ (* FIXME: use typ_of_bigarray_kind when ctypes support it. *)@,\ 294 | \ match Obj.magic k with@,\ 295 | \ | k when k = float32 -> Obj.magic (ptr Ctypes.float)@,\ 296 | \ | k when k = float64 -> Obj.magic (ptr Ctypes.double)@,\ 297 | \ | k when k = complex32 -> Obj.magic (ptr Ctypes.complex32)@,\ 298 | \ | k when k = complex64 -> Obj.magic (ptr Ctypes.complex64)@,\ 299 | \ | k when k = int8_signed -> Obj.magic (ptr Ctypes.int8_t)@,\ 300 | \ | k when k = int8_unsigned -> Obj.magic (ptr Ctypes.uint8_t)@,\ 301 | \ | k when k = int16_signed -> Obj.magic (ptr Ctypes.int16_t)@,\ 302 | \ | k when k = int16_unsigned -> Obj.magic (ptr Ctypes.uint16_t)@,\ 303 | \ | k when k = int -> Obj.magic (ptr Ctypes.camlint)@,\ 304 | \ | k when k = int32 -> Obj.magic (ptr Ctypes.int32_t)@,\ 305 | \ | k when k = int64 -> Obj.magic (ptr Ctypes.int64_t)@,\ 306 | \ | k when k = nativeint -> Obj.magic (ptr Ctypes.nativeint)@,\ 307 | \ | k when k = char -> Obj.magic (ptr Ctypes.char)@,\ 308 | \ | _ -> assert false@,@,\ 309 | \ let string_of_bigarray ba =@,\ 310 | \ let len = Bigarray.Array1.dim ba in@,\ 311 | \ let b = Buffer.create (len - 1) in@,\ 312 | \ try@,\ 313 | \ for i = 0 to len - 1 do@,\ 314 | \ if ba.{i} = '\\x00' then raise Exit else Buffer.add_char b \ 315 | ba.{i}@,\ 316 | \ done;@,\ 317 | \ raise Exit;@,\ 318 | \ with Exit -> Buffer.contents b@,@,\ 319 | \ (* Types *)@,@,\ 320 | \ @[%a@]@,\ 321 | \ (* Functions *)@,@,\ 322 | \ let stub = true (* If changed, will need updating Windows specific [foreign]. *)@,@,\ 323 | \ @[%a@]@,@,\ 324 | \ (* Enums *)@,@,\ 325 | \ @[%a@]@,\ 326 | end@,@]" 327 | (Oapi.doc_synopsis api) (Oapi.module_bind api) 328 | (pp_ml_types api) 329 | (sort_types (Oapi.types api)) 330 | (pp_list (pp_ml_fun ~log api)) 331 | (Oapi.funs api) 332 | (pp_list (pp_ml_enum api)) 333 | (Oapi.enums api) 334 | 335 | let pp_api_ml ~log ppf api = 336 | Genpp.pp_license_header ppf (); 337 | pp_ml_module ~log ppf api; 338 | () 339 | -------------------------------------------------------------------------------- /support/glreg.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2013 The tgls programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | let str = Printf.sprintf 7 | let str_of_name (u,l) = str "{%s}%s" u l 8 | let split_string s sep = 9 | let rec split accum j = 10 | let i = try (String.rindex_from s j sep) with Not_found -> -1 in 11 | if (i = -1) then 12 | let p = String.sub s 0 (j + 1) in 13 | if p <> "" then p :: accum else accum 14 | else 15 | let p = String.sub s (i + 1) (j - i) in 16 | let accum' = if p <> "" then p :: accum else accum in 17 | split accum' (i - 1) 18 | in 19 | split [] (String.length s - 1) 20 | 21 | (* Error messages *) 22 | 23 | let err s = failwith s 24 | let err_group_def n = str "group %s already defined" n 25 | let err_enum_def n = str "enum %s already defined" n 26 | let err_ext_def n = str "extension %s already defined" n 27 | let err_vnum n = str "cannot parse X.Y version number (%s)" n 28 | let err_data = "character data not allowed here" 29 | let err_exp_el_end = "expected end of element" 30 | let err_exp_data = "expected character data" 31 | let err_wf = "document not well formed" 32 | let err_miss_att n = str "missing attribute (%s)" (str_of_name n) 33 | let err_miss_el n = str "missing element (%s)" (str_of_name n) 34 | let err_exp_registry f = 35 | str "expected registry element found %s" (str_of_name f) 36 | 37 | (* Registry representation *) 38 | 39 | type typ = 40 | { t_name : string; 41 | t_api : string option; 42 | t_requires : string option; 43 | t_def : string; } 44 | 45 | type group = 46 | { g_name : string; 47 | g_enums : string list; } 48 | 49 | type enum = 50 | { e_name : string; 51 | e_p_namespace : string; 52 | e_p_type : string option; 53 | e_p_group : string option; 54 | e_p_vendor : string option; 55 | e_value : string; 56 | e_api : string option; 57 | e_type : string option; 58 | e_alias : string option; } 59 | 60 | type param_type = 61 | { p_group : string option; 62 | p_type : string; 63 | p_len : string option; 64 | p_nullable : bool; } 65 | 66 | type command = 67 | { c_name : string; 68 | c_p_namespace : string; 69 | c_ret : param_type; 70 | c_params : (string * param_type) list; 71 | c_alias : string option; 72 | c_vec_equiv : string option; } 73 | 74 | type i_element = 75 | { i_name : string; 76 | i_type : [ `Enum | `Command | `Type ]; 77 | i_api : string option; 78 | i_profile : string option; } 79 | 80 | type feature = 81 | { f_api : string; 82 | f_number : int * int; 83 | f_require : i_element list; 84 | f_remove : i_element list; } 85 | 86 | type extension = 87 | { x_name : string; 88 | x_supported : string option; 89 | x_require : i_element list; 90 | x_remove : i_element list; } 91 | 92 | type t = 93 | { types : (string, typ list) Hashtbl.t; 94 | groups : (string, group) Hashtbl.t; 95 | enums : (string, enum list) Hashtbl.t; 96 | commands : (string, command list) Hashtbl.t; 97 | features : (string, feature list) Hashtbl.t; 98 | extensions : (string, extension) Hashtbl.t; } 99 | 100 | let add err_def ht n v = 101 | try ignore (Hashtbl.find ht n); err (err_def n) with 102 | | Not_found -> Hashtbl.add ht n v 103 | 104 | let add_list ht n v = 105 | try Hashtbl.replace ht n (v :: (Hashtbl.find ht n)) 106 | with Not_found -> Hashtbl.add ht n [v] 107 | 108 | let add_type r n t = add_list r.types n t 109 | let add_group r n g = add err_group_def r.groups n g 110 | let add_enum r n e = add_list r.enums n e 111 | let add_command r n c = add_list r.commands n c 112 | let add_feature r n f = add_list r.features n f 113 | let add_extension r n x = add err_ext_def r.extensions n x 114 | 115 | (* Decode *) 116 | 117 | (* XML names *) 118 | 119 | let ns_gl = "" 120 | let n_alias = (ns_gl, "alias") 121 | let n_api = (ns_gl, "api") 122 | let n_commands = (ns_gl, "commands") 123 | let n_command = (ns_gl, "command") 124 | let n_comment = (ns_gl, "comment") 125 | let n_enum = (ns_gl, "enum") 126 | let n_enums = (ns_gl, "enums") 127 | let n_extensions = (ns_gl, "extensions") 128 | let n_extension = (ns_gl, "extension") 129 | let n_feature = (ns_gl, "feature") 130 | let n_group = (ns_gl, "group") 131 | let n_groups = (ns_gl, "groups") 132 | let n_len = (ns_gl, "len") 133 | let n_name = (ns_gl, "name") 134 | let n_namespace = (ns_gl, "namespace") 135 | let n_number = (ns_gl, "number") 136 | let n_param = (ns_gl, "param") 137 | let n_proto = (ns_gl, "proto") 138 | let n_profile = (ns_gl, "profile") 139 | let n_ptype = (ns_gl, "ptype") 140 | let n_registry = (ns_gl, "registry") 141 | let n_requires = (ns_gl, "requires") 142 | let n_require = (ns_gl, "require") 143 | let n_remove = (ns_gl, "remove") 144 | let n_supported = (ns_gl, "supported") 145 | let n_type = (ns_gl, "type") 146 | let n_types = (ns_gl, "types") 147 | let n_value = (ns_gl, "value") 148 | let n_vecequiv = (ns_gl, "vecequiv") 149 | let n_vendor = (ns_gl, "vendor") 150 | 151 | let attv n atts = (* value of attribute [n] in atts or raises. *) 152 | try snd (List.find (fun (en, v) -> en = n) atts) with 153 | | Not_found -> err (err_miss_att n) 154 | 155 | let attv_opt n atts = (* value of attribute [n] in atts, if any. *) 156 | try Some (snd (List.find (fun (en, v) -> en = n) atts)) with 157 | | Not_found -> None 158 | 159 | let rec skip_el d = (* skips an element, start signal was input. *) 160 | let rec loop d depth = match Xmlm.input d with 161 | | `El_start _ -> loop d (depth + 1) 162 | | `El_end -> if depth = 0 then () else loop d (depth - 1) 163 | | s -> loop d depth 164 | in 165 | loop d 0 166 | 167 | let p_data d = match Xmlm.input d with (* gets data and parses end signal. *) 168 | | `Data data -> 169 | begin match Xmlm.input d with 170 | | `El_end -> data 171 | | _ -> err err_exp_el_end 172 | end 173 | | _ -> err err_exp_data 174 | 175 | let p_seq r d n p_el = 176 | let rec loop r d = match Xmlm.input d with 177 | | `El_end -> () 178 | | `El_start (n, atts) when n = n -> p_el r d atts; loop r d 179 | | `El_start _ -> skip_el d; loop r d 180 | | `Data _ -> err err_data 181 | | _ -> assert false 182 | in 183 | loop r d 184 | 185 | let p_type r d atts = 186 | let t_name = ref (attv_opt n_name atts) in 187 | let t_requires = attv_opt n_requires atts in 188 | let t_api = attv_opt n_api atts in 189 | let def = Buffer.create 255 in 190 | let rec loop r d = match Xmlm.input d with 191 | | `El_start (n, _) when n = n_name -> t_name := Some (p_data d); loop r d 192 | | `El_start (n, _) -> skip_el d; loop r d 193 | | `El_end -> 194 | let t_name = match !t_name with None -> "" | Some name -> name in 195 | let t_def = 196 | let d = Buffer.contents def in 197 | let d = if String.length d <= 8 then d else match String.sub d 0 8 with 198 | | "typedef " -> String.sub d 8 (String.length d - 8 - 1) | _ -> d 199 | in 200 | try String.sub d 0 (String.rindex d ';') with Not_found -> d 201 | in 202 | add_type r t_name { t_name; t_api; t_requires; t_def; } 203 | | `Data s -> Buffer.add_string def s; loop r d 204 | | _ -> assert false 205 | in 206 | loop r d 207 | 208 | let p_group r d atts = 209 | let g_name = attv n_name atts in 210 | let rec loop acc r d = match Xmlm.input d with 211 | | `El_start (n, atts) when n = n_enum -> 212 | begin match Xmlm.input d with 213 | | `El_end -> loop ((attv n_name atts) :: acc) r d 214 | | _ -> err err_exp_el_end 215 | end 216 | | `El_start _ -> skip_el d; loop acc r d 217 | | `El_end -> 218 | add_group r g_name { g_name; g_enums = (List.rev acc); } 219 | | `Data _ -> err err_data 220 | | _ -> assert false 221 | in 222 | loop [] r d 223 | 224 | let p_enums r d atts = 225 | let e_p_namespace = attv n_namespace atts in 226 | let e_p_type = attv_opt n_type atts in 227 | let e_p_group = attv_opt n_group atts in 228 | let e_p_vendor = attv_opt n_type atts in 229 | let rec loop r d = match Xmlm.input d with 230 | | `El_start (n, atts) when n = n_enum -> 231 | begin match Xmlm.input d with 232 | | `El_end -> 233 | let e_name = attv n_name atts in 234 | let e_value = attv n_value atts in 235 | let e_api = attv_opt n_api atts in 236 | let e_type = attv_opt n_type atts in 237 | let e_alias = attv_opt n_alias atts in 238 | let e = { e_name; e_p_namespace; e_p_group; e_p_type; e_p_vendor; 239 | e_value; e_api; e_type; e_alias; } 240 | in 241 | add_enum r e_name e; 242 | loop r d 243 | | _ -> err err_exp_el_end 244 | end 245 | | `El_start _ -> skip_el d; loop r d 246 | | `El_end -> () 247 | | `Data _ -> err err_data 248 | | _ -> assert false 249 | in 250 | loop r d 251 | 252 | let p_param r d atts = 253 | let p_group = attv_opt n_group atts in 254 | let p_len = attv_opt n_len atts in 255 | let p_type = Buffer.create 255 in 256 | let name = ref None in 257 | let rec loop r d = match Xmlm.input d with 258 | | `El_start (n, _) when n = n_name -> name := Some (p_data d); loop r d 259 | | `El_start (n, _) when n = n_ptype -> 260 | if Buffer.length p_type <> 0 then Buffer.add_char p_type ' '; 261 | Buffer.add_string p_type (p_data d); loop r d 262 | | `El_end -> 263 | let name = match !name with 264 | | None -> err (err_miss_el n_name) 265 | | Some name -> name 266 | in 267 | let p_type = Buffer.contents p_type in 268 | name, { p_group; p_type; p_len; p_nullable = false; } 269 | | `Data s -> 270 | if Buffer.length p_type <> 0 && s <> "" then Buffer.add_char p_type ' '; 271 | Buffer.add_string p_type s; loop r d 272 | | _ -> assert false 273 | in 274 | loop r d 275 | 276 | let p_command c_p_namespace r d atts = 277 | let c_proto = ref None in 278 | let c_params = ref [] in 279 | let c_alias = ref None in 280 | let c_vec_equiv = ref None in 281 | let rec loop r d = match Xmlm.input d with 282 | | `El_start (n, atts) when n = n_proto -> 283 | c_proto := Some (p_param r d atts); loop r d 284 | | `El_start (n, atts) when n = n_param -> 285 | c_params := (p_param r d atts) :: !c_params; loop r d 286 | | `El_start (n, atts) when n = n_alias -> 287 | c_alias := Some (attv n_name atts); skip_el d; loop r d 288 | | `El_start (n, atts) when n = n_vecequiv -> 289 | c_vec_equiv := Some (attv n_name atts); skip_el d; loop r d 290 | | `El_start _ -> 291 | skip_el d; loop r d 292 | | `El_end -> 293 | let c_name, c_ret = match !c_proto with 294 | | None -> err (err_miss_el n_proto) | Some v -> v 295 | in 296 | (* add info not present in the registry. *) 297 | let add_miss_arg f (arg, p) = 298 | let p = 299 | if not (Fixreg.is_arg_nullable f arg) then p else 300 | { p with p_nullable = true } 301 | in 302 | let p = 303 | if not (Fixreg.is_arg_voidp_or_index f arg) then p else 304 | let l = String.index p.p_type 'd' in (* void -> void_or_index *) 305 | { p with p_type = (String.sub p.p_type 0 (l + 1)) ^ "_or_index" ^ 306 | (String.sub p.p_type (l + 1) 307 | (String.length p.p_type - l - 1)) } 308 | in 309 | (arg, p) 310 | in 311 | let add_miss_ret f p = 312 | if Fixreg.is_ret_nullable f then {p with p_nullable = true} else p 313 | in 314 | add_command r c_name 315 | { c_name; c_p_namespace; 316 | c_ret = add_miss_ret c_name c_ret; 317 | c_params = List.rev_map (add_miss_arg c_name) (!c_params); 318 | c_alias = !c_alias; c_vec_equiv = !c_vec_equiv; } 319 | | `Data _ -> err err_data 320 | | _ -> assert false 321 | in 322 | loop r d 323 | 324 | let p_version s = 325 | let l = String.length s in 326 | try 327 | let d = String.rindex s '.' in 328 | int_of_string (String.sub s 0 d), 329 | int_of_string (String.sub s (d + 1) (l - d - 1)) 330 | with _ -> err (err_vnum s) 331 | 332 | let p_i_elements d atts acc = 333 | let i_api = attv_opt n_api atts in 334 | let i_profile = attv_opt n_profile atts in 335 | let p_element d i_type atts = 336 | let i_name = attv n_name atts in 337 | begin match Xmlm.input d with 338 | | `El_end -> { i_type; i_name; i_api; i_profile } 339 | | _ -> err (err_exp_el_end) 340 | end 341 | in 342 | let rec loop acc d = match Xmlm.input d with 343 | | `El_start (n, atts) when n = n_enum -> 344 | loop ((p_element d `Enum atts) :: acc) d 345 | | `El_start (n, atts) when n = n_command -> 346 | loop ((p_element d `Command atts) :: acc) d 347 | | `El_start (n, atts) when n = n_type -> 348 | loop ((p_element d `Type atts) :: acc) d 349 | | `El_start _ -> skip_el d; loop acc d 350 | | `El_end -> acc 351 | | _ -> assert false 352 | in 353 | loop acc d 354 | 355 | let p_feature r d atts = 356 | let f_api = attv n_api atts in 357 | let f_number = p_version (attv n_number atts) in 358 | let f_require = ref [] in 359 | let f_remove = ref [] in 360 | let rec loop r d = match Xmlm.input d with 361 | | `El_start (n, atts) when n = n_require -> 362 | f_require := p_i_elements d ((n_api, f_api) :: atts) !f_require; loop r d 363 | | `El_start (n, atts) when n = n_remove -> 364 | f_remove := p_i_elements d ((n_api, f_api) :: atts) !f_remove; loop r d 365 | | `El_start _ -> skip_el d 366 | | `El_end -> 367 | add_feature r f_api 368 | { f_api; f_number; f_require = !f_require; f_remove = !f_remove } 369 | | `Data _ -> err err_data 370 | | _ -> assert false 371 | in 372 | loop r d 373 | 374 | let p_extension r d atts = 375 | let x_name = attv n_name atts in 376 | let x_supported = attv_opt n_supported atts in 377 | let x_require = ref [] in 378 | let x_remove = ref [] in 379 | let rec loop r d = match Xmlm.input d with 380 | | `El_start (n, atts) when n = n_require -> 381 | x_require := p_i_elements d atts !x_require; loop r d 382 | | `El_start (n, atts) when n = n_remove -> 383 | x_remove := p_i_elements d atts !x_remove; loop r d 384 | | `El_start _ -> skip_el d 385 | | `El_end -> 386 | add_extension r x_name 387 | { x_name; x_supported; x_require = !x_require; x_remove = !x_remove } 388 | | `Data _ -> err err_data 389 | | _ -> assert false 390 | in 391 | loop r d 392 | 393 | let p_registry d = 394 | let r = 395 | { types = Hashtbl.create 503; 396 | groups = Hashtbl.create 503; 397 | enums = Hashtbl.create 6047; 398 | commands = Hashtbl.create 10047; 399 | features = Hashtbl.create 97; 400 | extensions = Hashtbl.create 1003; } 401 | in 402 | while (Xmlm.peek d <> `El_end) do match Xmlm.input d with 403 | | `El_start (n, _) when n = n_types -> p_seq r d n_type p_type 404 | | `El_start (n, _) when n = n_groups -> p_seq r d n_group p_group 405 | | `El_start (n, atts) when n = n_enums -> p_enums r d atts 406 | | `El_start (n, atts) when n = n_commands -> 407 | let ns = attv n_namespace atts in 408 | p_seq r d n_command (p_command ns) 409 | | `El_start (n, atts) when n = n_feature -> p_feature r d atts 410 | | `El_start (n, atts) when n = n_extensions -> 411 | p_seq r d n_extension p_extension 412 | | `El_start (n, _) -> skip_el d 413 | | `Data _ -> err err_data 414 | | _ -> assert false; 415 | done; 416 | ignore (Xmlm.input d); 417 | if not (Xmlm.eoi d) then err err_wf; 418 | r 419 | 420 | type src = [ `Channel of in_channel | `String of string ] 421 | type decoder = Xmlm.input 422 | 423 | let decoder src = 424 | let src = match src with `String s -> `String (0, s) | `Channel _ as s -> s in 425 | Xmlm.make_input ~strip:true src 426 | 427 | let decoded_range d = Xmlm.pos d, Xmlm.pos d 428 | let decode d = try 429 | ignore (Xmlm.input d); (* `Dtd *) 430 | begin match Xmlm.input d with 431 | | `El_start (n, _) when n = n_registry -> `Ok (p_registry d) 432 | | `El_start (n, _) -> err (err_exp_registry n) 433 | | _ -> assert false 434 | end; 435 | with 436 | | Failure e -> `Error e | Xmlm.Error (_, e) -> `Error (Xmlm.error_message e) 437 | -------------------------------------------------------------------------------- /support/oapi.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2013 The tgls programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | let str = Printf.sprintf 7 | let pp = Format.fprintf 8 | 9 | (* Error string *) 10 | 11 | let err_odd_fname f = str "Odd function name for OpenGL: `%s'" f 12 | let err_odd_ename e = str "Odd enumerant name for OpenGL: `%s'" e 13 | let err_no_type_def t = str "No OCaml type definition for %s" t 14 | 15 | (* String maps and sets *) 16 | 17 | module Smap = Map.Make(String) 18 | module Sset = struct 19 | include Set.Make(String) 20 | let map f s = fold (fun e acc -> add (f e) acc) s empty 21 | end 22 | 23 | (* API *) 24 | 25 | type t = Capi.t 26 | 27 | let doc_synopsis api = match Capi.id api with 28 | | `Gl (maj, 0) -> str "OpenGL %d" maj 29 | | `Gl (maj, _) -> str "OpenGL %d.x" maj 30 | | `Gles (maj, 0) -> str "OpenGL ES %d" maj 31 | | `Gles (maj, _) -> str "OpenGL ES %d.x" maj 32 | | `Ext e -> e 33 | 34 | let doc_synopsis_long api = 35 | let mins x y = if y = 0 then str "%d" x else str "%d.0 to %d.%d" x x y in 36 | match Capi.id api with 37 | | `Gl (3, 2) -> str "OpenGL 3.2" 38 | | `Gl (3, 3) -> str "OpenGL 3.2 and 3.3" 39 | | `Gl (maj, min) -> str "OpenGL %s" (mins maj min) 40 | | `Gles (maj, min) -> str "OpenGL ES %s" (mins maj min) 41 | | `Ext e -> e 42 | 43 | (* OCaml identifiers 44 | add '_' to keywords, prefix with '_' if not lowercase start *) 45 | let identifier = function 46 | | "and" | "as" | "assert" | "asr" | "begin" | "class" 47 | | "constraint" | "do" | "done" | "downto" | "else" 48 | | "end"| "exception" | "external" | "false" | "for" | "fun" | "function" 49 | | "functor" | "if" | "in" | "include" | "inherit" | "initializer" 50 | | "land" | "lazy" | "let" | "lor" | "lsl" | "lsr" | "lxor" 51 | | "match" | "method" | "mod" | "module" | "mutable" | "new" 52 | | "object" | "of" | "open" | "or" | "private" | "rec" | "sig" 53 | | "struct" | "then" | "to" | "true" | "try" | "type" | "val" 54 | | "virtual" | "when" | "while" | "with" as id -> id ^ "_" 55 | | name -> if 'a' <= name.[0] && name.[0] <= 'z' then name else "_" ^ name 56 | 57 | (* Modules *) 58 | 59 | let module_lib api = match (Capi.id api) with 60 | | `Gles (m, _) -> str "Tgles%d" m 61 | | `Gl (m, _) -> str "Tgl%d" m 62 | | `Ext e -> str "T%s" (String.lowercase_ascii e) 63 | 64 | let module_bind api = match (Capi.id api) with 65 | | `Gles _ | `Gl _ -> "Gl" 66 | | `Ext e -> String.capitalize_ascii (String.lowercase_ascii e) 67 | 68 | (* Types *) 69 | 70 | type ctypes = 71 | [ `Builtin of string 72 | | `View of string * string * string * string 73 | | `Builtin_wrap_in of string * (Format.formatter -> string -> unit) 74 | | `Def of string * string ] 75 | 76 | type typ = 77 | { type_name : string; 78 | type_def : [ `Alias of string | `Abstract of string | `Builtin ]; 79 | type_ctypes : ctypes; 80 | type_doc : string option; } 81 | 82 | let bool = 83 | { type_name = "bool"; 84 | type_def = `Builtin; 85 | type_ctypes = `View ("bool", 86 | "(fun u -> Unsigned.UChar.(compare u zero <> 0))", 87 | "(fun b -> Unsigned.UChar.(of_int \ 88 | (Stdlib.compare b false)))", 89 | "uchar"); 90 | type_doc = None; } 91 | 92 | let char = 93 | { type_name = "char"; 94 | type_def = `Builtin; 95 | type_ctypes = `Builtin "uchar"; 96 | type_doc = None; } 97 | 98 | let int8 = 99 | { type_name = "int8"; 100 | type_def = `Alias "int"; 101 | type_ctypes = `Builtin "char"; 102 | type_doc = None; } 103 | 104 | let uint8 = 105 | { type_name = "uint8"; 106 | type_def = `Alias "int"; 107 | type_ctypes = `View ("int_as_uint8_t", 108 | "Unsigned.UInt8.to_int", "Unsigned.UInt8.of_int", 109 | "uint8_t"); 110 | type_doc = None; } 111 | 112 | let int16 = 113 | { type_name = "int16"; 114 | type_def = `Alias "int"; 115 | type_ctypes = `Builtin "short"; 116 | type_doc = None } 117 | 118 | let uint16 = 119 | { type_name = "uint16"; 120 | type_def = `Alias "int"; 121 | type_ctypes = `Builtin "short"; 122 | type_doc = None } 123 | 124 | let int = 125 | { type_name = "int"; 126 | type_def = `Builtin; 127 | type_ctypes = `Builtin "int"; 128 | type_doc = None } 129 | 130 | let intptr = int 131 | let sizeiptr = int 132 | let sizei = int 133 | 134 | let uint = 135 | { type_name = "int"; 136 | type_def = `Builtin; 137 | type_ctypes = `View ("int_as_uint", 138 | "Unsigned.UInt.to_int", "Unsigned.UInt.of_int", 139 | "uint"); 140 | type_doc = None; } 141 | 142 | let int32 = 143 | { type_name = "int32"; 144 | type_def = `Builtin; 145 | type_ctypes = `Builtin "int32_t"; 146 | type_doc = None; } 147 | 148 | let uint32 = 149 | { type_name = "uint32"; 150 | type_def = `Alias "int32"; 151 | type_ctypes = `View ("int32_as_uint32_t", 152 | "Unsigned.UInt32.to_int32", "Unsigned.UInt32.of_int32", 153 | "uint32_t"); 154 | type_doc = None; } 155 | 156 | let int64 = 157 | { type_name = "int64"; 158 | type_def = `Builtin; 159 | type_ctypes = `Builtin "int64_t"; 160 | type_doc = None; } 161 | 162 | let uint64 = 163 | { type_name = "uint64"; 164 | type_def = `Alias "int64"; 165 | type_ctypes = `View ("int64_as_uint64_t", 166 | "Unsigned.UInt64.to_int64", "Unsigned.UInt64.of_int64", 167 | "uint64_t"); 168 | type_doc = None; } 169 | 170 | let float32 = 171 | { type_name = "float"; 172 | type_def = `Builtin; 173 | type_ctypes = `Builtin "float"; 174 | type_doc = None } 175 | 176 | let float64 = 177 | { type_name = "float"; 178 | type_def = `Builtin; 179 | type_ctypes = `Builtin "double"; 180 | type_doc = None; } 181 | 182 | let clampx = 183 | { uint32 with type_name = "clampx"; } 184 | 185 | let bitfield = 186 | { uint with type_name = "bitfield"; type_def = `Alias "int";} 187 | 188 | let enum = 189 | { uint with type_name = "enum"; type_def = `Alias "int" } 190 | 191 | let fixed = 192 | { int32 with type_name = "fixed"; type_def = `Alias "int32" } 193 | 194 | let sync = 195 | { type_name = "sync"; 196 | type_def = `Abstract "unit ptr"; 197 | type_ctypes = `Def ("sync", 198 | "let sync : sync typ = ptr void\n \ 199 | let sync_opt : sync option typ = ptr_opt void"); 200 | type_doc = None; } 201 | 202 | let debug_proc = 203 | { type_name = "debug_proc"; 204 | type_def = `Alias "enum -> enum -> int -> enum -> string -> unit"; 205 | type_ctypes = `Builtin "(assert false)"; (* Unused, manual *) 206 | type_doc = None; } 207 | 208 | let void = 209 | { type_name = "unit"; 210 | type_def = `Builtin; 211 | type_ctypes = `Builtin "void"; 212 | type_doc = None } 213 | 214 | let string = 215 | { type_name = "string"; 216 | type_def = `Builtin; 217 | type_ctypes = `Builtin "string"; 218 | type_doc = None } 219 | 220 | let string_opt = 221 | { type_name = "string option"; 222 | type_def = `Builtin; 223 | type_ctypes = `Builtin "string_opt"; 224 | type_doc = None } 225 | 226 | let ba_as_voidp name = 227 | `View (name, 228 | "(fun _ -> assert false)", 229 | "(fun b -> to_voidp (bigarray_start array1 b))", 230 | "(ptr void)") 231 | 232 | let ba_opt_as_voidp name = 233 | `View (name, 234 | "(fun _ -> assert false)", 235 | "(function\n\ 236 | \ | None -> null\n\ 237 | \ | Some b -> to_voidp (bigarray_start array1 b))", 238 | "(ptr void)") 239 | 240 | let ba_as_charp = 241 | { type_name = "(char, Bigarray.int8_unsigned_elt) bigarray"; 242 | type_def = `Builtin; 243 | type_ctypes = ba_as_voidp "ba_as_charp"; 244 | type_doc = None } 245 | 246 | let ba_opt_as_charp = 247 | { type_name = "(char, Bigarray.int8_unsigned_elt) bigarray option"; 248 | type_def = `Builtin; 249 | type_ctypes = ba_opt_as_voidp "ba_opt_as_charp"; 250 | type_doc = None } 251 | 252 | let ba_as_int8p = 253 | { type_name = "(int, Bigarray.int8_signed_elt) bigarray"; 254 | type_def = `Builtin; 255 | type_ctypes = ba_as_voidp "ba_as_int8p"; 256 | type_doc = None } 257 | 258 | let ba_as_uint8p = 259 | { type_name = "(int, Bigarray.int8_unsigned_elt) bigarray"; 260 | type_def = `Builtin; 261 | type_ctypes = ba_as_voidp "ba_as_uint8p"; 262 | type_doc = None } 263 | 264 | let ba_as_int16p = 265 | { type_name = "(int, Bigarray.int16_signed_elt) bigarray"; 266 | type_def = `Builtin; 267 | type_ctypes = ba_as_voidp "ba_as_int16p"; 268 | type_doc = None } 269 | 270 | let ba_as_uint16p = 271 | { type_name = "(int, Bigarray.int16_unsigned_elt) bigarray"; 272 | type_def = `Builtin; 273 | type_ctypes = ba_as_voidp "ba_as_uint16p"; 274 | type_doc = None } 275 | 276 | let ba_as_int32p = 277 | { type_name = "(int32, Bigarray.int32_elt) bigarray"; 278 | type_def = `Builtin; 279 | type_ctypes = ba_as_voidp "ba_as_int32p"; 280 | type_doc = None } 281 | 282 | let ba_as_uint32p = 283 | { type_name = "uint32_bigarray"; 284 | type_def = `Alias "(int32, Bigarray.int32_elt) bigarray"; 285 | type_ctypes = ba_as_voidp "ba_as_uint32p"; 286 | type_doc = None } 287 | 288 | let ba_opt_as_uint32p = 289 | { type_name = "uint32_bigarray option"; 290 | type_def = `Builtin; 291 | type_ctypes = ba_opt_as_voidp "ba_opt_as_uint32p"; 292 | type_doc = None } 293 | 294 | let ba_opt_as_int32p = 295 | { type_name = "(int32, Bigarray.int32_elt) bigarray option"; 296 | type_def = `Builtin; 297 | type_ctypes = ba_opt_as_voidp "ba_opt_as_int32p"; 298 | type_doc = None } 299 | 300 | let ba_as_enump = 301 | { type_name = "enum_bigarray"; 302 | type_def = `Alias "(int32, Bigarray.int32_elt) bigarray"; 303 | type_ctypes = ba_as_voidp "ba_as_enump"; 304 | type_doc = None } 305 | 306 | let ba_opt_as_enump = 307 | { type_name = "enum_bigarray option"; 308 | type_def = `Builtin; 309 | type_ctypes = ba_opt_as_voidp "ba_opt_as_enump"; 310 | type_doc = None } 311 | 312 | let ba_as_nativeintp = 313 | { type_name = "(nativeint, Bigarray.nativeint_elt) bigarray"; 314 | type_def = `Builtin; 315 | type_ctypes = ba_as_voidp "ba_as_nativeint"; 316 | type_doc = None } 317 | 318 | let ba_opt_as_nativeintp = 319 | { type_name = "(nativeint, Bigarray.nativeint_elt) bigarray option"; 320 | type_def = `Builtin; 321 | type_ctypes = ba_opt_as_voidp "ba_opt_as_nativeint"; 322 | type_doc = None } 323 | 324 | let ba_as_float32p = 325 | { type_name = "(float, Bigarray.float32_elt) bigarray"; 326 | type_def = `Builtin; 327 | type_ctypes = ba_as_voidp "ba_as_float32p"; 328 | type_doc = None } 329 | 330 | let ba_as_float64p = 331 | { type_name = "(float, Bigarray.float64_elt) bigarray"; 332 | type_def = `Builtin; 333 | type_ctypes = ba_as_voidp "ba_as_float64p"; 334 | type_doc = None } 335 | 336 | let ba_as_int64p = 337 | { type_name = "(int64, Bigarray.int64_elt) bigarray"; 338 | type_def = `Builtin; 339 | type_ctypes = ba_as_voidp "ba_as_int64p"; 340 | type_doc = None } 341 | 342 | let ba_as_uint64p = 343 | { type_name = "uint64_bigarray"; 344 | type_def = `Alias "(int64, Bigarray.int64_elt) bigarray"; 345 | type_ctypes = ba_as_voidp "ba_as_uint64p"; 346 | type_doc = None } 347 | 348 | let ba_as_voidp = 349 | (* Need to wrap because of the value restriction, can't make a view. *) 350 | let pp_wrap ppf arg = 351 | pp ppf 352 | "@[let %s = to_voidp (bigarray_start array1 %s) in@]" arg arg 353 | in 354 | { type_name = "('a, 'b) bigarray"; 355 | type_def = `Builtin; 356 | type_ctypes = `Builtin_wrap_in ("(ptr void)", pp_wrap); 357 | type_doc = None; } 358 | 359 | let ba_opt_as_voidp = 360 | (* Need to wrap because of the value restriction, can't make a view. *) 361 | let pp_wrap ppf arg = 362 | pp ppf 363 | "@[let %s = match %s with@\n\ 364 | | None -> null | Some b -> to_voidp (bigarray_start array1 b)@\n\ 365 | in@]" arg arg 366 | in 367 | { type_name = "('a, 'b) bigarray option"; 368 | type_def = `Builtin; 369 | type_ctypes = `Builtin_wrap_in ("(ptr void)", pp_wrap); 370 | type_doc = None } 371 | 372 | let ba_or_offset_as_voidp = 373 | (* Need to wrap because of the value restriction, can't make a view. *) 374 | let pp_wrap ppf arg = 375 | pp ppf 376 | "@[let %s = match %s with@\n\ 377 | | `Offset o -> ptr_of_raw_address (Nativeint.of_int o)@\n\ 378 | | `Data b -> to_voidp (bigarray_start array1 b)@\n\ 379 | in@]" arg arg 380 | in 381 | { type_name = "[ `Offset of int | `Data of ('a, 'b) bigarray ]"; 382 | type_def = `Builtin; 383 | type_ctypes = `Builtin_wrap_in ("(ptr void)", pp_wrap); 384 | type_doc = None } 385 | 386 | let type_def api t = 387 | let no_def t = 388 | let t = Capi.type_to_string t in 389 | `Unknown (err_no_type_def t) 390 | in 391 | match t with 392 | | `Base b as t -> 393 | begin match b with 394 | | `GLDEBUGPROC -> `Ok debug_proc 395 | | `GLbitfield -> `Ok bitfield 396 | | `GLboolean -> `Ok bool 397 | | `GLbyte -> `Ok int8 398 | | `GLchar -> `Ok char 399 | | `GLclampx -> `Ok clampx 400 | | `GLdouble -> `Ok float64 401 | | `GLenum -> `Ok enum 402 | | `GLfixed -> `Ok fixed 403 | | `GLfloat -> `Ok float32 404 | | `GLint -> `Ok int 405 | | `GLint64 -> `Ok int64 406 | | `GLintptr -> `Ok intptr 407 | | `GLshort -> `Ok int16 408 | | `GLsizei -> `Ok sizei 409 | | `GLsizeiptr -> `Ok sizeiptr 410 | | `GLsync -> `Ok sync 411 | | `GLubyte -> `Ok uint8 412 | | `GLuint -> `Ok uint 413 | | `GLuint64 -> `Ok uint64 414 | | `GLushort -> `Ok uint16 415 | | `Void -> `Ok void 416 | | _ -> no_def t 417 | end 418 | | `Ptr (`Base `GLchar) -> `Ok ba_as_charp 419 | | `Ptr (`Ptr (`Base `Void)) -> `Ok ba_as_nativeintp 420 | | `Ptr (`Base base) 421 | | `Const (`Ptr (`Base base)) -> 422 | begin match base with 423 | | `GLboolean -> `Ok ba_as_uint8p 424 | | `GLbyte -> `Ok ba_as_int8p 425 | | `GLchar -> `Ok string (* `Const, see above for non `Const *) 426 | | `GLdouble -> `Ok ba_as_float64p 427 | | `GLenum -> `Ok ba_as_enump 428 | | `GLfloat -> `Ok ba_as_float32p 429 | | `GLint -> `Ok ba_as_int32p 430 | | `GLint64 -> `Ok ba_as_int64p 431 | | `GLshort -> `Ok ba_as_uint16p 432 | | `GLsizei -> `Ok ba_as_int32p 433 | | `GLubyte -> `Ok ba_as_uint8p 434 | | `GLuint -> `Ok ba_as_uint32p 435 | | `GLuint64 -> `Ok ba_as_uint64p 436 | | `GLushort -> `Ok ba_as_uint16p 437 | | `Void -> `Ok ba_as_voidp 438 | | `Void_or_index -> `Ok ba_or_offset_as_voidp 439 | | b -> no_def t 440 | end 441 | | `Nullable (`Ptr (`Base `GLchar)) -> `Ok ba_opt_as_charp 442 | | `Nullable (`Ptr (`Base `GLubyte)) -> `Ok ba_opt_as_charp 443 | | `Nullable (`Ptr (`Base base)) 444 | | `Nullable (`Const (`Ptr (`Base base))) -> 445 | begin match base with 446 | | `GLchar -> `Ok string_opt (* `Const see above for non `Const *) 447 | | `GLenum -> `Ok ba_as_enump 448 | | `GLintptr -> `Ok ba_opt_as_nativeintp 449 | | `GLsizei -> `Ok ba_opt_as_int32p 450 | | `GLsizeiptr -> `Ok ba_opt_as_nativeintp 451 | | `GLubyte -> `Ok string_opt (* `Const see above for non `Const *) 452 | | `GLuint -> `Ok ba_opt_as_uint32p 453 | | `Void -> `Ok ba_opt_as_voidp 454 | | _ -> no_def t 455 | end 456 | | _ -> no_def t 457 | 458 | (* OCaml function definitions *) 459 | 460 | type arg = { arg_name : string; arg_type : typ } 461 | type fun_def = 462 | [ `Derived of arg list * typ 463 | | `Manual of string * string 464 | | `Unknown 465 | | `Unbound of string ] 466 | 467 | type func = 468 | { fun_name : string; 469 | fun_c : Capi.func; 470 | fun_def : fun_def; 471 | fun_doc : string option; } 472 | 473 | let fun_name api f = (* remove `gl', uncamlcase, lowercase *) 474 | let cname = fst f in 475 | if not (String.length cname > 3 && String.sub cname 0 2 = "gl") 476 | then failwith (err_odd_fname cname) 477 | else 478 | let is_upper c = 'A' <= c && c <= 'Z' in 479 | let is_digit c = '0' <= c && c <= '9' in 480 | let buf = Buffer.create (String.length cname) in 481 | let last_up = ref true (* avoids prefix by _ *) in 482 | for i = 2 to String.length cname - 1 do 483 | if is_upper cname.[i] && 484 | not (!last_up) && 485 | not (is_digit (cname.[i - 1])) (* maps eg 2D to 2d not 2_d *) 486 | then (Buffer.add_char buf '_'; last_up := true) 487 | else (last_up := false); 488 | Buffer.add_char buf (Char.lowercase_ascii cname.[i]); 489 | done; 490 | identifier (Buffer.contents buf) 491 | 492 | let derived_doc = function 493 | | "glMultiDrawElements" | "glMultiDrawElementsBaseVertex" -> 494 | Some "{b Note.} [indices] are byte offsets in the buffer bound on \ 495 | {!Gl.element_array_buffer}. Directly specifiying index arrays \ 496 | is unsupported." 497 | | "glMemoryBarrier" | "glMemoryBarrierByRegion" -> 498 | (* FIXME (or not): see Capi.enums *) 499 | Some "{b Warning.} On 32 bits platforms the constant 500 | {!all_barrier_bits} is represented by 0x7FFFFFFF 501 | instead of 0xFFFFFFFF, this may result in an OpenGL 502 | error (or not)." 503 | | "glUseProgramStages" -> (* FIXME (or not): see Capi.enums *) 504 | Some "{b Warning.} On 32 bits platforms the constant 505 | {!all_shader_bits} is represented by 0x7FFFFFFF 506 | instead of 0xFFFFFFFF, this may result in an OpenGL 507 | error (or not)." 508 | | _ -> None 509 | 510 | let derived api (fn, (cargs, cret) as cdef) = 511 | let arg_type t = 512 | let t = match t with 513 | | `Const (`Ptr (`Const (`Ptr (`Base `Void)))) -> 514 | begin match fn with 515 | | "glMultiDrawElements" (* See derived_doc for an explanation. *) 516 | | "glMultiDrawElementsBaseVertex" -> `Const (`Ptr (`Base `Void)) 517 | | _ -> t 518 | end 519 | | t -> t 520 | in 521 | match type_def api t with 522 | | `Unknown _ -> raise Exit 523 | | `Ok def -> def 524 | in 525 | let ret_type = arg_type (* nothing special for now *) in 526 | let arg a = 527 | { arg_name = a.Capi.arg_name; 528 | arg_type = arg_type a.Capi.arg_type } 529 | in 530 | try 531 | let fun_name = fun_name api cdef in 532 | let fun_def = `Derived (List.map arg cargs, ret_type cret) in 533 | Some { fun_name; fun_c = cdef; fun_def; fun_doc = derived_doc fn } 534 | with Exit -> None 535 | 536 | let unbound api f = (* unbound functions, list them here *) 537 | None 538 | 539 | let manual api (fn, _ as cdef) = match Manual.get api fn with 540 | | None -> None 541 | | Some def -> 542 | Some { fun_name = fun_name api cdef; fun_c = cdef; 543 | fun_def = `Manual def; fun_doc = None } 544 | 545 | let funs api = 546 | let func cdef = match unbound api cdef with 547 | | Some r -> r 548 | | None -> 549 | match manual api cdef with 550 | | Some f -> f 551 | | None -> 552 | match derived api cdef with 553 | | Some f -> f 554 | | None -> 555 | { fun_name = fun_name api cdef; fun_c = cdef; 556 | fun_def = `Unknown; fun_doc = None } 557 | in 558 | List.map func (Capi.funs api) 559 | 560 | let types api = 561 | let add_type acc t = if List.memq t acc then acc else t :: acc in 562 | let add_arg_type acc arg = add_type acc arg.arg_type in 563 | let add_types acc f = match f.fun_def with 564 | | `Derived (args, ret) -> 565 | List.fold_left add_arg_type (add_type acc ret) args 566 | | _ -> acc 567 | in 568 | let manual = [ debug_proc ] in 569 | List.fold_left add_types manual (funs api) 570 | 571 | (* Enum value definitions. *) 572 | 573 | type enum = 574 | { enum_name : string; 575 | enum_c_name : string; 576 | enum_value : Capi.enum_value } 577 | 578 | let enums api = 579 | let add_fname acc f = Sset.add (fun_name api f) acc in 580 | let fun_names = List.fold_left add_fname Sset.empty (Capi.funs api) in 581 | let enum (cname, v) = 582 | (* remove `GL_`, lowercase, fix clashes with fun names *) 583 | if not (String.length cname > 3 && (String.sub cname 0 3) = "GL_") 584 | then failwith (err_odd_ename cname) 585 | else 586 | let n = 587 | String.lowercase_ascii (String.sub cname 3 (String.length cname - 3)) 588 | in 589 | let n = identifier n in 590 | let n = if Sset.mem n fun_names then n ^ "_enum" else n in 591 | { enum_name = n; enum_c_name = cname; enum_value = v } 592 | in 593 | List.map enum (Capi.enums api) 594 | -------------------------------------------------------------------------------- /support/doc.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2013 The tgls programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | let str = Printf.sprintf 7 | 8 | module Smap = Map.Make(String) 9 | 10 | let fun_page_map = ref Smap.empty (* Filled at the end of the module *) 11 | let fun_to_page f = try Some (Smap.find f !fun_page_map) with Not_found -> None 12 | let page_uri uri f = match fun_to_page f with 13 | | None -> None | Some page -> Some (uri page) 14 | 15 | let default = 16 | ("http://www.opengl.org", fun _ -> None) 17 | 18 | let docs_GL_ES_1_0 = 19 | let home = "http://www.khronos.org/opengles/1_X" in 20 | let man_base = "http://www.khronos.org/opengles/sdk/1.1/docs/man/" in 21 | let man = page_uri (str "%s%s.xml" man_base) in 22 | (home, man) 23 | 24 | let docs_GL_ES_2_0 = 25 | let home = "http://www.khronos.org/opengles/2_X" in 26 | let man_base = "http://www.khronos.org/opengles/sdk/docs/man/" in 27 | let man = page_uri (str "%sxhtml/%s.xml" man_base) in 28 | (home, man) 29 | 30 | let docs_GL_ES_3_0 = 31 | let home = "http://www.khronos.org/opengles/3_X" in 32 | let man_base = "http://www.khronos.org/opengles/sdk/docs/man32/" in 33 | let man = page_uri (str "%shtml/%s.xhtml" man_base) in 34 | (home, man) 35 | 36 | let docs_GL_3_X = 37 | let home = "http://www.opengl.org/registry" in 38 | let man_base = "http://www.opengl.org/sdk/docs/man3/" in 39 | let man = page_uri (str "%sxhtml/%s.xml" man_base) in 40 | (home, man) 41 | 42 | let docs_GL_4_X = 43 | let home = "http://www.opengl.org/registry" in 44 | let man_base = "http://www.opengl.org/sdk/docs/man4/" in 45 | let man = page_uri (str "%shtml/%s.xhtml" man_base) in 46 | (home, man) 47 | 48 | let docs_ext e = 49 | try 50 | let fst = String.index_from e 0 '_' in 51 | let snd = String.index_from e (fst + 1) '_' in 52 | let vend = String.sub e (fst + 1) (snd - fst - 1) in 53 | let ext = String.sub e (snd + 1) (String.length e - snd - 1) in 54 | let home = str "http://www.opengl.org/registry/specs/%s/%s.txt" vend ext in 55 | let man = fun _ -> None in 56 | (home, man) 57 | with Not_found -> default 58 | 59 | let docs api = match Capi.id api with 60 | | `Gl (3, _) -> docs_GL_3_X 61 | | `Gl (4, _) -> docs_GL_4_X 62 | | `Gles (1, _) -> docs_GL_ES_1_0 63 | | `Gles (2, _) -> docs_GL_ES_2_0 64 | | `Gles (3, _) -> docs_GL_ES_3_0 65 | | `Ext e -> docs_ext e 66 | | _ -> default 67 | 68 | let home_uri api = fst (docs api) 69 | let man_uri api = snd (docs api) 70 | 71 | (* 72 | Extracted from https://www.opengl.org/sdk/docs/man/xhtml/index.html 73 | and manual additions. We hope the scheme is identical for all GLs. 74 | *) 75 | 76 | let () = 77 | fun_page_map := 78 | List.fold_left (fun acc (f, page) -> Smap.add f page acc) Smap.empty [ 79 | "glActiveShaderProgram", "glActiveShaderProgram"; 80 | "glActiveTexture", "glActiveTexture"; 81 | "glAttachShader", "glAttachShader"; 82 | "glBeginConditionalRender", "glBeginConditionalRender"; 83 | "glBeginQuery", "glBeginQuery"; 84 | "glBeginQueryIndexed", "glBeginQueryIndexed"; 85 | "glBeginTransformFeedback", "glBeginTransformFeedback"; 86 | "glBindAttribLocation", "glBindAttribLocation"; 87 | "glBindBuffer", "glBindBuffer"; 88 | "glBindBufferBase", "glBindBufferBase"; 89 | "glBindBufferRange", "glBindBufferRange"; 90 | "glBindBuffersBase", "glBindBuffersBase"; 91 | "glBindBuffersRange", "glBindBuffersRange"; 92 | "glBindFragDataLocation", "glBindFragDataLocation"; 93 | "glBindFragDataLocationIndexed", "glBindFragDataLocationIndexed"; 94 | "glBindFramebuffer", "glBindFramebuffer"; 95 | "glBindImageTexture", "glBindImageTexture"; 96 | "glBindImageTextures", "glBindImageTextures"; 97 | "glBindProgramPipeline", "glBindProgramPipeline"; 98 | "glBindRenderbuffer", "glBindRenderbuffer"; 99 | "glBindSampler", "glBindSampler"; 100 | "glBindSamplers", "glBindSamplers"; 101 | "glBindTexture", "glBindTexture"; 102 | "glBindTextureUnit", "glBindTextureUnit"; 103 | "glBindTextures", "glBindTextures"; 104 | "glBindTransformFeedback", "glBindTransformFeedback"; 105 | "glBindVertexArray", "glBindVertexArray"; 106 | "glBindVertexBuffer", "glBindVertexBuffer"; 107 | "glVertexArrayVertexBuffer", "glBindVertexBuffer"; 108 | "glBindVertexBuffers", "glBindVertexBuffers"; 109 | "glVertexArrayVertexBuffers", "glBindVertexBuffers"; 110 | "glVertexArrayElementBuffer", "glVertexArrayElementBuffer"; 111 | "glBlendBarrier", "glBlendBarrier"; 112 | "glBlendColor", "glBlendColor"; 113 | "glBlendEquation", "glBlendEquation"; 114 | "glBlendEquationSeparate", "glBlendEquationSeparate"; 115 | "glBlendEquationSeparatei", "glBlendEquationSeparate"; 116 | "glBlendEquationi", "glBlendEquation"; 117 | "glBlendFunc", "glBlendFunc"; 118 | "glBlendFuncSeparate", "glBlendFuncSeparate"; 119 | "glBlendFuncSeparatei", "glBlendFuncSeparate"; 120 | "glBlendFunci", "glBlendFunc"; 121 | "glBlitFramebuffer", "glBlitFramebuffer"; 122 | "glBlitNamedFramebuffer", "glBlitFramebuffer"; 123 | "glBufferData", "glBufferData"; 124 | "glNamedBufferData", "glBufferData"; 125 | "glBufferStorage", "glBufferStorage"; 126 | "glNamedBufferStorage", "glBufferStorage"; 127 | "glBufferSubData", "glBufferSubData"; 128 | "glNamedBufferSubData", "glBufferSubData"; 129 | "glCheckFramebufferStatus", "glCheckFramebufferStatus"; 130 | "glCheckNamedFramebufferStatus", "glCheckFramebufferStatus"; 131 | "glClampColor", "glClampColor"; 132 | "glClear", "glClear"; 133 | "glClearBuffer", "glClearBuffer"; 134 | "glClearBufferData", "glClearBufferData"; 135 | "glClearNamedBufferData", "glClearBufferData"; 136 | "glClearBufferSubData", "glClearBufferSubData"; 137 | "glClearNamedBufferSubData", "glClearBufferSubData"; 138 | "glClearBufferfi", "glClearBuffer"; 139 | "glClearBufferfv", "glClearBuffer"; 140 | "glClearBufferiv", "glClearBuffer"; 141 | "glClearBufferuiv", "glClearBuffer"; 142 | "glClearNamedFramebufferfi", "glClearBuffer"; 143 | "glClearNamedFramebufferfv", "glClearBuffer"; 144 | "glClearNamedFramebufferiv", "glClearBuffer"; 145 | "glClearNamedFramebufferuiv", "glClearBuffer"; 146 | "glClearColor", "glClearColor"; 147 | "glClearDepth", "glClearDepth"; 148 | "glClearDepthf", "glClearDepth"; 149 | "glClearStencil", "glClearStencil"; 150 | "glClearTexImage", "glClearTexImage"; 151 | "glClearTexSubImage", "glClearTexSubImage"; 152 | "glClientWaitSync", "glClientWaitSync"; 153 | "glClipControl", "glClipControl"; 154 | "glColorMask", "glColorMask"; 155 | "glColorMaski", "glColorMask"; 156 | "glCompileShader", "glCompileShader"; 157 | "glCompressedTexImage1D", "glCompressedTexImage1D"; 158 | "glCompressedTexImage2D", "glCompressedTexImage2D"; 159 | "glCompressedTexImage3D", "glCompressedTexImage3D"; 160 | "glCompressedTexSubImage1D", "glCompressedTexSubImage1D"; 161 | "glCompressedTextureSubImage1D", "glCompressedTexSubImage1D"; 162 | "glCompressedTexSubImage2D", "glCompressedTexSubImage2D"; 163 | "glCompressedTextureSubImage2D", "glCompressedTexSubImage2D"; 164 | "glCompressedTexSubImage3D", "glCompressedTexSubImage3D"; 165 | "glCompressedTextureSubImage3D", "glCompressedTexSubImage3D"; 166 | "glCopyBufferSubData", "glCopyBufferSubData"; 167 | "glCopyNamedBufferSubData", "glCopyBufferSubData"; 168 | "glCopyImageSubData", "glCopyImageSubData"; 169 | "glCopyTexImage1D", "glCopyTexImage1D"; 170 | "glCopyTexImage2D", "glCopyTexImage2D"; 171 | "glCopyTexSubImage1D", "glCopyTexSubImage1D"; 172 | "glCopyTextureSubImage1D", "glCopyTexSubImage1D"; 173 | "glCopyTexSubImage2D", "glCopyTexSubImage2D"; 174 | "glCopyTextureSubImage2D", "glCopyTexSubImage2D"; 175 | "glCopyTexSubImage3D", "glCopyTexSubImage3D"; 176 | "glCopyTextureSubImage3D", "glCopyTexSubImage3D"; 177 | "glCreateProgram", "glCreateProgram"; 178 | "glCreateShader", "glCreateShader"; 179 | "glCreateShaderProgram", "glCreateShaderProgram"; 180 | "glCreateShaderProgramv", "glCreateShaderProgram"; 181 | "glCreateBuffers", "glCreateBuffers"; 182 | "glCreateFramebuffers", "glCreateFramebuffers"; 183 | "glCreateProgramPipelines","glCreateProgramPipelines"; 184 | "glCreateQueries","glCreateQueries"; 185 | "glCreateRenderbuffers","glCreateRenderbuffers"; 186 | "glCreateSamplers","glCreateSamplers"; 187 | "glCreateTextures","glCreateTextures"; 188 | "glCreateTransformFeedbacks","glCreateTransformFeedbacks"; 189 | "glCreateVertexArrays", "glCreateVertexArrays"; 190 | "glCullFace", "glCullFace"; 191 | "glDebugMessageCallback", "glDebugMessageCallback"; 192 | "glDebugMessageControl", "glDebugMessageControl"; 193 | "glDebugMessageInsert", "glDebugMessageInsert"; 194 | "glDeleteBuffers", "glDeleteBuffers"; 195 | "glDeleteFramebuffers", "glDeleteFramebuffers"; 196 | "glDeleteProgram", "glDeleteProgram"; 197 | "glDeleteProgramPipelines", "glDeleteProgramPipelines"; 198 | "glDeleteQueries", "glDeleteQueries"; 199 | "glDeleteRenderbuffers", "glDeleteRenderbuffers"; 200 | "glDeleteSamplers", "glDeleteSamplers"; 201 | "glDeleteShader", "glDeleteShader"; 202 | "glDeleteSync", "glDeleteSync"; 203 | "glDeleteTextures", "glDeleteTextures"; 204 | "glDeleteTransformFeedbacks", "glDeleteTransformFeedbacks"; 205 | "glDeleteVertexArrays", "glDeleteVertexArrays"; 206 | "glDepthFunc", "glDepthFunc"; 207 | "glDepthMask", "glDepthMask"; 208 | "glDepthRange", "glDepthRange"; 209 | "glDepthRangeArray", "glDepthRangeArray"; 210 | "glDepthRangeArrayv", "glDepthRangeArray"; 211 | "glDepthRangeIndexed", "glDepthRangeIndexed"; 212 | "glDepthRangef", "glDepthRange"; 213 | "glDetachShader", "glDetachShader"; 214 | "glDisable", "glEnable"; 215 | "glDisableVertexAttribArray", "glEnableVertexAttribArray"; 216 | "glDisableVertexArrayAttrib", "glEnableVertexAttribArray"; 217 | "glDisablei", "glEnable"; 218 | "glDispatchCompute", "glDispatchCompute"; 219 | "glDispatchComputeIndirect", "glDispatchComputeIndirect"; 220 | "glDrawArrays", "glDrawArrays"; 221 | "glDrawArraysIndirect", "glDrawArraysIndirect"; 222 | "glDrawArraysInstanced", "glDrawArraysInstanced"; 223 | "glDrawArraysInstancedBaseInstance", "glDrawArraysInstancedBaseInstance"; 224 | "glDrawBuffer", "glDrawBuffer"; 225 | "glNamedFramebufferDrawBuffer", "glDrawBuffer"; 226 | "glDrawBuffers", "glDrawBuffers"; 227 | "glNamedFramebufferDrawBuffers", "glDrawBuffers"; 228 | "glDrawElements", "glDrawElements"; 229 | "glDrawElementsBaseVertex", "glDrawElementsBaseVertex"; 230 | "glDrawElementsIndirect", "glDrawElementsIndirect"; 231 | "glDrawElementsInstanced", "glDrawElementsInstanced"; 232 | "glDrawElementsInstancedBaseInstance", 233 | "glDrawElementsInstancedBaseInstance"; 234 | "glDrawElementsInstancedBaseVertex", "glDrawElementsInstancedBaseVertex"; 235 | "glDrawElementsInstancedBaseVertexBaseInstance", 236 | "glDrawElementsInstancedBaseVertexBaseInstance"; 237 | "glDrawRangeElements", "glDrawRangeElements"; 238 | "glDrawRangeElementsBaseVertex", "glDrawRangeElementsBaseVertex"; 239 | "glDrawTransformFeedback", "glDrawTransformFeedback"; 240 | "glDrawTransformFeedbackInstanced", "glDrawTransformFeedbackInstanced"; 241 | "glDrawTransformFeedbackStream", "glDrawTransformFeedbackStream"; 242 | "glDrawTransformFeedbackStreamInstanced", 243 | "glDrawTransformFeedbackStreamInstanced"; 244 | "glEnable", "glEnable"; 245 | "glEnableVertexAttribArray", "glEnableVertexAttribArray"; 246 | "glEnableVertexArrayAttrib", "glEnableVertexAttribArray"; 247 | "glEnablei", "glEnable"; 248 | "glEndConditionalRender", "glBeginConditionalRender"; 249 | "glEndQuery", "glBeginQuery"; 250 | "glEndQueryIndexed", "glBeginQueryIndexed"; 251 | "glEndTransformFeedback", "glBeginTransformFeedback"; 252 | "glFenceSync", "glFenceSync"; 253 | "glFinish", "glFinish"; 254 | "glFlush", "glFlush"; 255 | "glFlushMappedBufferRange", "glFlushMappedBufferRange"; 256 | "glFlushMappedNamedBufferRange", "glFlushMappedBufferRange"; 257 | "glFramebufferParameteri", "glFramebufferParameteri"; 258 | "glNamedFramebufferParameteri", "glFramebufferParameteri"; 259 | "glFramebufferRenderbuffer", "glFramebufferRenderbuffer"; 260 | "glNamedFramebufferRenderbuffer", "glFramebufferRenderbuffer"; 261 | "glFramebufferTexture", "glFramebufferTexture"; 262 | "glNamedFramebufferTexture", "glFramebufferTexture"; 263 | "glFramebufferTexture1D", "glFramebufferTexture"; 264 | "glFramebufferTexture2D", "glFramebufferTexture"; 265 | "glFramebufferTexture3D", "glFramebufferTexture"; 266 | "glFramebufferTextureLayer", "glFramebufferTextureLayer"; 267 | "glNamedFramebufferTextureLayer", "glFramebufferTextureLayer"; 268 | "glFrontFace", "glFrontFace"; 269 | "glGenBuffers", "glGenBuffers"; 270 | "glGenFramebuffers", "glGenFramebuffers"; 271 | "glGenProgramPipelines", "glGenProgramPipelines"; 272 | "glGenQueries", "glGenQueries"; 273 | "glGenRenderbuffers", "glGenRenderbuffers"; 274 | "glGenSamplers", "glGenSamplers"; 275 | "glGenTextures", "glGenTextures"; 276 | "glGenTransformFeedbacks", "glGenTransformFeedbacks"; 277 | "glGenVertexArrays", "glGenVertexArrays"; 278 | "glGenerateMipmap", "glGenerateMipmap"; 279 | "glGenerateTextureMipmap", "glGenerateMipmap"; 280 | "glGet", "glGet"; 281 | "glGetActiveAtomicCounterBufferiv", "glGetActiveAtomicCounterBufferiv"; 282 | "glGetActiveAttrib", "glGetActiveAttrib"; 283 | "glGetActiveSubroutineName", "glGetActiveSubroutineName"; 284 | "glGetActiveSubroutineUniform", "glGetActiveSubroutineUniform"; 285 | "glGetActiveSubroutineUniformName", "glGetActiveSubroutineUniformName"; 286 | "glGetActiveSubroutineUniformiv", "glGetActiveSubroutineUniform"; 287 | "glGetActiveUniform", "glGetActiveUniform"; 288 | "glGetActiveUniformBlock", "glGetActiveUniformBlock"; 289 | "glGetActiveUniformBlockName", "glGetActiveUniformBlockName"; 290 | "glGetActiveUniformBlockiv", "glGetActiveUniformBlock"; 291 | "glGetActiveUniformName", "glGetActiveUniformName"; 292 | "glGetActiveUniformsiv", "glGetActiveUniformsiv"; 293 | "glGetAttachedShaders", "glGetAttachedShaders"; 294 | "glGetAttribLocation", "glGetAttribLocation"; 295 | "glGetBooleani_v", "glGet"; 296 | "glGetBooleanv", "glGet"; 297 | "glGetBufferParameter", "glGetBufferParameter"; 298 | "glGetNamedBufferParameter", "glGetBufferParameter"; 299 | "glGetBufferParameteri64v", "glGetBufferParameter"; 300 | "glGetNamedBufferParameteri64v", "glGetBufferParameter"; 301 | "glGetBufferParameteriv", "glGetBufferParameter"; 302 | "glGetNamedBufferParameteriv", "glGetBufferParameter"; 303 | "glGetBufferPointerv", "glGetBufferPointerv"; 304 | "glGetNamedBufferPointerv", "glGetBufferPointerv"; 305 | "glGetBufferSubData", "glGetBufferSubData"; 306 | "glGetNamedBufferSubData", "glGetBufferSubData"; 307 | "glGetCompressedTexImage", "glGetCompressedTexImage"; 308 | "glGetnCompressedTexImage", "glGetCompressedTexImage"; 309 | "glGetCompressedTextureImage", "glGetCompressedTexImage"; 310 | "glGetCompressedTextureSubImage", "glGetCompressedTextureSubImage"; 311 | "glGetDebugMessageLog", "glGetDebugMessageLog"; 312 | "glGetDoublei_v", "glGet"; 313 | "glGetDoublev", "glGet"; 314 | "glGetError", "glGetError"; 315 | "glGetFloati_v", "glGet"; 316 | "glGetFloatv", "glGet"; 317 | "glGetFragDataIndex", "glGetFragDataIndex"; 318 | "glGetFragDataLocation", "glGetFragDataLocation"; 319 | "glGetFramebufferAttachmentParameter", 320 | "glGetFramebufferAttachmentParameter"; 321 | "glGetFramebufferAttachmentParameteriv", 322 | "glGetFramebufferAttachmentParameter"; 323 | "glGetNamedFramebufferAttachmentParameteriv", 324 | "glGetFramebufferAttachmentParameter"; 325 | "glGetFramebufferParameter", "glGetFramebufferParameter"; 326 | "glGetNamedFramebufferParameter", "glGetFramebufferParameter"; 327 | "glGetFramebufferParameteriv", "glGetFramebufferParameter"; 328 | "glGetNamedFramebufferParameteriv", "glGetFramebufferParameter"; 329 | "glGetGraphicsResetStatus", "glGetGraphicsResetStatus"; 330 | "glGetInteger64i_v", "glGet"; 331 | "glGetInteger64v", "glGet"; 332 | "glGetIntegeri_v", "glGet"; 333 | "glGetIntegerv", "glGet"; 334 | "glGetInternalformat", "glGetInternalformat"; 335 | "glGetInternalformati64v", "glGetInternalformat"; 336 | "glGetInternalformativ", "glGetInternalformat"; 337 | "glGetMultisample", "glGetMultisample"; 338 | "glGetMultisamplefv", "glGetMultisample"; 339 | "glGetObjectLabel", "glGetObjectLabel"; 340 | "glGetObjectPtrLabel", "glGetObjectPtrLabel"; 341 | "glGetPointerv", "glGetPointerv"; 342 | "glGetProgram", "glGetProgram"; 343 | "glGetProgramBinary", "glGetProgramBinary"; 344 | "glGetProgramInfoLog", "glGetProgramInfoLog"; 345 | "glGetProgramInterface", "glGetProgramInterface"; 346 | "glGetProgramInterfaceiv", "glGetProgramInterface"; 347 | "glGetProgramPipeline", "glGetProgramPipeline"; 348 | "glGetProgramPipelineInfoLog", "glGetProgramPipelineInfoLog"; 349 | "glGetProgramPipelineiv", "glGetProgramPipeline"; 350 | "glGetProgramResource", "glGetProgramResource"; 351 | "glGetProgramResourceIndex", "glGetProgramResourceIndex"; 352 | "glGetProgramResourceLocation", "glGetProgramResourceLocation"; 353 | "glGetProgramResourceLocationIndex", "glGetProgramResourceLocationIndex"; 354 | "glGetProgramResourceName", "glGetProgramResourceName"; 355 | "glGetProgramResourceiv", "glGetProgramResource"; 356 | "glGetProgramStage", "glGetProgramStage"; 357 | "glGetProgramStageiv", "glGetProgramStage"; 358 | "glGetProgramiv", "glGetProgram"; 359 | "glGetQueryIndexed", "glGetQueryIndexed"; 360 | "glGetQueryIndexediv", "glGetQueryIndexed"; 361 | "glGetQueryObject", "glGetQueryObject"; 362 | "glGetQueryObjecti64v", "glGetQueryObject"; 363 | "glGetQueryObjectiv", "glGetQueryObject"; 364 | "glGetQueryObjectui64v", "glGetQueryObject"; 365 | "glGetQueryObjectuiv", "glGetQueryObject"; 366 | "glGetQueryiv", "glGetQueryiv"; 367 | "glGetRenderbufferParameter", "glGetRenderbufferParameter"; 368 | "glGetRenderbufferParameteriv", "glGetRenderbufferParameter"; 369 | "glGetNamedRenderbufferParameteriv", "glGetRenderbufferParameter"; 370 | "glGetSamplerParameter", "glGetSamplerParameter"; 371 | "glGetSamplerParameterIiv", "glGetSamplerParameter"; 372 | "glGetSamplerParameterIuiv", "glGetSamplerParameter"; 373 | "glGetSamplerParameterfv", "glGetSamplerParameter"; 374 | "glGetSamplerParameteriv", "glGetSamplerParameter"; 375 | "glGetShader", "glGetShader"; 376 | "glGetShaderInfoLog", "glGetShaderInfoLog"; 377 | "glGetShaderPrecisionFormat", "glGetShaderPrecisionFormat"; 378 | "glGetShaderSource", "glGetShaderSource"; 379 | "glGetShaderiv", "glGetShader"; 380 | "glGetString", "glGetString"; 381 | "glGetStringi", "glGetString"; 382 | "glGetSubroutineIndex", "glGetSubroutineIndex"; 383 | "glGetSubroutineUniformLocation", "glGetSubroutineUniformLocation"; 384 | "glGetSync", "glGetSync"; 385 | "glGetSynciv", "glGetSync"; 386 | "glGetTexImage", "glGetTexImage"; 387 | "glGetnTexImage", "glGetTexImage"; 388 | "glGetTextureImage", "glGetTexImage"; 389 | "glGetTextureSubImage", "glGetTextureSubImage"; 390 | "glGetTexLevelParameter", "glGetTexLevelParameter"; 391 | "glGetTexLevelParameterfv", "glGetTexLevelParameter"; 392 | "glGetTextureLevelParameterfv", "glGetTexLevelParameter"; 393 | "glGetTexLevelParameteriv", "glGetTexLevelParameter"; 394 | "glGetTextureLevelParameteriv", "glGetTexLevelParameter"; 395 | "glGetTexParameter", "glGetTexParameter"; 396 | "glGetTexParameterIiv", "glGetTexParameter"; 397 | "glGetTextureParameterIiv", "glGetTexParameter"; 398 | "glGetTexParameterIuiv", "glGetTexParameter"; 399 | "glGetTextureParameterIuiv", "glGetTexParameter"; 400 | "glGetTexParameterfv", "glGetTexParameter"; 401 | "glGetTextureParameterfv", "glGetTexParameter"; 402 | "glGetTexParameteriv", "glGetTexParameter"; 403 | "glGetTextureParameteriv", "glGetTexParameter"; 404 | "glGetTransformFeedbackVarying", "glGetTransformFeedbackVarying"; 405 | "glGetTransformFeedbackiv", "glGetTransformFeedback"; 406 | "glGetTransformFeedbacki_v", "glGetTransformFeedback"; 407 | "glGetTransformFeedbacki64_v", "glGetTransformFeedback"; 408 | "glGetUniform", "glGetUniform"; 409 | "glGetUniformBlockIndex", "glGetUniformBlockIndex"; 410 | "glGetUniformIndices", "glGetUniformIndices"; 411 | "glGetUniformLocation", "glGetUniformLocation"; 412 | "glGetUniformSubroutine", "glGetUniformSubroutine"; 413 | "glGetUniformSubroutineuiv", "glGetUniformSubroutine"; 414 | "glGetUniformdv", "glGetUniform"; 415 | "glGetUniformfv", "glGetUniform"; 416 | "glGetUniformiv", "glGetUniform"; 417 | "glGetUniformuiv", "glGetUniform"; 418 | "glGetnUniformdv", "glGetUniform"; 419 | "glGetnUniformfv", "glGetUniform"; 420 | "glGetnUniformiv", "glGetUniform"; 421 | "glGetnUniformuiv", "glGetUniform"; 422 | "glGetVertexArrayIndexediv", "glGetVertexArrayIndexed"; 423 | "glGetVertexArrayIndexed64iv", "glGetVertexArrayIndexed"; 424 | "glGetVertexArrayiv", "glGetVertexArrayiv"; 425 | "glGetVertexAttrib", "glGetVertexAttrib"; 426 | "glGetVertexAttribIiv", "glGetVertexAttrib"; 427 | "glGetVertexAttribIuiv", "glGetVertexAttrib"; 428 | "glGetVertexAttribLdv", "glGetVertexAttrib"; 429 | "glGetVertexAttribPointerv", "glGetVertexAttribPointerv"; 430 | "glGetVertexAttribdv", "glGetVertexAttrib"; 431 | "glGetVertexAttribfv", "glGetVertexAttrib"; 432 | "glGetVertexAttribiv", "glGetVertexAttrib"; 433 | "glHint", "glHint"; 434 | "glInvalidateBufferData", "glInvalidateBufferData"; 435 | "glInvalidateNamedFramebufferData", "glInvalidateBufferData"; 436 | "glInvalidateBufferSubData", "glInvalidateBufferSubData"; 437 | "glInvalidateNamedFramebufferSubData", "glInvalidateBufferSubData"; 438 | "glInvalidateFramebuffer", "glInvalidateFramebuffer"; 439 | "glInvalidateSubFramebuffer", "glInvalidateSubFramebuffer"; 440 | "glInvalidateTexImage", "glInvalidateTexImage"; 441 | "glInvalidateTexSubImage", "glInvalidateTexSubImage"; 442 | "glIsBuffer", "glIsBuffer"; 443 | "glIsEnabled", "glIsEnabled"; 444 | "glIsEnabledi", "glIsEnabled"; 445 | "glIsFramebuffer", "glIsFramebuffer"; 446 | "glIsProgram", "glIsProgram"; 447 | "glIsProgramPipeline", "glIsProgramPipeline"; 448 | "glIsQuery", "glIsQuery"; 449 | "glIsRenderbuffer", "glIsRenderbuffer"; 450 | "glIsSampler", "glIsSampler"; 451 | "glIsShader", "glIsShader"; 452 | "glIsSync", "glIsSync"; 453 | "glIsTexture", "glIsTexture"; 454 | "glIsTransformFeedback", "glIsTransformFeedback"; 455 | "glIsVertexArray", "glIsVertexArray"; 456 | "glLineWidth", "glLineWidth"; 457 | "glLinkProgram", "glLinkProgram"; 458 | "glLogicOp", "glLogicOp"; 459 | "glMapBuffer", "glMapBuffer"; 460 | "glMapNamedBuffer", "glMapBuffer"; 461 | "glMapBufferRange", "glMapBufferRange"; 462 | "glMapNamedBufferRange", "glMapBufferRange"; 463 | "glMemoryBarrier", "glMemoryBarrier"; 464 | "glMemoryBarrierByRegion", "glMemoryBarrier"; 465 | "glMinSampleShading", "glMinSampleShading"; 466 | "glMultiDrawArrays", "glMultiDrawArrays"; 467 | "glMultiDrawArraysIndirect", "glMultiDrawArraysIndirect"; 468 | "glMultiDrawElements", "glMultiDrawElements"; 469 | "glMultiDrawElementsBaseVertex", "glMultiDrawElementsBaseVertex"; 470 | "glMultiDrawElementsIndirect", "glMultiDrawElementsIndirect"; 471 | "glObjectLabel", "glObjectLabel"; 472 | "glObjectPtrLabel", "glObjectPtrLabel"; 473 | "glPatchParameter", "glPatchParameter"; 474 | "glPatchParameterfv", "glPatchParameter"; 475 | "glPatchParameteri", "glPatchParameter"; 476 | "glPauseTransformFeedback", "glPauseTransformFeedback"; 477 | "glPixelStore", "glPixelStore"; 478 | "glPixelStoref", "glPixelStore"; 479 | "glPixelStorei", "glPixelStore"; 480 | "glPointParameter", "glPointParameter"; 481 | "glPointParameterf", "glPointParameter"; 482 | "glPointParameterfv", "glPointParameter"; 483 | "glPointParameteri", "glPointParameter"; 484 | "glPointParameteriv", "glPointParameter"; 485 | "glPointSize", "glPointSize"; 486 | "glPolygonMode", "glPolygonMode"; 487 | "glPolygonOffset", "glPolygonOffset"; 488 | "glPopDebugGroup", "glPopDebugGroup"; 489 | "glPrimitiveRestartIndex", "glPrimitiveRestartIndex"; 490 | "glPrimitiveBoundingBox", "glPrimitiveBoundingBox"; 491 | "glProgramBinary", "glProgramBinary"; 492 | "glProgramParameter", "glProgramParameter"; 493 | "glProgramParameteri", "glProgramParameter"; 494 | "glProgramUniform", "glProgramUniform"; 495 | "glProgramUniform1d", "glProgramUniform"; 496 | "glProgramUniform1dv", "glProgramUniform"; 497 | "glProgramUniform1f", "glProgramUniform"; 498 | "glProgramUniform1fv", "glProgramUniform"; 499 | "glProgramUniform1i", "glProgramUniform"; 500 | "glProgramUniform1iv", "glProgramUniform"; 501 | "glProgramUniform1ui", "glProgramUniform"; 502 | "glProgramUniform1uiv", "glProgramUniform"; 503 | "glProgramUniform2d", "glProgramUniform"; 504 | "glProgramUniform2dv", "glProgramUniform"; 505 | "glProgramUniform2f", "glProgramUniform"; 506 | "glProgramUniform2fv", "glProgramUniform"; 507 | "glProgramUniform2i", "glProgramUniform"; 508 | "glProgramUniform2iv", "glProgramUniform"; 509 | "glProgramUniform2ui", "glProgramUniform"; 510 | "glProgramUniform2uiv", "glProgramUniform"; 511 | "glProgramUniform3d", "glProgramUniform"; 512 | "glProgramUniform3dv", "glProgramUniform"; 513 | "glProgramUniform3f", "glProgramUniform"; 514 | "glProgramUniform3fv", "glProgramUniform"; 515 | "glProgramUniform3i", "glProgramUniform"; 516 | "glProgramUniform3iv", "glProgramUniform"; 517 | "glProgramUniform3ui", "glProgramUniform"; 518 | "glProgramUniform3uiv", "glProgramUniform"; 519 | "glProgramUniform4d", "glProgramUniform"; 520 | "glProgramUniform4dv", "glProgramUniform"; 521 | "glProgramUniform4f", "glProgramUniform"; 522 | "glProgramUniform4fv", "glProgramUniform"; 523 | "glProgramUniform4i", "glProgramUniform"; 524 | "glProgramUniform4iv", "glProgramUniform"; 525 | "glProgramUniform4ui", "glProgramUniform"; 526 | "glProgramUniform4uiv", "glProgramUniform"; 527 | "glProgramUniformMatrix2dv", "glProgramUniform"; 528 | "glProgramUniformMatrix2fv", "glProgramUniform"; 529 | "glProgramUniformMatrix2x3dv", "glProgramUniform"; 530 | "glProgramUniformMatrix2x3fv", "glProgramUniform"; 531 | "glProgramUniformMatrix2x4dv", "glProgramUniform"; 532 | "glProgramUniformMatrix2x4fv", "glProgramUniform"; 533 | "glProgramUniformMatrix3dv", "glProgramUniform"; 534 | "glProgramUniformMatrix3fv", "glProgramUniform"; 535 | "glProgramUniformMatrix3x2dv", "glProgramUniform"; 536 | "glProgramUniformMatrix3x2fv", "glProgramUniform"; 537 | "glProgramUniformMatrix3x4dv", "glProgramUniform"; 538 | "glProgramUniformMatrix3x4fv", "glProgramUniform"; 539 | "glProgramUniformMatrix4dv", "glProgramUniform"; 540 | "glProgramUniformMatrix4fv", "glProgramUniform"; 541 | "glProgramUniformMatrix4x2dv", "glProgramUniform"; 542 | "glProgramUniformMatrix4x2fv", "glProgramUniform"; 543 | "glProgramUniformMatrix4x3dv", "glProgramUniform"; 544 | "glProgramUniformMatrix4x3fv", "glProgramUniform"; 545 | "glProvokingVertex", "glProvokingVertex"; 546 | "glPushDebugGroup", "glPushDebugGroup"; 547 | "glQueryCounter", "glQueryCounter"; 548 | "glReadBuffer", "glReadBuffer"; 549 | "glNamedFramebufferReadBuffer", "glReadBuffer"; 550 | "glReadPixels", "glReadPixels"; 551 | "glReadnPixels", "glReadPixels"; 552 | "glReleaseShaderCompiler", "glReleaseShaderCompiler"; 553 | "glRenderbufferStorage", "glRenderbufferStorage"; 554 | "glNamedRenderbufferStorage", "glRenderbufferStorage"; 555 | "glRenderbufferStorageMultisample", "glRenderbufferStorageMultisample"; 556 | "glNamedRenderbufferStorageMultisample", "glRenderbufferStorageMultisample"; 557 | "glResumeTransformFeedback", "glResumeTransformFeedback"; 558 | "glSampleCoverage", "glSampleCoverage"; 559 | "glSampleMaski", "glSampleMaski"; 560 | "glSamplerParameter", "glSamplerParameter"; 561 | "glSamplerParameterIiv", "glSamplerParameter"; 562 | "glSamplerParameterIuiv", "glSamplerParameter"; 563 | "glSamplerParameterf", "glSamplerParameter"; 564 | "glSamplerParameterfv", "glSamplerParameter"; 565 | "glSamplerParameteri", "glSamplerParameter"; 566 | "glSamplerParameteriv", "glSamplerParameter"; 567 | "glScissor", "glScissor"; 568 | "glScissorArray", "glScissorArray"; 569 | "glScissorArrayv", "glScissorArray"; 570 | "glScissorIndexed", "glScissorIndexed"; 571 | "glScissorIndexedv", "glScissorIndexed"; 572 | "glShaderBinary", "glShaderBinary"; 573 | "glShaderSource", "glShaderSource"; 574 | "glShaderStorageBlockBinding", "glShaderStorageBlockBinding"; 575 | "glStencilFunc", "glStencilFunc"; 576 | "glStencilFuncSeparate", "glStencilFuncSeparate"; 577 | "glStencilMask", "glStencilMask"; 578 | "glStencilMaskSeparate", "glStencilMaskSeparate"; 579 | "glStencilOp", "glStencilOp"; 580 | "glStencilOpSeparate", "glStencilOpSeparate"; 581 | "glTextureBarrier", "glTextureBarrier"; 582 | "glTexBuffer", "glTexBuffer"; 583 | "glTextureBuffer", "glTexBuffer"; 584 | "glTexBufferRange", "glTexBufferRange"; 585 | "glTextureBufferRange", "glTexBufferRange"; 586 | "glTexImage1D", "glTexImage1D"; 587 | "glTexImage2D", "glTexImage2D"; 588 | "glTexImage2DMultisample", "glTexImage2DMultisample"; 589 | "glTexImage3D", "glTexImage3D"; 590 | "glTexImage3DMultisample", "glTexImage3DMultisample"; 591 | "glTexParameter", "glTexParameter"; 592 | "glTexParameterIiv", "glTexParameter"; 593 | "glTextureParameterIiv", "glTexParameter"; 594 | "glTexParameterIuiv", "glTexParameter"; 595 | "glTextureParameterIuiv", "glTexParameter"; 596 | "glTexParameterf", "glTexParameter"; 597 | "glTextureParameterf", "glTexParameter"; 598 | "glTexParameterfv", "glTexParameter"; 599 | "glTextureParameterfv", "glTexParameter"; 600 | "glTexParameteri", "glTexParameter"; 601 | "glTextureParameteri", "glTexParameter"; 602 | "glTexParameteriv", "glTexParameter"; 603 | "glTextureParameteriv", "glTexParameter"; 604 | "glTexStorage1D", "glTexStorage1D"; 605 | "glTextureStorage1D", "glTexStorage1D"; 606 | "glTexStorage2D", "glTexStorage2D"; 607 | "glTextureStorage2D", "glTexStorage2D"; 608 | "glTexStorage2DMultisample", "glTexStorage2DMultisample"; 609 | "glTextureStorage2DMultisample", "glTexStorage2DMultisample"; 610 | "glTexStorage3D", "glTexStorage3D"; 611 | "glTextureStorage3D", "glTexStorage3D"; 612 | "glTexStorage3DMultisample", "glTexStorage3DMultisample"; 613 | "glTextureStorage3DMultisample", "glTexStorage3DMultisample"; 614 | "glTexSubImage1D", "glTexSubImage1D"; 615 | "glTextureSubImage1D", "glTexSubImage1D"; 616 | "glTexSubImage2D", "glTexSubImage2D"; 617 | "glTextureSubImage2D", "glTexSubImage2D"; 618 | "glTexSubImage3D", "glTexSubImage3D"; 619 | "glTextureSubImage3D", "glTexSubImage3D"; 620 | "glTextureView", "glTextureView"; 621 | "glTransformFeedbackVaryings", "glTransformFeedbackVaryings"; 622 | "glTransformFeedbackBufferBase", "glTransformFeedbackBufferBase"; 623 | "glTransformFeedbackBufferRange", "glTransformFeedbackBufferRange"; 624 | "glUniform", "glUniform"; 625 | "glUniform1d", "glUniform"; 626 | "glUniform1dv", "glUniform"; 627 | "glUniform1f", "glUniform"; 628 | "glUniform1fv", "glUniform"; 629 | "glUniform1i", "glUniform"; 630 | "glUniform1iv", "glUniform"; 631 | "glUniform1ui", "glUniform"; 632 | "glUniform1uiv", "glUniform"; 633 | "glUniform2d", "glUniform"; 634 | "glUniform2dv", "glUniform"; 635 | "glUniform2f", "glUniform"; 636 | "glUniform2fv", "glUniform"; 637 | "glUniform2i", "glUniform"; 638 | "glUniform2iv", "glUniform"; 639 | "glUniform2ui", "glUniform"; 640 | "glUniform2uiv", "glUniform"; 641 | "glUniform3d", "glUniform"; 642 | "glUniform3dv", "glUniform"; 643 | "glUniform3f", "glUniform"; 644 | "glUniform3fv", "glUniform"; 645 | "glUniform3i", "glUniform"; 646 | "glUniform3iv", "glUniform"; 647 | "glUniform3ui", "glUniform"; 648 | "glUniform3uiv", "glUniform"; 649 | "glUniform4d", "glUniform"; 650 | "glUniform4dv", "glUniform"; 651 | "glUniform4f", "glUniform"; 652 | "glUniform4fv", "glUniform"; 653 | "glUniform4i", "glUniform"; 654 | "glUniform4iv", "glUniform"; 655 | "glUniform4ui", "glUniform"; 656 | "glUniform4uiv", "glUniform"; 657 | "glUniformBlockBinding", "glUniformBlockBinding"; 658 | "glUniformMatrix2dv", "glUniform"; 659 | "glUniformMatrix2fv", "glUniform"; 660 | "glUniformMatrix2x3dv", "glUniform"; 661 | "glUniformMatrix2x3fv", "glUniform"; 662 | "glUniformMatrix2x4dv", "glUniform"; 663 | "glUniformMatrix2x4fv", "glUniform"; 664 | "glUniformMatrix3dv", "glUniform"; 665 | "glUniformMatrix3fv", "glUniform"; 666 | "glUniformMatrix3x2dv", "glUniform"; 667 | "glUniformMatrix3x2fv", "glUniform"; 668 | "glUniformMatrix3x4dv", "glUniform"; 669 | "glUniformMatrix3x4fv", "glUniform"; 670 | "glUniformMatrix4dv", "glUniform"; 671 | "glUniformMatrix4fv", "glUniform"; 672 | "glUniformMatrix4x2dv", "glUniform"; 673 | "glUniformMatrix4x2fv", "glUniform"; 674 | "glUniformMatrix4x3dv", "glUniform"; 675 | "glUniformMatrix4x3fv", "glUniform"; 676 | "glUniformSubroutines", "glUniformSubroutines"; 677 | "glUniformSubroutinesuiv", "glUniformSubroutines"; 678 | "glUnmapBuffer", "glUnmapBuffer"; 679 | "glUnmapNamedBuffer", "glUnmapBuffer"; 680 | "glUseProgram", "glUseProgram"; 681 | "glUseProgramStages", "glUseProgramStages"; 682 | "glValidateProgram", "glValidateProgram"; 683 | "glValidateProgramPipeline", "glValidateProgramPipeline"; 684 | "glVertexAttrib", "glVertexAttrib"; 685 | "glVertexAttrib1d", "glVertexAttrib"; 686 | "glVertexAttrib1dv", "glVertexAttrib"; 687 | "glVertexAttrib1f", "glVertexAttrib"; 688 | "glVertexAttrib1fv", "glVertexAttrib"; 689 | "glVertexAttrib1s", "glVertexAttrib"; 690 | "glVertexAttrib1sv", "glVertexAttrib"; 691 | "glVertexAttrib2d", "glVertexAttrib"; 692 | "glVertexAttrib2dv", "glVertexAttrib"; 693 | "glVertexAttrib2f", "glVertexAttrib"; 694 | "glVertexAttrib2fv", "glVertexAttrib"; 695 | "glVertexAttrib2s", "glVertexAttrib"; 696 | "glVertexAttrib2sv", "glVertexAttrib"; 697 | "glVertexAttrib3d", "glVertexAttrib"; 698 | "glVertexAttrib3dv", "glVertexAttrib"; 699 | "glVertexAttrib3f", "glVertexAttrib"; 700 | "glVertexAttrib3fv", "glVertexAttrib"; 701 | "glVertexAttrib3s", "glVertexAttrib"; 702 | "glVertexAttrib3sv", "glVertexAttrib"; 703 | "glVertexAttrib4Nbv", "glVertexAttrib"; 704 | "glVertexAttrib4Niv", "glVertexAttrib"; 705 | "glVertexAttrib4Nsv", "glVertexAttrib"; 706 | "glVertexAttrib4Nub", "glVertexAttrib"; 707 | "glVertexAttrib4Nubv", "glVertexAttrib"; 708 | "glVertexAttrib4Nuiv", "glVertexAttrib"; 709 | "glVertexAttrib4Nusv", "glVertexAttrib"; 710 | "glVertexAttrib4bv", "glVertexAttrib"; 711 | "glVertexAttrib4d", "glVertexAttrib"; 712 | "glVertexAttrib4dv", "glVertexAttrib"; 713 | "glVertexAttrib4f", "glVertexAttrib"; 714 | "glVertexAttrib4fv", "glVertexAttrib"; 715 | "glVertexAttrib4iv", "glVertexAttrib"; 716 | "glVertexAttrib4s", "glVertexAttrib"; 717 | "glVertexAttrib4sv", "glVertexAttrib"; 718 | "glVertexAttrib4ubv", "glVertexAttrib"; 719 | "glVertexAttrib4uiv", "glVertexAttrib"; 720 | "glVertexAttrib4usv", "glVertexAttrib"; 721 | "glVertexAttribBinding", "glVertexAttribBinding"; 722 | "glVertexArrayAttribBinding", "glVertexAttribBinding"; 723 | "glVertexAttribDivisor", "glVertexAttribDivisor"; 724 | "glVertexAttribFormat", "glVertexAttribFormat"; 725 | "glVertexArrayAttribFormat", "glVertexAttribFormat"; 726 | "glVertexAttribI1i", "glVertexAttrib"; 727 | "glVertexAttribI1iv", "glVertexAttrib"; 728 | "glVertexAttribI1ui", "glVertexAttrib"; 729 | "glVertexAttribI1uiv", "glVertexAttrib"; 730 | "glVertexAttribI2i", "glVertexAttrib"; 731 | "glVertexAttribI2iv", "glVertexAttrib"; 732 | "glVertexAttribI2ui", "glVertexAttrib"; 733 | "glVertexAttribI2uiv", "glVertexAttrib"; 734 | "glVertexAttribI3i", "glVertexAttrib"; 735 | "glVertexAttribI3iv", "glVertexAttrib"; 736 | "glVertexAttribI3ui", "glVertexAttrib"; 737 | "glVertexAttribI3uiv", "glVertexAttrib"; 738 | "glVertexAttribI4bv", "glVertexAttrib"; 739 | "glVertexAttribI4i", "glVertexAttrib"; 740 | "glVertexAttribI4iv", "glVertexAttrib"; 741 | "glVertexAttribI4sv", "glVertexAttrib"; 742 | "glVertexAttribI4ubv", "glVertexAttrib"; 743 | "glVertexAttribI4ui", "glVertexAttrib"; 744 | "glVertexAttribI4uiv", "glVertexAttrib"; 745 | "glVertexAttribI4usv", "glVertexAttrib"; 746 | "glVertexAttribIFormat", "glVertexAttribFormat"; 747 | "glVertexArrayAttribIFormat", "glVertexAttribFormat"; 748 | "glVertexAttribIPointer", "glVertexAttribPointer"; 749 | "glVertexAttribL1d", "glVertexAttrib"; 750 | "glVertexAttribL1dv", "glVertexAttrib"; 751 | "glVertexAttribL2d", "glVertexAttrib"; 752 | "glVertexAttribL2dv", "glVertexAttrib"; 753 | "glVertexAttribL3d", "glVertexAttrib"; 754 | "glVertexAttribL3dv", "glVertexAttrib"; 755 | "glVertexAttribL4d", "glVertexAttrib"; 756 | "glVertexAttribL4dv", "glVertexAttrib"; 757 | "glVertexAttribLFormat", "glVertexAttribFormat"; 758 | "glVertexArrayAttribLFormat", "glVertexAttribFormat"; 759 | "glVertexAttribLPointer", "glVertexAttribPointer"; 760 | "glVertexAttribP1ui", "glVertexAttrib"; 761 | "glVertexAttribP1uiv", "glVertexAttrib"; 762 | "glVertexAttribP2ui", "glVertexAttrib"; 763 | "glVertexAttribP2uiv", "glVertexAttrib"; 764 | "glVertexAttribP3ui", "glVertexAttrib"; 765 | "glVertexAttribP3uiv", "glVertexAttrib"; 766 | "glVertexAttribP4ui", "glVertexAttrib"; 767 | "glVertexAttribP4uiv", "glVertexAttrib"; 768 | "glVertexAttribPointer", "glVertexAttribPointer"; 769 | "glVertexBindingDivisor", "glVertexBindingDivisor"; 770 | "glVertexArrayBindingDivisor", "glVertexBindingDivisor"; 771 | "glViewport", "glViewport"; 772 | "glViewportArray", "glViewportArray"; 773 | "glViewportArrayv", "glViewportArray"; 774 | "glViewportIndexed", "glViewportIndexed"; 775 | "glViewportIndexedf", "glViewportIndexed"; 776 | "glViewportIndexedfv", "glViewportIndexed"; 777 | "glWaitSync", "glWaitSync"; ] 778 | --------------------------------------------------------------------------------