OpenGLCore/uglcContext.pas

unit uglcContext;

{ Package:      OpenGLCore
  Prefix:       glc - OpenGL Core
  Beschreibung: diese Unit enthält eine abstrakte Klassen-Kapselung für OpenGL Kontexte


Abstrakte Contextklasse zum Erstellen von Renderkontexten auf Windows & Linux(bzw X11/Gtk2)
Für aktuelle Plattform passende Klasse kann per GetPlatformClass gefunden werden.

Bsp.:
  //muss im GUI/Main-Thread aufgerufen werden:
  pf := TglcContext.GetPlatformClass().MakePF();
  fContext := TglcContext.GetPlatformClass().Create(MyTWinControl, PF);

  //_kann_ in Background Thread abgerufen werden:
  fContext.BuildContext();
  [Arbeit mit dem Context]
  fContext.CloseContext();

  //im MainThread
  FreeAndNil(fContext)


weitere Funktionen:
  MakePF()             erzeugt PixelFormatDescriptor mit Defaults
  BuildContext()       baut Kontext (kann in BackgrounThread aufgerufen werden)
  CloseContext()       gibt den Kontext frei (muss im selben Thread aufgerufen werden wie BuildContext;
                       wird der Kontext nur im MainThread genutzt, muss CloseContext nicht explizit aufgerufen
                       werden und wird beim zerstören des Kontext-Objekts ausgeführt)
  Activate/Deactiveate Kontext aktiv schalten oder nicht
  SwapBuffers          DoubleBuffering
  SetSwapInterval      VSync
  Share                ShareLists
  EnableDebugOutput    GL-Debug via ARB_debug_output oder AMD_debug_output de/aktivieren
}

interface

uses
  SysUtils, Controls, dglOpenGL;

const
  GLC_CONTEXT_VERSION_UNKNOWN = -1;

type
  TMultiSample = 1..high(byte);
  TglcContextPixelFormatSettings = packed record
    DoubleBuffered: boolean;
    Stereo: boolean;
    MultiSampling: TMultiSample;
    ColorBits: Integer;
    DepthBits: Integer;
    StencilBits: Integer;
    AccumBits: Integer;
    AuxBuffers: Integer;
    Layer: Integer;
  end;
  TglcContextVersionSettings = packed record
    Major: Integer;
    Minor: Integer;
    ForwardCompatible: Boolean;
  end;

  TglcDisplayFlag = (
    dfFullscreen);
  TglcDisplayFlags = set of TglcDisplayFlag;

  EGLError = class(Exception);

  { TglcContext }
  TglcContextClass = class of TglcContext;
  TglcContext = class
  private
    fControl: TWinControl;
    fThreadID: TThreadID;
    fEnableVsync: Boolean;

    function GetEnableVSync: Boolean;
    procedure SetEnableVSync(aValue: Boolean);

  protected
    fUseVersion: Boolean;
    fPixelFormatSettings: TglcContextPixelFormatSettings;
    fVersionSettings: TglcContextVersionSettings;
    procedure OpenContext; virtual;

  public
    property PixelFormatSettings: TglcContextPixelFormatSettings read fPixelFormatSettings;
    property VersionSettings:     TglcContextVersionSettings     read fVersionSettings;

    constructor Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings); virtual; overload;
    constructor Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aVersionSettings: TglcContextVersionSettings); virtual; overload;
    destructor Destroy; override;

    property ThreadID:    TThreadID read fThreadID;
    property EnableVSync: Boolean   read GetEnableVSync write SetEnableVSync;

    procedure BuildContext;
    procedure CloseContext; virtual;
    procedure Activate; virtual; abstract;
    procedure Deactivate; virtual; abstract;
    function IsActive: boolean; virtual; abstract;
    procedure SwapBuffers; virtual; abstract;
    procedure SetSwapInterval(const aInterval: GLint); virtual; abstract;
    function GetSwapInterval: GLint; virtual; abstract;
    procedure Share(const aContext: TglcContext); virtual; abstract;

  private class var
    fMainContextThreadID: TThreadID;
  public
    class property MainContextThreadID: TThreadID read fMainContextThreadID;
    class function MakePF(DoubleBuffered: boolean = true;
                          Stereo: boolean=false;
                          MultiSampling: TMultiSample=1;
                          ColorBits: Integer=32;
                          DepthBits: Integer=24;
                          StencilBits: Integer=0;
                          AccumBits: Integer=0;
                          AuxBuffers: Integer=0;
                          Layer: Integer=0): TglcContextPixelFormatSettings;
    class function MakeVersion(const aMajor, aMinor: Integer; const aForwardCompatible: Boolean): TglcContextVersionSettings;
    class function GetPlatformClass: TglcContextClass;
    class function ChangeDisplaySettings(const aWidth, aHeight,
      aBitPerPixel, aFreq: Integer; const aFlags: TglcDisplayFlags): Boolean; virtual; abstract;
    class function IsAnyContextActive: boolean; virtual;
  end;

