OpenGLCore/examples/sharecontext/uMainForm.pas

unit uMainForm;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
  uglcContext, uglcShader, uglcArrayBuffer, uglcTypes;

type
  TMainForm = class(TForm)
    ApplicationProperties: TApplicationProperties;
    LogLB: TListBox;
    RenderPanel2: TPanel;
    RenderPanel1: TPanel;
    procedure ApplicationPropertiesIdle(Sender: TObject; var Done: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    fContext1: TglcContext;
    fContext2: TglcContext;
    fShader: TglcShaderProgram;
    fVBO: TglcArrayBuffer;
    procedure Log(aSender: TObject; const aMsg: String);
    procedure Render;
  public
    { public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

uses
  dglOpenGL, ugluVector;

const
  SHADER_FILE  = 'shader.glsl';

  LAYOUT_LOCATION_POS = 0;

procedure TMainForm.FormCreate(Sender: TObject);
type
  TVertex = packed record
    pos: TgluVector3f;
  end;
  PVertex = ^TVertex;
var
  pf: TglcContextPixelFormatSettings;
  p: PVertex;
begin
  pf := TglcContext.MakePF();
  fContext1 := TglcContext.GetPlatformClass.Create(RenderPanel1, pf);
  fContext1.BuildContext;

  fContext2 := TglcContext.GetPlatformClass.Create(RenderPanel2, pf, fContext1);
  fContext2.BuildContext;

  fContext1.Activate;

  fShader := TglcShaderProgram.Create(@Log);
  fShader.LoadFromFile(ExtractFilePath(Application.ExeName) + SHADER_FILE);
  fShader.Compile;

  fVBO := TglcArrayBuffer.Create(TglcBufferTarget.btArrayBuffer);
  fVBO.BufferData(4, sizeof(TVertex), TglcBufferUsage.buStaticDraw, nil);
  p := fVBO.MapBuffer(TglcBufferAccess.baWriteOnly);
  try
    p^.pos := gluVector3f(-0.5, -0.5, 0); inc(p);
    p^.pos := gluVector3f( 0.5, -0.5, 0); inc(p);
    p^.pos := gluVector3f( 0.5,  0.5, 0); inc(p);
    p^.pos := gluVector3f(-0.5,  0.5, 0); inc(p);
  finally
    fVBO.UnmapBuffer;
  end;
end;

procedure TMainForm.ApplicationPropertiesIdle(Sender: TObject; var Done: Boolean);
begin
  Render;
  Done := false;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  FreeAndNil(fVBO);
  FreeAndNil(fShader);
  FreeAndNil(fContext2);
  FreeAndNil(fContext1);
end;

procedure TMainForm.FormResize(Sender: TObject);

  procedure DoResize(const l, r, w, h: Integer; const aPanel: TPanel; const aContext: TglcContext);
  begin
    aPanel.SetBounds(l, r, w, h);
    if Assigned(aContext) then begin
      aContext.Activate;
      glViewport(0, 0, w, h);
    end;
  end;

var
  w, h: Integer;
begin
  w := (ClientWidth - 24) div 2;
  h := LogLB.Top - 16;
  DoResize(     8, 8, w, h, RenderPanel1, fContext1);
  DoResize(w + 16, 8, w, h, RenderPanel2, fContext2);
end;

procedure TMainForm.Log(aSender: TObject; const aMsg: String);
begin
  LogLB.Items.Add(aMsg);
end;

procedure TMainForm.Render;

  procedure DoRender;
  begin
    glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

    fVBO.Bind;
    fShader.Enable;

    glEnableVertexAttribArray(LAYOUT_LOCATION_POS);
    glVertexAttribPointer(LAYOUT_LOCATION_POS, 3, GL_FLOAT, False, 0, nil);

    glDrawArrays(GL_QUADS, 0, fVBO.DataCount);

    glDisableVertexAttribArray(LAYOUT_LOCATION_POS);

    fShader.Disable;
    fVBO.Unbind;
  end;

begin
  fContext1.Activate;
  glClearColor(0.1, 0.2, 0.1, 0);
  DoRender;
  fContext1.SwapBuffers;

  fContext2.Activate;
  glClearColor(0.1, 0.1, 0.2, 0);
  DoRender;
  fContext2.SwapBuffers;
end;

end.