summaryrefslogtreecommitdiff
path: root/packages/opengl/examples/glxtest.pp
blob: 376fa9001bb9853bbc660babaf5ae2c26c63de69 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
{
  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
  { 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.