Автор: Romtek (Romiras)

Здесь размещены некоторые примеры, спортированные из примеров GLUT от SGI (язык С), а также от Jan Horn (язык Delphi c WinAPI). Большинство примеров должно работать в Windows/Linux без изменений кода, необходимо только наличие драйверов (библиотек) OpenGL, GLU, GLUT/libgl, libglu,libglut.

(***
 << Scene demo >>
 
 Ported to Free Pascal by Romiras, Feb 2005
 
***)
 
{$apptype GUI}
{$mode objfpc}
 
Uses
   GL, GLU, GLUT;
 
var
  oglWin : integer;
 
procedure myinit(); 
const
light_ambient: array [0..3] of GLfloat = (0.0,0.0,0.0,1.0);
 
light_diffuse: array [0..3] of GLfloat = (1.0,0.0,0.0,1.0);
 
light_specular: array [0..3] of GLfloat = (1.0,1.0,1.0,1.0);
 (* light_position is NOT default value *)
light_position: array [0..3] of GLfloat = (1.0,1.0,1.0,0.0);
 
begin
  glLightfv(GL_LIGHT0,GL_AMBIENT,light_ambient);
  glLightfv(GL_LIGHT0,GL_DIFFUSE,light_diffuse); 
  glLightfv(GL_LIGHT0,GL_SPECULAR,light_specular); 
  glLightfv(GL_LIGHT0,GL_POSITION,light_position); 
  glEnable(GL_LIGHT0); 
  glDepthFunc(GL_LESS); 
  glEnable(GL_DEPTH_TEST); 
  glEnable(GL_LIGHTING); 
end;
 
procedure display(); cdecl; 
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); 
  glPushMatrix(); 
  glScalef(1.3,1.3,1.3); 
  glRotatef(20.0,1.0,0.0,0.0); 
  glPushMatrix(); 
  glTranslatef(-0.75,0.5,0.0); 
  glRotatef(90.0,1.0,0.0,0.0); 
  glutSolidTorus(0.275,0.85,10,15); 
  glPopMatrix(); 
  glPushMatrix(); 
  glTranslatef(-0.75,-0.5,0.0); 
  glRotatef(270.0,1.0,0.0,0.0); 
  glutSolidTetrahedron(); 
  glPopMatrix(); 
  glPushMatrix(); 
  glTranslatef(0.75,0.0,-1.0); 
  glutSolidIcosahedron(); 
  glPopMatrix(); 
  glPopMatrix(); 
  glFlush(); 
end;
 
procedure myReshape(w,h: longint); cdecl;
var aspect: glFloat;
begin
  glViewport(0,0,w,h); 
  glMatrixMode(GL_PROJECTION); 
  glLoadIdentity(); 
  aspect := w/h;
  if w<=h
  then
  glOrtho(-2.5,2.5, -2.5/aspect, 2.5/aspect,-10.0,10.0)
  else
  glOrtho(-2.5*aspect,2.5*aspect,-2.5,2.5,-10.0,10.0);
  glMatrixMode(GL_MODELVIEW); 
end;
 
procedure polygon_mode(value: integer); cdecl; 
begin
  case value of
    1:
    begin
      glEnable(GL_DEPTH_TEST); 
      glEnable(GL_LIGHTING); 
      glDisable(GL_BLEND); 
      glPolygonMode(GL_FRONT_AND_BACK,GL_FILL); 
    end;
    2:
    begin
      glDisable(GL_DEPTH_TEST); 
      glDisable(GL_LIGHTING); 
      glColor3f(1.0,1.0,1.0); 
      glPolygonMode(GL_FRONT_AND_BACK,GL_LINE); 
      glEnable(GL_LINE_SMOOTH); 
      glEnable(GL_BLEND); 
      glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA); 
    end;
 
  end;
  glutPostRedisplay(); 
end;
 
procedure main_menu(value: integer); cdecl; 
begin
  if value=666 then
  begin
    glutDestroyWindow (oglWin);
    halt(0);
  end;
end;
(*  Main Loop
 *  Open window with initial window size, title bar, 
 *  RGBA display mode, and handle input events.
 *)
 
var
submenu: integer; 
 
begin
  glutInit (@argc,argv);
  glutInitWindowPosition(0,0);
  glutInitWindowSize(500,500); 
  oglWin := glutCreateWindow('Demo');
  myinit(); 
  glutReshapeFunc(@myReshape);
  glutDisplayFunc(@display);
  submenu:= glutCreateMenu(@polygon_mode);
  glutAddMenuEntry('Filled',1); 
  glutAddMenuEntry('Outline',2); 
  glutCreateMenu(@main_menu);
  glutAddMenuEntry('Quit',666); 
  glutAddSubMenu('Polygon mode',submenu); 
  glutAttachMenu(GLUT_RIGHT_BUTTON); 
  glutMainLoop(); 
