← Back to branch summary

~ubuntu-branches/ubuntu/dapper/fpc/dapper

« back to all changes in this revision

Viewing changes to packages/extra/opengl/examples/glutdemo.pp

  • Committer: Bazaar Package Importer
  • Author(s): Carlos Laviola
  • Date: 2004-08-12 16:29:37 UTC
  • mfrom: (1.2.1 upstream) (2.1.1 warty)
  • Revision ID: james.westby@ubuntu.com-20040812162937-moo8ulvysp1ln771
Tags: 1.9.4-5
http://bugs.debian.org/265265
fp-compiler: needs ld, adding dependency on binutils.  (Closes: #265265)

Show diffs side-by-side

added added

removed removed

Lines of Context:
packages/extra/opengl/examples/glutdemo.pp
 
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
 
 
11
program GLUTDemo;
 
12
uses
 
13
  GL, GLU, GLUT;
 
14
 
 
15
const
 
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
 
 
24
var
 
25
  counter: Integer;
 
26
 
 
27
 
 
28
const
 
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
 
 
37
procedure 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;
 
49
begin
 
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;
 
58
end;
 
59
 
 
60
 
 
61
procedure DisplayWindow; cdecl;
 
62
var
 
63
  x, y: Integer;
 
64
begin
 
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;
 
93
end;
 
94
 
 
95
procedure OnTimer(value: Integer); cdecl;
 
96
begin
 
97
  glutPostRedisplay;
 
98
  glutTimerFunc(20, @OnTimer, 0);
 
99
end;
 
100
 
 
101
begin
 
102
  glutInitDisplayMode(GLUT_RGB or GLUT_DOUBLE or GLUT_DEPTH);
 
103
  glutCreateWindow('Free Pascal GLUT demo');
 
104
  glutDisplayFunc(@DisplayWindow);
 
105
  glutTimerFunc(20, @OnTimer, 0);
 
106
 
 
107
  WriteLn;
 
108
  WriteLn('GL info:');
 
109
  WriteLn('  Vendor: ', PChar(glGetString(GL_VENDOR)));
 
110
  WriteLn('  Renderer: ', PChar(glGetString(GL_RENDERER)));
 
111
  WriteLn('  Version: ', PChar(glGetString(GL_VERSION)));
 
112
  WriteLn('  Extensions: ', PChar(glGetString(GL_EXTENSIONS)));
 
113
 
 
114
  // Enable backface culling
 
115
  glEnable(GL_CULL_FACE);
 
116
 
 
117
  // Set up depth buffer
 
118
  glEnable(GL_DEPTH_TEST);
 
119
  glDepthFunc(GL_LESS);
 
120
 
 
121
  // Set up projection matrix
 
122
  glMatrixMode(GL_PROJECTION);
 
123
  glLoadIdentity;
 
124
  gluPerspective(90, 1.3, 0.1, 100);
 
125
  glMatrixMode(GL_MODELVIEW);
 
126
  glLoadIdentity;
 
127
  glTranslatef(0, 0, -5.5);
 
128
 
 
129
  WriteLn('Starting...');
 
130
  glutMainLoop;
 
131
 
 
132
end.