wesz
03-12-2007, 03:50 PM
Hello, i have problem with my engine class. When i compile it on linux, all works fine, but on windows something crash application. I use FPC 2.0.4.
unit engine;
interface
uses
sdl,
dglOpenGL,
sysUtils;
var
oldGetTicks: uInt32;
frame: double;
frameRate: integer = 0;
frameCount: integer = 0;
timerTime: uInt32 = 0;
type
TEngine = class
private
quit: boolean;
event: tsdl_event;
mousePos: TPoint;
procedure keyDown(key: integer);
procedure keyUp(key: integer);
procedure mouseUp(key: integer);
procedure mouseDown(key: integer);
procedure update;
procedure render;
procedure start;
public
width, height, bpp: integer;
fullscreen: boolean;
fps, maxFps: integer;
title: string;
screen: psdl_surface;
constructor create;
procedure init;
end;
procedure initOpenGL(width, height, fps: integer);
implementation
procedure initOpenGL(width, height, fps: integer);
begin
glShadeModel(gl_smooth);
glClearColor(0.0, 0.0, 0.0, 0.0);
glDisable(gl_depth_test);
glHint(gl_perspective_correction_hint, gl_nicest);
glViewport(0, 0, width , height);
glMatrixMode(gl_projection);
glLoadIdentity();
glOrtho(0, width, height, 0, 0, fps);
glMatrixMode(gl_modelview);
glLoadIdentity();
glEnable(gl_texture_2d);
glBlendFunc(gl_src_alpha, gl_one_minus_src_alpha);
end;
constructor TEngine.create;
begin
quit := false;
fullscreen := false;
width := 800;
height := 600;
bpp := 32;
fps := 0;
maxFps := 100;
title := 'engine';
end;
procedure TEngine.init;
var
videoInfo : psdl_videoInfo;
videoFlags: cardinal;
begin
if sdl_init(sdl_init_video) = -1 then
begin
sdl_quit;
halt(1);
end;
videoInfo := sdl_getVideoInfo;
videoFlags := sdl_opengl;
videoFlags := videoFlags or sdl_doublebuf;
videoFlags := videoFlags or sdl_hwpalette;
if fullscreen then videoFlags := videoFlags or sdl_fullscreen;
if videoInfo.hw_available <> 0 then
videoFlags := videoFlags or sdl_hwsurface
else
videoFlags := videoFlags or sdl_swsurface;
if videoInfo.blit_hw <0>= timerTime + 1000 then
begin
fps := frameCount;
frameCount := 0;
timerTime := sdl_getTicks;
end;
sdl_wm_setCaption(PChar('FPS: ' + intToStr(fps)), nil);
end;
procedure TEngine.start;
var
i: integer;
begin
oldGetTicks := sdl_getTicks;
frame := 0;
while not quit do
begin
while sdl_pollEvent(@event) > 0 do
begin
if event.type_ = sdl_quitev then quit := true;
if event.type_ = sdl_keydown then
begin
case event.key.keysym.sym of
sdlk_escape:
quit := true;
end;
keyDown(event.key.keysym.sym);
end;
if event.type_ = sdl_keyup then
begin
keyUp(event.key.keysym.sym);
end;
if event.type_ = sdl_mousemotion then
begin
mousePos.x := event.button.x;
mousePos.y := event.button.y;
end;
if event.type_ = sdl_mousebuttonup then
begin
if event.button.button = sdl_button_left then
begin
mouseUp(1);
end;
if event.button.button = sdl_button_right then
mouseUp(2);
end;
if event.type_ = sdl_mousebuttondown then
begin
if event.button.button = sdl_button_left then
begin
mouseDown(1);
end;
if event.button.button = sdl_button_right then
mouseDown(2);
end;
end;
if sdl_getTicks - oldGetTicks > 0 then frame := frame + (maxFps / (1000 / (sdl_getTicks - oldGetTicks)));
oldGetTicks := sdl_getTicks;
for i := 1 to trunc(frame) do
begin
update;
end;
frame := frame - trunc(frame);
render;
sdl_flip(screen);
sdl_delay(1)
end;
end;
end.
ttp://pordesign.eu/public_html/hax/opengl.rar - sample for windows.
unit engine;
interface
uses
sdl,
dglOpenGL,
sysUtils;
var
oldGetTicks: uInt32;
frame: double;
frameRate: integer = 0;
frameCount: integer = 0;
timerTime: uInt32 = 0;
type
TEngine = class
private
quit: boolean;
event: tsdl_event;
mousePos: TPoint;
procedure keyDown(key: integer);
procedure keyUp(key: integer);
procedure mouseUp(key: integer);
procedure mouseDown(key: integer);
procedure update;
procedure render;
procedure start;
public
width, height, bpp: integer;
fullscreen: boolean;
fps, maxFps: integer;
title: string;
screen: psdl_surface;
constructor create;
procedure init;
end;
procedure initOpenGL(width, height, fps: integer);
implementation
procedure initOpenGL(width, height, fps: integer);
begin
glShadeModel(gl_smooth);
glClearColor(0.0, 0.0, 0.0, 0.0);
glDisable(gl_depth_test);
glHint(gl_perspective_correction_hint, gl_nicest);
glViewport(0, 0, width , height);
glMatrixMode(gl_projection);
glLoadIdentity();
glOrtho(0, width, height, 0, 0, fps);
glMatrixMode(gl_modelview);
glLoadIdentity();
glEnable(gl_texture_2d);
glBlendFunc(gl_src_alpha, gl_one_minus_src_alpha);
end;
constructor TEngine.create;
begin
quit := false;
fullscreen := false;
width := 800;
height := 600;
bpp := 32;
fps := 0;
maxFps := 100;
title := 'engine';
end;
procedure TEngine.init;
var
videoInfo : psdl_videoInfo;
videoFlags: cardinal;
begin
if sdl_init(sdl_init_video) = -1 then
begin
sdl_quit;
halt(1);
end;
videoInfo := sdl_getVideoInfo;
videoFlags := sdl_opengl;
videoFlags := videoFlags or sdl_doublebuf;
videoFlags := videoFlags or sdl_hwpalette;
if fullscreen then videoFlags := videoFlags or sdl_fullscreen;
if videoInfo.hw_available <> 0 then
videoFlags := videoFlags or sdl_hwsurface
else
videoFlags := videoFlags or sdl_swsurface;
if videoInfo.blit_hw <0>= timerTime + 1000 then
begin
fps := frameCount;
frameCount := 0;
timerTime := sdl_getTicks;
end;
sdl_wm_setCaption(PChar('FPS: ' + intToStr(fps)), nil);
end;
procedure TEngine.start;
var
i: integer;
begin
oldGetTicks := sdl_getTicks;
frame := 0;
while not quit do
begin
while sdl_pollEvent(@event) > 0 do
begin
if event.type_ = sdl_quitev then quit := true;
if event.type_ = sdl_keydown then
begin
case event.key.keysym.sym of
sdlk_escape:
quit := true;
end;
keyDown(event.key.keysym.sym);
end;
if event.type_ = sdl_keyup then
begin
keyUp(event.key.keysym.sym);
end;
if event.type_ = sdl_mousemotion then
begin
mousePos.x := event.button.x;
mousePos.y := event.button.y;
end;
if event.type_ = sdl_mousebuttonup then
begin
if event.button.button = sdl_button_left then
begin
mouseUp(1);
end;
if event.button.button = sdl_button_right then
mouseUp(2);
end;
if event.type_ = sdl_mousebuttondown then
begin
if event.button.button = sdl_button_left then
begin
mouseDown(1);
end;
if event.button.button = sdl_button_right then
mouseDown(2);
end;
end;
if sdl_getTicks - oldGetTicks > 0 then frame := frame + (maxFps / (1000 / (sdl_getTicks - oldGetTicks)));
oldGetTicks := sdl_getTicks;
for i := 1 to trunc(frame) do
begin
update;
end;
frame := frame - trunc(frame);
render;
sdl_flip(screen);
sdl_delay(1)
end;
end;
end.
ttp://pordesign.eu/public_html/hax/opengl.rar - sample for windows.