- Код: Выделить всё
{$mode objfpc}{$h+}
unit tr_application;
interface
uses
{$ifdef windows}
tr_windows,
{$endif}
classes, tr_logger;
type
TApplication = class
private
fwindow_name : string;
fwindow_width : integer;
fwindow_height : integer;
ffullscreen : boolean;
fparams : tstringList;
flog : tlogger; static;
public
property window_width : integer read fwindow_width write fwindow_width;
property window_height : integer read fwindow_height write fwindow_height;
property window_name : string read fwindow_name write fwindow_name;
constructor create();
destructor destroy();
class function get_instance() : tapplication;
function create_window(app_name : pchar; awindow_width, awindow_height : longint; afullscreen : boolean ) : boolean;
procedure parse_params(aparams : string);
procedure main_loop();
private
end;
implementation
var
app : TApplication = nil;
constructor TApplication.create();
begin
fwindow_name := 'tr_application_empty';
fwindow_width := 800;
fwindow_height := 600;
ffullscreen := false;
flog := tlogger.create('TEST_LOG.TXT');
end;
destructor TApplication.destroy();
begin
kill_gl_window();
end;
class function TApplication.get_instance() : tapplication;
begin
if(app = nil) then
app := tapplication.create();
result := app;
flog.write('Application has been created...');
end;
function TApplication.create_window(app_name : pchar; awindow_width, awindow_height : longint; afullscreen : boolean ) : boolean;
begin
if app_name <> '' then
fwindow_name := app_name;
fwindow_width := awindow_width;
fwindow_height := awindow_height;
ffullscreen := afullscreen;
// следующая функция создаёт само окно с opengl контекстом, но в нём же и обработка всех событий, как бы их вытащить?
result := create_gl_window(pchar(fwindow_name), fwindow_width, fwindow_height, ffullscreen);
end;
procedure TApplication.main_loop();
begin
process_messages();
end;
procedure TApplication.parse_params(aparams : string);
begin
end;
end.
Модуль создания окна, для Windows, под Linux планировался такой же модуль, с такими же функциями:
function create_gl_window(app_name : pchar; wnd_width, wnd_height : longint; app_fullscreen : boolean) : boolean;
procedure kill_gl_window();
procedure process_messages();
только другой реализацией.
- Код: Выделить всё
{$mode objfpc}{$h+}
{$apptype gui}
unit tr_windows;
interface
uses
gl, glu, windows;
var
msg : tmsg; // Windows messages
hwindow : hwnd; // Windows Handle to the OGL Window
dc_window : hdc; // Device Context for the OGL Window
rc_window : hglrc; // Render Context for the OGL Window
width, height : longint;
fullscreen, active : boolean;
function create_gl_window(app_name : pchar; wnd_width, wnd_height : longint; app_fullscreen : boolean) : boolean;
procedure kill_gl_window();
procedure process_messages();
implementation
procedure gl_init();
begin
glShadeModel(GL_SMOOTH);
glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);
glClearColor( 0.0, 0.0, 0.0, 1.0 );
glTranslatef(0.0, 0.0, -1.0);
end;
procedure gl_resize(awidth : integer; aheight : integer);
var
ar : real;
begin
if (aheight = 0) then
aheight := 1;
width := awidth;
height := aheight;
glViewport(0, 0, awidth, aheight);
glMatrixMode(GL_PROJECTION);
glLoadIdentity();
ar := awidth/aheight;
glOrtho(0, 10000, 0, 10000, 0.0, 0.0);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity;
end;
procedure gl_render();
var
i, x, y, segments_amount : integer;
angle, r, dx, dy : real;
begin
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
{ draw here }
{ тут просто рисование, рисуем бублик и две полоски }
glClear( GL_COLOR_BUFFER_BIT );
glLoadIdentity();
glColor3f(0.0, 0.0, 1.0);
glBegin(GL_LINES);
glVertex2f(0.0, 0.0);
glVertex2f(0.0, 1.0);
glEnd();
glColor3f(1.0, 0.0, 0.0);
glBegin(GL_LINES);
glVertex2f(0.0, 0.0);
glVertex2f(1.0, 0.0);
glEnd();
glColor3f(1.0, 1.0, 0.0);
i := 0;
r := 0.25;
x := 0;
y := 0;
segments_amount := 32;
glBegin(GL_LINE_LOOP);
for i := 0 to segments_amount do begin
angle := 2.0 * 3.1415926 * i / segments_amount;
dx := r * cos(angle);
dy := r * sin(angle);
glVertex2f(x + dx, y + dy);
end;
glEnd();
r := r/2;
glBegin(GL_LINE_LOOP);
for i := 0 to segments_amount do begin
angle := 2.0 * 3.1415926 * i / segments_amount;
dx := r * cos(angle);
dy := r * sin(angle);
glVertex2f(x + dx, y + dy);
end;
glEnd();
swapBuffers(dc_window); // put opengl stuff to screen
end;
procedure throw_error(pcErrorMessage : pchar);
begin
messageBox(0, pcErrorMessage, 'Error', MB_OK);
halt(0);
end;
{ Функция обработки сообщений}
function wnd_proc(window: hwnd; amessage, wparam, lparam: longint): longint; stdcall; export;
begin
result := 0;
case amessage of
WM_CREATE:
begin
active := true; // if GL Window was created correctly, then set
exit; // active-flag to "true".
end;
WM_PAINT:
begin
gl_render();
exit; // nothing to paint to Windows as we do all drawing with OGL
end;
WM_SIZE:
begin
gl_resize(LOWORD(lparam), HIWORD(lparam));
gl_render();
active := true;
exit;
end;
WM_MOVE:
begin
exit;
end;
WM_ERASEBKGND:
begin
exit; // чтобы не перезаливалось окно и не было мерцания
end;
WM_KEYDOWN:
begin
if wparam = VK_ESCAPE then
sendMessage(hwindow, wm_destroy,0,0);
exit; // check for ESC key. If pressed, then send quit message
end;
WM_DESTROY:
begin
active := false; // if quit message was sent, exit the main loop by setting
postQuitMessage(0); // the active-flag to "false".
kill_gl_window();
exit;
end;
WM_SYSCOMMAND: // system wants something..
begin
case (wparam) of
SC_SCREENSAVE : begin // ..don't start any screensavers.
result := 0;
end;
SC_MONITORPOWER : begin // ..and don't kill monitor power.
result := 0;
end;
end;
end;
WM_GETMINMAXINFO:
begin
with pMinMaxInfo(lparam)^ do begin
ptMinTrackSize.x := 800;
ptMinTrackSize.y := 600;
end;
exit;
end;
end;
result := defWindowProc(window, amessage, wparam, lparam); // let Windows deal with the rest of the messages.
end;
function register_window: boolean;
var
window_class : wndClass;
begin
window_class.style := CS_HREDRAW or CS_VREDRAW;
window_class.lpfnWndProc := wndProc(@wnd_proc); // Handle to our Windows messaging interface func.
window_class.cbClsExtra := 0;
window_class.cbWndExtra := 0;
window_class.hInstance := system.mainInstance; // Get the Windows Instance for our app.
window_class.hIcon := loadIcon(0, IDI_APPLICATION);
window_class.hCursor := loadCursor(0, IDC_ARROW);
window_class.hbrBackground := getStockObject(WHITE_BRUSH);
window_class.lpszMenuName := nil;
window_class.lpszClassName := 'GLWindow'; // Name the specified Window Class
result := registerClass(window_class) <> 0;
end;
{ Создаём пустое окно }
function create_empty_window(app_name : pchar; visible : boolean = true): hwnd;
var
hwindow: hwnd; // Handle to Window
//dmScreenSettings : DEVMODE; // Used for Full Screen Mode
begin
hwindow := createWindow('GLWindow',
app_name,
WS_OVERLAPPEDWINDOW or WS_CLIPCHILDREN or WS_CLIPSIBLINGS,
cw_useDefault,
cw_useDefault,
width,
height,
0, 0,
system.mainInstance,
nil);
if hwindow <> 0 then
begin
if visible then begin
showWindow(hwindow, CmdShow);
updateWindow(hwindow);
end;
end;
create_empty_window := hwindow;
end;
{ Init the Window and bind OGL to it. }
function init_window(hparent : hwnd): boolean;
var
function_error : integer;
pfd : PIXELFORMATDESCRIPTOR;
iformat : integer; // Pixel Format
begin
function_error := 0;
dc_window := getDC( hParent ); // Get Device Context
fillChar(pfd, sizeof(pfd), 0); // Define Pixel Format
pfd.nSize := sizeof(pfd);
pfd.nVersion := 1;
pfd.dwFlags := PFD_SUPPORT_OPENGL or PFD_DRAW_TO_WINDOW or PFD_DOUBLEBUFFER;
pfd.iPixelType := PFD_TYPE_RGBA;
pfd.cColorBits := 32;
pfd.cDepthBits := 32;
pfd.iLayerType := PFD_MAIN_PLANE;
iformat := choosePixelFormat(dc_window, @pfd); // Create Pixel Format
if (iformat = 0) then
function_error := 1;
setPixelFormat(dc_window, iformat, @pfd); // Set Pixel Format
rc_window := wglCreateContext(dc_window); // Create OpenGL Context
if (rc_window = 0) then
function_error := 2;
wglMakeCurrent(dc_window, rc_window); // Bind OpenGL to our Window
if function_error = 0 then
init_window := true
else
init_window := false;
end;
{ Kill Application Window again. }
procedure kill_gl_window();
begin
wglMakeCurrent(dc_window, 0); // Kill Device Context
wglDeleteContext(rc_window); // Kill Render Context
releaseDC(hWindow, dc_window); // Release Window
destroyWindow(hwindow); // Kill Window itself
end;
{ ***************************************************************************************************** }
procedure process_messages();
begin
repeat // start main proc
if peekMessage(@msg,0,0,0,0) = true then
begin
getMessage(@msg,0,0,0);
translateMessage(msg);
dispatchMessage(msg);
end;
until active = false; // end main proc
end;
function create_gl_window(app_name : pchar; wnd_width, wnd_height : longint; app_fullscreen : boolean) : boolean;
begin
width := wnd_width;
height := wnd_height;
fullscreen := app_fullscreen;
if not register_window() then begin
throw_error('Could not register the Application Window!');
result := false;
exit;
end;
hwindow := create_empty_window(app_name);
if longint(hwindow) = 0 then begin
throw_error('Could not create Application Window!');
result := false;
exit;
end;
if not init_window(hwindow) then begin
throw_error('Could not initialise Application Window!');
result := false;
exit;
end;
gl_init();
result := true;
end;
end.
А вот сюда бы передать управление, чтобы обрабатывать все события от кона, нажатия клавиш на клавиатуре и обработку мыши:
- Код: Выделить всё
{$mode objfpc}{$h+}
unit tr_core;
interface
uses
tr_application;
type
TCore = class
private
fapp : tapplication;
fscene_width : integer;
fscene_height : integer;
public
constructor create();
destructor destroy();
procedure on_key_pressed(key : integer);
procedure on_key_released(key : integer);
procedure on_mouse_move(x : integer; y : integer);
procedure on_mouse_down(x : integer; y : integer; button : integer);
procedure on_mouse_up(x : integer; y : integer; button : integer);
procedure on_double_click(x : integer; y : integer; button : integer);
procedure on_mouse_wheel(dx : integer; dy : integer);
procedure on_resize(width : integer; height : integer);
procedure render();
end;
implementation
constructor TCore.create();
begin
end;
destructor TCore.destroy();
begin
end;
procedure TCore.on_key_pressed(key : integer);
begin
end;
. . .
procedure TCore.render();
begin
end;
end.
Ну и основной код прилоежения:
- Код: Выделить всё
program ttt;
uses
tr_application;
var
app : tapplication;
begin
app := tapplication.get_instance();
app.create_window('', 1024, 768, false);
app.main_loop();
app.destroy();
end.
У кого какие мысли?
