1{ 2 GL units for Free Pascal - GLUT demo 3 1999 Sebastian Guenther, sguenther@gmx.de 4 5 You may use this source as starting point for your own programs; consider it 6 as Public Domain. 7} 8 9{$mode objfpc} 10 11program GLUTDemo; 12uses 13 GL, GLU, GLUT; 14 15const 16 17 FPCImg: array[0..4, 0..10] of Byte = 18 ((1, 1, 1, 0, 1, 1, 1, 0, 0, 1, 1), 19 (1, 0, 0, 0, 1, 0, 1, 0, 1, 0, 0), 20 (1, 1, 1, 0, 1, 1, 1, 0, 1, 0, 0), 21 (1, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0), 22 (1, 0, 0, 0, 1, 0, 0, 0, 0, 1, 1)); 23 24var 25 counter: Integer; 26 27 28const 29 colors: array[0..7, 0..2] of Single = 30 ((0, 0, 0), (0, 0, 1), (0, 1, 0), (0, 1, 1), 31 (1, 0, 0), (1, 0, 1), (1, 1, 0), (1, 1, 1)); 32 corners: array[0..7, 0..2] of Single = 33 ((-1, -1, -1), (+1, -1, -1), (+1, +1, -1), (-1, +1, -1), 34 (-1, -1, +1), (+1, -1, +1), (+1, +1, +1), (-1, +1, +1)); 35 36 37procedure DrawCube; 38 procedure DrawSide(i1, i2, i3, i4: Integer); 39 begin 40 glColor4f (colors [i1, 0], colors [i1, 1], colors [i1, 2], 0.5); 41 glVertex3f(corners[i1, 0], corners[i1, 1], corners[i1, 2]); 42 glColor4f (colors [i2, 0], colors [i2, 1], colors [i2, 2], 0.5); 43 glVertex3f(corners[i2, 0], corners[i2, 1], corners[i2, 2]); 44 glColor4f (colors [i3, 0], colors [i3, 1], colors [i3, 2], 0.5); 45 glVertex3f(corners[i3, 0], corners[i3, 1], corners[i3, 2]); 46 47 glVertex3f(corners[i4, 0], corners[i4, 1], corners[i4, 2]); 48 end; 49begin 50 glBegin(GL_QUADS); 51 DrawSide(4, 5, 6, 7); // Front 52 DrawSide(3, 2, 1, 0); // Back 53 DrawSide(2, 3, 7, 6); // Top 54 DrawSide(0, 1, 5, 4); // Bottom 55 DrawSide(4, 7, 3, 0); // Left 56 DrawSide(1, 2, 6, 5); // Right 57 glEnd; 58end; 59 60 61procedure DisplayWindow; cdecl; 62var 63 x, y: Integer; 64begin 65 Inc(counter); 66 67 glClearColor(0, 0, 0.2, 1); 68 glClear(GL_COLOR_BUFFER_BIT+GL_DEPTH_BUFFER_BIT); 69 70 glPushMatrix; 71 glTranslatef(0, 0, Sin(Single(counter) / 20.0) * 5.0 - 5.0); 72 glRotatef(Sin(Single(counter) / 200.0) * 720.0, 0, 1, 0); 73 glRotatef(counter, 0, 0, 1); 74 75 for y := 0 to 4 do 76 for x := 0 to 10 do 77 if FPCImg[y, x] > 0 then begin 78 glPushMatrix; 79 glRotatef(x * Sin(Single(counter) / 5.0), 0, 1, 0); 80 glRotatef(y * Sin(Single(counter) / 12.0) * 4.0, 0, 0, 1); 81 glTranslatef((x - 5) * 1, (2 - y) * 1, 0); 82 glScalef(0.4, 0.4, 0.4); 83 glRotatef(counter, 0.5, 1, 0); 84 DrawCube; 85 glPopMatrix; 86 end; 87 88 glPopMatrix; 89 90 Inc(counter); 91 92 glutSwapBuffers; 93end; 94 95procedure OnTimer(value: Integer); cdecl; 96begin 97 glutPostRedisplay; 98 glutTimerFunc(20, @OnTimer, 0); 99end; 100 101begin 102 glutInit(@argc, argv); 103 104 glutInitDisplayMode(GLUT_RGB or GLUT_DOUBLE or GLUT_DEPTH); 105 glutCreateWindow('Free Pascal GLUT demo'); 106 glutDisplayFunc(@DisplayWindow); 107 glutTimerFunc(20, @OnTimer, 0); 108 109 WriteLn; 110 WriteLn('GL info:'); 111 WriteLn(' Vendor: ', PChar(glGetString(GL_VENDOR))); 112 WriteLn(' Renderer: ', PChar(glGetString(GL_RENDERER))); 113 WriteLn(' Version: ', PChar(glGetString(GL_VERSION))); 114 WriteLn(' Extensions: ', PChar(glGetString(GL_EXTENSIONS))); 115 116 // Enable backface culling 117 glEnable(GL_CULL_FACE); 118 119 // Set up depth buffer 120 glEnable(GL_DEPTH_TEST); 121 glDepthFunc(GL_LESS); 122 123 // Set up projection matrix 124 glMatrixMode(GL_PROJECTION); 125 glLoadIdentity; 126 gluPerspective(90, 1.3, 0.1, 100); 127 glMatrixMode(GL_MODELVIEW); 128 glLoadIdentity; 129 glTranslatef(0, 0, -5.5); 130 131 WriteLn('Starting...'); 132 glutMainLoop; 133 134end. 135