mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-05-03 18:23:40 +02:00
110 lines
2.7 KiB
ObjectPascal
110 lines
2.7 KiB
ObjectPascal
{
|
|
GLX demo for FreePascal
|
|
2005 Bart Tierens, BTierens@netscape.net
|
|
|
|
This program is in the public domain
|
|
|
|
Warning: This demo works only with FreePascal 2.1 and better, due to changes to the glx header
|
|
}
|
|
program glxTest;
|
|
|
|
{$MODE delphi}
|
|
|
|
uses glx,unix,x,xlib,xutil,gl,glu;
|
|
|
|
var
|
|
attr: Array[0..8] of integer = (GLX_RGBA,GLX_RED_SIZE,1,GLX_GREEN_SIZE,1,GLX_BLUE_SIZE,1,GLX_DOUBLEBUFFER,none);
|
|
visinfo: PXVisualInfo;
|
|
cm: TColormap;
|
|
winAttr: TXSetWindowAttributes;
|
|
glXCont: GLXContext;
|
|
dpy: PDisplay;
|
|
win: TWindow;
|
|
|
|
procedure redraw();
|
|
begin
|
|
glClear(GL_COLOR_BUFFER_BIT);
|
|
|
|
glTranslatef(-0.5,-0.5,-2);
|
|
glBegin(GL_QUADS);
|
|
glColor3f(1,0,0);
|
|
glVertex3f(0,0,0);
|
|
glColor3f(0,1,0);
|
|
glVertex3f(1,0,0);
|
|
glColor3f(0,0,1);
|
|
glVertex3f(1,1,0);
|
|
glColor3f(1,1,1);
|
|
glVertex3f(0,1,0);
|
|
glEnd();
|
|
|
|
glXSwapBuffers(dpy, win); //Swap the buffers
|
|
end;
|
|
|
|
procedure resize(width,height: integer);
|
|
begin
|
|
glViewport(0,0,width,height);
|
|
glMatrixMode(GL_PROJECTION);
|
|
glLoadIdentity();
|
|
gluPerspective(45,width/height,0.1,200);
|
|
glMatrixMode(GL_MODELVIEW);
|
|
end;
|
|
|
|
procedure loop();
|
|
var
|
|
event: TXEvent;
|
|
begin
|
|
while true do
|
|
begin
|
|
XNextEvent(dpy,@event);
|
|
case event._type of
|
|
Expose: redraw();
|
|
ConfigureNotify: resize(event.xconfigure.width,event.xconfigure.height);
|
|
KeyPress: halt(1);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
errorBase,eventBase: integer;
|
|
window_title_property: TXTextProperty;
|
|
title: String;
|
|
begin
|
|
initGlx();
|
|
dpy := XOpenDisplay(nil);
|
|
if(dpy = nil) then
|
|
writeLn('Error: Could not connect to X server');
|
|
|
|
if not (glXQueryExtension(dpy,errorBase,eventBase)) then
|
|
writeLn('Error: GLX extension not supported');
|
|
|
|
visinfo := glXChooseVisual(dpy,DefaultScreen(dpy), Attr);
|
|
if(visinfo = nil) then
|
|
writeLn('Error: Could not find visual');
|
|
|
|
//Create a new colormap
|
|
cm := XCreateColormap(dpy,RootWindow(dpy,visinfo.screen),visinfo.visual,AllocNone);
|
|
winAttr.colormap := cm;
|
|
winAttr.border_pixel := 0;
|
|
winAttr.background_pixel := 0;
|
|
winAttr.event_mask := ExposureMask or ButtonPressMask or StructureNotifyMask or KeyPressMask;
|
|
|
|
//Create a window
|
|
win := XCreateWindow(dpy,RootWindow(dpy,visinfo.screen),0,0,640,480,0,visinfo.depth,InputOutput,visinfo.visual,CWBorderPixel or CWColormap or CWEventMask,@winAttr);
|
|
|
|
title := 'FreePascal GLX demo --------- Press any key to exit';
|
|
XStringListToTextProperty(@title,1,@window_title_property);
|
|
XSetWMName(dpy,win,@window_title_property);
|
|
|
|
//Create an OpenGL rendering context
|
|
glXCont := glXCreateContext(dpy,visinfo,none,true);
|
|
if(glXCont = nil) then
|
|
writeLn('Error: Could not create an OpenGL rendering context');
|
|
|
|
//Make it current
|
|
glXMakeCurrent(dpy,win,glXCont);
|
|
|
|
//Map the window on the display
|
|
XMapWindow(dpy,win);
|
|
|
|
loop();
|
|
end. |