end.

(***
 << Blender >>
 
Ported to Free Pascal by Romiras, Feb 2005
 
***)
 
{$apptype GUI}
{$mode objfpc}
 
Uses
   GL, GLU, GLUT;
 
Type
  Arr3 = array [0..3] of GLfloat;
 
Const
  light0_ambient:   Arr3 = (0.2,0.2,0.2,1.0);
  light0_diffuse:   Arr3 = (0.0,0.0,0.0,1.0);
  light1_diffuse:   Arr3 = (1.0,0.0,0.0,1.0);
  light1_position:  Arr3 = (1.0,1.0,1.0,0.0);
  light2_diffuse:   Arr3 = (0.0,1.0,0.0,1.0);
  light2_position:  Arr3 = (-1.0,-1.0,1.0,0.0);
  s: GLfloat = 0.0;
  angle1: GLfloat = 0.0; 
  angle2: GLfloat = 0.0; 
var
  oglWin : integer;
 
procedure output(x: GLfloat;  y: GLfloat;  text: pchar);
var
  i: word;
begin
  glPushMatrix();
  glTranslatef(x,y,0); 
  for i := 0 to strlen(text)-1 do
      glutStrokeCharacter(GLUT_STROKE_ROMAN, smallint(text[i]));
 
  glPopMatrix(); 
end;
 
 
procedure display(); cdecl;
const
amb: array [0..3] of GLfloat=(0.4,0.4,0.4,0.0);
dif: array [0..3] of GLfloat=(1.0,1.0,1.0,0.0);
 
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  glEnable(GL_LIGHT1); 
  glDisable(GL_LIGHT2); 
  dif[3]:= cos(s) / 2.0 + 0.5;
  amb[3]:= dif[3];
  glMaterialfv(GL_FRONT,GL_AMBIENT,amb); 
  glMaterialfv(GL_FRONT,GL_DIFFUSE,dif); 
  glPushMatrix(); 
  glTranslatef(-0.3,-0.3,0.0); 
  glRotatef(angle1,1.0,5.0,0.0); 
  glCallList(1); 
  glPopMatrix(); 
  (* render ico display list *)
  glClear(GL_DEPTH_BUFFER_BIT); 
  glEnable(GL_LIGHT2); 
  glDisable(GL_LIGHT1); 
  dif[3]:= 0.5 - cos(s*0.95) / 2.0;
  amb[3]:= dif[3];
  glMaterialfv(GL_FRONT,GL_AMBIENT,amb); 
  glMaterialfv(GL_FRONT,GL_DIFFUSE,dif); 
  glPushMatrix(); 
  glTranslatef(0.3,0.3,0.0); 
  glRotatef(angle2,1.0,0.0,5.0); 
  glCallList(1); 
  glPopMatrix(); 
  (* render ico display list *)
  glPushAttrib(GL_ENABLE_BIT); 
  glDisable(GL_DEPTH_TEST); 
  glDisable(GL_LIGHTING); 
  glMatrixMode(GL_PROJECTION); 
  glPushMatrix(); 
  glLoadIdentity(); 
  gluOrtho2D(0,1500,0,1500); 
  glMatrixMode(GL_MODELVIEW); 
  glPushMatrix(); 
  glLoadIdentity(); 
  glRotatef(4,0.0,0.0,1.0); 
  (* Rotate text slightly to help show jaggies. *)
  output(200,225,'This is antialiased.');
  glDisable(GL_LINE_SMOOTH); 
  glDisable(GL_BLEND); 
  output(160,100,'This text is not.');
  glPopMatrix(); 
  glMatrixMode(GL_PROJECTION); 
  glPopMatrix(); 
  glPopAttrib(); 
  glMatrixMode(GL_MODELVIEW); 
  glutSwapBuffers(); 
end;
 
function FMod(a,b: glFloat): glFloat;
var
   x: Integer;
begin
   x := Trunc (a / b);
   result := a - b * x;
end;
 
procedure idle(); cdecl;
begin
  angle1:= fmod (angle1+0.8, 360.0);
  angle2:= fmod (angle2+1.1, 360.0);
  s += 0.5;
  glutPostRedisplay(); 
end;
 
procedure visible(vis: integer); cdecl; 
begin
  if vis=GLUT_VISIBLE then
    glutIdleFunc(@idle)
  else
    glutIdleFunc(nil);
end;
 
procedure keyboard(key: byte;  x ,y: longint); cdecl;
begin
  case Chr(key) of
    #27:
    begin
      glutDestroyWindow (oglWin);
      halt(0);
    end;
 
  end;
end;
 
