3D Motion Graphics with Shaders

Rotating Gradient-Shaded Tetrahedra

The example supplied with the OpenGL component is an impressive demonstration of 3D motion graphics, but it uses "fixed pipeline" OpenGL code rather than shaders. This demonstration of the use of shaders is based on our Smart Pascal WebGL online demo. The code of each shader is a long string; look for the green syntax highlighting after the array data near the start of the unit. We have used some of Max Foster's matrix routines from the Display unit of MrSnugglekins. The program requires the dglOpenGL unit, which you can download from this English page on the Delphi OpenGL Community wiki.

The code of the form follows the Pascal code of the unit.

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, OpenGLContext, Forms, Controls, Graphics,
  Dialogs, ExtCtrls, GLU, dglOpenGL, Math;
type
  matrix4d = array[0 .. 15] of glFloat;
  TForm1 = class(TForm)
    OpenGLControl1: TOpenGLControl;
    Timer1: TTimer;

    procedure FormCreate(Sender: TObject);
    procedure OpenGLControl1Paint(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  end;

const
  DELAY = 20; // ms

var
  Form1: TForm1;
  VertexArray: array[0..17] of GLFloat = ( // Vertices of tetrahedron are alternate vertices of cube
    -1.0, -1.0,  1.0,
     1.0, -1.0, -1.0,
     1.0,  1.0,  1.0,
    -1.0,  1.0, -1.0,
    -1.0, -1.0,  1.0,  // repeating the first two vertices
     1.0, -1.0, -1.0
  );

  ColourArray: array[0..17] of GLFloat = (
    1.0, 0.0, 0.0, //r
    0.0, 1.0, 0.0, //g
    0.0, 0.0, 1.0, //b
    1.0, 1.0, 1.0, //w
    1.0, 0.0, 0.0, //repeating the first two colours to match the repeated vertices
    0.0, 1.0, 0.0
  );

  VertexShader, FragmentShader, ShaderProgram, ShaderProgram2: glHandle;
  VertexCode: PGLchar = 'attribute vec3 aVertexPosition; ' +
                        'attribute vec3 aVertexColor; ' +

                        'uniform mat4 uModelViewMatrix; ' +
                        'uniform mat4 uProjectionMatrix; ' +

                        'varying vec4 vColor; ' +

                        'void main(void) { ' +
                        '  gl_Position = uProjectionMatrix * uModelViewMatrix * vec4(aVertexPosition, 1.0); ' +
                        '  vColor = vec4(aVertexColor, 1.0); ' +
                        '} ';

  FragmentCode: PGLchar = 'precision mediump float; ' +
                          'varying vec4 vColor; ' +

                          'void main(void) { ' +
                          '  gl_FragColor = vColor; ' +
                          '} ';

  VertexPosAttrib, ColourAttrib, PM, MVM, Success: integer;
  ProjectionMatrix, ModelViewMatrix, MVMTemp: Matrix4d;
  FrameCount: glFloat;

implementation

{$R *.lfm}

function multiplyMatrix(operandMatrix, multiplierMatrix: matrix4d): matrix4d;
begin
  result[0] := operandMatrix[0] * multiplierMatrix[0] + operandMatrix[4] * multiplierMatrix[1] +
               operandMatrix[8] * multiplierMatrix[2] +  operandMatrix[12] * multiplierMatrix[3];

  result[1] := operandMatrix[1] * multiplierMatrix[0] + operandMatrix[5] * multiplierMatrix[1] +
               operandMatrix[9] * multiplierMatrix[2] + operandMatrix[13] * multiplierMatrix[3];

  result[2] := operandMatrix[2] * multiplierMatrix[0] + operandMatrix[6] * multiplierMatrix[1] +
               operandMatrix[10] * multiplierMatrix[2] + operandMatrix[14] * multiplierMatrix[3];

  result[3] := operandMatrix[3] * multiplierMatrix[0] + operandMatrix[7] * multiplierMatrix[1] +
               operandMatrix[11] * multiplierMatrix[2] + operandMatrix[15] * multiplierMatrix[3];

  result[4] := operandMatrix[0] * multiplierMatrix[4] + operandMatrix[4] * multiplierMatrix[5] +
               operandMatrix[8] * multiplierMatrix[6] + operandMatrix[12] * multiplierMatrix[7];

  result[5] := operandMatrix[1] * multiplierMatrix[4] + operandMatrix[5] * multiplierMatrix[5] +
               operandMatrix[9] * multiplierMatrix[6] + operandMatrix[13] * multiplierMatrix[7];

  result[6] := operandMatrix[2] * multiplierMatrix[4] + operandMatrix[6] * multiplierMatrix[5] +
               operandMatrix[10] * multiplierMatrix[6] + operandMatrix[14] * multiplierMatrix[7];

  result[7] := operandMatrix[3] * multiplierMatrix[4] + operandMatrix[7] * multiplierMatrix[5] +
               operandMatrix[11] * multiplierMatrix[6] + operandMatrix[15] * multiplierMatrix[7];

  result[8] := operandMatrix[0] * multiplierMatrix[8] + operandMatrix[4] * multiplierMatrix[9] +
               operandMatrix[8] * multiplierMatrix[10] + operandMatrix[12] * multiplierMatrix[11];

  result[9] := operandMatrix[1] * multiplierMatrix[8] + operandMatrix[5] * multiplierMatrix[9] +
               operandMatrix[9] * multiplierMatrix[10] + operandMatrix[13] * multiplierMatrix[11];

  result[10] := operandMatrix[2] * multiplierMatrix[8] + operandMatrix[6] * multiplierMatrix[9] +
                operandMatrix[10] * multiplierMatrix[10] + operandMatrix[14] * multiplierMatrix[11];

  result[11] := operandMatrix[3] * multiplierMatrix[8] + operandMatrix[7] * multiplierMatrix[9] +
                operandMatrix[11] * multiplierMatrix[10] + operandMatrix[15] * multiplierMatrix[11];

  result[12] := operandMatrix[0] * multiplierMatrix[12] + operandMatrix[4] * multiplierMatrix[13] +
                operandMatrix[8] * multiplierMatrix[14] + operandMatrix[12] * multiplierMatrix[15];

  result[13] := operandMatrix[1] * multiplierMatrix[12] + operandMatrix[5] * multiplierMatrix[13] +
                operandMatrix[9] * multiplierMatrix[14] + operandMatrix[13] * multiplierMatrix[15];

  result[14] := operandMatrix[2] * multiplierMatrix[12] + operandMatrix[6] * multiplierMatrix[13] +
                operandMatrix[10] * multiplierMatrix[14] + operandMatrix[14] * multiplierMatrix[15];

  result[15] := operandMatrix[3] * multiplierMatrix[12] + operandMatrix[7] * multiplierMatrix[13] +
                operandMatrix[11] * multiplierMatrix[14] + operandMatrix[15] * multiplierMatrix[15];

end;

procedure initIdentityMatrix(var dstMatrix: matrix4d);
var
  i: byte;
begin
  for i := 0 to 15 do
    dstMatrix[i] := 0.0;
  dstMatrix[0] := 1.0;
  dstMatrix[5] := 1.0;
  dstMatrix[10] := 1.0;
  dstMatrix[15] := 1.0;
end;

procedure translateMatrix(var dstMatrix: matrix4d; x, y, z: glFloat);
var
  transformationMatrix: matrix4d;
begin
  initIdentityMatrix(transformationMatrix);
  transformationMatrix[12] := x;
  transformationMatrix[13] := y;
  transformationMatrix[14] := z;
  dstMatrix := multiplyMatrix(dstMatrix, transformationMatrix);
end;

procedure rotateMatrix(var dstMatrix: matrix4d; angle, x, y, z: glFloat);
var
  len, c, s, x2, y2, z2, t: glFloat;
  transformationMatrix: matrix4d;
begin
  angle := degToRad(angle);
  len := sqrt((x * x) + (y * y) + (z * z));
  x /= len;
  y /= len;
  z /= len;

  c := cos(angle);
  s := sin(angle);
  x2 := x * x;
  y2 := y * y;
  z2 := z * z;
  t := 1.0 - c;

  transformationMatrix[0] := (x2 * t) + c;
  transformationMatrix[1] := (y * x * t) + z * s;
  transformationMatrix[2] := (x * z * t) - (y * s);
  transformationMatrix[3] := 0.0;

  transformationMatrix[4] := (x * y * t) - (z * s);
  transformationMatrix[5] := (y2 * t) + c;
  transformationMatrix[6] := (y * z * t) + (x * s);
  transformationMatrix[7] := 0.0;

  transformationMatrix[8] := (x * z * t) + (y * s);
  transformationMatrix[9] := (y * z * t) - (x * s);
  transformationMatrix[10] := (z2 * t) + c;
  transformationMatrix[11] := 0.0;

  transformationMatrix[12] := 0.0;
  transformationMatrix[13] := 0.0;
  transformationMatrix[14] := 0.0;
  transformationMatrix[15] := 1.0;

  dstMatrix := multiplyMatrix(dstMatrix, transformationMatrix);
end;

function getPerspectiveMatrix(left, right, bottom, top, front, back: glFloat): matrix4d;
begin
  result[0] := (2.0 * front) / (right - left);
  result[1] := 0.0;
  result[2] := 0.0;
  result[3] := 0.0;

  result[4] := 0.0;
  result[5] := (2.0 * front) / (top - bottom);
  result[6] := 0.0;
  result[7] := 0.0;

  result[8] := (right + left) / (right - left);
  result[9] := (top + bottom) / (top - bottom);
  result[10] := (-(back + front)) / (back - front);
  result[11] := -1.0;

  result[12] := 0.0;
  result[13] := 0.0;
  result[14] := (-2.0 * back * front) / (back - front);
  result[15] := 0.0;
end;

function getPerspectiveMatrix(angle, aspectRatio, front, back: glFloat): matrix4d;
var
  tangent, height, width: real;
begin
  tangent := tan(degToRad(angle / 2));
  height := front * tangent;
  width := height * aspectRatio;
  result := getPerspectiveMatrix(-width, width, -height, height, front, back);
end;

procedure initShader;
begin
  VertexShader := glCreateShader(GL_VERTEX_SHADER);
  FragmentShader := glCreateShader(GL_FRAGMENT_SHADER);

  glShaderSource(VertexShader, 1, @VertexCode, nil);
  glCompileShader(VertexShader);
  // If vertex shader did not compile, show a message and exit.
  glGetShaderiv(VertexShader, GL_COMPILE_STATUS, @success);
  if success = GL_FALSE then
    begin
      ShowMessage('Vertex shader failed to compile');
      exit;
    end;
  glShaderSource(FragmentShader, 1, @FragmentCode, nil);
  glCompileShader(FragmentShader);
  glGetShaderiv(FragmentShader, GL_COMPILE_STATUS, @success);
  // If fragment shader did not compile, show a message and exit.
  if success = GL_FALSE then
    begin
      Showmessage('Fragment shader failed to compile');
      exit;
    end;
  ShaderProgram := glCreateProgram();
  glAttachShader(ShaderProgram, VertexShader);
  glAttachShader(ShaderProgram, FragmentShader);
  glLinkProgram(ShaderProgram);
  // Error check
  glGetProgramiv(ShaderProgram, GL_LINK_STATUS, @success);
  if success = GL_FALSE then
    begin
      ShowMessage('Error with linking shader program');
      exit;
    end;
  glUseProgram(ShaderProgram);
  // Detach and delete shaders
  glDetachShader(ShaderProgram, VertexShader);
  glDeleteShader(VertexShader);
  glDetachShader(ShaderProgram, FragmentShader);
  glDeleteShader(FragmentShader);
  // Obtain locations of attributes and uniforms
  VertexPosAttrib := glGetAttribLocation(ShaderProgram, pchar('aVertexPosition'));
  ColourAttrib := glGetAttribLocation(ShaderProgram, pchar('aVertexColor'));
  PM := glGetUniformLocation(ShaderProgram, 'uProjectionMatrix');
  MVM := glGetUniformLocation(ShaderProgram, 'uModelViewMatrix');
  // Enable array processing
  glEnableVertexAttribArray(VertexPosAttrib);
  glEnableVertexAttribArray(ColourAttrib);
  // Populate model view matrix
  ProjectionMatrix := getPerspectiveMatrix(45.0, 1.0, 0.1, 1000.0);
  // Pass attributes and one uniform to shader program
  glVertexAttribPointer(VertexPosAttrib, 3, GL_Float, False, 0, @VertexArray);
  glVertexAttribPointer(ColourAttrib, 3, GL_Float, False, 0, @ColourArray);
  glUniformMatrix4fv(PM, 1, false, @ProjectionMatrix);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Timer1.Enabled := true;
  Timer1.Interval := DELAY;
  InitOpenGL;
  OpenGLControl1.MakeCurrent;
  ReadImplementationProperties;
  ReadExtensions;

  glClearColor(0.0, 0.0, 0.25, 1.0); // Sets clear colour to blue, fully opaque
  glViewport(0, 0, OpenGLControl1.Width, OpenGLControl1.Height);
  glClearDepth(1.0);
  glEnable(GL_DEPTH_TEST);           // Enable depth testing
  glDepthFunc(GL_LEQUAL);
  InitShader;
end;

procedure TForm1.OpenGLControl1Paint(Sender: TObject);

  procedure RenderTetrahedron(angle, xPos: glFloat);
  var
    vertex: integer;
  begin
    glEnableClientState(GL_VERTEX_ARRAY);
    initIdentityMatrix(ModelViewMatrix);
    translateMatrix(ModelViewMatrix, xPos, 0.0, -16.0 + FrameCount / 25);
    rotateMatrix(ModelViewMatrix, angle + FrameCount * 2, 0.0, 1.0, 0.0);
    glUniformMatrix4fv(MVM, 1, false, @ModelViewMatrix);
    for vertex := 0 to 3 do
      glDrawArrays(gl_TRIANGLES, vertex, 3);
  end;

begin
  FrameCount += 1.0;
  if FrameCount > 300 then
    FrameCount := 0.0;
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  RenderTetrahedron(45, -1.5);
  RenderTetrahedron(135, 1.5);
  glDisableClientState(GL_VERTEX_ARRAY);
  OpenGLControl1.SwapBuffers;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  OpenGLControl1.Invalidate;
end;

end.    

Code of form:

object Form1: TForm1
  Left = 315
  Height = 404
  Top = 98
  Width = 472
  Caption = 'Form1'
  ClientHeight = 404
  ClientWidth = 472
  OnCreate = FormCreate
  LCLVersion = '1.4.0.4'
  object OpenGLControl1: TOpenGLControl
    Left = 10
    Height = 390
    Top = 10
    Width = 454
    OnPaint = OpenGLControl1Paint
  end
  object Timer1: TTimer
    OnTimer = Timer1Timer
    left = 24
    top = 2
  end
end
    

We use much of this code also in a version using OpenGL within PasSFML.

Programming - a skill for life!

How to use OpenGL for 2D and 3D graphics