Drawing 3D Shapes with and without Shaders

Displaying a Texture of Faces of a Cube

This example is designed to be the equivalent of our Smart Pascal WebGL demonstration and it produces a similar output to the one shown on that page. We do not use shaders but do incorporate image handling routines from the impressive demonstration that is supplied with TOpenGLControl.

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, OpenGLContext, Forms, Controls, Graphics, Dialogs,
  LCLProc, LResources, IntfGraphics, FPimage, dglOpenGL, GLU;
type
  TglTexture = class
  public
    Width, Height: longint;
    Data: pointer;
    destructor Destroy; override;
  end;

  TForm1 = class(TForm)
    OpenGLControl1: TOpenGLControl;
    procedure FormCreate(Sender: TObject);
    procedure OpenGLControl1Paint(Sender: TObject);
  end;

const
  CCube: array [0..71] of GLfloat = (
   // front face: 0, 1, 2, 0, 2, 3
   -100.0, -100.0,  100.0, //0
    100.0, -100.0,  100.0, //1
    100.0,  100.0,  100.0, //2
   -100.0, -100.0,  100.0, //0
    100.0, 100.0,  100.0,  //2
   -100.0,  100.0,  100.0, //3
   // back face: 4, 5, 6,  4, 6, 7
   -100.0, -100.0, -100.0, //4
   -100.0,  100.0, -100.0, //5
    100.0,  100.0, -100.0, //6
   -100.0, -100.0, -100.0, //4
    100.0,  100.0, -100.0, //6
    100.0, -100.0, -100.0, //7
   // right face: 16, 17, 18, 16, 18, 19
    100.0, -100.0, -100.0, //16 same as 7
    100.0,  100.0, -100.0, //17 same as 6
    100.0,  100.0,  100.0, //18 same as 2
    100.0, -100.0, -100.0, //16 same as 7
    100.0,  100.0,  100.0, //18 same as 2
    100.0, -100.0,  100.0, //19 same as 1
   // left face: 20, 21, 22, 20, 22, 23
   -100.0, -100.0, -100.0, //20 same as 4
   -100.0, -100.0,  100.0, //21 same as 0
   -100.0,  100.0,  100.0, //22 same as 3
   -100.0, -100.0, -100.0, //20 same as 4
   -100.0,  100.0,  100.0, //22 same as 3
   -100.0,  100.0, -100.0  //23 same as 5
  );

  CubeTexCoords : array [0.. 47] of GLfloat = (
    0.0, 1.0,
    1.0, 1.0,
    1.0, 0.0,
    0.0, 1.0,
    1.0, 0.0,
    0.0, 0.0, // end triangle 2 face 1
    1.0, 1.0,
    1.0, 0.0,
    0.0, 0.0,
    1.0, 1.0,
    0.0, 0.0,
    0.0, 1.0, // end triangle 2 face 2
    1.0, 1.0,
    1.0, 0.0,
    0.0, 0.0,
    1.0, 1.0,
    0.0, 0.0,
    0.0, 1.0,
    0.0, 1.0,
    1.0, 1.0,
    1.0, 0.0,
    0.0, 1.0,
    1.0, 0.0,
    0.0, 0.0
  );

var
  Form1: TForm1;
  BricksTexture: TGLTexture;

implementation

{$R *.lfm}

function LoadFileToMemStream(const Filename: string): TMemoryStream;
var FileStream: TFileStream;
begin
  Result:=TMemoryStream.Create;
  try
    FileStream:=TFileStream.Create(UTF8ToSys(Filename), fmOpenRead);
    try
      Result.CopyFrom(FileStream,FileStream.Size);
      Result.Position:=0;
    finally
      FileStream.Free;
    end;
  except
    Result.Free;
    Result:=nil;
  end;
end;

function LoadglTexImage2DFromPNG(PNGFilename: string; Image: TglTexture): boolean;
var
  png: TPortableNetworkGraphic;
  IntfImg: TLazIntfImage;
  y: Integer;
  x: Integer;
  c: TFPColor;
  p: PByte;
begin
  Result := false;
  png := TPortableNetworkGraphic.Create;
  IntfImg := nil;
  try
    png.LoadFromFile(PNGFilename);
    IntfImg := png.CreateIntfImage;
    Image.Width := IntfImg.Width;
    Image.Height := IntfImg.Height;
    GetMem(Image.Data, Image.Width * Image.Height * 3);
    p := PByte(Image.Data);
    for y:=0 to IntfImg.Height-1 do
      begin
        for x:=0 to IntfImg.Width - 1 do
          begin
            c := IntfImg.Colors[x, y];
            p^ := c.red shr 8;
            inc(p);
            p^ := c.green shr 8;
            inc(p);
            p^ := c.blue shr 8;
            inc(p);
          end;
     end;
  finally
    png.Free;
    IntfImg.Free;
  end;
  Result := true;
end;

procedure LoadglTexture(Filename:string; Image: TglTexture);
begin
  Filename := ExpandFileNameUTF8(Filename);
  if not LoadglTexImage2DFromPNG(Filename, Image) then
    ShowMessage('File not found');
end;

{ TForm1 }