begin
  glutInit (@argc,argv);
  glutInitDisplayMode(GLUT_DOUBLE or GLUT_RGB or GLUT_DEPTH); 
  oglWin := glutCreateWindow('blender'); 
  glutDisplayFunc(@display);
  glutVisibilityFunc(@visible);
  glutKeyboardFunc(@keyboard);
 
  glNewList(1,GL_COMPILE); 
  glutSolidIcosahedron(); 
  (* create ico display list *)
  glEndList(); 
 
  glEnable(GL_LIGHTING); 
  glEnable(GL_LIGHT0); 
  glLightfv(GL_LIGHT0,GL_AMBIENT,light0_ambient); 
  glLightfv(GL_LIGHT0,GL_DIFFUSE,light0_diffuse); 
  glLightfv(GL_LIGHT1,GL_DIFFUSE,light1_diffuse); 
  glLightfv(GL_LIGHT1,GL_POSITION,light1_position); 
  glLightfv(GL_LIGHT2,GL_DIFFUSE,light2_diffuse); 
  glLightfv(GL_LIGHT2,GL_POSITION,light2_position); 
  glEnable(GL_DEPTH_TEST); 
  glEnable(GL_CULL_FACE); 
  glEnable(GL_BLEND); 
  glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA); 
  glEnable(GL_LINE_SMOOTH); 
  glLineWidth(2.0);
 
  glMatrixMode(GL_PROJECTION); 
  gluPerspective(40.0,1.0,1.0,10.0); 
  (* field of view in degree *)
  (* aspect ratio *)
  (* Z  *)
  (* Z  *)
  glMatrixMode(GL_MODELVIEW); 
  gluLookAt(0.0,0.0,5.0,0.0,0.0,0.0,0.0,1.0,0.0);
  (* eye is at (0,0,5) *)
  (* center is at (0,0,0) *)
  glTranslatef(0.0,0.6,-1.0); 
  (* up is in positive Y direction *)
 
  glutMainLoop(); 
end.

(***
 << Spinning cone demo >>
 
  Control:
  Space key - Turn On/Off spinning
  "+" key - increase speed
  "-" key - decrease speed
 
  NOTE:
  == C-like operators support ==
  turn on in IDE: Options -> Compiler-> C-like operators
  or
  "-Sc" in command line
 
 Ported to Free Pascal by Romiras, Feb 2005
 
***)
 
{$apptype GUI}
{$mode ObjFPC}
 
{*** C-like operators support ***
turn on in IDE: Options -> Compiler-> C-like operators
or
"-Sc" in command line
***}
 
Uses
   GL, GLU, GLUT;
 
