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