Beginning with OpenGL in OCaml

OpenGL in OCaml, the forward compatible way

In OpenGL 3.X a deprecation model was introduced.
Here is a tutorial about how to write forward compatible OpenGL programs in OCaml.
You can adopt this forward compatible way even if you currently use an OpenGL version 2.X

If you prefer to learn the old model, or by curiosity you can see this old tutorial.



Introduction

OpenGL is a generic real-time 3D library. Its rendering can be hardware accelerated when a driver is installed for the graphics-card, or it can be software rendered with the Mesa library. So OpenGL is available in a wide range of environments.

The Deprecation

With OpenGL 3.X a deprecation model was introduced.
In the specifications it is explained as:
"OpenGL 3.0 introduces a deprecation model in which certain features may be marked as deprecated.
Deprecated features are expected to be completely removed from a future version of OpenGL."

This tutorial does not use any deprecated features, so the examples presented on this page are believed to be "forward-compatible".
Also please note that you can do forward-compatible OpenGL programming even if you are using an OpenGL 2.1 version, because the main change is not adding new features but tagging as deprecated the old features.

What is deprecated?

If you are new to OpenGL you can skip this paragraph, otherwise you could be interested to know what in brief is now deprecated?
The main feature removed is the "immediate-mode" which is drawing primitives with glBegin / ... / glVertex3 / glEnd, now you should use VBO instead. In fact only VBO should be used now, all the other drawing methods "Vertex-Arrays" and "Display-Lists" are deprecated too. You should not use any internal matrices of OpenGL which are GL_MODELVIEW / GL_PROJECTION / GL_TEXTURE, this means that all the associated functions are now deprecated too, a non-exhaustive list of them being glRotate / glTranslate / glScale and glPushMatrix / glPopMatrix / glLoadIdentity / glMultMatrix / glLoadMatrix. And no projection matrix means no glFrustum / gluPerspective / glOrtho.
The "fixed-pipeline" is also deprecated which means that now GLSL shaders are not optional but required to render all the primitives. You should also probably avoid to use GLU.

In OCaml

The examples presented on this web-page use the OCaml-OpenGL interface glMLite (GH). You can have an overview of the modules that it provides through its ocamldoc generated documentation. The GL module (the core OpenGL functions) provides links to the manual pages for each functions of the OpenGL API.
After each deprecated function there is "Deprecated" written in red.
Also if you do care to not use any deprecated feature you can compile glMLite so that calling any deprecated function will raise an exception. To compile glMLite like so, use:
make <target> USE_GL3_CORE_PROFILE=OK
All the scripts below can be executed with this command line:
 ocaml -I +glMLite  Glut.cma GL.cma bigarray.cma vertArray.cma VBO.cma  demo.ml
Or alternatly you can add the following instructions at the very beginning of your files:
#!/usr/bin/env ocaml
#directory "+glMLite"
#load "Glut.cma"
#load "GL.cma"
#load "bigarray.cma"
#load "vertArray.cma"
#load "VBO.cma"
Or if you prefer to compile to binary native code for the best performances, use this command:
ocamlopt -I +glMLite Glut.cmxa GL.cmxa bigarray.cmxa vertArray.cmxa VBO.cmxa demo.ml -o demo.opt

Windowing

First OpenGL only covers the 3D rendering, it does not handle the interaction with the windowing system.
For simple OpenGL demos we often use the Glut library. It is portable, simple to use, and it is designed to work with OpenGL.
glMLite also provides a Glut module.
There are other solutions to handle windowing and user interactions:


Primitives

To draw things on screen we use primitives, and in OpenGL the primitives are very low-level, there are points, lines (segments), and triangle faces. The gl-enum for this is the type primitive in the module GL. Quadrilaterals (polygons with four sides) and polygons with more than four sides are now deprecated in OpenGL, so we should only use triangle faces now, what is anyway what we use the more. So to create more complex objects we constitute meshes with adjacent triangles what we call triangle meshes. So a mesh is a list of triangle faces, and a triangle face is made of three vertices. A vertex is specified with 3 coordinates, these coordinates are given as floats. The three components of a vertex are called (x,y,z), which are the coordinates along the three axes.


Quick Start

Now let's have a look at a simple example:

open Glut
open GL
open VertArray
open VBO

let display vbo shader_prog vertexPosAttrib = function () ->
  glClear [GL_COLOR_BUFFER_BIT];
  glUseProgram shader_prog;
  glBindBuffer GL_ARRAY_BUFFER vbo;
  glEnableVertexAttribArray vertexPosAttrib;
  glVertexAttribPointerOfs32 vertexPosAttrib 3 VAttr.GL_FLOAT false 3 0;
  glDrawArrays GL_TRIANGLES 0 3;
  glutSwapBuffers ()

let make_vbo () =
  let vertex_data =
    Bigarray.Array1.of_array Bigarray.float32 Bigarray.c_layout [|
      -1.0; -1.0; 0.0;
       0.0;  1.0; 0.0;
       1.0; -1.0; 0.0;
    |]
  in
  let id = glGenBuffer () in
  glBindBuffer GL_ARRAY_BUFFER id;
  glBufferData GL_ARRAY_BUFFER (ba_sizeof vertex_data) vertex_data GL_STATIC_DRAW;
  (id)

let vertex_shader_src = "
#version 130
in vec3 VertexPosition;
invariant gl_Position;
void main () {
  gl_Position = vec4(VertexPosition, 1.0);
}"

let fragment_shader_src = "
#version 130
out vec4 Color;
void main() {
  Color = vec4(1.0, 0.0, 0.0, 1.0);
}"

