This commit is contained in:
1 parent
f71802c885
commit
b8e2d0007d
6 files changed
+639
-39
No files matched your search
@@ -6,7 +6,7 @@ uses
|
||||
{$IFDEF FPC} Controls, {$ENDIF}
|
||||
Classes,
|
||||
Dialogs, SysUtils,
|
||||
KM_CommonTypes, KM_Defaults, KM_RenderControl, KM_Video,
|
||||
KM_CommonTypes, KM_Defaults, KM_Video,
|
||||
KM_Campaigns, KM_Game, KM_InterfaceDefaults, KM_InterfaceMainMenu, KM_InterfaceTypes, KM_Resource,
|
||||
KM_Music, KM_Maps, KM_MapTypes, KM_CampaignClasses, KM_Networking,
|
||||
KM_GameSettings,
|
||||
@@ -20,6 +20,11 @@ type
|
||||
//Methods relevant to gameplay
|
||||
TKMGameApp = class
|
||||
private
|
||||
fGraphicsGeneration: QWord;
|
||||
fGraphicsGenerationAccepted: Boolean;
|
||||
fGraphicsAttemptGeneration: QWord;
|
||||
fApplicationGraphicsReadyGeneration: QWord;
|
||||
|
||||
fGlobalTickCount: Cardinal;
|
||||
fIsExiting: Boolean;
|
||||
fIsLoading: Boolean;
|
||||
@@ -66,9 +71,14 @@ type
|
||||
|
||||
procedure InitMainMenu(aScreenX, aScreenY: Word);
|
||||
function GetActiveInterface: TKMUserInterfaceCommon;
|
||||
procedure GraphicsContextAvailabilityChanged(aAvailable: Boolean);
|
||||
function IsCurrentGraphicsAttempt(aCandidateGeneration: QWord): Boolean;
|
||||
procedure ReevaluateApplicationGraphicsReadiness(aCandidateGeneration: QWord);
|
||||
function ApplicationGraphicsReadyForCurrentGeneration: Boolean;
|
||||
procedure RenderPresentationFrame;
|
||||
|
||||
public
|
||||
constructor Create(aRenderControl: TKMRenderControl; aScreenX, aScreenY: Word; aVSync: Boolean; aOnLoadingStep: TKMEvent;
|
||||
constructor Create(aScreenX, aScreenY: Word; aVSync: Boolean; aOnLoadingStep: TKMEvent;
|
||||
aOnLoadingText: TUnicodeStringEvent; aOnStatusBarUpdate: TProc<TKMStatusBarPanel, string>; NoMusic: Boolean = False);
|
||||
destructor Destroy; override;
|
||||
procedure AfterConstruction(aReturnToOptions: Boolean); reintroduce;
|
||||
@@ -172,17 +182,22 @@ uses
|
||||
KM_GameSavePoints,
|
||||
KM_Cursor, KM_ResTexts, KM_ResKeys, KM_ResTypes,
|
||||
KM_IoGraphicUtils, KM_Settings,
|
||||
KM_Saves, KM_CommonUtils
|
||||
KM_Saves, KM_CommonUtils, KM_GameApp_Mobile
|
||||
{$IFDEF DBG_RNG_SPY}, KM_RandomChecks{$ENDIF};
|
||||
|
||||
|
||||
{ TKMGameApp }
|
||||
// Creating everything needed for MainMenu, game stuff is created on StartGame
|
||||
constructor TKMGameApp.Create(aRenderControl: TKMRenderControl; aScreenX, aScreenY: Word; aVSync: Boolean; aOnLoadingStep: TKMEvent;
|
||||
constructor TKMGameApp.Create(aScreenX, aScreenY: Word; aVSync: Boolean; aOnLoadingStep: TKMEvent;
|
||||
aOnLoadingText: TUnicodeStringEvent; aOnStatusBarUpdate: TProc<TKMStatusBarPanel, string>; NoMusic: Boolean = False);
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
fGraphicsGeneration := 0;
|
||||
fGraphicsGenerationAccepted := False;
|
||||
fGraphicsAttemptGeneration := 0;
|
||||
fApplicationGraphicsReadyGeneration := 0;
|
||||
|
||||
fCampaigns := TKMCampaignsCollection.Create;
|
||||
|
||||
fOnStatusBarUpdate := aOnStatusBarUpdate;
|
||||
@@ -195,7 +210,8 @@ begin
|
||||
// it makes sense to store its settings along with the game's in the shared folder
|
||||
fServerSettings := TKMServerSettings.Create(slShared);
|
||||
|
||||
gRender := TKMRender.Create(aRenderControl, aScreenX, aScreenY, aVSync);
|
||||
gRender := TKMRender.Create(aScreenX, aScreenY);
|
||||
KMGameAppMobileAttach(GraphicsContextAvailabilityChanged);
|
||||
|
||||
fChat := TKMChat.Create;
|
||||
|
||||
@@ -238,6 +254,7 @@ begin
|
||||
|
||||
fOnGameStart := GameStarted;
|
||||
fOnGameEnd := GameEnded;
|
||||
KMGameAppMobileAttachPresentation(RenderPresentationFrame, Resize);
|
||||
end;
|
||||
|
||||
|
||||
@@ -250,12 +267,87 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure TKMGameApp.GraphicsContextAvailabilityChanged(aAvailable: Boolean);
|
||||
var
|
||||
candidateGeneration: QWord;
|
||||
begin
|
||||
if aAvailable then
|
||||
begin
|
||||
if fGraphicsGeneration = High(QWord) then
|
||||
raise Exception.Create('Graphics generation exhausted');
|
||||
|
||||
Inc(fGraphicsGeneration);
|
||||
fGraphicsAttemptGeneration := fGraphicsGeneration;
|
||||
fGraphicsGenerationAccepted := True;
|
||||
fApplicationGraphicsReadyGeneration := 0;
|
||||
candidateGeneration := fGraphicsAttemptGeneration;
|
||||
|
||||
TKMRender.GraphicsContextChanged(True);
|
||||
if not TKMRender.TextureBackendReady then
|
||||
raise Exception.Create('Graphics texture backend is not ready after context restore');
|
||||
|
||||
if (gRes <> nil) and (gRes.DataState <> rlsNone) then
|
||||
gRes.StartGameSpriteRecovery;
|
||||
|
||||
ReevaluateApplicationGraphicsReadiness(candidateGeneration);
|
||||
end
|
||||
else
|
||||
begin
|
||||
fGraphicsGenerationAccepted := False;
|
||||
fGraphicsAttemptGeneration := 0;
|
||||
fApplicationGraphicsReadyGeneration := 0;
|
||||
|
||||
TKMRender.GraphicsContextChanged(False);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TKMGameApp.ReevaluateApplicationGraphicsReadiness(aCandidateGeneration: QWord);
|
||||
begin
|
||||
if not IsCurrentGraphicsAttempt(aCandidateGeneration) then
|
||||
Exit;
|
||||
|
||||
fApplicationGraphicsReadyGeneration := 0;
|
||||
if not TKMRender.TextureBackendReady then
|
||||
Exit;
|
||||
if gGame <> nil then
|
||||
begin
|
||||
if gRes = nil then
|
||||
Exit;
|
||||
if not gRes.GameResourcesReady then
|
||||
Exit;
|
||||
end;
|
||||
if IsCurrentGraphicsAttempt(aCandidateGeneration) then
|
||||
fApplicationGraphicsReadyGeneration := aCandidateGeneration;
|
||||
end;
|
||||
|
||||
|
||||
function TKMGameApp.ApplicationGraphicsReadyForCurrentGeneration: Boolean;
|
||||
begin
|
||||
Result := fGraphicsGenerationAccepted
|
||||
and (fGraphicsGeneration <> 0)
|
||||
and (fGraphicsAttemptGeneration = fGraphicsGeneration)
|
||||
and (fApplicationGraphicsReadyGeneration = fGraphicsGeneration);
|
||||
end;
|
||||
|
||||
|
||||
function TKMGameApp.IsCurrentGraphicsAttempt(aCandidateGeneration: QWord): Boolean;
|
||||
begin
|
||||
Result := (aCandidateGeneration <> 0)
|
||||
and fGraphicsGenerationAccepted
|
||||
and (aCandidateGeneration = fGraphicsGeneration)
|
||||
and (aCandidateGeneration = fGraphicsAttemptGeneration);
|
||||
end;
|
||||
|
||||
|
||||
{ Destroy what was created }
|
||||
destructor TKMGameApp.Destroy;
|
||||
begin
|
||||
//Freeing network sockets and OpenAL can result in events like Resize/Paint occuring (seen in crash reports)
|
||||
//Set fIsExiting so we know to skip them
|
||||
fIsExiting := True;
|
||||
KMGameAppMobileDetachPresentation;
|
||||
KMGameAppMobileDetach;
|
||||
|
||||
//We might have crashed part way through .Create, so we can't assume ANYTHING exists here.
|
||||
//Doing so causes a 2nd exception which overrides 1st. Hence check <> nil on everything except Free (TObject.Free does that already)
|
||||
@@ -372,6 +464,12 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure TKMGameApp.RenderPresentationFrame;
|
||||
begin
|
||||
Render(False);
|
||||
end;
|
||||
|
||||
|
||||
// This event happens every ~33ms if the Key is Down and holded
|
||||
procedure TKMGameApp.KeyDown(Key: Word; Shift: TShiftState; aIsFirst: Boolean);
|
||||
var
|
||||
@@ -540,6 +638,8 @@ end;
|
||||
|
||||
|
||||
procedure TKMGameApp.CreateGame(aGameMode: TKMGameMode);
|
||||
var
|
||||
candidateGeneration: QWord;
|
||||
begin
|
||||
//Reset controls if MainForm exists (KMR could be run without main form)
|
||||
if gMain <> nil then
|
||||
@@ -550,6 +650,8 @@ begin
|
||||
fBaseSaveWorkerThreadHolder,
|
||||
fAutoSaveWorkerThreadHolder,
|
||||
fSavePointWorkerThreadHolder);
|
||||
candidateGeneration := fGraphicsAttemptGeneration;
|
||||
ReevaluateApplicationGraphicsReadiness(candidateGeneration);
|
||||
end;
|
||||
|
||||
|
||||
@@ -624,6 +726,8 @@ end;
|
||||
//5. Free the game object
|
||||
//6. Switch to MainMenu
|
||||
procedure TKMGameApp.StopGame(aMsg: TKMGameResultMsg; const aTextMsg: UnicodeString = '');
|
||||
var
|
||||
candidateGeneration: QWord;
|
||||
begin
|
||||
if gGame = nil then Exit;
|
||||
|
||||
@@ -655,6 +759,8 @@ begin
|
||||
end;
|
||||
|
||||
FreeThenNil(gGame);
|
||||
candidateGeneration := fGraphicsAttemptGeneration;
|
||||
ReevaluateApplicationGraphicsReadiness(candidateGeneration);
|
||||
gLog.AddTime('Gameplay ended - ' + GetEnumName(TypeInfo(TKMGameResultMsg), Integer(aMsg)) + ' /' + aTextMsg);
|
||||
end;
|
||||
|
||||
@@ -677,6 +783,8 @@ end;
|
||||
|
||||
|
||||
procedure TKMGameApp.StopGameReturnToLobby;
|
||||
var
|
||||
candidateGeneration: QWord;
|
||||
begin
|
||||
if gGame = nil then Exit;
|
||||
|
||||
@@ -692,6 +800,8 @@ begin
|
||||
fOnGameEnd(gGame.Params.Mode);
|
||||
|
||||
FreeThenNil(gGame);
|
||||
candidateGeneration := fGraphicsAttemptGeneration;
|
||||
ReevaluateApplicationGraphicsReadiness(candidateGeneration);
|
||||
|
||||
fNetworking.ReturnToLobby; //Clears gGame event pointers from Networking
|
||||
fMainMenuInterface.ReturnToLobby(RETURN_TO_LOBBY_SAVE); //Assigns Lobby event pointers to Networking and selects map
|
||||
@@ -1224,7 +1334,7 @@ begin
|
||||
if Self = nil then Exit;
|
||||
if SKIP_RENDER then Exit;
|
||||
if fIsExiting then Exit;
|
||||
if gRender.Blind then Exit;
|
||||
if not ApplicationGraphicsReadyForCurrentGeneration then Exit;
|
||||
if fIsLoading then Exit; //Don't render while toggling locale
|
||||
|
||||
gRender.BeginFrame;
|
||||
@@ -1239,7 +1349,6 @@ begin
|
||||
|
||||
gRender.RenderBrightness(gGameSettings.GFX.Brightness);
|
||||
|
||||
gRender.EndFrame;
|
||||
gRender.Query.QueriesSwapBuffers;
|
||||
|
||||
if not aForPrintScreen
|
||||
@@ -1393,12 +1502,20 @@ end;
|
||||
|
||||
// This is our real-time "thread", use it wisely
|
||||
procedure TKMGameApp.UpdateStateIdle(aFrameTime: Cardinal);
|
||||
var
|
||||
candidateGeneration: QWord;
|
||||
begin
|
||||
if gGame <> nil then gGame.UpdateStateIdle(aFrameTime);
|
||||
if gMusic <> nil then gMusic.UpdateStateIdle;
|
||||
if gSoundPlayer <> nil then gSoundPlayer.UpdateStateIdle;
|
||||
if fNetworking <> nil then fNetworking.UpdateStateIdle;
|
||||
if gRes <> nil then gRes.UpdateStateIdle;
|
||||
candidateGeneration := fGraphicsAttemptGeneration;
|
||||
try
|
||||
if gRes <> nil then
|
||||
gRes.UpdateStateIdle;
|
||||
finally
|
||||
ReevaluateApplicationGraphicsReadiness(candidateGeneration);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
@@ -5,7 +5,7 @@ uses
|
||||
{$IFDEF WDC} Windows, {$ENDIF}
|
||||
{$IFDEF Unix} LCLIntf, LCLType, OpenGLContext, {$ENDIF}
|
||||
dglOpenGL,
|
||||
KM_RenderControl, KM_RenderQuery, KM_RenderTypes, KM_CommonTypes;
|
||||
KM_RenderQuery, KM_RenderTypes, KM_CommonTypes;
|
||||
|
||||
|
||||
const
|
||||
@@ -25,17 +25,15 @@ type
|
||||
fFBO: Cardinal;
|
||||
fRenderBuf: Cardinal;
|
||||
|
||||
fRenderControl: TKMRenderControl;
|
||||
fOpenGL_Vendor, fOpenGL_Renderer, fOpenGL_Version: UnicodeString;
|
||||
fScreenX, fScreenY: Word;
|
||||
fBlind: Boolean;
|
||||
fQuery: TKMRenderQuery;
|
||||
|
||||
procedure InitFBO;
|
||||
procedure SaveBufferToFile(aUseFBOBuffer: Boolean; var aWidth, aHeight: Integer; var aPixelData: TKMCardinalArray);
|
||||
function GetMaxFBOSize: Cardinal;
|
||||
public
|
||||
constructor Create(aRenderControl: TKMRenderControl; aScreenX, aScreenY: Integer; aVSync: Boolean);
|
||||
constructor Create(aScreenX, aScreenY: Integer);
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure SetRenderMode(aRenderMode: TKMRenderMode); //Switch between 2D and 3D perspectives
|
||||
@@ -64,13 +62,10 @@ type
|
||||
|
||||
property ScreenX: Word read fScreenX;
|
||||
property ScreenY: Word read fScreenY;
|
||||
property Blind: Boolean read fBlind;
|
||||
|
||||
property Query: TKMRenderQuery read fQuery;
|
||||
|
||||
procedure BeginFrame;
|
||||
procedure RenderBrightness(aValue: Byte);
|
||||
procedure EndFrame;
|
||||
end;
|
||||
|
||||
var
|
||||
@@ -91,22 +86,17 @@ const
|
||||
MAX_FBO_BUFFER_SIZE = CELL_SIZE_PX * (MAX_MAP_SIZE - 1); // (10200 = CELL_SIZE=40px)*255
|
||||
|
||||
{ TKMRender }
|
||||
constructor TKMRender.Create(aRenderControl: TKMRenderControl; aScreenX, aScreenY: Integer; aVSync: Boolean);
|
||||
constructor TKMRender.Create(aScreenX, aScreenY: Integer);
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
gLog.AddTime('Init Render started');
|
||||
|
||||
fFBOInited := False;
|
||||
fBlind := aRenderControl = nil;
|
||||
fRenderControl := aRenderControl;
|
||||
|
||||
if not fBlind then
|
||||
begin
|
||||
fQuery := TKMRenderQuery.Create;
|
||||
|
||||
fRenderControl.CreateRenderContext;
|
||||
|
||||
fMaxViewportDim := GetMaxViewportDim;
|
||||
gLog.AddTime('GL_MAX_VIEWPORT_DIM = ' + IntToStr(fMaxViewportDim));
|
||||
|
||||
@@ -129,10 +119,8 @@ begin
|
||||
fOpenGL_Renderer := UnicodeString(glGetString(GL_RENDERER)); gLog.AddNoTime('OpenGL Renderer: ' + fOpenGL_Renderer);
|
||||
fOpenGL_Version := UnicodeString(glGetString(GL_VERSION)); gLog.AddNoTime('OpenGL Version: ' + fOpenGL_Version);
|
||||
|
||||
SetupVSync(aVSync);
|
||||
|
||||
Resize(aScreenX, aScreenY);
|
||||
end;
|
||||
Resize(aScreenX, aScreenY);
|
||||
gLog.AddTime('Init Render Done');
|
||||
end;
|
||||
|
||||
@@ -141,7 +129,6 @@ destructor TKMRender.Destroy;
|
||||
begin
|
||||
if not fBlind then
|
||||
begin
|
||||
fRenderControl.DestroyRenderContext;
|
||||
fQuery.Free;
|
||||
|
||||
if fFBOInited then
|
||||
@@ -189,11 +176,8 @@ end;
|
||||
|
||||
procedure TKMRender.Resize(aWidth, aHeight: Integer);
|
||||
begin
|
||||
if fBlind then Exit;
|
||||
|
||||
fScreenX := max(aWidth, 1);
|
||||
fScreenY := max(aHeight, 1);
|
||||
glViewport(0, 0, fScreenX, fScreenY);
|
||||
end;
|
||||
|
||||
|
||||
@@ -383,13 +367,4 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure TKMRender.EndFrame;
|
||||
begin
|
||||
if fBlind then Exit;
|
||||
|
||||
glFinish;
|
||||
fRenderControl.SwapBuffers;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
@@ -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