
{*******************************************************}
{                                                       }
{       Układanka - Delphi                              }
{       Wykorzystanie komponentu GlBox i OpenGL         }
{                                                       }
{       autor: Waldemara Pokuta - 2003                  }
{                                                       }
{*******************************************************}

unit Unit1;

interface

uses
  Windows, Forms, OpenGl, GLBox, Messages, Controls, ExtCtrls, Classes;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    GL: TGLBox;
    procedure UstawOswietlenie;
    procedure UstalRozmiar;
    procedure glSetupRC(Sender: TObject);
    procedure glRender(Sender: TObject);
    procedure glResize(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure WezKlawisz(var Msg: TMsg; var Handled: Boolean);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TArrayi3 = array[0..2] of integer;

  TFigura = record
    kolor     : TGLArrayf3;
    szesc     : array[0..3,0..2] of integer;
    polozenie : TArrayi3;
    kat       : integer;
    wekt_obr  : TArrayi3;
    wekt_przes: TArrayi3;
  end;

const
  Figury : array[0..8] of TFigura =
  ((kolor: (1.0, 0.0, 0.5); szesc: (( 0,-1, 0),( 0, 0, 0),( 0, 1, 0),( 0, 2, 0))),
   (kolor: (0.5, 1.0, 0.0); szesc: (( 0,-1, 0),( 0, 0, 0),( 0, 1, 0),( 1, 1, 0))),
   (kolor: (0.0, 0.5, 1.0); szesc: (( 0,-1, 0),( 0, 0, 0),( 1, 0, 0),( 1, 1, 0))),
   (kolor: (1.0, 0.5, 0.0); szesc: (( 0, 0, 0),( 1, 0, 0),( 0, 1, 0),( 0, 0, 1))),
   (kolor: (1.0, 0.5, 1.0); szesc: (( 0, 0, 0),( 1, 0, 0),( 1, 1, 0),( 1, 1, 1))),
   (kolor: (0.5, 1.0, 1.0); szesc: (( 0, 0, 0),( 1, 0, 0),( 1, 1, 0),( 0, 1, 0))),
   (kolor: (1.0, 0.5, 0.5); szesc: (( 0,-1, 0),( 0, 0, 0),( 0, 1, 0),( 1, 0, 0))),
   (kolor: (0.5, 0.5, 1.0); szesc: (( 0, 0, 0),( 1, 0, 0),( 1, 0, 1),( 1, 1, 1))),());
  akt_figura: integer = 0;
var
  Form1: TForm1;
  klawisze: array[char] of boolean;
  katx    : real = 0;
  katy    : real = 0;
  katz    : real = 0;

  procedure Szescian;
  procedure Figura(nr: integer);
  procedure obrot;

implementation

{$R *.DFM}

procedure TForm1.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.UstalRozmiar;
var
  w, h: integer;
begin
  // Ustalenie widoku perspektywicznego
  w := gl.Width;
  h := gl.Height;
  glViewport(0, 0, w, h);
  if h = 0 then h := 1;
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  gluPerspective(60, w/h, 1, 400);
  glMatrixMode(GL_MODELVIEW);
end;

procedure TForm1.glSetupRC(Sender: TObject);
const
  amb_dif: TGLArrayf4 = (1.0, 1.0, 1.0, 1);
  spec   : TGLArrayf4 = (1.0, 1.0, 1.0, 1);
  emis   : TGLArrayf4 = (0.1, 0.1, 0.1, 1);
begin
  // 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);
  // Wartości początkowe
  glClearColor(0, 0, 0, 1);
  UstalRozmiar;
  glEnable(GL_LIGHTING);
  glEnable(GL_DEPTH_TEST);
  glEnable(GL_NORMALIZE);
  glEnable(GL_COLOR_MATERIAL);
  // Załączenie zegara
  Timer1.Enabled := TRUE;
end;

procedure TForm1.glRender(Sender: TObject);
var
  x, y, z: real;
  i: integer;
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  glLoadIdentity;   // Przekształcenie tożsamościowe
  // Ustawienie kamery
  x :=  200*Sin(katx)*Cos(katy);
  y :=  200*Sin(katy);
  z := -200*Cos(katx)*Cos(katy);
  if katy < -pi then katy := katy+2*pi;
  if katy > pi then katy := katy-2*pi;
  if (katy > -pi/2) and (katy < pi/2) then
  gluLookAt(x, y, z, 0, 0, 0, 0, 1, 0) else
  gluLookAt(x, y, z, 0, 0, 0, 0,-1, 0);
  // Oświetlenie
  UstawOswietlenie;
  // Rysowanie sceny
  glScalef(15, 15, 15);
  for i := 0 to 7 do figura(i);
end;

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

procedure TForm1.Timer1Timer(Sender: TObject);
const
  kier:array[0..5] of char = (#45,#46,#36,#35,#33,#34);
  wo0: array[0..5] of integer = ( 1,-1, 0, 0, 0, 0);
  wo1: array[0..5] of integer = ( 0, 0, 1,-1, 0, 0);
  wo2: array[0..5] of integer = ( 0, 0, 0, 0, 1,-1);
var
  i: integer;
begin
  with Figury[akt_figura] do begin
    if klawisze[#17] then begin  // Jeżeli Ctrl
      // Obrót aktualnej figury
      for i := 0 to 5 do begin
        if klawisze[kier[i]] and (kat = 0) then begin
          wekt_obr[0] := wo0[i]; wekt_obr[1] := wo1[i]; wekt_obr[2] := wo2[i];
          kat := 90;
          obrot;
        end;
      end;
    end else begin  // Jezeli bez Ctrl
      // Zmiana aktualnej figury
      for i := 0 to 7 do if klawisze[chr(i+49)] then akt_figura := i;
      // Obrót sceny
      if klawisze[#38] then katy := katy-0.1;
      if klawisze[#40] then katy := katy+0.1;
      if klawisze[#37] then katx := katx-0.1;
      if klawisze[#39] then katx := katx+0.1;
      // Przesunięcie aktualnej figury
      for i := 0 to 5 do begin
        if klawisze[kier[i]] and (wekt_przes[i div 2] = 0) then begin
          if i in [0, 1, 4, 5] then Figury[8] := Figury[akt_figura];
          if odd(i) then dec(polozenie[i div 2]) else inc(polozenie[i div 2]);
          if odd(i) then inc(wekt_przes[i div 2], 10) else dec(wekt_przes[i div 2], 10);
        end;
      end;
      if katx > pi then katx := katx-2*pi;
      if katx < -pi then katx := katx+2*pi;
    end;  // if
  end;    // with
  gl.Invalidate;
end;

procedure TForm1.WezKlawisz(var Msg: TMsg; var Handled: Boolean);
begin
  // Naciśnięcie klawisza
  if (Msg.message = WM_KEYDOWN) then begin
    klawisze[chr(Msg.wParam)] := True;
    if klawisze[#27] then close;
    Handled := True;
  end;
  // Puszczenie klawisza
  if (Msg.message = WM_KEYUP) then begin
    klawisze[chr(Msg.wParam)] := False;
    Handled := True;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  c: char;
  i, j: integer;
begin
  // Inicjowanie tablicy klawiszy
  for c := #0 to #255 do klawisze[c] := false;
  // Rozmieszczenie początkowe figur
  for i := 0 to 7 do
    for j := 0 to 2 do Figury[i].polozenie[j] := Random(10)-5;
  for i := 0 to 7 do begin
    Figury[i].kat := 0;
    for j := 0 to 2 do Figury[i].wekt_przes[i] := 0;
  end;
  // Komunikaty przechwytywane przez procedurę WezKlawisz
  Application.OnMessage := WezKlawisz;
  BorderStyle := bsNone;  // Okienko bez ramek
end;

procedure Szescian;
var i: integer;
begin
  glPushMatrix;
  for i:=0 to 5 do begin
    glBegin(GL_QUADS);
      glNormal3f( 0.0, 0.0, 1.0);
      glVertex3f( 0.5, 0.5, 0.5);
      glVertex3f(-0.5, 0.5, 0.5);
      glVertex3f(-0.5,-0.5, 0.5);
      glVertex3f( 0.5,-0.5, 0.5);
    glEnd;
    if odd(i) then glRotatef(90, 1, 0, 0) else glRotatef(90, 0, 1, 0);
  end;
  glPopMatrix;
end;

procedure Figura(nr: integer);
var i: integer;
begin
  glPushMatrix;
  with Figury[nr] do begin
    glTranslatef(polozenie[0]+wekt_przes[0]/10, polozenie[1]+wekt_przes[1]/10, polozenie[2]+wekt_przes[2]/10);
    glRotatef(kat, wekt_obr[0], wekt_obr[1], wekt_obr[2]);
    // Aktualna figura rysowana na biało, pozostał według zdefiniowanej tablicy
    if nr = akt_figura then glColor3f( 1, 1, 1)
    else glColor3f(kolor[0], kolor[1], kolor[2]);
    for i := 0 to 3 do begin
      glPushMatrix;
      glTranslatef(szesc[i, 0], szesc[i, 1], szesc[i, 2]);
      szescian;
      glPopMatrix;
    end;
    // Jeżeli figura jest aktualnie przesuwana
    for i := 0 to 2 do begin
      if wekt_przes[i] > 0 then dec(wekt_przes[i]);
      if wekt_przes[i] < 0 then inc(wekt_przes[i]);
    end;
    // Jeżeli figura jest aktualnie obracana
    if kat > 0 then dec(kat, 10);
    if kat < 0 then inc(kat, 10);
  end;
  glPopMatrix;
end;

procedure obrot;
var i, j, wart: integer;
begin
  with Figury[akt_figura] do begin
    for j := 0 to 2 do begin
      if wekt_obr[j] <> 0 then
        // Obrót wokół jednej z osi (każdego sześcianu figury)
        for i := 0 to 3 do begin
          wart := szesc[i, (j+1) mod 3];
          szesc[i, (j+1) mod 3] := wekt_obr[j]*szesc[i, (j+2) mod 3];
          szesc[i, (j+2) mod 3] := -wekt_obr[j]*wart;
        end;
    end;
  end;
end;

end.
