PageRenderTime 93ms CodeModel.GetById 68ms app.highlight 23ms RepoModel.GetById 1ms app.codeStats 0ms

/packages/opengl/examples/bounce.pp

https://github.com/slibre/freepascal
Puppet | 246 lines | 204 code | 42 blank | 0 comment | 14 complexity | 5aa9c32944375f4fdfca4efc40dd5957 MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0
  1{
  2  Bouncing ball demo.  Color index mode only!
  3
  4  This program is in the public domain
  5  Brian Paul
  6
  7  Converted to Pascal by Peter Vreman
  8}
  9program bounce;
 10
 11{$mode objfpc}
 12
 13uses
 14  gl,glut;
 15
 16const
 17  RED=1;
 18  WHITE=2;
 19  CYAN=3;
 20
 21var
 22  IndexMode : Boolean;
 23  Ball : GLuint;
 24
 25const
 26  Zrot  : GLfloat = 0.0;
 27  Zstep : GLfloat = 6.0;
 28  Xpos  : GLfloat = 0.0;
 29  Ypos  : GLfloat = 1.0;
 30  Xvel  : GLfloat = 0.2;
 31  Yvel  : GLfloat = 0.0;
 32  Xmin  : GLfloat = -4.0;
 33  Xmax  : GLfloat = 4.0;
 34  Ymin  : GLfloat = -3.8;
 35  Ymax  : GLfloat = 4.0;
 36  G     : GLfloat = -0.1;
 37
 38
 39function make_ball:GLuint;
 40var
 41  list   : GLuint;
 42  a,b,
 43  ar,br  : GLFloat;
 44  da,db,
 45  dar    : GLFloat;
 46  radius : GLFloat;
 47  color  : boolean;
 48  x,y,z  : GLFloat;
 49begin
 50  da:=18.0;
 51  db:=18.0;
 52  radius:=1.0;
 53
 54  list := glGenLists(1);
 55
 56  glNewList(list, GL_COMPILE);
 57
 58  color := false;
 59  a:=-90.0;
 60  while (a+da<=90.0) do
 61   begin
 62     glBegin(GL_QUAD_STRIP);
 63
 64     b:=0.0;
 65     while (b<=360.0) do
 66      begin
 67        if (color) then
 68         begin
 69           glIndexi(RED);
 70           glColor3f(1, 0, 0);
 71         end
 72        else
 73         begin
 74           glIndexi(WHITE);
 75           glColor3f(1, 1, 1);
 76         end;
 77
 78        ar:=a * 3.14159/180.0;
 79        br:=b * 3.14159/180.0;
 80        x := COS(br) * COS(ar);
 81        y := SIN(br) * COS(ar);
 82        z := SIN(ar);
 83        glVertex3f(x, y, z);
 84
 85        dar:=da * 3.14159/180.0;
 86        x := radius * COS(br) * COS(ar + dar);
 87        y := radius * SIN(br) * COS(ar + dar);
 88        z := radius * SIN(ar + dar);
 89        glVertex3f(x, y, z);
 90
 91        color := not color;
 92        b:=b+db;
 93      end;
 94
 95     glEnd();
 96     a:=a+da;
 97   end;
 98
 99  glEndList();
100
101  make_ball:=list;
102end;
103
104
105procedure reshape(width,height:longint); cdecl;
106var
107  aspect : glFloat;
108begin
109  aspect := glfloat(width) / glfloat(height);
110  glViewport(0, 0, width, height);
111  glMatrixMode(GL_PROJECTION);
112  glLoadIdentity();
113  glOrtho(-6.0 * aspect, 6.0 * aspect, -6.0, 6.0, -6.0, 6.0);
114  glMatrixMode(GL_MODELVIEW);
115end;
116
117
118procedure key(k:byte;x,y:longint); cdecl;
119begin
120  case k of
121    27 :
122      halt(0);
123  end;
124end;
125
126
127procedure draw; cdecl;
128var
129  i : GLint;
130begin
131  glClear(GL_COLOR_BUFFER_BIT);
132
133  glIndexi(CYAN);
134  glColor3f(0, 1, 1);
135  glBegin(GL_LINES);
136  for i:=-5 to 5 do
137   begin
138     glVertex2i(i, -5);
139     glVertex2i(i, 5);
140   end;
141  for i:=-5 to 5 do
142   begin
143     glVertex2i(-5, i);
144     glVertex2i(5, i);
145   end;
146  for i:=-5 to 5 do
147   begin
148     glVertex2i(i, -5);
149     glVertex2f(i * 1.15, -5.9);
150   end;
151  glVertex2f(-5.3, -5.35);
152  glVertex2f(5.3, -5.35);
153  glVertex2f(-5.75, -5.9);
154  glVertex2f(5.75, -5.9);
155  glEnd();
156
157  glPushMatrix();
158  glTranslatef(Xpos, Ypos, 0.0);
159  glScalef(2.0, 2.0, 2.0);
160  glRotatef(8.0, 0.0, 0.0, 1.0);
161  glRotatef(90.0, 1.0, 0.0, 0.0);
162  glRotatef(Zrot, 0.0, 0.0, 1.0);
163
164  glCallList(Ball);
165
166  glPopMatrix();
167
168  glFlush();
169  glutSwapBuffers();
170end;
171
172
173const
174  vel0 : glfloat = -100.0;
175procedure idle; cdecl;
176begin
177  Zrot:=Zrot+Zstep;
178  Xpos:=Xpos+Xvel;
179  if (Xpos >= Xmax) then
180   begin
181     Xpos := Xmax;
182     Xvel := -Xvel;
183     Zstep := -Zstep;
184   end;
185  if (Xpos <= Xmin) then
186   begin
187     Xpos := Xmin;
188     Xvel := -Xvel;
189     Zstep := -Zstep;
190   end;
191  Ypos:=Ypos+Yvel;
192  Yvel:=Yvel+G;
193  if (Ypos < Ymin) then
194   begin
195     Ypos := Ymin;
196     if (vel0 = -100.0) then
197       vel0 := abs(Yvel);
198     Yvel := vel0;
199   end;
200  glutPostRedisplay();
201end;
202
203
204procedure visible(vis:longint); cdecl;
205begin
206  if (vis=GLUT_VISIBLE) then
207    glutIdleFunc(@idle)
208  else
209    glutIdleFunc(nil);
210end;
211
212
213begin
214  glutInit(@argc, argv);
215  glutInitWindowPosition(0, 0);
216  glutInitWindowSize(600, 450);
217
218  if paramcount>1 then
219   IndexMode:=(paramstr(1)='-ci');
220
221  if (IndexMode) then
222     glutInitDisplayMode(GLUT_INDEX or GLUT_DOUBLE)
223  else
224     glutInitDisplayMode(GLUT_RGB or GLUT_DOUBLE);
225
226  glutCreateWindow('Bounce');
227  Ball := make_ball();
228  glCullFace(GL_BACK);
229  glEnable(GL_CULL_FACE);
230  glDisable(GL_DITHER);
231  glShadeModel(GL_FLAT);
232
233  glutDisplayFunc(@draw);
234  glutReshapeFunc(@reshape);
235  glutVisibilityFunc(@visible);
236  glutKeyboardFunc(@key);
237
238  if (IndexMode) then
239   begin
240     glutSetColor(RED, 1.0, 0.0, 0.0);
241     glutSetColor(WHITE, 1.0, 1.0, 1.0);
242     glutSetColor(CYAN, 0.0, 1.0, 1.0);
243   end;
244
245  glutMainLoop();
246end.