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