DGL
https://delphigl.com/forum/

GLX and FreePascal
https://delphigl.com/forum/viewtopic.php?f=19&t=4554		 Seite 1 von 1
Autor:  BTierens [ Fr Sep 09, 2005 12:09 ]
Betreff des Beitrags:  GLX and FreePascal
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:
  1.  
  2. var
  3.   dpy: PDisplay;
  4.   win,root: TWindow;
  5.   attr: PXSetWindowAttributes;
  6.   ctx: GLXContext;
  7.   visinfo: PXVisualInfo;
  8.   attrMask: longint;
  9.   visAttributes: Array[0..8] of integer = (GLX_RGBA,GLX_RED_SIZE,1,GLX_GREEN_SIZE,1,GLX_BLUE_SIZE,1,GLX_DOUBLEBUFFER,None);
  10. begin
  11.   dpy := XOpenDisplay(nil);
  12.   root := RootWindow(dpy,0);
  13.   writeLn('glXChooseVisual');
  14.   visinfo := glXChooseVisual(dpy,0,visAttributes);
  15.   writeLn('glXChooseVisual ok');
  16.   attr.background_pixel := 0;
  17.   attr.border_pixel := 0;
  18.   attr.colormap := XCreateColormap(dpy,root,visinfo.visual,AllocNone);
  19.   attrMask := CWBackPixel or CWBorderPixel or CWColormap;
  20.   win := XCreateWindow(dpy,root,0,0,width,height,0,visinfo.depth,InputOutput,visinfo.visual,attrMask,@attr);
  21.   XMapWindow(dpy,win);
  22.   ctx := glXCreateContext(dpy,visinfo,nil,true);
  23.   glXMakeCurrent(dpy,win,ctx);
  24.  


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?
Autor:  BTierens [ Do Sep 29, 2005 19:16 ]
Betreff des Beitrags: 
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:
  1.  
  2. {
  3.   GLX demo for FreePascal
  4.   2005 Bart Tierens, BTierens@netscape.net
  5.  
  6.   This program is in the public domain
  7.  
  8.   Warning: This demo works only with FreePascal 2.1 and better, due to changes to the glx header
  9. }
  10. program glxTest;
  11.  
  12. {$MODE delphi}
  13.  
  14. uses glx,unix,x,xlib,xutil,gl,glu;
  15.  
  16. var
  17.   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);
  18.   visinfo: PXVisualInfo;
  19.   cm: TColormap;
  20.   winAttr: TXSetWindowAttributes;
  21.   glXCont: GLXContext;
  22.   dpy: PDisplay;
  23.   win: TWindow;
  24.  
  25. procedure redraw();
  26. begin
  27.   glClear(GL_COLOR_BUFFER_BIT);
  28.  
  29.   glTranslatef(-0.5,-0.5,-2);
  30.   glBegin(GL_QUADS);
  31.     glColor3f(1,0,0);
  32.     glVertex3f(0,0,0);
  33.     glColor3f(0,1,0);
  34.     glVertex3f(1,0,0);
  35.     glColor3f(0,0,1);
  36.     glVertex3f(1,1,0);
  37.     glColor3f(1,1,1);
  38.     glVertex3f(0,1,0);
  39.   glEnd();
  40.  
  41.   glXSwapBuffers(dpy, win); //Swap the buffers
  42. end;
  43.  
  44. procedure resize(width,height: integer);
  45. begin
  46.   glViewport(0,0,width,height);
  47.   glMatrixMode(GL_PROJECTION);
  48.   glLoadIdentity();
  49.   gluPerspective(45,width/height,0.1,200);
  50.   glMatrixMode(GL_MODELVIEW);
  51. end;
  52.  
  53. procedure loop();
  54. var
  55.   event: TXEvent;
  56. begin
  57.   while true do
  58.   begin
  59.     XNextEvent(dpy,@event);
  60.     case event._type of
  61.     Expose: redraw();
  62.     ConfigureNotify: resize(event.xconfigure.width,event.xconfigure.height);
  63.     KeyPress: halt(1);
  64.     end;
  65.   end;
  66. end;
  67.  
  68. var
  69.   errorBase,eventBase: integer;
  70.   window_title_property: TXTextProperty;
  71.   title: String;
  72. begin
  73.   initGlx();
  74.   dpy := XOpenDisplay(nil);
  75.   if(dpy = nil) then
  76.   writeLn('Error: Could not connect to X server');
  77.  
  78.   if not (glXQueryExtension(dpy,errorBase,eventBase)) then
  79.   writeLn('Error: GLX extension not supported');
  80.  
  81.   visinfo := glXChooseVisual(dpy,DefaultScreen(dpy), Attr);
  82.   if(visinfo = nil) then
  83.   writeLn('Error: Could not find visual');
  84.  
  85.   //Create a new colormap
  86.   cm := XCreateColormap(dpy,RootWindow(dpy,visinfo.screen),visinfo.visual,AllocNone);
  87.   winAttr.colormap := cm;
  88.   winAttr.border_pixel := 0;
  89.   winAttr.background_pixel := 0;
  90.   winAttr.event_mask := ExposureMask or ButtonPressMask or StructureNotifyMask or KeyPressMask;
  91.  
  92.   //Create a window
  93.   win := XCreateWindow(dpy,RootWindow(dpy,visinfo.screen),0,0,640,480,0,visinfo.depth,InputOutput,visinfo.visual,CWBorderPixel or CWColormap or CWEventMask,@winAttr);
  94.  
  95.   title := 'FreePascal GLX demo --------- Press any key to exit';
  96.   XStringListToTextProperty(@title,1,@window_title_property);
  97.   XSetWMName(dpy,win,@window_title_property);
  98.  
  99.   //Create an OpenGL rendering context
  100.   glXCont := glXCreateContext(dpy,visinfo,none,true);
  101.   if(glXCont = nil) then
  102.   writeLn('Error: Could not create an OpenGL rendering context');
  103.  
  104.   //Make it current
  105.   glXMakeCurrent(dpy,win,glXCont);
  106.  
  107.   //Map the window on the display
  108.   XMapWindow(dpy,win);
  109.  
  110.   loop();
  111. end.
  112.  
Seite 1 von 1 Alle Zeiten sind UTC + 1 Stunde
Powered by phpBB® Forum Software © phpBB Group
https://www.phpbb.com/