freepascal.compiler/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
  { Attributes to choose context with glXChooseVisual }
  Attr: Array[0..8] of integer = (
    GLX_RGBA,
    GLX_RED_SIZE, 1,
    GLX_GREEN_SIZE, 1,
    GLX_BLUE_SIZE, 1,
    GLX_DOUBLEBUFFER,
    none);

  { Attributes to choose context with glXChooseFBConfig.
    Similar to Attr, but not exactly compatible. }
  AttrFB: Array[0..10] of integer = (
    GLX_X_RENDERABLE, 1 { true },
    GLX_RED_SIZE, 1,
    GLX_GREEN_SIZE, 1,
    GLX_BLUE_SIZE, 1,
    GLX_DOUBLEBUFFER, 1 { true },
    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;

procedure Error(const S: string);
begin
  Writeln(ErrOutput, 'Error: ', S);
  Halt(1);
end;

var
  window_title_property: TXTextProperty;
  title: String;
  FBConfig: TGLXFBConfig;
  FBConfigs: PGLXFBConfig;
  FBConfigsCount: Integer;

  { Used with glXCreateContextAttribsARB to select 3.0 forward-compatible context }
  Context30Forward: array [0..6] of Integer =
  ( GLX_CONTEXT_MAJOR_VERSION_ARB, 3,
    GLX_CONTEXT_MINOR_VERSION_ARB, 0,
    GLX_CONTEXT_FLAGS_ARB        , GLX_CONTEXT_FORWARD_COMPATIBLE_BIT_ARB,
    None
  );
begin
  dpy := XOpenDisplay(nil);
  if(dpy = nil) then
    Error('Could not connect to X server');

  if not GLX_version_1_0(dpy) then
    Error('GLX extension not supported');

  if GLX_version_1_3(dpy) then
  begin
    { use approach recommended since glX 1.3 }
    FBConfigs := glXChooseFBConfig(dpy, DefaultScreen(dpy), AttrFB, FBConfigsCount);
    if FBConfigsCount = 0 then
      Error('Could not find FB config');

    { just choose the first FB config from the FBConfigs list.
      More involved selection possible. }
    FBConfig := FBConfigs^;
    visinfo := glXGetVisualFromFBConfig(dpy, FBConfig);
  end else
  begin
    visinfo := glXChooseVisual(dpy, DefaultScreen(dpy), Attr);
  end;

  if(visinfo = nil) then
    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
  if GLX_version_1_3(dpy) then
  begin
    writeln('Using GLX 1.3 code path');
    { Uncomment two lines below to use GLX_ARB_create_context extension
      to request OpenGL 3.0 forward-compatible context. This is just
      a simple example, be aware of some shortcomings:

      - In case of failure, glXCreateContextAttribsARB not only returns nil,
        it also raises X error that by default simply breaks your program.
        In a real program, you probably want to catch it (use XSetErrorHandler
        to assign custom error handler) and retry glXCreateContextAttribsARB
        with less restrictive attributes.

      - In case of success, you will just see a black screen.
        That's because the Redraw and Resize procedures defined in this program
        actually use deprecated OpenGL calls, that are *not* available in
        a forward-compatible context (glGetError would show actual errors). }
//  if GLX_ARB_create_context(dpy, DefaultScreen(dpy)) then
//    glXCont := glXCreateContextAttribsARB(dpy, FBConfig, 0, true, Context30Forward) else
      { use approach recommended since glX 1.3 }
      glXCont := glXCreateNewContext(dpy, FBConfig, GLX_RGBA_TYPE, 0, true);
  end else
    glXCont := glXCreateContext(dpy, visinfo, none, true);

  if(glXCont = nil) then
    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.