var
  oglWin    : integer;
  rotating  : integer; (* to store if we're currently rotating *)
  rotx,
  roty,
  rotz      : glFloat; (* the rotation to give our object *)
 
//  last_fps_time,
//  time_per_fps_disp,
//  framecount,
  oldtime,
  newtime   : longint;
  rspeed,
  dt: single;
 
 
function FMod(a,b: glFloat): glFloat;
var
   x: Integer;
begin
   x := Trunc (a / b);
   result := a - b * x;
end;
 
function delta_time: single;
const
  CLOCKS_PER_SEC = 18.2;
begin
  oldtime:= newtime; 
  newtime:= glutGet (GLUT_ELAPSED_TIME);
  result:= (newtime - oldtime) / CLOCKS_PER_SEC;
end;
 
 
procedure init;
const
  mat_specular: array [0..3] of GLfloat=(1.0,1.0,1.0,1.0); (* material definition *)
 (* material definition *)
  mat_shininess: array [0..0] of GLfloat=(50.0); (* another... *)
 (* another... *)
  light_position: array [0..3] of GLfloat=(1.0,1.0,1.0,0.0);
  LightPosition: array [0..3] of GLfloat=(0.0,0.0,2.0,1.0);
  LightDiffuse: array [0..3] of GLfloat=(1.0,1.0,1.0,1.0); // Значения диффузного света ( НОВОЕ )
 
begin
  glClearColor(0.1,0.2,0.1,0.0);
  glShadeModel(GL_FLAT); 
  (* black and opaque *)
  glMaterialfv(GL_FRONT,GL_SPECULAR,mat_specular); 
  (* GL_FLAT is faster, but if you have curved
                                   * surfaces, GL_SMOOTH is way prettier. *)
 
  glMaterialfv(GL_FRONT,GL_SHININESS,mat_shininess); 
  (* apply the material *)
 
  glLightfv(GL_LIGHT0,GL_POSITION,light_position); 
  (* definitions *)
 
  glLightfv(GL_LIGHT1, GL_DIFFUSE, LightDiffuse);    // Установка Диффузного Света
  glLightfv(GL_LIGHT1, GL_POSITION, LightPosition);   // Позиция света
 
  glEnable(GL_LIGHTING); 
  (* defien a light *)
 
//  glEnable(GL_LIGHT0);
  glEnable(GL_LIGHT1);
  (* enable lighting in general *)
  glEnable(GL_DEPTH_TEST); 
  (* enable the light we made *)
 
  glNewList (1, GL_Compile);
  glBegin(GL_TRIANGLES);
      glNormal3f(1,1,-1);
      glVertex3f(1,0,0);
      glVertex3f(0,1,0);
      glVertex3f(0,0,-1);
  glEnd;
  glBegin(GL_TRIANGLES);
      glNormal3f(-1,1,-1);
      glVertex3f(-1,0,0);
      glVertex3f(0,1,0);
      glVertex3f(0,0,-1);
  glEnd;
  glBegin(GL_TRIANGLES);
      glNormal3f(-1,1,1);
      glVertex3f(-1,0,0);
      glVertex3f(0,1,0);
      glVertex3f(0,0,1);
  glEnd;
  glBegin(GL_TRIANGLES);
      glNormal3f(1,1,1);
      glVertex3f(1,0,0);
      glVertex3f(0,1,0);
      glVertex3f(0,0,1);
  glEnd;
  glEndList;
 
 
  rspeed:= 0.04;
end;
 
 
(* function to run when the window is reshaped (set up viewport) *)
 
procedure reshape(w: integer;  h: integer); cdecl; 
var aspratio: GLfloat;
begin
  glViewport(0,0, w, h);
  glMatrixMode(GL_PROJECTION); 
  glLoadIdentity(); 
 
  aspratio := GLfloat(h)/GLfloat(w);
  if w<=h then
    glOrtho(-1.5,1.5, -1.5*aspratio, 1.5*aspratio, -10.0, 10.0)
  else
    glOrtho(-1.5*aspratio, 1.5*aspratio, -1.5, 1.5, -10.0, 10.0);
  glMatrixMode(GL_MODELVIEW); 
 
end;
 
(* function to draw stuff in graphic context *)
procedure display; cdecl;
begin
  dt := delta_time ();
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  (* this one clears the gl scene *)
 
  if rotating<>0 then
  begin 
    (* update the rotation, with bounds checking *)
    (* % doesn't like glFloats... so we cast to int and cast
                                     * back after the modulus. the % keeps the number
                                     * bounded between [0,360). (No, that's not a type,
                                     * that's math notation for inclusive and exclusive *)
    rotx:= FMod(rspeed*30.0*dt+rotx, 360.0);
    roty:= FMod(rspeed*45.0*dt+roty, 360.0);
    rotz:= FMod(rspeed*60.0*dt+rotz, 360.0);
  end;
 
  glLoadIdentity(); 
  glRotatef(rotx,1,0,0); 
  glRotatef(roty,0,1,0);
  glRotatef(rotz,0,0,1);
  glColor3f(1.0,0.0,0.0);
  glCallList (1);
  glColor3f(1.0,0.0,1.0);
 
 
  (* remembers, another important operation is
                                   * glTranslatef(). If you want to rotate or
                                   * move one thing and have it not effect the 
                                   * other objects in the scene, you can use
                                   * glPushMatrix() before the operations and
                                   * glPopMatrix() after the operations. *)
 
  glutSwapBuffers(); 
  (* draw a cube :) *)
 
end;(* actually display it (doublebuffer style) *)
 
(* keyboard callback *)
procedure keyboard(key: byte;  x: integer;  y: integer); cdecl;
begin
  case Chr(key) of
    #27: (* escape exits *)
    begin
      glutDestroyWindow (oglWin);
      halt(0);
    end;
    ' ': rotating:= rotating xor 1; (* space toggles 'rotating' *)
    '+': rspeed += 0.01;
    '-': rspeed -= 0.01;
  end;
 
  if rspeed>2.0 then
     rspeed:= 2.0;
  if rspeed<-2.0 then
     rspeed:= -2.0;
end;
 
procedure OnTimer(value: Integer); cdecl;
begin
  glutPostRedisplay;
  glutTimerFunc(20, @OnTimer, 0);
end;
 
begin
  glutInit(@argc,argv);
  glutInitDisplayMode(GLUT_DOUBLE or GLUT_RGB or GLUT_DEPTH);
  glutInitWindowSize(400,400);
  oglWin := glutCreateWindow('GLUT demo');
  init(); 
 
  glutDisplayFunc(@display); 
 
  // define the callbacks
  glutReshapeFunc(@reshape); 
  glutKeyboardFunc(@keyboard); 
  glutTimerFunc(20, @OnTimer, 0);
  glutMainLoop(); 
end.