Skip to content

Commit

Permalink
implemented multi-window support in ANT (only tested on MS Windows)
Browse files Browse the repository at this point in the history 
code and files added consists of the following:
  - two_windows.pp: added an example for two window creation
  - refactor gdi_CreateWindow and move towards gdi_Init and gdi_Terminate (prevent memleak for ANTWindow)
  - implement ANT_MakeCurrent to allow switching the context
  - implement ANT_GetDisplayCoords to determine the display coordinates (based on main monitor)
  • Loading branch information
@daar
daar committed Aug 27, 2018
1 parent 88e4723 commit 52f5bbc
Show file tree
Hide file tree
Showing 7 changed files with 317 additions and 76 deletions.
127 changes: 89 additions & 38 deletions intern/ant/ANT_gdi.pas
View file
Expand Up @@ -10,19 +10,25 @@ interface
MEM_guardedalloc,
ANT_base, ANT_types;

function gdi_Init: boolean;
function gdi_Terminate: boolean;

{
Creates a GDI window and its associated context.
@param Width: the width of the window
@param Height: the height of the window
@param title: the title of the window
@return a reference to the created window
}
function gdi_CreateWindow(Width, Height: integer; title: PChar): pANTwindow;
function gdi_CreateWindow(win: pANTwindow; posx, posy, sizex, sizey: integer; title: PChar): boolean;
{
Destroys a GDI window and its associated context.
@param win: the reference to the window being destroyed
}
procedure gdi_DestroyWindow(var win: pANTwindow);

function gdi_MakeCurrent(win: pANTwindow): boolean;

{
Swaps the front and back buffers of the specified window.
@param win: the reference to the window
Expand All @@ -43,58 +49,86 @@ procedure gdi_GetFrameBufferSize(win: pANTwindow; out width, height: integer);
}
procedure gdi_PollEvents;

procedure gdi_GetDisplayCoords(var dr: ANTRect);

implementation

uses
SysUtils,
ANT_main, ANT_messages;

var
wc: TWndclass;
h_Instance: HINST;

