{*******************************************************}
{                                                       }
{       Macierze przekształceń - Delphi                 }
{       Wykorzystanie komponentu GlBox i OpenGL         }
{                                                       }
{       autor: Waldemara Pokuta - 2003                  }
{                                                       }
{*******************************************************}

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  GLBox, OpenGL, ExtCtrls;

type
  TForm1 = class(TForm)
    GL: TGLBox;
    Timer1: TTimer;
    procedure UstalRozmiar;
    procedure GLSetupRC(Sender: TObject);
    procedure GLResize(Sender: TObject);
    procedure GLRender(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  kw: gluQuadricObj;
  textura8x8: array[0..7, 0..7, 0..3] of byte;
  procedure UstawOswietlenie;
  procedure Daszek;
  procedure Niebo;
  procedure Szescian;
  procedure Woda;
implementation

{$R *.DFM}

procedure TForm1.UstalRozmiar;
var
  w, h: integer;
begin
  // Ustalenie widoku perspektywicznego
  w := gl.Width;
  h := gl.Height;
  if h = 0 then h := 1;
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  gluPerspective(80, w/h, 1, 600);
  glMatrixMode(GL_MODELVIEW);
end;

procedure UstawOswietlenie;
const
  ambient: TGLArrayf4 = (0.3, 0.3, 0.3, 1.0);
  swiatla: array[0..3] of record
    dif, spec, pos: TGLArrayf4
  end =
  ((dif:( 0.9, 0.9, 0.1, 1.0); spec:( 0.9, 0.9, 0.1, 1.0); pos:(-200,-100,   0, 1.0)),
   (dif:( 0.1, 0.9, 0.9, 1.0); spec:( 0.1, 0.9, 0.9, 1.0); pos:(-100, 200,   0, 1.0)),
   (dif:( 0.9, 0.1, 0.9, 1.0); spec:( 0.9, 0.1, 0.9, 1.0); pos:( 200,   0,-200, 1.0)),
   (dif:( 0.5, 0.5, 0.9, 1.0); spec:( 0.5, 0.5, 0.9, 1.0); pos:(   0, 100, 200, 1.0)));
var
  i:integer;
begin
  glLightModelfv(GL_LIGHT_MODEL_AMBIENT, @ambient);
  for i := 0 to 3 do begin
    glLightfv(GL_LIGHT0+i, GL_DIFFUSE,  @swiatla[i].dif );
    glLightfv(GL_LIGHT0+i, GL_SPECULAR, @swiatla[i].spec);
    glLightfv(GL_LIGHT0+i, GL_POSITION, @swiatla[i].pos );
    glEnable (GL_LIGHT0+i);
  end;
end;

procedure TForm1.GLResize(Sender: TObject);
begin
  UstalRozmiar;
end;

procedure TForm1.GLSetupRC(Sender: TObject);
const
  amb_dif: TGLArrayf4 = (0.8, 0.8, 0.2, 0.2);
  spec   : TGLArrayf4 = (0.5, 0.5, 0.5, 0.2);
  emis   : TGLArrayf4 = (0.0, 0.0, 0.0, 0.2);
begin
  // Wartości początkowe
  glClearColor(0, 0, 0, 1);
  UstalRozmiar;
  glEnable(GL_LIGHTING);
  glEnable(GL_DEPTH_TEST);
  glEnable(GL_COLOR_MATERIAL);
  // Materiał figur
  glMaterialfv(GL_FRONT_AND_BACK, GL_AMBIENT_AND_DIFFUSE, @amb_dif);
  glMaterialfv(GL_FRONT_AND_BACK,            GL_SPECULAR,    @spec);
  glMaterialf (GL_FRONT_AND_BACK,           GL_SHININESS,       80);
  glMaterialfv(GL_FRONT_AND_BACK,            GL_EMISSION,    @emis);
  // Kwadryki
  kw := gluNewQuadric;
  gluQuadricDrawStyle(kw, GLU_FILL);
  gluQuadricNormals(kw, GLU_SMOOTH);
  gluQuadricOrientation(kw, GLU_INSIDE);
  gluQuadricTexture(kw, true);
  // Parametry tekstur
  glTexParameteri(GL_TEXTURE_1D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
  glTexParameteri(GL_TEXTURE_1D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  Timer1.Enabled := TRUE;
end;

procedure Daszek;
const
  textura8: array[0..7, 0..2] of byte=
  (($3F, $00, $3F), ($7F, $00, $7F),
   ($BF, $00, $BF), ($00, $00, $FF),
   ($00, $FF, $00), ($FF, $FF, $00),
   ($FF, $7F, $00), ($FF, $00, $00));
begin
  glPushAttrib(GL_COLOR_BUFFER_BIT or GL_ENABLE_BIT);
  glColor3f(1, 1, 1);
  glEnable(GL_TEXTURE_1D);
  glDisable(GL_TEXTURE_2D);
  glTexImage1D(GL_TEXTURE_1D, 0, 3, 8, 0, GL_RGB, GL_UNSIGNED_BYTE, @textura8);
  glPushMatrix;
  glTranslatef(0, 80, 0);
  glRotatef(-90, 1, 0, 0);
  gluCylinder(kw, 90, 20, 50, 50, 50);
  gluCylinder(kw, 70, 90, 0, 50, 50);
  glPopMatrix;
  glPopAttrib;
end;

procedure Niebo;
const
  pierwszy: boolean = true;
var
  i, j, k: integer;
begin
  // Tekstura nieba
  if pierwszy then begin
  for i := 0 to 7 do
    for j := 0 to 7 do
      for k := 0 to 3 do
        textura8x8[i, j, k] := random(128)+128;
    pierwszy:=false;
  end;
  // Rysowanie nieba
  glPushAttrib(GL_COLOR_BUFFER_BIT or GL_ENABLE_BIT);
  glEnable(GL_TEXTURE_2D);
  glTexImage2D(GL_TEXTURE_2D, 0, 4, 8, 8, 0, GL_RGBA, GL_UNSIGNED_BYTE, @textura8x8);
  glPushMatrix;
  glRotatef(90, 1, 0, 0);
  gluSphere(kw, 250, 50, 50);
  glPopMatrix;
  glPopAttrib;
end;

procedure Szescian;
const
  kat: integer = 0;
var
  i: integer;
begin
  // Rysowanie sześcianu
  glPushMatrix;
  glTranslatef(0, 50, 0);
  glRotatef(kat, 1, 0.8, 0.6);
  for i := 0 to 5 do begin
    glBegin(GL_QUADS);
      glNormal3f(0, 0, 1);
      glVertex3f( -40, -40,  40);
      glVertex3f( -40,  40,  40);
      glVertex3f(  40,  40,  40);
      glVertex3f(  40, -40,  40);
    glEnd;
    if odd(i) then glRotatef(90, 1, 0, 0) else glRotatef(90, 0, 1, 0);
  end;
  glPopMatrix;
  inc(kat);
end;

procedure Woda;
const
  kat: integer = 0;
  pierwszy: boolean = true;
var
  i, j, ii, jj, rog: integer;
begin
  // Rysowanie wody
  glBegin(GL_QUADS);
  for i := -25 to 23 do
    for j := -25 to 23 do begin
      for rog := 0 to 3 do begin
        if rog in [0, 1] then ii := 0 else ii := 1;
        if rog in [0, 3] then jj := 0 else jj := 1;
        glNormal3f(0, 1, 0);
        glVertex3f((i+ii)*10, 2, (j+jj)*10);
      end;
    end;
  glEnd;
  kat := (kat+1) mod 10;
end;

procedure TForm1.GLRender(Sender: TObject);
const
  kat: integer = 0;
begin
  glClear (GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  glLoadIdentity;
  gluLookAt(sin(kat/50)*200, 20, cos(kat/50)*200, 0, 0, 0, 0, 1, 0);
  UstawOswietlenie;
  // Rysowanie sceny
  Daszek;
  Szescian;
  Niebo;
  Woda;
  kat := kat+1;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  gl.Invalidate;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  gluDeleteQuadric(kw);
end;

end.
