fpc/packages/opengl/examples/glxtest.pp

{
  GLX demo for FreePascal
  2005 Bart Tierens, [email protected]

  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.