DGL • Thema anzeigen - GLX and FreePascal

GLX and FreePascal

Moderator: DGL-Team

Seite 1 von 1

[ 2 Beiträge ]

Druckansicht

Vorheriges Thema | Nächstes Thema

Autor

Nachricht

BTierens

Betreff des Beitrags: GLX and FreePascal

Verfasst: Fr Sep 09, 2005 12:09

DGL Member

Registriert: Fr Aug 13, 2004 17:43
Beiträge: 60
Wohnort: Belgien

Hi,

When I try to use GLX in Freepascal, I always get an Acces Violation when calling glXChooseVisual. I use the FreePascal GLX header. This is the source:

Code:

 
var
  dpy: PDisplay;
  win,root: TWindow;
  attr: PXSetWindowAttributes;
  ctx: GLXContext;
  visinfo: PXVisualInfo;
  attrMask: longint;
  visAttributes: Array[0..8] of integer = (GLX_RGBA,GLX_RED_SIZE,1,GLX_GREEN_SIZE,1,GLX_BLUE_SIZE,1,GLX_DOUBLEBUFFER,None);
begin
  dpy := XOpenDisplay(nil);
  root := RootWindow(dpy,0);
  writeLn('glXChooseVisual');
  visinfo := glXChooseVisual(dpy,0,visAttributes);
  writeLn('glXChooseVisual ok');
  attr.background_pixel := 0;
  attr.border_pixel := 0;
  attr.colormap := XCreateColormap(dpy,root,visinfo.visual,AllocNone);
  attrMask := CWBackPixel or CWBorderPixel or CWColormap;
  win := XCreateWindow(dpy,root,0,0,width,height,0,visinfo.depth,InputOutput,visinfo.visual,attrMask,@attr);
  XMapWindow(dpy,win);
  ctx := glXCreateContext(dpy,visinfo,nil,true);
  glXMakeCurrent(dpy,win,ctx);
 

The code was based on code from http://www.mesa3d.org/MiniGLX.html

I tried the DelphiGL GLX header but I get errors while compiling. I also tried to apply Phobeus' patch but the Linux patch command fails to patch the header. Does somebody knows how to use GLX with FreePascal?

Nach oben

BTierens

Betreff des Beitrags:

Verfasst: Do Sep 29, 2005 19:16

DGL Member

Registriert: Fr Aug 13, 2004 17:43
Beiträge: 60
Wohnort: Belgien

One of the FreePascal programmers changed the glx header a bit and I've written a demo program that works. The demo works only with FreePascal 2.1 (a development version) and higher.

Code:

 
{
  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..10] of integer = (GLX_DEPTH_SIZE,16,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.
 

Nach oben

Seite 1 von 1

[ 2 Beiträge ]

Foren-Übersicht » English » English Programming Forum

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 14 Gäste

Du darfst keine neuen Themen in diesem Forum erstellen.
Du darfst keine Antworten zu Themen in diesem Forum erstellen.
Du darfst deine Beiträge in diesem Forum nicht ändern.
Du darfst deine Beiträge in diesem Forum nicht löschen.
Du darfst keine Dateianhänge in diesem Forum erstellen.