paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-01 10:02:33 +02:00
Code Issues Packages Projects Releases Wiki Activity

* new bounce demo

Browse Source
This commit is contained in:
peter 2000-10-01 22:17:58 +00:00
parent 2a0e0ebd24
commit 000049f35b
18 changed files with 358 additions and 105 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
packages/opengl/build/glut.def
View File

@ -148,6 +148,7 @@ type
TGlutTimerFunc = procedure(value: Integer); extdecl
TGlutKeyboardFunc = procedure(key: char;x,y:Integer); extdecl
TGlutIdleFunc = procedure; extdecl
TGlutVisibilityFunc = procedure(state:Integer); extdecl
// GLUT game mode sub-API
{$ifdef GLUT_GAME}
@ -170,7 +171,7 @@ const
%PROCS
// GLUT initialization sub-API
glutInit: procedure(var argcp: Integer; var argv: PChar);
glutInit: procedure(argcp: PInteger; argv: PPChar);
glutInitDisplayMode: procedure(mode: LongWord);
glutInitDisplayString: procedure(AString: PChar);
glutInitWindowPosition: procedure(x, y: Integer);
@ -210,7 +211,7 @@ const
glutTimerFunc: procedure(millis: LongWord; func: TGlutTimerFunc; value: longint);
glutKeyboardFunc : procedure(func: TGlutKeyboardFunc);
glutIdleFunc : procedure(func: TGlutIdleFunc);
glutVisibilityFunc : procedure(func: TGlutVisibilityFunc);
// GLUTAPI void APIENTRY glutDisplayFunc(void (GLUTCALLBACK * func)(void));
// GLUTAPI void APIENTRY glutReshapeFunc(void (GLUTCALLBACK * func)(int width, int height));

2
packages/opengl/examples/Makefile
View File

@ -176,7 +176,7 @@ endif
# Targets
override EXEOBJECTS+=glutdemo morph3d
override EXEOBJECTS+=glutdemo morph3d bounce
# Clean

2
packages/opengl/examples/Makefile.fpc
View File

@ -3,7 +3,7 @@
#
[targets]
programs=glutdemo morph3d
programs=glutdemo morph3d bounce
[require]
packages=opengl

247
packages/opengl/examples/bounce.pp Normal file
View File

