|
|
@@ -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 |
|
|
|