1 program es2example1;
2 // By Benjamin 'BeRo' Rosseaux - benjamin@rosseaux.com - http://www.rosseaux.com
3 // Tested on desktop linux and the Nokia N900 with Maemo 5
4 {$ifdef fpc}
5  {$mode delphi}
6  {$ifdef CPUARM}
7   {$define ogles}
8  {$endif}
9  {$ifdef CPUI386}
10   {$define CPU386}
11  {$endif}
12  {$ifdef CPU386}
13   {$asmmode intel}
14  {$endif}
15 {$endif}
16 
17 uses SysUtils,Classes,BaseUnix,Unix,UnixType,X,XLib,XUtil,XAtom{$ifdef ogles},gles20{$else},xf86vmode,GL,GLX,GLExt{$endif};
18 
19 const VertexArray:array[0..11] of single=(0,-1,0,1,
20                                           1,1,0,1,
21                                           -1,1,0,1);
22 
23       ShaderPrecode={$ifdef ogles}''{$else}'#version 120'#10{$endif};
24 
25       VertexShaderSource:string=ShaderPrecode+'attribute vec4 position;'#10+
26                                               'varying mediump vec2 pos;'#10+
27                                               'void main(){'#10+
28                                               ' gl_Position=position;'#10+
29                                               ' pos=position.xy;'#10+
30                                               '}';
31 
32       FragmentShaderSource:string=ShaderPrecode+'varying mediump vec2 pos;'#10+
33                                                 'uniform mediump float phase;'#10+
34                                                 'void main(){'#10+
35                                                 ' gl_FragColor=vec4(1.0,1.0,1.0,1.0)*sin(((pos.x*pos.x)+(pos.y*pos.y))*40.0+phase);'#10+
36                                                 '}';
37 
38 var ReturnCode,CanvasWidth,CanvasHeight:integer;
39     Running:boolean;
40     VertexShader,FragmentShader,ShaderProgram:TGLuint;
41     PhaseLocation:TGLint;
42     CurrentTime:int64;
43 
GetTimenull44 function GetTime:int64;
45 var NowTime:TDateTime;
46     Year,Month,Day,hour,min,sec,msec:word;
47 begin
48  NowTime:=Now;
49  DecodeDate(NowTime,Year,Month,Day);
50  DecodeTime(NowTime,hour,min,sec,msec);
51  result:=(((((((((((Year*365)+Month)*31)+Day)*24)+hour)*60)+min)*60)+sec)*1000)+msec;
52 end;
53 
54 procedure PrintShaderInfoLog(Shader:TGLUint;ShaderType:string);
55 var len,Success:TGLint;
56     Buffer:pchar;
57 begin
58  glGetShaderiv(Shader,GL_COMPILE_STATUS,@Success);
59  if Success<>GL_TRUE then begin
60   glGetShaderiv(Shader,GL_INFO_LOG_LENGTH,@len);
61   if len>0 then begin
62    getmem(Buffer,len+1);
63    glGetShaderInfoLog(Shader,len,nil,Buffer);
64    writeln(ShaderType,': ',Buffer);
65    freemem(Buffer);
66    Running:=false;
67    ReturnCode:=1;
68   end;
69  end;
70 end;
71 
CreateShadernull72 function CreateShader(ShaderType:TGLenum;Source:pchar):TGLuint;
73 begin
74  result:=glCreateShader(ShaderType);
75  glShaderSource(result,1,@Source,nil);
76  glCompileShader(result);
77  if ShaderType=GL_VERTEX_SHADER then begin
78   PrintShaderInfoLog(result,'Vertex shader');
79  end else begin
80   PrintShaderInfoLog(result,'Fragment shader');
81  end;
82 end;
83 
84 procedure Init;
85 begin
86  ShaderProgram:=glCreateProgram();
87 
88  VertexShader:=CreateShader(GL_VERTEX_SHADER,pchar(VertexShaderSource));
89  FragmentShader:=CreateShader(GL_FRAGMENT_SHADER,pchar(FragmentShaderSource));
90 
91  glAttachShader(ShaderProgram,VertexShader);
92  glAttachShader(ShaderProgram,FragmentShader);
93 
94  glLinkProgram(ShaderProgram);
95 
96  glUseProgram(ShaderProgram);
97 
98  PhaseLocation:=glGetUniformLocation(ShaderProgram,'phase');
99  if PhaseLocation<0 then begin
100   writeln('Error: Cannot get phase shader uniform location');
101   Running:=false;
102   ReturnCode:=1;
103  end;
104 end;
105 
106 procedure Done;
107 begin
108 end;
109 
110 procedure Render;
111 begin
112  glViewPort(0,0,CanvasWidth,CanvasHeight);
113  glClearColor(0,1,0,1);
114  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
115 
116  glUniform1f(PhaseLocation,(GetTime mod 2000)*0.001*pi);
117 
118  glVertexAttribPointer(0,4,GL_FLOAT,0,0,@VertexArray);
119  glEnableVertexAttribArray(0);
120  glDrawArrays(GL_TRIANGLE_STRIP,0,3);
121 
122 end;
123 
124 const MOUSE_MASK=ButtonPressMask or ButtonReleaseMask or PointerMotionMask or ButtonMotionMask;
125       KEY_MASK=KeyPressMask or KeyReleaseMask or KeymapStateMask;
126       X_MASK=KEY_MASK or MOUSE_MASK or VisibilityChangeMask or StructureNotifymask or ExposureMask;
127 
128 {$ifdef ogles}
129      Attr:array[0..6] of EGLint=(EGL_BUFFER_SIZE,16,
130                                   EGL_DEPTH_SIZE,8,
131                                   EGL_RENDERABLE_TYPE,EGL_OPENGL_ES2_BIT,
132                                   EGL_NONE);
133 {    Attr:array[0..12] of EGLint=(EGL_BUFFER_SIZE,16,
134                                   EGL_RED_SIZE,6,
135                                   EGL_GREEN_SIZE,5,
136                                   EGL_BLUE_SIZE,6,
137                                   EGL_DEPTH_SIZE,8,
138                                   EGL_RENDERABLE_TYPE,EGL_OPENGL_ES2_BIT,
139                                   EGL_NONE);}
140      CtxAttr:array[0..2] of EGLint=(EGL_CONTEXT_CLIENT_VERSION,2,EGL_NONE);
141 {$else}
142      Attr:array[0..8] of TGLint=(GLX_RGBA,
143                                  GLX_RED_SIZE,1,
144                                  GLX_GREEN_SIZE,1,
145                                  GLX_BLUE_SIZE,1,
146                                  GLX_DOUBLEBUFFER,
147                                  none);
148 {$endif}
149 
150      Title:string='GL test';
151 
152 var dpy:PXDisplay;
153     win,root:TWindow;
154     screennum,ScreenWidth,ScreenHeight:integer;
155     screen:PScreen;
156     visual:PVisual;
157     Event:TXEvent;
158 {$ifdef ogles}
159     swa:TXSetWindowAttributes;
160     ecfg:EGLConfig;
161     num_config:EGLint;
162     esfc:EGLSurface;
163     ectxt:EGLContext;
164     edpy:EGLDisplay;
165     mouse_accel_numerator,mouse_accel_denominator,mouse_threshold:integer;
166 {$else}
167     WinAttr:TXSetWindowAttributes;
168     GLXCont:GLXContext;
169     WindowTitleProperty:TXTextProperty;
170     visualinfo:PXVisualInfo;
171     ErrorBase,EventBase:integer;
172 {$endif}
173     WM_DELETE_WINDOW:TAtom;
174 
175 procedure DisableComposition;
176 {$ifdef ogles}
177 const one:integer=1;
178 {$endif}
179 var xclient:TXClientMessageEvent;
180     wm_state,fullscreen{$ifdef ogles},non_composited{$endif}:TAtom;
181 begin
182  wm_state:=XInternAtom(dpy,'_NET_WM_STATE',false);
183  fullscreen:=XInternAtom(dpy,'_NET_WN_STATE_FULLSCREEN',false);
184  XChangeProperty(dpy,win,wm_state,XA_ATOM,32,PropModeReplace,@fullscreen,1);
185  XFlush(dpy);
186 
187 {$ifdef ogles}
188  non_composited:=XInternAtom(dpy,'_HILDON_NON_COMPOSITED_WINDOW',false);
189  XChangeProperty(dpy,win,non_composited,XA_INTEGER,32,PropModeReplace,@one,1);
190  XFlush(dpy);
191 {$endif}
192 
193  xclient._type:=ClientMessage;
194  xclient.window:=win;
195  xclient.message_type:=XInternAtom(dpy,'_NET_WM_STATE',false);
196  xclient.format:=32;
197  xclient.data.l[0]:=1;
198  xclient.data.l[1]:=XInternAtom(dpy,'_NET_WM_STATE_FULLSCREEN',false);
199  xclient.data.l[2]:=0;
200  xclient.data.l[3]:=0;
201  xclient.data.l[4]:=0;
202  XSendEvent(dpy,root,false,SubstructureRedirectMask or SubstructureNotifyMask,PXEvent(pointer(@xclient)));
203  XFlush(dpy);
204 end;
205 
206 procedure SetEmptyMouseCursor;
207 const bm_no_data:array[0..7] of byte=(0,0,0,0,0,0,0,0);
208 var bm_no:TPixmap;
209     cmap:TColormap;
210     no_ptr:TCursor;
211     black,dummy:TXColor;
212 begin
213  cmap:=DefaultColormap(Dpy,screennum);
214  XAllocNamedColor(Dpy,cmap,'black',@black,@dummy);
215  bm_no:=XCreateBitmapFromData(Dpy,Win,POINTER(@bm_no_data),8,8);
216  no_ptr:=XCreatePixmapCursor(Dpy,bm_no,bm_no,@black,@black,0,0);
217  XDefineCursor(Dpy,Win,no_ptr);
218  XFreeCursor(Dpy,no_ptr);
219  if bm_no<>None then begin
220   XFreePixmap(Dpy,bm_no);
221  end;
222  XFreeColors(Dpy,cmap,@black.pixel,1,0);
223 end;
224 
225 begin
226  CurrentTime:=0;
227 
228  dpy:=XOpenDisplay(nil);
229  if not assigned(dpy) then begin
230   writeln('Error: Cannot connect to X server');
231   halt(1);
232  end;
233 
234  root:=DefaultRootWindow(dpy);
235 
236  screen:=XDefaultScreenOfDisplay(dpy);
237  if not assigned(screen) then begin
238   writeln('Error: Cannot get default screen');
239   halt(1);
240  end;
241 
242  ScreenWidth:=screen^.Width;
243  ScreenHeight:=screen^.Height;
244 
245  screennum:=XDefaultScreen(dpy);
246 
247  visual:=XDefaultVisualOfScreen(screen);
248 
249  CanvasWidth:=ScreenWidth;
250  CanvasHeight:=ScreenHeight;
251 {$ifdef ogles}
252 
253  swa.event_mask:=X_MASK;
254 
255  win:=XCreateWindow(dpy,root,0,0,ScreenWidth,ScreenHeight,0,CopyFromParent,InputOutput,Visual,CWEventMask,@swa);
256 
257  WM_DELETE_WINDOW:=XInternAtom(dpy,'WM_DELETE_WINDOW',FALSE);
258  XSetWMProtocols(dpy,win,@WM_DELETE_WINDOW,1);
259  XFlush(dpy);
260 
261  DisableComposition;
262 
263  XMapWindow(dpy,win);
264  XFlush(dpy);
265 
266  DisableComposition;
267 
268  XSelectInput(Dpy,Win,FocusChangeMask or KeyPressMask or KeyReleaseMask or PropertyChangeMask or StructureNotifyMask or KeymapStateMask or PointerMotionMask or EnterWindowMask or LeaveWindowMask or ButtonPressMask or ButtonReleaseMask or ExposureMask);
269 
270  XStoreName(dpy,win,pchar(Title));
271  XFlush(dpy);
272 
273  XMoveWindow(dpy,win,0,0);
274  XRaiseWindow(dpy,win);
275  //XWarpPointer(dpy,None,win,0,0,0,0,0,0);
276  XFlush(dpy);
277 
278  SetEmptyMouseCursor;
279 
280  XGrabPointer(dpy,win,true,MOUSE_MASK,GrabModeAsync,GrabModeAsync,win,None,CurrentTime);
281  XFlush(dpy);
282 
283  XGetPointerControl(dpy,@mouse_accel_numerator,@mouse_accel_denominator,@mouse_threshold);
284  XFlush(dpy);
285 
286  XChangePointerControl(dpy,1,1,1,1,0);
287  XFlush(dpy);
288 
289  XGrabKeyboard(dpy,win,false,GrabModeAsync,GrabModeAsync,CurrentTime);
290  XFlush(dpy);
291 
292  edpy:=eglGetDisplay(dpy);
293  if edpy=EGL_NO_DISPLAY then begin
294   writeln('Error: Got no EGL display');
295   halt(1);
296  end;
297 
298  if eglInitialize(edpy,nil,nil)=0 then begin
299   writeln('Error: Unable to initialize EGL');
300   halt(1);
301  end;
302 
303  num_config:=0;
304  if eglChooseConfig(edpy,@Attr,@ecfg,1,@num_config)=0 then begin
305   writeln('Error: Failed to choose config (',eglGetError,')');
306   halt(1);
307  end;
308  if num_config<>1 then begin
309   writeln('Error: Didn''t get exactly config but ',num_config);
310   halt(1);
311  end;
312 
313  esfc:=eglCreateWindowSurface(edpy,ecfg,win,nil);
314  if esfc=EGL_NO_SURFACE then begin
315   writeln('Error: Unable to create EGL surface (',eglGetError,')');
316   halt(1);
317  end;
318 
319  ectxt:=eglCreateContext(edpy,ecfg,EGL_NO_CONTEXT,@CtxAttr);
320  if ectxt=EGL_NO_CONTEXT then begin
321   writeln('Error: Unable to create EGL context (',eglGetError,')');
322   halt(1);
323  end;
324 
325  eglMakeCurrent(edpy,esfc,esfc,ectxt);
326 
327 {$else}
328  InitGLX;
329 
330  if not glXQueryExtension(dpy,ErrorBase,EventBase) then begin
331   writeln('Error: GLX extension not supported');
332   halt(1);
333  end;
334 
335  visualinfo:=glXChooseVisual(dpy,screennum,Attr);
336  if not assigned(Visualinfo) THEN BEGIN
337   writeln('Error: Could not find visual info');
338   exit;
339  end;
340 
341  WinAttr.colormap:=XCreateColormap(dpy,root,VisualInfo.Visual,AllocNone);
342  WinAttr.border_pixel:=0;
343  WinAttr.background_pixel:=0;
344  WinAttr.event_mask:=X_MASK;
345  WinAttr.override_redirect:=1;
346  WinAttr.backing_store:=NotUseful;
347  WinAttr.save_under:=0;
348 
349  Win:=XCreateWindow(dpy,root,0,0,ScreenWidth,ScreenHeight,0,VisualInfo.Depth,InputOutput,VisualInfo.Visual,CWOverrideRedirect or CWBackPixel or CWColormap or CWBackingStore or CWSaveUnder or CWEventMask,@WinAttr);
350 
351  XSelectInput(Dpy,Win,FocusChangeMask or KeyPressMask or KeyReleaseMask or PropertyChangeMask or StructureNotifyMask or KeymapStateMask or PointerMotionMask or EnterWindowMask or LeaveWindowMask or ButtonPressMask or ButtonReleaseMask or ExposureMask);
352 
353  XStringListToTextProperty(@Title,1,@WindowTitleProperty);
354  XSetWMName(Dpy,Win,@WindowTitleProperty);
355 
356  glXCont:=glXCreateContext(Dpy,VisualInfo,none,true);
357  if not assigned(glXCont) then begin
358   writeln('Error: Could not create an OpenGL rendering context');
359   halt(1);
360  end;
361 
362  DisableComposition;
363 
364  XMapWindow(Dpy,Win);
365  XFlush(dpy);
366 
367  DisableComposition;
368 
369  glXMakeCurrent(Dpy,Win,glXCont);
370 
371  SetEmptyMouseCursor;
372 
373  XMoveWindow(dpy,win,0,0);
374  XRaiseWindow(dpy,win);
375  XWarpPointer(dpy,None,win,0,0,0,0,0,0);
376  XFlush(dpy);
377 
378  XF86VidmodeSetViewPort(dpy,screennum,0,0);
379  XFlush(dpy);
380 
381  XGrabPointer(dpy,win,true,MOUSE_MASK,GrabModeAsync,GrabModeAsync,win,None,CurrentTime);
382  XGrabKeyboard(dpy,win,false,GrabModeAsync,GrabModeAsync,CurrentTime);
383  XFlush(dpy);
384 
385  XAutoRepeatOn(Dpy);
386  XFlush(dpy);
387 
388  WM_DELETE_WINDOW:=XInternAtom(dpy,'WM_DELETE_WINDOW',FALSE);
389  XSetWMProtocols(dpy,win,@WM_DELETE_WINDOW,1);
390  XFlush(Dpy);
391 
392  CanvasWidth:=ScreenWidth;
393  CanvasHeight:=ScreenHeight;
394 
395  if assigned(visual) then begin
396   // Den Compiler befriedigen, so dass der kein Warning deswegen ausspuckt  :)
397  end;
398 {$endif}
399 
400  Running:=true;
401  ReturnCode:=0;
402 {$ifndef ogles}
403  if not (Load_GL_version_1_2 and Load_GL_version_1_3 and Load_GL_version_1_4 and Load_GL_version_2_0) then begin
404   Running:=false;
405   writeln('Error: Cannot load OpenGL 2.0 API');
406   ReturnCode:=1;
407  end;
408 {$endif}
409  if Running then begin
410   Init;
411   CurrentTime:=GetTime;
412  end;
413  while Running do begin
414 
415   while XPending(Dpy)>0 do begin
416    XNextEvent(Dpy,@Event);
417 
418    case Event._type of
419 
420     ClientMessage:BEGIN
421      if (Event.xclient.format=32) and (longword(Event.xclient.Data.l[0])=longword(WM_DELETE_WINDOW)) then begin
422       Running:=false;
423      end;
424     end;
425 
426     Expose:begin
427     end;
428 
429     ConfigureNotify:begin
430     end;
431 
432     MotionNotify:begin
433 //   Running:=false;
434     end;
435 
436     ButtonPress:begin
437      Running:=false;
438     end;
439 
440     ButtonRelease:begin
441      Running:=false;
442     end;
443 
444     KeyMapNotify:begin
445     end;
446 
447     KeyPress:begin
448      Running:=false;
449     end;
450 
451     KeyRelease:begin
452      Running:=false;
453     end;
454 
455    end;
456 
457   end;
458 
459   CurrentTime:=GetTime;
460   Render;
461 
462 {$ifdef ogles}
463   eglSwapBuffers(edpy,esfc);
464 {$else}
465   glXSwapBuffers(dpy,win);
466 {$endif}
467 
468   XFlush(dpy);
469 
470  end;
471  if ReturnCode=0 then begin
472   Done;
473  end;
474 
475 {$ifdef ogles}
476  XChangePointerControl(dpy,1,1,mouse_accel_numerator,mouse_accel_denominator,mouse_threshold);
477  XUngrabPointer(dpy,CurrentTime);
478  XUngrabKeyboard(dpy,CurrentTime);
479  eglDestroyContext(edpy,ectxt);
480  eglDestroySurface(edpy,esfc);
481  eglTerminate(edpy);
482 {$else}
483  XUngrabPointer(dpy,CurrentTime);
484  XUngrabKeyboard(dpy,CurrentTime);
485  glXDestroyContext(dpy,glxCont);
486 {$endif}
487 
488  XDestroyWindow(dpy,win);
489  XCloseDisplay(dpy);
490 
491  halt(ReturnCode);
492 end.
493