mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-10 07:38:49 +02:00
107 lines
2.2 KiB
ObjectPascal
107 lines
2.2 KiB
ObjectPascal
{ 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.
|