freepascal.compiler/packages/opengl/examples/freeglutdemo.pp

{ 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.