function gdi_WindowFromHWND(hWnd: Windows.HWND): pANTwindow; forward;
function gdi_GetKeyboardShiftState: TShiftState; forward;
function WndProc(hWnd: Windows.HWND; message: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; forward;

function gdi_CreateWindow(Width, Height: integer; title: PChar): pANTwindow;
const
bits = 16;
var
Pixelformat: GLuint;
wc: TWndclass;
dwExStyle: dword;
dwStyle: dword;
pfd: pixelformatdescriptor;
dmScreenSettings: Devmode;
WindowRect: TRect;
win: pANTwindow = nil;
function gdi_Init: boolean;
begin
win := callocN(sizeof(ANTWindow), 'ANTWindow');

WindowRect.Left := 0;
WindowRect.Top := 0;
WindowRect.Right := Width;
WindowRect.Bottom := Height;

win^.h_Instance := GetModuleHandle(nil);
h_Instance := GetModuleHandle(nil);

with wc do
begin
style := CS_HREDRAW or CS_VREDRAW or CS_OWNDC;
lpfnWndProc := @WndProc;
cbClsExtra := 0;
cbWndExtra := 0;
hInstance := win^.h_Instance;
hInstance := h_Instance;
hIcon := LoadIcon(0, IDI_WINLOGO);
hCursor := LoadCursor(0, IDC_ARROW);
hbrBackground := 0;
lpszMenuName := nil;
lpszClassName := 'ANT';
lpszClassName := 'ANT class';
end;

if RegisterClass(wc) = 0 then
begin
antError(ANT_PLATFORM_ERROR, 'ANT error: failed to register the window class', []);
exit(nil);
case GetLastError of
ERROR_CLASS_ALREADY_EXISTS:
antError(ANT_PLATFORM_ERROR, 'ANT error: class already exists', []);
ERROR_CLASS_DOES_NOT_EXIST:
antError(ANT_PLATFORM_ERROR, 'ANT error: class does not exists', []);
ERROR_CLASS_HAS_WINDOWS:
antError(ANT_PLATFORM_ERROR, 'ANT error: class has windows', []);
else
antError(ANT_PLATFORM_ERROR, 'ANT error: unknown class error', []);
end;

exit(False);
end;

exit(True);
end;

function gdi_Terminate: boolean;
begin
if (not UnregisterClass('ANT class', h_Instance)) then
begin
antError(ANT_PLATFORM_ERROR, 'ANT error: could not unregister class', []);
exit(False);
end;

exit(True);
end;

function gdi_CreateWindow(win: pANTwindow; posx, posy, sizex, sizey: integer; title: PChar): boolean;
const
bits = 16;
var
Pixelformat: GLuint;
dwExStyle: dword;
dwStyle: dword;
pfd: pixelformatdescriptor;
dmScreenSettings: Devmode;
WindowRect: TRect;
begin
WindowRect.Left := posx;
WindowRect.Top := posy;
WindowRect.Right := sizex;
WindowRect.Bottom := sizey;

if win^.fscreen then
begin
ZeroMemory(@dmScreenSettings, sizeof(dmScreenSettings));
Expand Down Expand Up @@ -129,7 +163,7 @@ function gdi_CreateWindow(Width, Height: integer; title: PChar): pANTwindow;
AdjustWindowRectEx(WindowRect, dwStyle, False, dwExStyle);

win^.h_Wnd := CreateWindowEx(dwExStyle,
'ANT',
'ANT class',
Title,
dwStyle,
0, 0,
Expand All @@ -143,7 +177,7 @@ function gdi_CreateWindow(Width, Height: integer; title: PChar): pANTwindow;
begin
gdi_DestroyWindow(win);
antError(ANT_PLATFORM_ERROR, 'ANT error: window creation error', []);
exit(nil);
exit(False);
end;

with pfd do
Expand Down Expand Up @@ -180,45 +214,45 @@ function gdi_CreateWindow(Width, Height: integer; title: PChar): pANTwindow;
begin
gdi_DestroyWindow(win);
antError(ANT_PLATFORM_ERROR, 'ANT error: can''t create a GL device context', []);
exit(nil);
exit(False);
end;

PixelFormat := ChoosePixelFormat(win^.h_DC, @pfd);
if PixelFormat = 0 then
begin
gdi_DestroyWindow(win);
antError(ANT_PLATFORM_ERROR, 'ANT error: can''t find a suitable PixelFormat', []);
exit(nil);
exit(False);
end;

if not SetPixelFormat(win^.h_DC, PixelFormat, @pfd) then
begin
gdi_DestroyWindow(win);
antError(ANT_PLATFORM_ERROR, 'ANT error: can''t set PixelFormat', []);
exit(nil);
exit(False);
end;

win^.h_RC := wglCreateContext(win^.h_DC);
if win^.h_RC = 0 then
begin
gdi_DestroyWindow(win);
antError(ANT_PLATFORM_ERROR, 'ANT error: can''t create a GL rendering context', []);
exit(nil);
exit(False);
end;

if not wglMakeCurrent(win^.h_DC, win^.h_RC) then
begin
gdi_DestroyWindow(win);
antError(ANT_PLATFORM_ERROR, 'ANT error: can''t activate the GL rendering context', []);
exit(nil);
exit(False);
end;

ShowWindow(win^.h_Wnd, SW_SHOW);
SetForegroundWindow(win^.h_Wnd);
SetFocus(win^.h_Wnd);

addtail(@windowlist, win);
exit(win);
exit(True);
end;

procedure gdi_DestroyWindow(var win: pANTwindow);
Expand Down Expand Up @@ -253,11 +287,11 @@ procedure gdi_DestroyWindow(var win: pANTwindow);
antError(ANT_PLATFORM_ERROR, 'ANT error: could not release hWnd', []);
win^.h_Wnd := 0;
end;
end;

if (not UnregisterClass('ANT', win^.h_Instance)) then
begin
antError(ANT_PLATFORM_ERROR, 'ANT error: could not unregister class', []);
end;
function gdi_MakeCurrent(win: pANTwindow): boolean;
begin
exit(wglMakeCurrent(win^.h_DC, win^.h_RC));
end;

procedure gdi_SwapBuffers(win: pANTwindow);
Expand Down Expand Up @@ -287,6 +321,17 @@ procedure gdi_PollEvents;
end;
end;

procedure gdi_GetDisplayCoords(var dr: ANTRect);
begin
if not SystemParametersInfo(SPI_GETWORKAREA, 0, @dr, 0) then
begin
dr.right := 0;
dr.left := 0;
dr.bottom := 0;
dr.top := 0;
end;
end;

function gdi_WindowFromHWND(hWnd: Windows.HWND): pANTwindow;
var
wi: pANTwindow;
Expand All @@ -300,6 +345,8 @@ function gdi_WindowFromHWND(hWnd: Windows.HWND): pANTwindow;

wi := wi^.next;
end;

exit(nil);
end;

function gdi_GetKeyboardShiftState: TShiftState;
Expand Down Expand Up @@ -409,11 +456,15 @@ function WndProc(hWnd: Windows.HWND; message: UINT; wParam: WPARAM; lParam: LPAR

antPostMessage(win, ANT_MESSAGE_RESIZE, params);
end;

//WM_PAINT:
// antPostMessage(win, ANT_MESSAGE_PAINT, params);
else
begin
//writeln(message);

if message = WM_PAINT then
antPostMessage(win, ANT_MESSAGE_PAINT, params);

exit(DefWindowProc(hWnd, message, wParam, lParam));
end;
end;
Expand Down

0 comments on commit 52f5bbc

Please sign in to comment.