summaryrefslogtreecommitdiff
path: root/fpcsrc/packages/opengl/examples/freeglutdemo.pp
blob: e0586fa85ad792fba51d3ca96f86c67578fae32d (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
{ Trivial demo of some freeglut extensions, by Michalis Kamburelis,
  parts based on glutdemo.pp. Public domain.

  freeglut features:
  - when you press escape key, program returns gracefully to main begin...end.
  - we show special geometric objects: Sierpinski sponge, cylinder.
  - mouse wheel up/down can be used to zoom in/out.
}

{$mode objfpc}

program FreeGlutDemo;

uses
  GL, GLU, GLUT, FreeGlut;

var
  T: GLFloat;
  Zoom: GLFloat = -3;

procedure Display; cdecl;
const
  Offset: TGLDouble3 = (0, 0, 0);
begin
  glClear(GL_COLOR_BUFFER_BIT + GL_DEPTH_BUFFER_BIT);

  glPushMatrix;
    glTranslatef(-1, -1, Zoom);
    glRotatef(T, 0, 1, 0);
    glutWireCylinder(0.5, 1, 32, 8);
  glPopMatrix;

  glPushMatrix;
    glTranslatef(-1,  1, Zoom);
    glRotatef(T, 0, 1, 0);
    glutSolidCylinder(0.5, 1, 32, 8);
  glPopMatrix;

  glPushMatrix;
    glTranslatef(1, -1, Zoom);
    glRotatef(T, 0, 1, 0);
    glutWireSierpinskiSponge(3, @Offset, 1);
  glPopMatrix;

  glPushMatrix;
    glTranslatef(1,  1, Zoom);
    glRotatef(T, 0, 1, 0);
    glutSolidSierpinskiSponge(3, @Offset, 1);
  glPopMatrix;

  glutSwapBuffers;
end;

procedure Timer(Value: Integer); cdecl;
begin
  glutPostRedisplay;
  T := T + 1.0;
  glutTimerFunc(20, @Timer, 0);
end;

procedure Key(K: Byte; X, Y: Integer); cdecl;
begin
  case K of
    27: glutLeaveMainLoop(); // using freeglut you can exit cleanly
  end;
end;

procedure Wheel(Wheel, Direction, X, Y: Integer); cdecl;
begin
  if Wheel = 0 then
  begin
    Zoom := Zoom + Direction / 2;
    glutPostRedisplay();
  end;
end;

begin
  glutInit(@argc, argv);
  glutInitWindowSize(400, 400);
  glutInitDisplayMode(GLUT_RGB or GLUT_DOUBLE or GLUT_DEPTH);
  glutCreateWindow('FreeGlut demo');

  glutDisplayFunc(@Display);
  glutTimerFunc(20, @Timer, 0);
  glutKeyboardFunc(@Key);
  glutMouseWheelFunc(@Wheel);

  glEnable(GL_CULL_FACE); // Enable backface culling

  // Set up depth buffer
  glEnable(GL_DEPTH_TEST);
  glDepthFunc(GL_LESS);

  // Set up projection matrix
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  gluPerspective(90, 1.3, 0.1, 100);
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;

  glutSetOption(GLUT_ACTION_ON_WINDOW_CLOSE, GLUT_ACTION_CONTINUE_EXECUTION);

  WriteLn('Starting...');
  glutMainLoop;
  Writeln('glutMainLoop finished');
end.