* [uglcContext] reimplemented EnableDebugOutput

uglcContext.pas

@@ -61,6 +61,8 @@ type
     Minor: Integer;
     ForwardCompatible: Boolean;
   end;
+  TSeverity = (svLow, svMedium, svHigh);
+  TLogEvent = procedure(const aSender: TObject; const aSeverity: TSeverity; const aMsg: String) of Object;
 
   TglcDisplayFlag = (
     dfFullscreen);
@@ -75,10 +77,12 @@ type
     fControl: TWinControl;
     fThreadID: TThreadID;
     fEnableVsync: Boolean;
+    fLogEvent: TLogEvent;
 
     function GetEnableVSync: Boolean;
     procedure SetEnableVSync(aValue: Boolean);
-
+    procedure LogMsg(const aSeverity: TSeverity; const aMsg: String);
+    procedure SetDebugMode(const aEnable: Boolean);
   protected
     fUseVersion: Boolean;
     fPixelFormatSettings: TglcContextPixelFormatSettings;
@@ -97,6 +101,8 @@ type
     property EnableVSync: Boolean   read GetEnableVSync write SetEnableVSync;
 
     procedure BuildContext;
+    procedure EnableDebugOutput(const aLogEvent: TLogEvent);
+    procedure DisableDebugOutput;
     procedure CloseContext; virtual;
     procedure Activate; virtual; abstract;
     procedure Deactivate; virtual; abstract;
@@ -137,6 +143,65 @@ uses
   {$ENDIF}
   ;
 
+procedure GlDebugCallbackARB(source: GLenum; type_: GLenum; id: GLuint; severity: GLenum; {%H-}length: GLsizei; const message_: PGLchar; {%H-}userParam: PGLvoid); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
+var
+  src, typ: String;
+  sv: TSeverity;
+begin
+  case source of
+    GL_DEBUG_SOURCE_API_ARB            : src:= 'API';
+    GL_DEBUG_SOURCE_WINDOW_SYSTEM_ARB  : src:= 'WINDOW';
+    GL_DEBUG_SOURCE_SHADER_COMPILER_ARB: src:= 'SHADER';
+    GL_DEBUG_SOURCE_THIRD_PARTY_ARB    : src:= '3RDPARTY';
+    GL_DEBUG_SOURCE_APPLICATION_ARB    : src:= 'APPLICATION';
+    GL_DEBUG_SOURCE_OTHER_ARB          : src:= 'OTHER';
+  end;
+  src:= 'GL_' + src;
+
+  case type_ of
+    GL_DEBUG_TYPE_ERROR_ARB               : typ:= 'ERROR';
+    GL_DEBUG_TYPE_DEPRECATED_BEHAVIOR_ARB : typ:= 'DEPRECATED';
+    GL_DEBUG_TYPE_UNDEFINED_BEHAVIOR_ARB  : typ:= 'UNDEF BEHAV';
+    GL_DEBUG_TYPE_PORTABILITY_ARB         : typ:= 'PORTABILITY';
+    GL_DEBUG_TYPE_PERFORMANCE_ARB         : typ:= 'PERFORMANCE';
+    GL_DEBUG_TYPE_OTHER_ARB               : typ:= 'OTHER';
+  end;
+
+  case severity of
+    GL_DEBUG_SEVERITY_LOW_ARB:    sv := svLow;
+    GL_DEBUG_SEVERITY_MEDIUM_ARB: sv := svMedium;
+    GL_DEBUG_SEVERITY_HIGH_ARB:   sv := svHigh;
+  end;
+
+  TglcContext(userParam).LogMsg(sv, format('%s [%d] %s',[typ, id, message_]));
+end;
+
+procedure GlDebugCallbackAMD(id: GLuint; category: GLenum; severity: GLenum; {%H-}length: GLsizei; const message_: PGLchar; {%H-}userParam: PGLvoid); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
+var
+  src: String;
+  sv: TSeverity;
+begin
+  case category of
+    GL_DEBUG_CATEGORY_API_ERROR_AMD            : src:= 'API';
+    GL_DEBUG_CATEGORY_WINDOW_SYSTEM_AMD        : src:= 'WINDOW';
+    GL_DEBUG_CATEGORY_DEPRECATION_AMD          : src:= 'SHADER';
+    GL_DEBUG_CATEGORY_UNDEFINED_BEHAVIOR_AMD   : src:= 'UNDEF BEHAV';
+    GL_DEBUG_CATEGORY_PERFORMANCE_AMD          : src:= 'PERFORMANCE';
+    GL_DEBUG_CATEGORY_SHADER_COMPILER_AMD      : src:= 'SHADER';
+    GL_DEBUG_CATEGORY_APPLICATION_AMD          : src:= 'APPLICATION';
+    GL_DEBUG_CATEGORY_OTHER_AMD                : src:= 'OTHER';
+  end;
+  src:= 'GL_' + src;
+
+  case severity of
+    GL_DEBUG_SEVERITY_LOW_AMD:    sv := svLow;
+    GL_DEBUG_SEVERITY_MEDIUM_AMD: sv := svMedium;
+    GL_DEBUG_SEVERITY_HIGH_AMD:   sv := svHigh;
+  end;
+
+  TglcContext(userParam).LogMsg(sv, format('[%d] %s',[id, message_]));
+end;
+
 function TglcContext.GetEnableVSync: Boolean;
 begin
   result := fEnableVsync;
@@ -153,6 +218,32 @@ begin
   end;
 end;
 
+procedure TglcContext.LogMsg(const aSeverity: TSeverity; const aMsg: String);
+begin
+  if Assigned(fLogEvent) then
+    fLogEvent(self, aSeverity, aMsg);
+end;
+
+procedure TglcContext.SetDebugMode(const aEnable: Boolean);
+begin
+  // ARB Debug Output
+  if GL_ARB_debug_output then begin
+    glDebugMessageCallbackARB(@GlDebugCallbackARB, self);
+    glDebugMessageControlARB(GL_DONT_CARE, GL_DONT_CARE, GL_DONT_CARE, 0, nil, aEnable);
+    if aEnable then begin
+      glEnable(GL_DEBUG_OUTPUT_SYNCHRONOUS_ARB);
+      glDebugMessageInsertARB(GL_DEBUG_SOURCE_APPLICATION_ARB, GL_DEBUG_TYPE_OTHER_ARB, 0, GL_DEBUG_SEVERITY_LOW_ARB, -1, PGLchar('Attached ARB_debug_output'));
+    end;
+
+  // AMD Debug Output
+  end else if GL_AMD_debug_output then begin
+    glDebugMessageCallbackAMD(@GlDebugCallbackAMD, self);
+    glDebugMessageEnableAMD(GL_DONT_CARE, GL_DONT_CARE, 0, nil, aEnable);
+    if aEnable then
+      glDebugMessageInsertAMD(GL_DEBUG_CATEGORY_OTHER_AMD, GL_DEBUG_SEVERITY_LOW_ARB, 0, -1, PGLchar('Attached ARB_debug_output'));
+  end;
+end;
+
 procedure TglcContext.OpenContext;
 begin
   fThreadID := GetCurrentThreadId;
@@ -231,6 +322,17 @@ begin
   SetEnableVSync(fEnableVsync);
 end;
 
+procedure TglcContext.EnableDebugOutput(const aLogEvent: TLogEvent);
+begin
+  fLogEvent := aLogEvent;
+  SetDebugMode(true);
+end;
+
+procedure TglcContext.DisableDebugOutput;
+begin
+  SetDebugMode(false);
+end;
+
 procedure TglcContext.CloseContext;
 begin
   if fMainContextThreadID = fThreadID then