This commit is contained in:
admin_d committed
1 parent
f71802c885
commit
b8e2d0007d
6 files changed
+639
-39
No files matched your search
@@ -0,0 +1,275 @@
|
||||
unit KromOGLUtils;
|
||||
{$I KaM_Remake.inc}
|
||||
interface
|
||||
uses
|
||||
dglOpenGL,
|
||||
{$IFDEF FPC} GL, LCLIntf, {$ENDIF}
|
||||
{$IFDEF MSWindows} Windows {$ENDIF}
|
||||
{$IFDEF Unix} LCLType, glx, x, xlib, xutil {$ENDIF}
|
||||
;
|
||||
|
||||
{$IFDEF Unix}
|
||||
type HGLRC = Integer;
|
||||
type PFD_DRAW_TO_WINDOW = Integer;
|
||||
type PFD_SUPPORT_OPENGL = Integer;
|
||||
type PFD_DOUBLEBUFFER = Integer;
|
||||
type PFD_TYPE_RGBA = Integer;
|
||||
type PFD_MAIN_PLANE = Integer;
|
||||
{$ENDIF}
|
||||
|
||||
type
|
||||
TColor4 = Cardinal;
|
||||
TTexture = record Tex: Cardinal; U, V: Single; end;
|
||||
|
||||
procedure SetRenderFrame(RenderFrame: HWND; out h_DC: HDC; out h_RC: HGLRC);
|
||||
procedure SetRenderFrameAA(DummyFrame, RenderFrame: HWND; AntiAliasing: Byte; out h_DC: HDC; out h_RC: HGLRC);
|
||||
|
||||
procedure BuildFont(h_DC: HDC; FontSize: Integer; FontWeight: Word = FW_NORMAL);
|
||||
procedure glPrint(const text: AnsiString);
|
||||
procedure glkScale(x: Single);
|
||||
procedure glkQuad(Ax, Ay, Bx, By, Cx, Cy, Dx, Dy: Single);
|
||||
procedure glkRect(Ax, Ay, Bx, By: Single);
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
function SetDCPixelFormat(h_DC: HDC; PixelFormat: Integer): Boolean;
|
||||
var
|
||||
nPixelFormat: Integer;
|
||||
PixelDepth: Integer;
|
||||
{$IFDEF MSWINDOWS}
|
||||
pfd: TPixelFormatDescriptor;
|
||||
{$ENDIF}
|
||||
begin
|
||||
PixelDepth := 32; //32bpp is common
|
||||
{$IFDEF MSWINDOWS}
|
||||
with pfd do begin
|
||||
nSize := SizeOf(TPIXELFORMATDESCRIPTOR); // Size Of This Pixel Format Descriptor
|
||||
nVersion := 1; // The version of this data structure
|
||||
dwFlags := PFD_DRAW_TO_WINDOW // Buffer supports drawing to window
|
||||
or PFD_SUPPORT_OPENGL // Buffer supports OpenGL drawing
|
||||
or PFD_DOUBLEBUFFER; // Supports double buffering
|
||||
iPixelType := PFD_TYPE_RGBA; // RGBA color format
|
||||
cColorBits := PixelDepth; // OpenGL color depth
|
||||
cRedBits := 0; // Number of red bitplanes
|
||||
cRedShift := 0; // Shift count for red bitplanes
|
||||
cGreenBits := 0; // Number of green bitplanes
|
||||
cGreenShift := 0; // Shift count for green bitplanes
|
||||
cBlueBits := 0; // Number of blue bitplanes
|
||||
cBlueShift := 0; // Shift count for blue bitplanes
|
||||
cAlphaBits := 0; // Not supported
|
||||
cAlphaShift := 0; // Not supported
|
||||
cAccumBits := 0; // No accumulation buffer
|
||||
cAccumRedBits := 0; // Number of red bits in a-buffer
|
||||
cAccumGreenBits := 0; // Number of green bits in a-buffer
|
||||
cAccumBlueBits := 0; // Number of blue bits in a-buffer
|
||||
cAccumAlphaBits := 0; // Number of alpha bits in a-buffer
|
||||
cDepthBits := 16; // Specifies the depth of the depth buffer
|
||||
cStencilBits := 8; // Turn off stencil buffer
|
||||
cAuxBuffers := 0; // Not supported
|
||||
iLayerType := PFD_MAIN_PLANE; // Ignored
|
||||
bReserved := 0; // Number of overlay and underlay planes
|
||||
dwLayerMask := 0; // Ignored
|
||||
dwVisibleMask := 0; // Transparent color of underlay plane
|
||||
dwDamageMask := 0; // Ignored
|
||||
end;
|
||||
|
||||
if PixelFormat = 0 then
|
||||
nPixelFormat := ChoosePixelFormat(h_DC, @pfd)
|
||||
else
|
||||
nPixelFormat := PixelFormat;
|
||||
|
||||
if nPixelFormat = 0 then begin
|
||||
MessageBox(0, 'Unable to find a suitable pixel format', 'Error', MB_OK or MB_ICONERROR);
|
||||
Result := False;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
//Even with known pixel format we still need to supply some PFD structure
|
||||
if not SetPixelFormat(h_DC, nPixelFormat, @pfd) then begin
|
||||
MessageBox(0, 'Unable to set the pixel format', 'Error', MB_OK or MB_ICONERROR);
|
||||
Result := False;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
Result := True;
|
||||
{$ENDIF}
|
||||
//glXChooseVisual() should be on Uni insted of ChoosePixelFormatx
|
||||
end;
|
||||
|
||||
|
||||
function GetMultisamplePixelFormat(h_DC: HDC; AntiAliasing: Byte): Integer;
|
||||
var
|
||||
pixelFormat: Integer;
|
||||
ValidFormat: Boolean;
|
||||
NumFormats: GLUint;
|
||||
iAttributes: array of GLint;
|
||||
begin
|
||||
Result := 0;
|
||||
{$IFDEF MSWINDOWS}
|
||||
if not WGL_ARB_multisample or not Assigned(wglChoosePixelFormatARB) then
|
||||
Exit;
|
||||
{$ENDIF}
|
||||
SetLength(iAttributes,21);
|
||||
iAttributes[0] := WGL_DRAW_TO_WINDOW_ARB;
|
||||
iAttributes[1] := 1;
|
||||
iAttributes[2] := WGL_SUPPORT_OPENGL_ARB;
|
||||
iAttributes[3] := 1;
|
||||
iAttributes[4] := WGL_ACCELERATION_ARB;
|
||||
iAttributes[5] := WGL_FULL_ACCELERATION_ARB;
|
||||
iAttributes[6] := WGL_COLOR_BITS_ARB;
|
||||
iAttributes[7] := 24;
|
||||
iAttributes[8] := WGL_ALPHA_BITS_ARB;
|
||||
iAttributes[9] := 8;
|
||||
iAttributes[10] := WGL_DEPTH_BITS_ARB;
|
||||
iAttributes[11] := 16;
|
||||
iAttributes[12] := WGL_STENCIL_BITS_ARB;
|
||||
iAttributes[13] := 0;
|
||||
iAttributes[14] := WGL_DOUBLE_BUFFER_ARB;
|
||||
iAttributes[15] := 1;
|
||||
iAttributes[16] := WGL_SAMPLE_BUFFERS_ARB;
|
||||
iAttributes[17] := 1;
|
||||
iAttributes[18] := WGL_SAMPLES_ARB;
|
||||
iAttributes[19] := AntiAliasing;
|
||||
iAttributes[20] := 0;
|
||||
|
||||
//Try to find mode with slightly worse AA before giving up
|
||||
repeat
|
||||
iAttributes[19] := AntiAliasing;
|
||||
{$IFDEF MSWINDOWS}
|
||||
ValidFormat := wglChoosePixelFormatARB(h_dc, @iAttributes[0], nil, 1, @pixelFormat, @NumFormats);
|
||||
{$ENDIF}
|
||||
if ValidFormat and (NumFormats >= 1) then
|
||||
begin
|
||||
Result := pixelFormat;
|
||||
Exit;
|
||||
end;
|
||||
AntiAliasing := AntiAliasing div 2;
|
||||
until(AntiAliasing < 2);
|
||||
end;
|
||||
|
||||
|
||||
procedure SetContexts(RenderFrame: HWND; PixelFormat: Integer; out h_DC: HDC; out h_RC: HGLRC);
|
||||
begin
|
||||
{$IFDEF MSWINDOWS}
|
||||
h_DC := GetDC(RenderFrame);
|
||||
|
||||
if h_DC = 0 then
|
||||
begin
|
||||
MessageBox(HWND(nil), 'Unable to get a device context', 'Error', MB_OK or MB_ICONERROR);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if not SetDCPixelFormat(h_DC, PixelFormat) then
|
||||
Exit;
|
||||
|
||||
h_RC := wglCreateContext(h_DC);
|
||||
if h_RC = 0 then
|
||||
begin
|
||||
MessageBox(HWND(nil), 'Unable to create an OpenGL rendering context', 'Error', MB_OK or MB_ICONERROR);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if not wglMakeCurrent(h_DC, h_RC) then
|
||||
|
||||
begin
|
||||
MessageBox(HWND(nil), 'Unable to activate OpenGL rendering context', 'Error', MB_OK or MB_ICONERROR);
|
||||
Exit;
|
||||
end;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
|
||||
procedure SetRenderFrame(RenderFrame: HWND; out h_DC: HDC; out h_RC: HGLRC);
|
||||
begin
|
||||
InitOpenGL;
|
||||
SetContexts(RenderFrame, 0, h_DC, h_RC);
|
||||
ReadExtensions;
|
||||
ReadImplementationProperties;
|
||||
end;
|
||||
|
||||
|
||||
{The key problem is this: the function we use to get WGL extensions is, itself, an OpenGL extension.
|
||||
Thus like any OpenGL function, it requires an OpenGL context to call it. So in order to get the
|
||||
functions we need to create a context, we have to... create a context.
|
||||
|
||||
Fortunately, this context does not need to be our final context. All we need to do is create a dummy
|
||||
context to get function pointers, then use those functions directly. Unfortunately, Windows does not
|
||||
allow recreation of a rendering context within a single HWND. We must destroy previous HWND context
|
||||
and create final HWND context after we are finished with the dummy context.}
|
||||
procedure SetRenderFrameAA(DummyFrame, RenderFrame: HWND; AntiAliasing: Byte; out h_DC: HDC; out h_RC: HGLRC);
|
||||
var
|
||||
PixelFormat: Integer;
|
||||
begin
|
||||
InitOpenGL;
|
||||
SetContexts(DummyFrame, 0, h_DC, h_RC);
|
||||
ReadExtensions;
|
||||
ReadImplementationProperties;
|
||||
|
||||
PixelFormat := GetMultisamplePixelFormat(h_DC, AntiAliasing);
|
||||
{$IFDEF MSWINDOWS}
|
||||
wglMakeCurrent(h_DC, 0);
|
||||
wglDeleteContext(h_RC);
|
||||
{$ENDIF}
|
||||
SetContexts(RenderFrame, PixelFormat, h_DC, h_RC);
|
||||
ReadExtensions;
|
||||
ReadImplementationProperties;
|
||||
end;
|
||||
|
||||
|
||||
procedure BuildFont(h_DC: HDC; FontSize: Integer; FontWeight: Word = FW_NORMAL);
|
||||
var
|
||||
Font: HFONT;
|
||||
begin
|
||||
//New parameter FontSize=16
|
||||
font:=CreateFont(-abs(FontSize),0,0,0,FontWeight,0,0,0,ANSI_CHARSET,
|
||||
OUT_TT_PRECIS,CLIP_DEFAULT_PRECIS,
|
||||
ANTIALIASED_QUALITY,FF_DONTCARE or DEFAULT_PITCH,
|
||||
'Terminal');
|
||||
SelectObject(h_dc,font);
|
||||
{$IFDEF MSWindows}
|
||||
wglUseFontBitmaps(h_dc,0,128,20000);
|
||||
{$ENDIF}
|
||||
{$IFDEF Unix}
|
||||
// Emulate these functions (with freetype we should be able to code a multi platform solution)
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
|
||||
procedure glPrint(const text: AnsiString);
|
||||
begin
|
||||
if text = '' then Exit;
|
||||
glPushAttrib(GL_LIST_BIT);
|
||||
glListBase(20000);
|
||||
glCallLists(length(text),GL_UNSIGNED_BYTE,Pchar(@text[1]));
|
||||
glPopAttrib;
|
||||
end;
|
||||
|
||||
|
||||
procedure glkScale(x: Single);
|
||||
begin
|
||||
glScalef(x, x, x);
|
||||
end;
|
||||
|
||||
|
||||
procedure glkQuad(Ax, Ay, Bx, By, Cx, Cy, Dx, Dy: Single);
|
||||
begin
|
||||
glvertex2f(Ax, Ay);
|
||||
glvertex2f(Bx, By);
|
||||
glvertex2f(Cx, Cy);
|
||||
glvertex2f(Dx, Dy);
|
||||
end;
|
||||
|
||||
|
||||
//Same as glkQuad, but requires on TopLeft and BottomRight coords
|
||||
procedure glkRect(Ax, Ay, Bx, By: Single);
|
||||
begin
|
||||
glvertex2f(Ax, Ay);
|
||||
glvertex2f(Bx, Ay);
|
||||
glvertex2f(Bx, By);
|
||||
glvertex2f(Ax, By);
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
Reference in new issue
Block a user