unit zap1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Transfrm, cOpenGL, OpenGL;

type
  TForm1 = class(TForm)
    OpenGL1: TOpenGL;
    Transform1: TTransform;
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure Transform1Paint(Sender: TObject);
  private
    deltaX,
    deltaY,
    deltaZ: GLfloat;
    procedure Idle(Sender:TObject;var Done:boolean);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Shapes;

{$R *.DFM}
type
  TTexel3=packed record
    red,
    green,
    blue: GLubyte;
  end;
  TTexel4=packed record
    red,
    green,
    blue,
    alpha: GLubyte;
  end;

const
  Level=0;
  Border=0;
  ColorComps=3;

type
  TRGB=packed record
    r,g,b: byte;
  end;
  TWrap=array[0..0] of TRGB;

var
  Wrapper: pointer;

function ReadBitmap(const FilePath:string;var sWidth,tHeight:GLsizei): pointer;
const
  szh=SizeOf(TBitmapFileHeader);
  szi=SizeOf(TBitmapInfoHeader);
var
  bmpfile: file;
  bfh: TBitmapFileHeader;
  bmi: TBitmapInfoHeader;
  t: byte;
  x,
  fpos,
  size: integer;
begin
  assignFile(bmpfile,FilePath);
  reset(bmpfile,1);
  size := FileSize(bmpfile)-szh-szi;
  blockread(bmpfile,bfh,szh);
  if Bfh.bfType<>$4D42 then
    raise EInvalidGraphic.Create('Invalid Bitmap');
  blockread(bmpfile,bmi,szi);
  with bmi do
  begin
    sWidth := biWidth;
    tHeight := biHeight;
  end;
  getmem(result,size);
  blockread(bmpfile,result^,size);
  for x := 0 to sWidth*tHeight-1 do
  with TWrap(result^)[x] do
  begin
    t := r;
    r := b;
    b := t;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  sWidth,
  tHeight: GLsizei;
begin
  glPixelStorei(GL_UNPACK_ALIGNMENT,1);
  glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_WRAP_S,GL_REPEAT);
  glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_WRAP_T,GL_REPEAT);
  glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MAG_FILTER,GL_NEAREST);
  glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MIN_FILTER,GL_NEAREST);
  Wrapper := ReadBitmap('Fig11-11.bmp',sWidth,tHeight);
  glTexImage2D(GL_TEXTURE_2D,Level,ColorComps,sWidth,tHeight,Border,
    GL_RGB,GL_UNSIGNED_BYTE,Wrapper);
  Freemem(Wrapper);
  glEnable(GL_TEXTURE_2D);
  glTexEnvf(GL_TEXTURE_ENV,GL_TEXTURE_ENV_MODE,GL_DECAL);  glTexEnvf(GL_TEXTURE_ENV,GL_TEXTURE_ENV_MODE,GL_DECAL);
  Application.OnIdle := Idle;
  deltaX := 0.01;
  deltaY := 0.01;
  deltaZ := 0.01;
  CylinderBase;
end;

procedure CylinderT(sTex,tTex:glFloat);
var
  around: integer;
  s36: GLfloat;
begin
  S36 := sTex/36.0;
  glBegin(GL_TRIANGLE_STRIP);
    for around := 0 to 35 do
    begin
      glTexCoord2f(around*s36,tTex);
      glVertex3f(circleX[around],circleY[around],-0.4);
      glTexCoord2f(around*s36,0.0);
      glVertex3f(circleX[around],circleY[around],+0.4);
    end; {for}
    glTexCoord2f(sTex,tTex);
    glVertex3f(circleX[0],circleY[0],-0.4);
    glTexCoord2f(sTex,0.0);
    glVertex3f(circleX[0],circleY[0],+0.4);
  glEnd;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  if OpenGL1.Smaller then
    FormPaint(Sender);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  Transform1.Apply;
  OpenGL1.Swap;
  OpenGL1.ErrorCheck('FormPaint');
end;

procedure TForm1.Transform1Paint(Sender: TObject);
begin
  CylinderT(2.0,1.0);
end;

procedure TForm1.Idle(Sender:TObject;var Done:boolean);
begin
  Done := false;
  with Transform1 do
  begin
    if Angle<360.0 then
      Angle := Angle+0.1
    else
      Angle := 0.0;

    if TranX<-0.7 then
      deltaX := 0.001;
    if TranX>0.7 then
      deltaX := -0.001;
    TranX := TranX+deltaX;

    if TranY<-0.8 then
      deltaY := 0.001;
    if TranY>0.8 then
      deltaY := -0.001;
    TranY := TranY+deltaY;

    if TranZ>-2.22 then
      deltaZ := -0.001;
    if TranZ<-9.00 then
      deltaZ := 0.001;
    TranZ := TranZ+deltaZ;
  end; {with}
  FormPaint(nil);
end;

end.