procedure TForm1.OpenGLControl1Paint(Sender: TObject);
begin
  glClearColor(0.0, 0.0, 0.25, 1.0); // Sets clear colour to blue, fully opaque
  glViewport(0, 0, OpenGLControl1.Width, OpenGLControl1.Height);

  glClear(GL_COLOR_BUFFER_BIT);
  // Enable position and texture coordinates vertex components
  glEnableClientState(GL_VERTEX_ARRAY);
  glEnableClientState(GL_TEXTURE_COORD_ARRAY);
  // Link array data
  glVertexPointer(3, GL_FLOAT, 3 * sizeof(GLfloat), @CCube);
  glTexCoordPointer(2, GL_FLOAT, 2 * sizeof(GLfloat), @CubeTexCoords);
  // Disable colour and normal vertex component
  glDisableClientState(GL_COLOR_ARRAY);
  glDisableClientState(GL_NORMAL_ARRAY);
  // Clear color and depth buffers
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  // Apply some transformations to cube
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;
  glTranslatef(0, 0, -330);
  glRotatef(0.5 * 180 / pi, 1, 0, 0);
  glRotatef(0.9 * 180 / pi, 0, 1, 0);
  glRotatef(0.2 * 180 / pi, 0, 0, 1);
  glScalef(0.7, 0.7, 0.7);
  // Draw the cube
  glDrawArrays(GL_TRIANGLES, 0, 36);

  OpenGLControl1.SwapBuffers;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  InitOpenGL;
  OpenGLControl1.MakeCurrent;
  ReadImplementationProperties;
  ReadExtensions;

  BricksTexture := TglTexture.Create;
  LoadglTexture('Bricks0.png', BricksTexture);
  glClearDepth(1);
  glClearColor(0.0, 0.0, 0.25, 1.0); // Set clear colour to blue, fully opaque
  // Enable Z-buffer read and write
  glEnable(GL_DEPTH_TEST);
 // glDepthMask(1);
  // Disable lighting and enable texturing
  glDisable(GL_LIGHTING);
  glEnable(GL_TEXTURE_2D);
  // Configure viewport to size of control
  glViewport(0, 0, OpenGLControl1.Width, OpenGLControl1.Height);
  // Set up perspective projection with 45 degree field of view
  glMatrixMode(GL_PROJECTION);
  gluPerspective(45, 1, 0.1, 1000);
  // Upload the image
  glTexImage2D(GL_TEXTURE_2D,0, 3, BricksTexture.Width, BricksTexture.Height, 0,
               GL_RGB, GL_UNSIGNED_BYTE, BricksTexture.Data);
  // Set parameters to render any size image
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
end;

{ TglTexture }
destructor TglTexture.Destroy;
begin
  if Data <> nil then
    FreeMem(Data);
  inherited Destroy;
end;

end.    

Drawing a Tetrahedron using Shaders

The code follows a screenshot of the output. See the code comments to help you to understand how it works. We have used some of Max Foster's matrix routines from the Display unit of MrSnugglekins.

Output

Output

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, OpenGLContext, Forms, Controls, Graphics, Dialogs, GLU,
  dglOpenGL, Math;
type
  TForm1 = class(TForm)
    OpenGLControl1: TOpenGLControl;
    procedure FormCreate(Sender: TObject);
    procedure OpenGLControl1Paint(Sender: TObject);
  end;
  matrix4d = array[0 .. 15] of GLfloat;

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,  //repeat 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
    0.0, 1.0, 0.0  //vertices below
  );

  VertexShader, FragmentShader, ShaderProgram: 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 : Matrix4d;

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 : real);
var
  transformationMatrix: matrix4d;
begin
  initIdentityMatrix(transformationMatrix);
  transformationMatrix[12] := x;
  transformationMatrix[13] := y;
  transformationMatrix[14] := z;
  dstMatrix := multiplyMatrix(dstMatrix, transformationMatrix);
end;

function getPerspectiveMatrix(left, right, bottom, top, front, back: real): 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 : real): 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 TForm1.FormCreate(Sender: TObject);
begin
  InitOpenGL;
  OpenGLControl1.MakeCurrent;
  ReadImplementationProperties;
  ReadExtensions;
  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);
  glDeleteShader(VertexShader);
  glDeleteShader(FragmentShader);
end;

procedure TForm1.OpenGLControl1Paint(Sender: TObject);
var
  vertex: integer;
begin
  glClearColor (1.0, 1.0, 1.0, 1.0); // white background
  glViewport(0, 0, OpenGLControl1.Width, OpenGLControl1.Height);

  glClear(GL_COLOR_BUFFER_BIT);
  glClearDepth(1.0);                 // Clear everything
  glEnable(GL_DEPTH_TEST);           // Enable depth testing
  glDepthFunc(GL_LEQUAL);
  // 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);
  glEnableClientState(GL_VERTEX_ARRAY);
  // Pass attributes to shader program
  glVertexAttribPointer(VertexPosAttrib, 3, GL_Float, False, 0, @VertexArray);
  glVertexAttribPointer(ColourAttrib, 3, GL_Float, False, 0, @ColourArray);
  // Populate projection and model view matrices
  ProjectionMatrix := getPerspectiveMatrix(45, 1, 0.1, 100);
  initIdentityMatrix(ModelViewMatrix);
  translateMatrix(ModelViewMatrix, 0, 0, -4);
  // Pass matrices to shader program
  glUniformMatrix4fv(PM, 1, false, @ProjectionMatrix);
  glUniformMatrix4fv(MVM, 1, false, @ModelViewMatrix);

  // Draw the four faces of the tet starting from each vertex in turn.
  for vertex := 0 to 3 do
    try
      glDrawArrays(GL_TRIANGLES, vertex, 3);
    except
      ShowMessage('Error on drawing arrays');
   end;

  OpenGLControl1.SwapBuffers;
end;

end.    
Programming - a skill for life!

How to use OpenGL for 2D and 3D graphics