@ -0,0 +1,247 @@
{
$Id$
Bouncing ball demo. Color index mode only!
This program is in the public domain
Brian Paul
Converted to Pascal by Peter Vreman
}
program bounce;
uses
gl,glut;
{#define COS(X) cos( (X) * 3.14159/180.0 )
#define SIN(X) sin( (X) * 3.14159/180.0 )}
const
RED=1;
WHITE=2;
CYAN=3;
var
IndexMode : Boolean;
Ball : GLuint;
const
Zrot : GLfloat = 0.0;
Zstep : GLfloat = 6.0;
Xpos : GLfloat = 0.0;
Ypos : GLfloat = 1.0;
Xvel : GLfloat = 0.2;
Yvel : GLfloat = 0.0;
Xmin : GLfloat = -4.0;
Xmax : GLfloat = 4.0;
Ymin : GLfloat = -3.8;
Ymax : GLfloat = 4.0;
G : GLfloat = -0.1;
function make_ball:GLuint;
var
list : GLuint;
a,b,
ar,br : GLFloat;
da,db,
dar : GLFloat;
radius : GLFloat;
color : boolean;
x,y,z : GLFloat;
begin
da:=18.0;
db:=18.0;
radius:=1.0;
list := glGenLists(1);
glNewList(list, GL_COMPILE);
color := false;
a:=-90.0;
while (a+da<=90.0) do
begin
glBegin(GL_QUAD_STRIP);
b:=0.0;
while (b<=360.0) do
begin
if (color) then
begin
glIndexi(RED);
glColor3f(1, 0, 0);
end
else
begin
glIndexi(WHITE);
glColor3f(1, 1, 1);
end;
ar:=a * 3.14159/180.0;
br:=b * 3.14159/180.0;
x := COS(br) * COS(ar);
y := SIN(br) * COS(ar);
z := SIN(ar);
glVertex3f(x, y, z);
dar:=da * 3.14159/180.0;
x := radius * COS(br) * COS(ar + dar);
y := radius * SIN(br) * COS(ar + dar);
z := radius * SIN(ar + dar);
glVertex3f(x, y, z);
color := not color;
b:=b+db;
end;
glEnd();
a:=a+da;
end;
glEndList();
make_ball:=list;
end;
procedure reshape(width,height:longint);cdecl;
var
aspect : glFloat;
begin
aspect := glfloat(width) / glfloat(height);
glViewport(0, 0, width, height);
glMatrixMode(GL_PROJECTION);
glLoadIdentity();
glOrtho(-6.0 * aspect, 6.0 * aspect, -6.0, 6.0, -6.0, 6.0);
glMatrixMode(GL_MODELVIEW);
end;
procedure key(k:char;x,y:longint);cdecl;
begin
case k of
#27 :
halt(0);
end;
end;
procedure draw;cdecl;
var
i : GLint;
begin
glClear(GL_COLOR_BUFFER_BIT);
glIndexi(CYAN);
glColor3f(0, 1, 1);
glBegin(GL_LINES);
for i:=-5 to 5 do
begin
glVertex2i(i, -5);
glVertex2i(i, 5);
end;
for i:=-5 to 5 do
begin
glVertex2i(-5, i);
glVertex2i(5, i);
end;
for i:=-5 to 5 do
begin
glVertex2i(i, -5);
glVertex2f(i * 1.15, -5.9);
end;
glVertex2f(-5.3, -5.35);
glVertex2f(5.3, -5.35);
glVertex2f(-5.75, -5.9);
glVertex2f(5.75, -5.9);
glEnd();
glPushMatrix();
glTranslatef(Xpos, Ypos, 0.0);
glScalef(2.0, 2.0, 2.0);
glRotatef(8.0, 0.0, 0.0, 1.0);
glRotatef(90.0, 1.0, 0.0, 0.0);
glRotatef(Zrot, 0.0, 0.0, 1.0);
glCallList(Ball);
glPopMatrix();
glFlush();
glutSwapBuffers();
end;
const
vel0 : glfloat = -100.0;
procedure idle;cdecl;
begin
Zrot:=Zrot+Zstep;
Xpos:=Xpos+Xvel;
if (Xpos >= Xmax) then
begin
Xpos := Xmax;
Xvel := -Xvel;
Zstep := -Zstep;
end;
if (Xpos <= Xmin) then
begin
Xpos := Xmin;
Xvel := -Xvel;
Zstep := -Zstep;
end;
Ypos:=Ypos+Yvel;
Yvel:=Yvel+G;
if (Ypos < Ymin) then
begin
Ypos := Ymin;
if (vel0 = -100.0) then
vel0 := abs(Yvel);
Yvel := vel0;
end;
glutPostRedisplay();
end;
procedure visible(vis:longint);cdecl;
begin
if (vis=GLUT_VISIBLE) then
glutIdleFunc(@idle)
else
glutIdleFunc(nil);
end;
begin
glutInit(@argc, argv);
glutInitWindowPosition(0, 0);
glutInitWindowSize(600, 450);
if paramcount>1 then
IndexMode:=(paramstr(1)='-ci');
if (IndexMode) then
glutInitDisplayMode(GLUT_INDEX or GLUT_DOUBLE)
else
glutInitDisplayMode(GLUT_RGB or GLUT_DOUBLE);
glutCreateWindow('Bounce');
Ball := make_ball();
glCullFace(GL_BACK);
glEnable(GL_CULL_FACE);
glDisable(GL_DITHER);
glShadeModel(GL_FLAT);
glutDisplayFunc(@draw);
glutReshapeFunc(@reshape);
glutVisibilityFunc(@visible);
glutKeyboardFunc(@key);
if (IndexMode) then
begin
glutSetColor(RED, 1.0, 0.0, 0.0);
glutSetColor(WHITE, 1.0, 1.0, 1.0);
glutSetColor(CYAN, 0.0, 1.0, 1.0);
end;
glutMainLoop();
end.

20
packages/opengl/linux/gl.pp
View File

@ -2039,11 +2039,11 @@ finalization
end.
{
$Log$
Revision 1.4 2000-09-03 21:25:45 peter
* new updated version
* gtkglarea unit and demo
* win32 opengl headers
* morph3d demo
Revision 1.5 2000-10-01 22:17:58 peter
* new bounce demo
Revision 1.4.2.1 2000/10/01 22:12:27 peter
* new demo
Revision 1.1 2000/07/13 06:34:17 michael
+ Initial import
@ -2056,10 +2056,10 @@ end.
{
$Log$
Revision 1.4 2000-09-03 21:25:45 peter
* new updated version
* gtkglarea unit and demo
* win32 opengl headers
* morph3d demo
Revision 1.5 2000-10-01 22:17:58 peter
* new bounce demo
Revision 1.4.2.1 2000/10/01 22:12:27 peter
* new demo
}

20
packages/opengl/linux/glu.pp
View File

@ -359,11 +359,11 @@ end.
{
$Log$
Revision 1.1 2000-09-03 21:25:45 peter
* new updated version
* gtkglarea unit and demo
* win32 opengl headers
* morph3d demo
Revision 1.2 2000-10-01 22:17:59 peter
* new bounce demo
Revision 1.1.2.1 2000/10/01 22:12:28 peter
* new demo
Revision 1.1 2000/07/13 06:34:18 michael
+ Initial import
@ -376,10 +376,10 @@ end.
{
$Log$
Revision 1.1 2000-09-03 21:25:45 peter
* new updated version
* gtkglarea unit and demo
* win32 opengl headers
* morph3d demo
Revision 1.2 2000-10-01 22:17:59 peter
* new bounce demo
Revision 1.1.2.1 2000/10/01 22:12:28 peter
* new demo
}

16
packages/opengl/linux/glut.pp
View File

@ -199,6 +199,7 @@ type
TGlutTimerFunc = procedure(value: Integer); extdecl
TGlutKeyboardFunc = procedure(key: char;x,y:Integer); extdecl
TGlutIdleFunc = procedure; extdecl
TGlutVisibilityFunc = procedure(state:Integer); extdecl
// GLUT game mode sub-API
{$ifdef GLUT_GAME}
@ -215,7 +216,7 @@ const
var
// GLUT initialization sub-API
glutInit: procedure(var argcp: Integer; var argv: PChar); cdecl;
glutInit: procedure(argcp: PInteger; argv: PPChar); cdecl;
glutInitDisplayMode: procedure(mode: LongWord); cdecl;
glutInitDisplayString: procedure(AString: PChar); cdecl;
glutInitWindowPosition: procedure(x, y: Integer); cdecl;
@ -255,7 +256,7 @@ var
glutTimerFunc: procedure(millis: LongWord; func: TGlutTimerFunc; value: longint); cdecl;
glutKeyboardFunc : procedure(func: TGlutKeyboardFunc); cdecl;
glutIdleFunc : procedure(func: TGlutIdleFunc); cdecl;
glutVisibilityFunc : procedure(func: TGlutVisibilityFunc); cdecl;
// GLUTAPI void APIENTRY glutDisplayFunc(void (GLUTCALLBACK * func)(void));
// GLUTAPI void APIENTRY glutReshapeFunc(void (GLUTCALLBACK * func)(int width, int height));
@ -380,6 +381,7 @@ begin
glutTimerFunc := GetProc(libglut, 'glutTimerFunc');
glutKeyboardFunc := GetProc(libglut, 'glutKeyboardFunc');
glutIdleFunc := GetProc(libglut, 'glutIdleFunc');
glutVisibilityFunc := GetProc(libglut, 'glutVisibilityFunc');
// GLUTAPI void APIENTRY glutDisplayFunc(void (GLUTCALLBACK * func)(void));
// GLUTAPI void APIENTRY glutReshapeFunc(void (GLUTCALLBACK * func)(int width, int height));
// GLUTAPI void APIENTRY glutKeyboardFunc(void (GLUTCALLBACK * func)(unsigned char key, int x, int y));
@ -449,10 +451,10 @@ end.
{
$Log$
Revision 1.4 2000-09-03 21:25:45 peter
* new updated version
* gtkglarea unit and demo
* win32 opengl headers
* morph3d demo
Revision 1.5 2000-10-01 22:17:59 peter
* new bounce demo
Revision 1.4.2.1 2000/10/01 22:12:28 peter
* new demo
}

20
packages/opengl/linux/glx.pp
View File

@ -246,11 +246,11 @@ end.
{
$Log$
Revision 1.1 2000-09-03 21:25:45 peter
* new updated version
* gtkglarea unit and demo
* win32 opengl headers
* morph3d demo
Revision 1.2 2000-10-01 22:17:59 peter
* new bounce demo
Revision 1.1.2.1 2000/10/01 22:12:28 peter
* new demo
Revision 1.1 2000/07/13 06:34:18 michael
+ Initial import
@ -263,10 +263,10 @@ end.
{
$Log$
Revision 1.1 2000-09-03 21:25:45 peter
* new updated version
* gtkglarea unit and demo
* win32 opengl headers
* morph3d demo
Revision 1.2 2000-10-01 22:17:59 peter
* new bounce demo
Revision 1.1.2.1 2000/10/01 22:12:28 peter
* new demo
}

16
packages/opengl/win32/gl.pp
View File

@ -2032,11 +2032,11 @@ end.
{
$Log$
Revision 1.2 2000-09-03 22:17:17 peter
* merged
Revision 1.3 2000-10-01 22:17:59 peter
* new bounce demo
Revision 1.1.2.1 2000/09/03 22:14:40 peter
* regenerated
Revision 1.1.2.2 2000/10/01 22:12:28 peter
* new demo
Revision 1.1 2000/09/03 21:25:45 peter
* new updated version
@ -2055,10 +2055,10 @@ end.
{
$Log$
Revision 1.2 2000-09-03 22:17:17 peter
* merged
Revision 1.3 2000-10-01 22:17:59 peter
* new bounce demo
Revision 1.1.2.1 2000/09/03 22:14:40 peter
* regenerated
Revision 1.1.2.2 2000/10/01 22:12:28 peter
* new demo
}

8
packages/opengl/win32/gl_sl.pp
View File

@ -1485,10 +1485,10 @@ END.
{
$Log$
Revision 1.2 2000-09-03 22:17:17 peter
* merged
Revision 1.3 2000-10-01 22:17:59 peter
* new bounce demo
Revision 1.1.2.1 2000/09/03 22:14:40 peter
* regenerated
Revision 1.1.2.2 2000/10/01 22:12:28 peter
* new demo
}

8
packages/opengl/win32/glaux.pp
View File

@ -504,10 +504,10 @@ end.
{
$Log$
Revision 1.2 2000-09-03 22:17:18 peter
* merged
Revision 1.3 2000-10-01 22:17:59 peter
* new bounce demo
Revision 1.1.2.1 2000/09/03 22:14:41 peter
* regenerated
Revision 1.1.2.2 2000/10/01 22:12:28 peter
* new demo
}

8
packages/opengl/win32/glaux_sl.pp
View File

@ -504,10 +504,10 @@ end.
{
$Log$
Revision 1.2 2000-09-03 22:17:18 peter
* merged
Revision 1.3 2000-10-01 22:17:59 peter
* new bounce demo
Revision 1.1.2.1 2000/09/03 22:14:41 peter
* regenerated
Revision 1.1.2.2 2000/10/01 22:12:28 peter
* new demo
}

16
packages/opengl/win32/glu.pp
View File

@ -349,11 +349,11 @@ end.
{
$Log$
Revision 1.2 2000-09-03 22:17:18 peter
* merged
Revision 1.3 2000-10-01 22:17:59 peter
* new bounce demo
Revision 1.1.2.1 2000/09/03 22:14:41 peter
* regenerated
Revision 1.1.2.2 2000/10/01 22:12:28 peter
* new demo
Revision 1.1 2000/07/13 06:34:18 michael
+ Initial import
@ -366,10 +366,10 @@ end.
{
$Log$
Revision 1.2 2000-09-03 22:17:18 peter
* merged
Revision 1.3 2000-10-01 22:17:59 peter
* new bounce demo
Revision 1.1.2.1 2000/09/03 22:14:41 peter
* regenerated
Revision 1.1.2.2 2000/10/01 22:12:28 peter
* new demo
}

16
packages/opengl/win32/glu_sl.pp
View File

@ -260,11 +260,11 @@ end.
{
$Log$
Revision 1.2 2000-09-03 22:17:18 peter
* merged
Revision 1.3 2000-10-01 22:17:59 peter
* new bounce demo
Revision 1.1.2.1 2000/09/03 22:14:41 peter
* regenerated
Revision 1.1.2.2 2000/10/01 22:12:28 peter
* new demo
Revision 1.1 2000/09/03 21:25:45 peter
* new updated version
@ -283,10 +283,10 @@ end.
{
$Log$
Revision 1.2 2000-09-03 22:17:18 peter
* merged
Revision 1.3 2000-10-01 22:17:59 peter
* new bounce demo
Revision 1.1.2.1 2000/09/03 22:14:41 peter
* regenerated
Revision 1.1.2.2 2000/10/01 22:12:28 peter
* new demo
}

14
packages/opengl/win32/glut.pp
View File

@ -174,6 +174,7 @@ type
TGlutTimerFunc = procedure(value: Integer); extdecl
TGlutKeyboardFunc = procedure(key: char;x,y:Integer); extdecl
TGlutIdleFunc = procedure; extdecl
TGlutVisibilityFunc = procedure(state:Integer); extdecl
// GLUT game mode sub-API
{$ifdef GLUT_GAME}
@ -190,7 +191,7 @@ const
var
// GLUT initialization sub-API
glutInit: procedure(var argcp: Integer; var argv: PChar); glut_dll
glutInit: procedure(argcp: PInteger; argv: PPChar); glut_dll
glutInitDisplayMode: procedure(mode: LongWord); glut_dll
glutInitDisplayString: procedure(AString: PChar); glut_dll
glutInitWindowPosition: procedure(x, y: Integer); glut_dll
@ -230,7 +231,7 @@ var
glutTimerFunc: procedure(millis: LongWord; func: TGlutTimerFunc; value: longint); glut_dll
glutKeyboardFunc : procedure(func: TGlutKeyboardFunc); glut_dll
glutIdleFunc : procedure(func: TGlutIdleFunc); glut_dll
glutVisibilityFunc : procedure(func: TGlutVisibilityFunc); glut_dll
// GLUTAPI void APIENTRY glutDisplayFunc(void (GLUTCALLBACK * func)(void));
// GLUTAPI void APIENTRY glutReshapeFunc(void (GLUTCALLBACK * func)(int width, int height));
@ -348,6 +349,7 @@ begin
glutTimerFunc := GetProc(libGLUT, 'glutTimerFunc');
glutKeyboardFunc := GetProc(libGLUT, 'glutKeyboardFunc');
glutIdleFunc := GetProc(libGLUT, 'glutIdleFunc');
glutVisibilityFunc := GetProc(libGLUT, 'glutVisibilityFunc');
// GLUTAPI void APIENTRY glutDisplayFunc(void (GLUTCALLBACK * func)(void));
// GLUTAPI void APIENTRY glutReshapeFunc(void (GLUTCALLBACK * func)(int width, int height));
// GLUTAPI void APIENTRY glutKeyboardFunc(void (GLUTCALLBACK * func)(unsigned char key, int x, int y));
@ -416,10 +418,10 @@ end.
{
$Log$
Revision 1.2 2000-09-03 22:17:18 peter
* merged
Revision 1.3 2000-10-01 22:17:59 peter
* new bounce demo
Revision 1.1.2.1 2000/09/03 22:14:41 peter
* regenerated
Revision 1.1.2.2 2000/10/01 22:12:28 peter
* new demo
}

13
packages/opengl/win32/glut_sl.pp
View File

@ -188,6 +188,7 @@ type
TGlutTimerFunc = procedure(value: Integer); extdecl
TGlutKeyboardFunc = procedure(key: char;x,y:Integer); extdecl
TGlutIdleFunc = procedure; extdecl
TGlutVisibilityFunc = procedure(state:Integer); extdecl
// GLUT game mode sub-API
{$ifdef GLUT_GAME}
@ -203,7 +204,7 @@ const
{$endif GLUT_GAME}
// GLUT initialization sub-API
procedure glutInit(var argcp: Integer; var argv: PChar); glut_dll;
procedure glutInit(argcp: PInteger; argv: PPChar); glut_dll;
procedure glutInitDisplayMode(mode: LongWord); glut_dll;
procedure glutInitDisplayString(AString: PChar); glut_dll;
procedure glutInitWindowPosition(x, y: Integer); glut_dll;
@ -243,7 +244,7 @@ procedure glutReshapeFunc(func: TGlutReshapeFunc); glut_dll;
procedure glutTimerFunc(millis: LongWord; func: TGlutTimerFunc; value: longint); glut_dll;
procedure glutKeyboardFunc(func: TGlutKeyboardFunc); glut_dll;
procedure glutIdleFunc(func: TGlutIdleFunc); glut_dll;
procedure glutVisibilityFunc(func: TGlutVisibilityFunc); glut_dll;
// GLUTAPI void APIENTRY glutDisplayFunc(void (GLUTCALLBACK * func)(void));
// GLUTAPI void APIENTRY glutReshapeFunc(void (GLUTCALLBACK * func)(int width, int height));
@ -312,10 +313,10 @@ end.
{
$Log$
Revision 1.2 2000-09-03 22:17:18 peter
* merged
Revision 1.3 2000-10-01 22:17:59 peter
* new bounce demo
Revision 1.1.2.1 2000/09/03 22:14:41 peter
* regenerated
Revision 1.1.2.2 2000/10/01 22:12:28 peter
* new demo
}

16
packages/opengl/win32/glx.pp
View File

@ -237,11 +237,11 @@ end.
{
$Log$
Revision 1.2 2000-09-03 22:17:18 peter
* merged
Revision 1.3 2000-10-01 22:17:59 peter
* new bounce demo
Revision 1.1.2.1 2000/09/03 22:14:41 peter
* regenerated
Revision 1.1.2.2 2000/10/01 22:12:28 peter
* new demo
Revision 1.1 2000/07/13 06:34:18 michael
+ Initial import
@ -254,10 +254,10 @@ end.
{
$Log$
Revision 1.2 2000-09-03 22:17:18 peter
* merged
Revision 1.3 2000-10-01 22:17:59 peter
* new bounce demo
Revision 1.1.2.1 2000/09/03 22:14:41 peter
* regenerated
Revision 1.1.2.2 2000/10/01 22:12:28 peter
* new demo
}

16
packages/opengl/win32/glx_sl.pp
View File

@ -166,11 +166,11 @@ end.
{
$Log$
Revision 1.2 2000-09-03 22:17:18 peter
* merged
Revision 1.3 2000-10-01 22:17:59 peter
* new bounce demo
Revision 1.1.2.1 2000/09/03 22:14:41 peter
* regenerated
Revision 1.1.2.2 2000/10/01 22:12:28 peter
* new demo
Revision 1.1 2000/09/03 21:25:45 peter
* new updated version
@ -189,10 +189,10 @@ end.
{
$Log$
Revision 1.2 2000-09-03 22:17:18 peter
* merged
Revision 1.3 2000-10-01 22:17:59 peter
* new bounce demo
Revision 1.1.2.1 2000/09/03 22:14:41 peter
* regenerated
Revision 1.1.2.2 2000/10/01 22:12:28 peter
* new demo
}