let load_shaders () =
  let vertexShaderID = glCreateShader GL_VERTEX_SHADER in
  let fragmentShaderID = glCreateShader GL_FRAGMENT_SHADER in

  glShaderSource vertexShaderID vertex_shader_src;
  glShaderSource fragmentShaderID fragment_shader_src;

  glCompileShader vertexShaderID;
  glCompileShader fragmentShaderID;

  let shader_prog = glCreateProgram () in
  glAttachShader shader_prog vertexShaderID;
  glAttachShader shader_prog fragmentShaderID;

  glLinkProgram shader_prog;
  let vertexPosAttrib = glGetAttribLocation shader_prog "VertexPosition" in
  (shader_prog, vertexPosAttrib)

let () =
  ignore(glutInit Sys.argv);
  glutInitDisplayMode [GLUT_DOUBLE];
  ignore(glutCreateWindow ~title:Sys.argv.(0));
  let vbo = make_vbo () in
  let sp, vp = load_shaders () in
  glutDisplayFunc ~display:(display vbo sp vp);
  glutMainLoop ()

Alternatively you can use these 1.2 shaders, if your hardware does not support GLSL version 1.3.

let vertex_shader_src = "
#version 120
in vec3 VertexPosition;
void main () {
  gl_Position = vec4(VertexPosition, 1.0);
}"

let fragment_shader_src = "
#version 120
void main() {
  gl_FragColor = vec4(1.0, 0.0, 0.0, 1.0);
}"
This short program displays a single red triangle:

Here is below a line-by-line explanation of it.

Initialise with Glut

Let's start looking at the main / the entry point, the first function called is glutInit with Sys.argv as parameter, it will initialise the Glut library. If the Sys.argv array contains parameters specific to OpenGL/Glut, those parameters will be stripped from the array returned by this function. This way your application can parse this returned array without seeing the OpenGL parameters.

To make animations fluid we use double buffering, which means that there are two images to process the rendering. One is displayed on the foreground of the drawing area, and a second one lies in the background and this is this last one that is used by drawing functions to draw the rendering, and when this rendering is finished the background buffer is swaped with the foreground buffer with the function glutSwapBuffers which is called at the end of the display callback. If you use another windowing library than Glut, you will still find equivalents to these functions that you will have to use to get a similar effect. For example with OCamlSDL1 this is Sdlgl.swap_buffers and with OCamlSDL2 this is Sdlgl.swap_window. In ocaml-sfml it's SFRenderWindow.display, and in Ocsfml it's the display method of the class render_window from the OcsfmlGraphics module.
So we select double buffering with the parameter GLUT_DOUBLE that we provide to the function glutInitDisplayMode .

Then the window is created with glutCreateWindow , the parameter is the title which will appear in the handle of the window. It returns the ID of the created window, but here we can just ignore it.

Then we create the vbo and the shader which will be used in the display callback. We will explain vbo and shaders below.

As OpenGL is a graphics rendering library, we need to define a rendering callback which will be called each time a new frame will be drawn. Register this callback with glutDisplayFunc . The display callback should have type unit -> unit, but we can provide additional parameters by partial application. We will examine the details of the display callback below.

Now the function glutMainLoop will make the program enter in the main execution loop. Depending on the Glut implementation you're using this function never returns (in this case exit the program with the exit function) or with more recent Glut (such as OpenGlut or FreeGlut) this main loop can be leaved with glutLeaveMainLoop.

Initialise OpenGL

In OpenGL the way we should now provide the primitives data to the driver (hardware or software) is with VBO, which is a method to make reside the data in the memory of the graphics-card. So there are two steps, first create the vbo and upload the data in its buffer, we do this during the initialisation. Then during the main loop, in the display callback we can call this vbo in order to draw its contents on screen.
So this first step here in this script is made with the function make_vbo. The variable vertex_data contains one triangle made of three vertices (one by line), each vertex is made of three floats (the {X,Y,Z} coordinates).
With glGenBuffer we create an id to handle the VBO, then with glBindBuffer we select this vbo as the active one for the following buffer operations, which is glBufferData used to upload the contents of the bigarray to the video-device. GL_STATIC_DRAW indicates that the data contained in the buffer won't change.
Finally make_vbo returns the vbo id which will be used in the display callback to draw its contents.

The display callback

Now Let's have a quick look at the display callback, before explaining the shader.
The first function clears the content of the window (the previous drawn frame), otherwise the primitives are drawn above the previous drawn frame. This won't have any important effect in this first example because the image is fixed, but you will see the difference in the next example if you remove this command.
The function glUseProgram selects which shader to use to make the rendering of the primitives (here there is only one shader program), and glBindBuffer selects which vbo we want to use.
Then we have to connect or "pipe" the contents of the vbo buffer to the shader so that the data will actually be rendered by the shader program. We do this in several steps with glEnableVertexAttribArray (enables this input in the shader), glVertexAttribPointerOfs32 (specifies the format of this input), (you will understand better what those operations do after the explanation of the shader).
When the connections are done, we call glDrawArrays to actually draw the primitive. Here we see that we request triangles primitives with GL_TRIANGLES because in the buffer the data are generic, it's only this primitive parameter and what is done in the shader from those data that decides what the data are really.

Shaders