implementation

uses
  {$IFDEF WINDOWS}
    uglcContextWGL
  {$ENDIF}
  {$IFDEF LINUX}
    uglcContextGtk2GLX
  {$ENDIF}
  ;

function TglcContext.GetEnableVSync: Boolean;
begin
  result := fEnableVsync;
end;

procedure TglcContext.SetEnableVSync(aValue: Boolean);
begin
  fEnableVsync := aValue;
  if IsActive then begin
    if fEnableVsync then
      SetSwapInterval(1)
    else
      SetSwapInterval(0);
  end;
end;

procedure TglcContext.OpenContext;
begin
  fThreadID := GetCurrentThreadId;
  if fMainContextThreadID = 0 then
    fMainContextThreadID := fThreadID;
end;

class function TglcContext.MakePF(DoubleBuffered: boolean; Stereo: boolean; MultiSampling: TMultiSample; ColorBits: Integer;
  DepthBits: Integer; StencilBits: Integer; AccumBits: Integer; AuxBuffers: Integer; Layer: Integer): TglcContextPixelFormatSettings;
begin
  Result.DoubleBuffered:= DoubleBuffered;
  Result.Stereo:= Stereo;
  Result.MultiSampling:= MultiSampling;
  Result.ColorBits:= ColorBits;
  Result.DepthBits:= DepthBits;
  Result.StencilBits:= StencilBits;
  Result.AccumBits:= AccumBits;
  Result.AuxBuffers:= AuxBuffers;
  Result.Layer:= Layer;
end;

class function TglcContext.MakeVersion(const aMajor, aMinor: Integer; const aForwardCompatible: Boolean): TglcContextVersionSettings;
begin
  result.Major := aMajor;
  result.Minor := aMinor;
  result.ForwardCompatible := aForwardCompatible;
end;

class function TglcContext.GetPlatformClass: TglcContextClass;
begin
  {$IFDEF WINDOWS}
  Result:= TglcContextWGL;
  {$ENDIF}
  {$IFDEF LINUX}
  Result:= TglcContextGtk2GLX;
  {$ENDIF}
end;

class function TglcContext.IsAnyContextActive: boolean;
begin
  Result:= GetPlatformClass.IsAnyContextActive;
end;

constructor TglcContext.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings);
begin
  inherited Create;
  fPixelFormatSettings := aPixelFormatSettings;
  FControl             := aControl;
  fThreadID            := 0;
  fEnableVsync         := false;
  fUseVersion          := false;
  InitOpenGL();
end;

constructor TglcContext.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aVersionSettings: TglcContextVersionSettings);
begin
  Create(aControl, aPixelFormatSettings);
  fVersionSettings := aVersionSettings;
  fUseVersion      := true;
end;

destructor TglcContext.Destroy;
begin
  if (GetCurrentThreadId = fMainContextThreadID) then
    fMainContextThreadID := 0;
  CloseContext;
  inherited Destroy;
end;

procedure TglcContext.BuildContext;
begin
  OpenContext;
  Activate;
  ReadImplementationProperties;
  ReadExtensions;
  SetEnableVSync(fEnableVsync);
end;

procedure TglcContext.CloseContext;
begin
  if fMainContextThreadID = fThreadID then
    fMainContextThreadID := 0;
end;

initialization
  TglcContext.fMainContextThreadID := 0;

end.