Now about the shaders which is maybe the hardest part.
Shaders are programs executed by the graphics-cards, they do the rendering from the input data to produce the final image displayed on screen.
The shader program is in fact made of two shaders, the "vertex shader" and the "fragment shader". The vertex shader is executed first and one time for each vertex (so it's called "vertex shader"). So for a triangle the vertex shader is called for each vertex of the triangle, which provides 3 points in the window space that OpenGL can use to rasterise the triangle in the window space, which produces a set of pixels. The "fragment shader" is then executed for each pixel of the rasterised primitive. By "each pixel" I mean pixels from the final rendered image. It is called "fragment shader" and not "pixel shader" because it is related to the fragments of the rendered primitive. It is also called "fragment shader" not "pixel shader" because several objects may be projected on the same part of the 2D image (one farther, and the other closer to the viewer), also it may happen that there are no primitives drawn on some areas of the image (here in this example the parts in black).
The shaders in OpenGL are written in a progamming language named GLSL. GLSL is very close to the C programming language, with some features from C++.

The source code of the shaders are provided to OpenGL with the function glShaderSource which takes it as a string, so that the glsl source code can be embeded into an ocaml string as in this example with the two strings vertex_shader_src and fragment_shader_src in order to keep this example simple, but often when shaders are more complex they are written in separated files which are loaded into a string, so then we can edit the shaders with the syntax highlighting for GLSL, as below:

// vertex shader
#version 130
in vec3 VertexPosition;
invariant gl_Position;
void main () {
  gl_Position = vec4(VertexPosition, 1.0);
}

The first line in these shaders tell which GLSL version we use (here 1.3).

Here in this vertex shader we first declare the variable VertexPosition which is declared with in and vec3. vec3 is the type, a vector with three components (3 floats). in declares this variable as an input of the vertex shader. In the ocaml function load_shaders() there is this line of code:
let vertexPosAttrib = glGetAttribLocation shader_prog "VertexPosition" in
so that this "attrib-location" is used later in the display callback to "pipe" the data from the vbo buffer into this "input". This connection is made with glEnableVertexAttribArray and glVertexAttribPointerOfs32 with this variable vertexPosAttrib. The first function just enables to access this attribute. The second one is trickier, let's have a look at its interface:

val glVertexAttribPointerOfs32 :
        index:int -> size:int ->
        data_type:VAttr.vertattr_data_type ->
        normalized:bool ->
        stride:int -> ofs:int -> unit

We use the glVertexAttribPointer* function that ends with "Ofs32" because in our ocaml bigarray we used Bigarray.float32 which means the atoms are 32 bits. (In OpenGL there are also half precision 16 bits floats, that we can use with Bigarray.int16_unsigned).
The index parameter is to tell for which "attrib" we are giving parameters.
The size parameter tells how many components we have, here it is 3 for our 3 floats (x,y,z).
For the data_type we give GL_FLOAT no need to explain why.
normalized is for fixed-point data, not used here (read the man for more inforations).
stride and ofs are usefull when we provide several data kind in the same buffer, for example RGB colors, normals and vertex coords. But this is not the case here so we put the size of the coords which is 3 for stride, and 0 for ofs.

The output of the vertex shader should be the position of the vertex which will be used for the rasterisation. Here we just set gl_Position as the same value than VertexPosition with a cast from the type vec3 to vec4. Here you see a similarity with C++ vec4 is used as a function where we add a fourth component 1.0.
 

// fragment shader
#version 130
out vec4 Color;
void main() {
  Color = vec4(1.0, 0.0, 0.0, 1.0);
}

In the fragment shader the purpose is to set the color of the pixel.
Here we set an RGBA value of (1.0, 0.0, 0.0, 1.0), the maximum value being 1.0, red is full and blue and green channels are zero, and there is no transparency. So our triangle appears colored in red.

 

The First Animation

This second script is quite close to the first one, with some additions.

Other Glut callback are used, a basic animation is made, a delete function was added to leave in a clean way, another data model based on indices, managing matrices including the projection matrix, a buffer containing several kind of data (vertices and colors), using interpolation in the shaders, using the depth buffer, checking if the shaders was compiled right, using cull-face and using a timer to calculate FPS.

open GL          (* the base functions of OpenGL *)
open VertArray   (* Vertex-Array, needed by VBO, VBO are build on top of VA's *)
open VBO         (* Vertex Buffer Object, the most efficient drawing method
                      and the base drawing method in OpenGL 3.X *)
open Glut        (* windowing with Glut *)


let msecs = 5000  (* print fps every 5 seconds *)

(* product of the modelview (world) matrix and the projection matrix *)
let modelviewProjectionMatrix = ref [| |]


let cube_vertices =
  Bigarray.Array1.of_array Bigarray.float32 Bigarray.c_layout [|
    (* RGB colors *)  (* XYZ coords *)
    0.0; 1.0; 0.0;    -1.0;  1.0; -1.0;
    0.0; 0.0; 0.0;    -1.0; -1.0; -1.0;
    1.0; 1.0; 0.0;    -1.0;  1.0;  1.0;
    1.0; 0.0; 0.0;    -1.0; -1.0;  1.0;
    1.0; 1.0; 1.0;     1.0;  1.0;  1.0;
    1.0; 0.0; 1.0;     1.0; -1.0;  1.0;
    0.0; 1.0; 1.0;     1.0;  1.0; -1.0;
    0.0; 0.0; 1.0;     1.0; -1.0; -1.0;
  |]

let cube_indices =
  Bigarray.Array1.of_array Bigarray.int32 Bigarray.c_layout (
    Array.map Int32.of_int [|
      (* 6 squares, each square made of 2 triangles,
         quad faces don't exist anymore in OGL 3.X *)
      0;1;3;  3;2;0;
      4;5;7;  7;6;4;
      3;1;7;  7;5;3;
      0;2;4;  4;6;0;
      6;7;1;  1;0;6;
      2;3;5;  5;4;2;
    |]
  )


(* construct a projection matrix *)
let perspective_projection ~fov ~ratio ~near ~far =

  let pi = 3.14159265358979323846 in
  let maxY = near *. tan (fov *. pi /. 360.0) in
  let minY = -. maxY in
  let minX = minY *. ratio
  and maxX = maxY *. ratio in

  let x_diff = maxX -. minX in
  let y_diff = maxY -. minY in
  let z_diff = far -. near in
  let near_twice = 2.0 *. near in

  let a = near_twice /. x_diff
  and b = near_twice /. y_diff
  and c = (maxX +. minX) /. x_diff
  and d = (maxY +. minY) /. y_diff
  and e = -. (far +. near) /. z_diff
  and f = -. (near_twice *. far) /. z_diff
  in
  [| a;   0.0; 0.0; 0.0;
     0.0; b;   0.0; 0.0;
     c;   d;   e;  -1.0;
     0.0; 0.0; f;   0.0; |]


let translation_matrix (x,y,z) =
  [| 1.0; 0.0; 0.0; 0.0;
     0.0; 1.0; 0.0; 0.0;
     0.0; 0.0; 1.0; 0.0;
       x;   y;   z; 1.0; |]


(* multiply two matrices *)
let mult_matrix ~m1 ~m2 =
  if Array.length m1 <> 16
  || Array.length m2 <> 16
  then invalid_arg "mult_matrix";

  let mat1_get = Array.unsafe_get m1
  and mat2_get = Array.unsafe_get m2 in

  let m1_0  = mat1_get 0     and m2_0  = mat2_get 0
  and m1_1  = mat1_get 1     and m2_1  = mat2_get 1
  and m1_2  = mat1_get 2     and m2_2  = mat2_get 2
  and m1_3  = mat1_get 3     and m2_3  = mat2_get 3
  and m1_4  = mat1_get 4     and m2_4  = mat2_get 4
  and m1_5  = mat1_get 5     and m2_5  = mat2_get 5
  and m1_6  = mat1_get 6     and m2_6  = mat2_get 6
  and m1_7  = mat1_get 7     and m2_7  = mat2_get 7
  and m1_8  = mat1_get 8     and m2_8  = mat2_get 8
  and m1_9  = mat1_get 9     and m2_9  = mat2_get 9
  and m1_10 = mat1_get 10    and m2_10 = mat2_get 10
  and m1_11 = mat1_get 11    and m2_11 = mat2_get 11
  and m1_12 = mat1_get 12    and m2_12 = mat2_get 12
  and m1_13 = mat1_get 13    and m2_13 = mat2_get 13
  and m1_14 = mat1_get 14    and m2_14 = mat2_get 14
  and m1_15 = mat1_get 15    and m2_15 = mat2_get 15
  in
  [|
    m1_0 *. m2_0  +. m1_4 *. m2_1  +. m1_8  *. m2_2  +. m1_12 *. m2_3;
    m1_1 *. m2_0  +. m1_5 *. m2_1  +. m1_9  *. m2_2  +. m1_13 *. m2_3;
    m1_2 *. m2_0  +. m1_6 *. m2_1  +. m1_10 *. m2_2  +. m1_14 *. m2_3;
    m1_3 *. m2_0  +. m1_7 *. m2_1  +. m1_11 *. m2_2  +. m1_15 *. m2_3;
    m1_0 *. m2_4  +. m1_4 *. m2_5  +. m1_8  *. m2_6  +. m1_12 *. m2_7;
    m1_1 *. m2_4  +. m1_5 *. m2_5  +. m1_9  *. m2_6  +. m1_13 *. m2_7;
    m1_2 *. m2_4  +. m1_6 *. m2_5  +. m1_10 *. m2_6  +. m1_14 *. m2_7;
    m1_3 *. m2_4  +. m1_7 *. m2_5  +. m1_11 *. m2_6  +. m1_15 *. m2_7;
    m1_0 *. m2_8  +. m1_4 *. m2_9  +. m1_8  *. m2_10 +. m1_12 *. m2_11;
    m1_1 *. m2_8  +. m1_5 *. m2_9  +. m1_9  *. m2_10 +. m1_13 *. m2_11;
    m1_2 *. m2_8  +. m1_6 *. m2_9  +. m1_10 *. m2_10 +. m1_14 *. m2_11;
    m1_3 *. m2_8  +. m1_7 *. m2_9  +. m1_11 *. m2_10 +. m1_15 *. m2_11;
    m1_0 *. m2_12 +. m1_4 *. m2_13 +. m1_8  *. m2_14 +. m1_12 *. m2_15;
    m1_1 *. m2_12 +. m1_5 *. m2_13 +. m1_9  *. m2_14 +. m1_13 *. m2_15;
    m1_2 *. m2_12 +. m1_6 *. m2_13 +. m1_10 *. m2_14 +. m1_14 *. m2_15;
    m1_3 *. m2_12 +. m1_7 *. m2_13 +. m1_11 *. m2_14 +. m1_15 *. m2_15;
  |]


let reshape ~width ~height =
  let height = max height 1 in
  glViewport 0 0 width height;
  let ratio = float width /. float height in

  (* creation of the matrices *)
  let projectionMatrix = perspective_projection 56.0 ratio 1.0 500.0 in
  let worldMatrix = translation_matrix (0.0, 0.0, -6.0) in
  modelviewProjectionMatrix := mult_matrix projectionMatrix worldMatrix;
;;


let normalise_vector (x,y,z) =
  let len = sqrt(x *. x +. y *. y +. z *. z) in
  (x /. len, y /. len, z /. len)

(* create a rotation matrix defined by a rotation axis and a rotation angle *)
let rotation_matrix_of_axis ~dir ~angle =
  let angle = angle *. 0.5 in
  let vn_x, vn_y, vn_z = normalise_vector dir in
  let sinAngle = sin angle in
  let qx = vn_x *. sinAngle
  and qy = vn_y *. sinAngle
  and qz = vn_z *. sinAngle
  and qw = cos angle
  in
  let x2 = qx *. qx
  and y2 = qy *. qy
  and z2 = qz *. qz
  and xy = qx *. qy
  and xz = qx *. qz
  and yz = qy *. qz
  and wx = qw *. qx
  and wy = qw *. qy
  and wz = qw *. qz in
  [| 1.0 -. 2.0 *. (y2 +. z2) ; 2.0 *. (xy -. wz);  2.0 *. (xz +. wy); 0.0;
     2.0 *. (xy +. wz);  1.0 -. 2.0 *. (x2 +. z2);  2.0 *. (yz -. wx); 0.0;
     2.0 *. (xz -. wy);  2.0 *. (yz +. wx);  1.0 -. 2.0 *. (x2 +. y2); 0.0;
     0.0;  0.0;  0.0;  1.0; |]


let frame_count = ref 0

let display
      (mesh_buffers, ndx_len,
       (shader_prog,
        uniformID,
        vertexPositionAttrib,
        vertexColorAttrib, _, _)) = function () ->

  glClear [GL_COLOR_BUFFER_BIT; GL_DEPTH_BUFFER_BIT];

  let now = Unix.gettimeofday() in
  let y = cos now
  and z = sin now in
  let dir = (0.0, y, z)        (* this is the axis of the rotation *)
  and angle = (now *. 0.8) in  (* and this is the angle of the rotation *)

  let rot_mat = rotation_matrix_of_axis dir angle in
  let world_proj_matrix = mult_matrix !modelviewProjectionMatrix rot_mat in

  glUseProgram shader_prog;
  glUniformMatrix4fv uniformID 1 false world_proj_matrix;

  (* activate the 2 generic arrays *)
  glEnableVertexAttribArray vertexColorAttrib;
  glEnableVertexAttribArray vertexPositionAttrib;

  (* bind the vertices buffer *)
  glBindBuffer GL_ARRAY_BUFFER mesh_buffers.(0);
  (* and link the buffer data with the shader program *)
  glVertexAttribPointerOfs32 vertexColorAttrib 3 VAttr.GL_FLOAT false 6 0;
  glVertexAttribPointerOfs32 vertexPositionAttrib 3 VAttr.GL_FLOAT false 6 3;

  (* active the indices buffer *)
  glBindBuffer GL_ELEMENT_ARRAY_BUFFER mesh_buffers.(1);
  (* and render the mesh *)
  glDrawElements0 GL_TRIANGLES ndx_len Elem.GL_UNSIGNED_INT;

  (* desactivate the generic arrays *)
  glDisableVertexAttribArray vertexColorAttrib;
  glDisableVertexAttribArray vertexPositionAttrib;

  glUnuseProgram ();

  incr frame_count;
  glutSwapBuffers ();
;;



let vertex_shader = "
#version 130
in vec3 VertexColor;
in vec3 VertexPosition;
uniform mat4 ModelViewProjectionMatrix;
invariant gl_Position;
smooth out vec3 InterpolatedColor;

void main () {
    InterpolatedColor = VertexColor;
    gl_Position = ModelViewProjectionMatrix * vec4 (VertexPosition, 1.0);
}"

let fragment_shader = "
#version 130
precision highp float;
smooth in vec3 InterpolatedColor;
out vec4 Color;
void main() {
    Color = vec4 (InterpolatedColor, 1.0);
}"


let load_shaders vertexShader fragmentShader =
  let vertexShaderID = glCreateShader GL_VERTEX_SHADER in
  let fragmentShaderID = glCreateShader GL_FRAGMENT_SHADER in

  glShaderSource vertexShaderID vertexShader;
  glShaderSource fragmentShaderID fragmentShader;

  glCompileShader vertexShaderID;
  glCompileShader fragmentShaderID;

  if not(glGetShaderCompileStatus vertexShaderID) then begin
    prerr_endline "vertex shader compile error";
    prerr_endline (glGetShaderInfoLog vertexShaderID);
    glGetShaderCompileStatus_exn vertexShaderID;
  end;
  if not(glGetShaderCompileStatus fragmentShaderID) then begin
    prerr_endline "fragment shader compile error";
    prerr_endline (glGetShaderInfoLog fragmentShaderID);
    glGetShaderCompileStatus_exn fragmentShaderID;
  end;

  let shaderProgram = glCreateProgram () in
  glAttachShader shaderProgram vertexShaderID;
  glAttachShader shaderProgram fragmentShaderID;

  glLinkProgram shaderProgram;

  let uniformMatrix = glGetUniformLocation shaderProgram "ModelViewProjectionMatrix"
  and vertexPositionAttrib = glGetAttribLocation shaderProgram "VertexPosition"
  and vertexColorAttrib = glGetAttribLocation shaderProgram "VertexColor" in

  ( shaderProgram,
    uniformMatrix,
    vertexPositionAttrib,
    vertexColorAttrib,
    vertexShaderID,
    fragmentShaderID )



let make_mesh ~indices:ba_indices ~vertices:ba_vertices =
  let ndx_len = Bigarray.Array1.dim ba_indices in
  let shading = load_shaders vertex_shader fragment_shader in
  let mesh_buffers = glGenBuffers 2 in
  glBindBuffer GL_ARRAY_BUFFER mesh_buffers.(0);
  glBufferData GL_ARRAY_BUFFER (ba_sizeof ba_vertices) ba_vertices GL_STATIC_DRAW;
  glBindBuffer GL_ELEMENT_ARRAY_BUFFER mesh_buffers.(1);
  glBufferData GL_ELEMENT_ARRAY_BUFFER (ba_sizeof ba_indices) ba_indices GL_STATIC_DRAW;
  (mesh_buffers, ndx_len, shading)


let delete_mesh
      (mesh_buffers, _,
       (shaderProgram,
        _, _, _,
        vertexShaderID,
        fragmentShaderID)) =

  glDeleteShader vertexShaderID;
  glDeleteShader fragmentShaderID;
  glDeleteProgram shaderProgram;
  glDeleteBuffers mesh_buffers;
;;


let keyboard mesh_with_shaders ~key ~x ~y =
  if key = '\027' then (delete_mesh mesh_with_shaders; exit 0);
;;


let last_time = ref(Unix.gettimeofday())

let rec timer ~value:msecs =
  glutTimerFunc ~msecs ~timer ~value:msecs;
  let now = Unix.gettimeofday() in
  let diff = (now -. !last_time) in
  Printf.printf " %d frames in %f seconds \t fps: %g\n%!"
                !frame_count diff (float !frame_count /. diff);
  frame_count := 0;
  last_time := now;
;;


let init_opengl ~width ~height =
  reshape ~width ~height;

  glEnable GL_DEPTH_TEST;
  glFrontFace GL_CCW;     (* assume a clean model *)
  glEnable GL_CULL_FACE;  (* activate elimination of polygons *)
  glCullFace GL_BACK;     (* remove back side of polygons *)
;;


(* main *)
let () =
  let width = 800 and height = 600 in
  ignore(glutInit Sys.argv);
  glutInitDisplayMode [GLUT_RGB; GLUT_DOUBLE; GLUT_DEPTH];
  glutInitWindowPosition ~x:100 ~y:100;
  glutInitWindowSize ~width ~height;
  ignore(glutCreateWindow ~title:"VBO with OpenGL 3.X");

  init_opengl ~width ~height;

  (* make a mesh ready to be drawn *)
  let mesh_with_shaders = make_mesh cube_indices cube_vertices in

  glutDisplayFunc ~display:(display mesh_with_shaders);
  glutKeyboardFunc ~keyboard:(keyboard mesh_with_shaders);
  glutIdleFunc ~idle:glutPostRedisplay;
  glutTimerFunc ~msecs ~timer ~value:msecs;
  glutReshapeFunc ~reshape;

  glutMainLoop ();
;;

And the equivalent shaders for GLSL version 1.2:

let vertex_shader = "
#version 120
in vec3 VertexColor;
in vec3 VertexPosition;
uniform mat4 ModelViewProjectionMatrix;
varying out vec3 InterpolatedColor;
void main () {
    InterpolatedColor = VertexColor;
    gl_Position = ModelViewProjectionMatrix * vec4 (VertexPosition, 1.0);
}"

let fragment_shader = "
#version 120
precision highp float;
in vec3 InterpolatedColor;
void main() {
    gl_FragColor = vec4 (InterpolatedColor, 1.0);
}"
This program displays a rotating colored cube:

Here are explanations of this program:

Managing Matrices

In the old OpenGL model the projection and the modelview matrices was handled internally by the OpenGL implementations. These internal matrices and all the associated functions and gl-enums are now deprecated. Now the OpenGL programmers should manage matrices themselves. So you can either write your own module to do so, or find a module ready to use.
In the glMLite tarball there is a module called Ogl_matrix in the directory "TEST3" (or "Incubating") that you can use. I would recommend you to copy the file of this module in your own project because even if it does work yet, several things may change as for example the name of the functions.

The projection Matrix

The projection matrix is used to transform the 3D coordinates of the vertices in the 3D world into 2D coordinates of points in the window where the image is rendered.
There are mainly two kinds of projections: orthographic projection and perspective projection.

In the old OpenGL model the projection matrix was handled internally by the OpenGL implementation and it was accessed and modified with glMatrixMode GL_PROJECTION; and the functions gluPerspective and glOrtho. What those functions did was modifing the internal projection matrix.
Now this internal projection matrix is deprecated and the OpenGL programmer should use equivalent functions that instead of setting the internal matrix will return this matrix. Then most often this matrix is provided to the vertex shader that apply this matrix to the input vertex.

The module Ogl_matrix available in glMLite's tarball provides replacements for those old functions: perspective_projection replaces gluPerspective and ortho_projection replaces glOrtho.

val perspective_projection :
  fov:float -> ratio:float ->
  near:float -> far:float -> float array

The fov argument is very simple, it is the "Field Of View", in other words the angle of the viewable area. This angle is between the left and the right planes of the view frustum, so along the vertical Y axis.
High values for fov will increase the perspective feeling, but too high values won't be realistic anymore. Very small values of fov will provide a result close to what you would get using an ortho projection.
Most of the time fov is set to values between 30 and 90 degrees.

The near and far arguments are quite important, they define the range along the Z axis (the axis of the look) between which the objects will be visible. So it's a common error while beginning with OpenGL to put wrong values and encounter problems with objects that are not visible.
But the trick is also not to put a too wide interval because this would reduce the precision of the display of the depth in the image, in particular for objects that are very close and intersecting. You can get more explanations about this in the Wikipedia article about the depth buffer.
The smaller is the range between near and far, the more precise will be the rendering of the intersections, So try to define these parameters to fit properly the dimensions of the elements that are drawn in the 3D scene.

val ortho_projection :
  left:float -> right:float ->
  bottom:float -> top:float ->
  near:float -> far:float -> float array

ortho_projection sets an orthographic projection matrix. You can see an example of such a projection on this screenshot where you can see that the walls are parallel and are not affected by any perspective.

Animated Rotation

A rotation is defined based on the Unix.gettimeofday() function.
So to apply this rotation we need to calculate a 4x4 matrix that represents the rotation. We do so with rotation_matrix_of_axis. We define an axis, this axis itself rotates while it's a unit vector defined with a cosinus and a sinus (see unit circle). And the angle of rotation is proportional to the value returned by gettimeofday.

Glut Interaction Callbacks

The Glut library provides callbacks to handle interaction with the user. There are callbacks for (non-exhaustive list) the keyboard, the mouse.

Here an Idle callback is defined. It is a function which is called when the computer has temporarily nothing to do. This is often usefull while OpenGL programs are often hard resource consumers. Here the Idle will call glutPostRedisplay which is a function that will request a new frame redraw at the end of the current function. So this program will draw frames greedily, and by the way we can check how many frames per seconds (fps) our program is able to draw.

Timer

With Glut timers are defined with three parameters which are msecs, timer and value. timer is the callback which will be called after msecs milliseconds elapsed. And it will be called only once, so to make it called regularly it has to be a recursive function that calls glutTimerFunc to make the recursive loop.

Here in this timer we just calculate the FPS and print it every 5 seconds.

Reshape the Window

If the window is not in fullscreen, it may happen that the user reshape the window. In this case the projection matrix have to be readapted to the new dimensions of the window, and also to its eventualy new aspect ratio. To fix all this we use a reshape callback where the new projection parameters will be set.

The reshape callback will be called a first time during the initialisation, so before the first frame rendering.
Here the reshape function is called in the initialisation function init_opengl, while glut calls it before the first call to the display callback so here it's not needed, but I have put it here to recall you to call it at startup if you use another windowing lib than Glut.

Clean and Delete

Long time living programs should delete shaders and vbo buffers that are not used anymore. Here it is done in the function delete_mesh, but you could take advantage of the garbage collector to do this automatically, by using Gc.finalise. But remember that this function does only work with heap-allocated values, so it won't work on vbo and shaders IDs alone while they are wrapped as ints, but this will work when they are grouped together in a tuple.

Indexed Face Set

In our cube (as in most meshes) each vertex belongs to several faces. As each square is made of two trangles, each vertex may belong to between 3 to 6 faces. In our cube each vertex belongs to an average of 4.5 faces.
So to save space, most often we use a different data model than in the first example which is made of two arrays. The first array contains each vertex only once. And the second array represents the faces using the indices of the vertices from the first array.
Here each int from cube_indices is the index of a vertex, and each vertex is represented by a full line in cube_vertices.
Also the number of ints in cube_indices should be a multiple of 3 because each group of 3 indices represents a triangle face.

Here is a demonstration that we actually save space here:
In cube_vertices we have 8 vertices, each being made of 6 floats.
(8 * 6) = 48
In cube_indices each square is made of 2 triangles, so 6 ints by square, and we have 6 squares.
(6 * 6) = 36
So the total is:
(48 floats + 36 ints) = 84 things

If we had use the previous model with our cube, the space used would be:
(6 * 6 * 6 floats) = 216 floats

Moreover with the indexed model we can use ints of smaller size than 32 bits.
In the current sample you can replace Bigarray.int by Bigarray.int8_unsigned in conjunction with replacing Elem.GL_UNSIGNED_INT by Elem.GL_UNSIGNED_BYTE with the function glDrawElements0. Then you can define a mesh with 256 vertices or less.
It is also possible to use the pair Bigarray.int16_unsigned & Elem.GL_UNSIGNED_SHORT, and then you can define a mesh with 65536 vertices or less.

In addition hardware usually has vertex cashing so a vertex used several times may only need to be computed (rasterised) once.

Mixed Buffers

Here cube_vertices contains both RGB colors and XYZ coordinates of the vertices. By the way in the vertex shader we don't only input "VertexPosition" but also the attribute "VertexColor".
So in the display callback we enable both with glEnableVertexAttribArray.
Also calling glVertexAttribPointerOfs32 is a bit trickier than in the first example, here we have a stride of 6, and an offset of 3 for vertices' positions.

Interpolated Variables

In this vertex shader the input VertexColor is connected to the output InterpolatedColor. This ouput of the vertex shader is connected to the input of the fragment shader of the same name.
InterpolatedColor is declared with the keyword smooth in both the vertex and the fragment shaders so while rasterising the triangle face this value will be "interpolated" from the different values of the three vertices.

Checking Shader Compile Status

If glGetShaderCompileStatus returns true this means that the shader's source was compiled right. If not it's possible to get some informations with glGetShaderInfoLog.
glGetShaderCompileStatus_exn is similar to glGetShaderCompileStatus but returns unit if the compilation was right and if not it raises an exception.

The Depth Buffer

The depth buffer enables to make depth-test while drawing fragements, so that we don't need to sort our faces from the farther to the closer along the Z axis before to draw. Moreover such a sort wouldn't enable to draw correctly intersecting faces.

To enable the depth buffer we need to provide GLUT_DEPTH to glutInitDisplayMode, and then we need to enable the depth test with a call to glEnable GL_DEPTH_TEST;. At any point it is possible to disable the depth test with glDisable GL_DEPTH_TEST; for example to draw some overlying text. But OpenGL being a state machine you need to re-enable it after if you need it again. For these kind of issues you can use functions from FunGL instead of the equivalent functions from the base module GL. In this case we could use FunGL.draw_enabled instead of glEnable to get only a local effect.

Finally before drawing each frame we need to clear the content of this depth buffer providing the parameter GL_DEPTH_BUFFER_BIT to glClear.

Back-Face Culling

Here our cube is closed so we see only its front faces. Back-face culling enables to draw only the front faces. We determine which side is the front or the back whether the vertices of the face are given in a clockwise or a counter clockwise way. We do this with glFrontFace GL_CCW; GL_CCW selects counterclockwise polygons as front-facing, GL_CW selects clockwise polygons as front-facing.
glEnable GL_CULL_FACE; activates elimination of polygons. glCullFace GL_BACK; tells that we want to remove the back side of polygons.

You can see the effect if you comment one line in cube_indices.


Unproject

We use the projection matrix to transform 3D world coords into window 2D coords. When we want to get mouse interaction where the location of the mouse will draw something in the 3D world, we need to make the opposite operation which is called "unprojection" and we use a function for this called "unproject". The module Ogl_matrix provides this function.

open Glut
open GL
open VertArray
open VBO

open Ogl_draw
open Ogl_matrix


(* position of the mouse pointer *)
let px = ref 0.0
let py = ref 0.0

(* coordinate bounds of the window *)
let x_min = -4.0 and x_max = 4.0
and y_min = -3.0 and y_max = 3.0
and z_min, z_max = -2.0, 20.0

(* left button down *)
let ldown = ref false

(* identity matrix *)
let id_mat = Ogl_matrix.get_identity()

(* the projection matrix *)
let proj_mat = ref id_mat

(* the rendering area *)
let viewport = ref (0,0,0,0)


let display mesh () =
  glClear [GL_COLOR_BUFFER_BIT];

  (* just display the mouse pointer *)
  let position = (!px, !py, 0.0) in

  (* with a different color when the left button is down *)
  let color =
    if !ldown
    then (1.0, 0.0, 0.0)
    else (1.0, 1.0, 0.0)
  in

  let model_mat = Ogl_matrix.translation_matrix position in
  let model_proj_matrix = Ogl_matrix.mult_matrix !proj_mat model_mat in
  Ogl_draw.draw_mesh ~color model_proj_matrix mesh;

  glFlush ();
  glutSwapBuffers ();
;;


let unproject_util ~x ~y =
  let v1, v2, v3, v4 = !viewport in
  let mx, my, _ =
    Ogl_matrix.unproject
      ~model:id_mat ~proj:!proj_mat
      ~viewport:[| v1; v2; v3; v4 |]
      ~win_x:(float x)
      ~win_y:(float (v4 - y))
      ~win_z:0.0
  in
  (mx, my)


(* convert the coordinates of the mouse
   from window coordinates to the local
   representation *)
let unproject_coords ~x ~y =
  let mx, my = unproject_util ~x ~y in
  px := mx;
  py := my;
;;

(* active mouse motion *)
let motion ~x ~y =
  unproject_coords ~x ~y;
;;

(* passive mouse motion *)
let passive ~x ~y =
  unproject_coords ~x ~y;
;;

(* mouse button event *)
let mouse ~button ~state ~x ~y =
  unproject_coords ~x ~y;
  match button, state with
  | GLUT_LEFT_BUTTON, GLUT_DOWN -> ldown := true;
  | GLUT_LEFT_BUTTON, GLUT_UP -> ldown := false;
  | _ -> ()
;;

let keyboard ~key ~x ~y =
  match key with
  | 'q' | '\027' -> exit 0
  | _ -> ()
;;

let reshape  ~width:w ~height:h =
  glViewport 0 0 w h;
  viewport := (0, 0, w, h);
  proj_mat :=
    if w <= h
    then ortho_projection x_min x_max y_min y_max z_min z_max
    else ortho_projection x_min x_max y_min y_max z_min z_max
    (*
    (* if the ratio (x_max - x_min) / (y_max - y_min) was 1.0 *)
    if w <= h then
      ortho_projection
          x_min x_max (y_min *. float h /. float w)
                      (y_max *. float h /. float w) z_min z_max
    else
      ortho_projection
            (x_min *. float w /. float h)
            (x_max *. float w /. float h) y_min y_max z_min z_max
    *)
;;

let idle () =
  glutPostRedisplay ();
;;

let gl_init () =
  glClearColor 0.5 0.5 0.5  0.0;
;;

let () =
  ignore(glutInit Sys.argv);
  glutInitDisplayMode [GLUT_DOUBLE; GLUT_RGB];
  (* (800 / 600) same ratio than (x_max - x_min) / (y_max - y_min) *)
  glutInitWindowSize 800 600;
  glutInitWindowPosition 100 100;
  ignore(glutCreateWindow Sys.argv.(0));
  glutSetCursor GLUT_CURSOR_NONE;

  gl_init ();

  let vertices = Vertices3 [|
    (-0.2,  0.2, 0.0);
    ( 0.2,  0.2, 0.0);
    ( 0.2, -0.2, 0.0);
    (-0.2, -0.2, 0.0); |] in
  let indices = [| (0, 1, 2);  (0, 2, 3) |] in
  let mesh = Ogl_draw.make_mesh ~indices ~vertices in

  glutDisplayFunc ~display:(display mesh);
  glutReshapeFunc ~reshape;
  glutIdleFunc ~idle;
  glutMouseFunc ~mouse;
  glutKeyboardFunc ~keyboard;
  glutMotionFunc ~motion;
  glutPassiveMotionFunc ~passive;

  print_endline "> move the mouse in the window";
  glutMainLoop ()

Going Further

This was an introduction about OpenGL programming in OCaml in a forward-compatible way. It is quite low level and perhaps not very easy to begin in case you're a beginner, but in the glMLite tarball there is a higher-level module Ogl_draw that you can use in conjunction with Ogl_matrix, both are in the directory "Incubating" of glMLite (the 3 stands for OpenGL 3). With the module Ogl_draw you don't need anymore to learn GLSL and you don't need to write VBO, this module does this for you, and you can just give meshes in a high-level way, and draw it with a single function. There is one example of use with the file "ogl3_highlevel.ml". These two modules are supposed to be forward-compatible (and if they are not, they are very close to be).


GNU/FDL   © 2010   Florent Monnier
 

Copying

Permission is granted to copy, distribute and/or modify this document under the terms of the GNU free Documentation License, Version 1.1 or any later version published by the Free Software Foundation; with no Invariant Sections, no Front-Cover Texts and no Back-Cover Texts.
You can read the full text of the "GNU Free Documentation License" on the gnu.org website.
The pieces of code can be considered in the public domain.

Alternatively, you may also use these contents under CC-by-sa license (any version).
(Last updated on 2013-03-12)

Camelly Yours!
The OCaml Language