unit texture1;

interface

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

type
  TForm1 = class(TForm)
    OpenGL1: TOpenGL;
    TransformLight: TTransform;
    TransformCube: TTransform;
    Material1: TMaterial;
    Light1: TLight;
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure TransformLightPaint(Sender: TObject);
    procedure TransformCubePaint(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    angl,
    rspeed,
    speed,
    tran,
    rot,
    wx,
    wz: GLfloat;
    bufType: GLenum;
    how_many: GLsizei;
    frames,
    elapsed,
    start: integer;
    buffer: array[1..256] of GLfloat;
    procedure Idle(Sender:TObject;var Done:boolean);
    procedure Adjust;
    procedure Feedback;
    procedure DumpBuffer;
    function ParseFeedback(var lastToken,values,verts,kind:integer;
      index:integer):string;
    function ValuesPerVertex:integer;
    function ProcessVertexValues(var lastToken,values,kind:integer;
      index:integer):string;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  pi180: double=pi/180.0;

implementation

uses Shapes;

{$R *.DFM}
const
  Level=0;
  Border=0;
  ColorComps=3;

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

var
  sBrick,
  tBrick: GLsizei;
  brick: 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,
  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);
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);
  glTexEnvf(GL_TEXTURE_ENV,GL_TEXTURE_ENV_MODE,GL_MODULATE);
  brick := ReadBitmap('fig13-10.bmp',sBrick,tBrick); 
  glTexImage2D(GL_TEXTURE_2D,Level,ColorComps,sBrick,tBrick,Border,
    GL_RGB,GL_UNSIGNED_BYTE,Brick);
  glEnable(GL_TEXTURE_2D);
  glLightModeli(GL_LIGHT_MODEL_TWO_SIDE,GL_TRUE);
  Application.OnIdle := Idle;
  bufType := GL_2D;
  start := TimeGetTime;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;
  glRotatef(angl,0.0,1.0,0.0);
  glTranslatef(wx,0.0,wz);

  TransformLight.Apply;
  TransformCube.Apply;

  OpenGL1.Swap;
  OpenGL1.ErrorCheck('FormPaint');
end;

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

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of
    VK_UP: tran := +speed;
    VK_DOWN: tran := -speed;
    VK_LEFT: rot := -rspeed;
    VK_RIGHT: rot := +rspeed;
    VK_ESCAPE: Close;
    ord('R'): begin
      if ssShift in Shift then
        rspeed := rspeed+0.01
      else begin
        if rspeed>0.01 then
          rspeed := rspeed-0.01;
      end;
    end;
    ord('S'): begin
      if ssShift in Shift then
        speed := speed+0.001
      else begin
        if speed>0.001 then
          speed := speed-0.001;
      end;
    end;
    ord('F'): begin
      Feedback;
    end;
    ord('2'): begin
      bufType := GL_2D;
    end;
    ord('3'): begin
      bufType := GL_3D;
    end;
    ord('C'): begin
      bufType := GL_3D_COLOR;
    end;
    ord('T'): begin
      bufType := GL_3D_COLOR_TEXTURE;
    end;
  end; {case}
end;

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  tran := 0.0;
  rot := 0.0;
end;

procedure TForm1.TransformLightPaint(Sender: TObject);
begin
  Light1.Apply;
end;

procedure TForm1.Idle(Sender:TObject;var Done:boolean);
const
  rollover=1000;
  mspersec=1000.0;
begin
  Done := false;
  Adjust;
  inc(frames);
  if frames>=rollover then
  begin
    elapsed := TimeGetTime;
    Caption := Format('fps=%0.1f wz=%0.2f',[rollover*mspersec/(elapsed-start),wz]);
    start := elapsed;
    frames := 0;
  end else
    FormPaint(nil);
end;

procedure TForm1.Adjust;
var
  theta: GLfloat;
begin
  angl := angl+rot;
  theta := angl*pi180;
  wx := wx-tran*sin(theta);
  wz := wz+tran*cos(theta);
end;

procedure TForm1.Feedback;
begin
  glFeedbackBuffer(256,bufType,@buffer);
  glRenderMode(GL_FEEDBACK);
  FormPaint(nil);
  how_many := glRenderMode(GL_RENDER);
  DumpBuffer;
end;

procedure TForm1.DumpBuffer;
var
  ix: integer;
  tf: TextFile;
  len,
  kind,
  values,
  vertices,
  lastToken: integer;
  s: string;
begin
  assignFile(tf,'Feedback.dmp');
  rewrite(tf);
  writeln(tf,Format('Feedback values returned=%d',[how_many]));
  writeln(tf);
  lastToken := 0;
  for ix := 1 to how_many do
  begin
    s := ParseFeedback(lastToken,values,vertices,kind,ix);
    len := length(s);
    write(tf,s);
    if (s='') or (s[len]<>' ') then
      writeln(tf);
  end;
  closeFile(tf);
end;

function TForm1.ParseFeedback(var lastToken,values,verts,kind:integer;
  index:integer):string;
var
  value: GLfloat;
begin
  value := buffer[index];
  case lastToken of
    0: begin
      lastToken := round(value);
      case lastToken of
        GL_POLYGON_TOKEN: begin
          result := 'GL_POLYGON_TOKEN: ';
          values := -1;
        end;
        GL_POINT_TOKEN: begin
          result := 'GL_POINT_TOKEN: vertices=1';
          kind := 0;
          verts := 1;
          values := ValuesPerVertex;
        end;
        GL_BITMAP_TOKEN: begin
          result := 'GL_BITMAP_TOKEN: coordinates=1';
          kind := 0;
          verts := 1;
          values := ValuesPerVertex;
        end;
        GL_LINE_RESET_TOKEN,
        GL_LINE_TOKEN: begin
          result := 'GL_LINE_TOKEN: vertices=2';
          kind := 0;
          verts := 2;
          values := verts*ValuesPerVertex;
        end;
        GL_PASS_THROUGH_TOKEN: begin
          result := #13#10'GL_PASS_THROUGH_TOKEN: ';
          values := 1;
        end;
      end;
    end; {new token}
    GL_POLYGON_TOKEN: begin
      if values=-1 then
      begin
        verts := round(value);
        result := Format('Vertices=%d',[verts]);
        values := verts*ValuesPerVertex;
        kind := 0;
      end else
        result := ProcessVertexValues(lastToken,values,kind,index);
    end;
    GL_LINE_RESET_TOKEN,
    GL_LINE_TOKEN,
    GL_BITMAP_TOKEN,
    GL_POINT_TOKEN: begin
      result := ProcessVertexValues(lastToken,values,kind,index);
    end;
    GL_PASS_THROUGH_TOKEN:
    begin
      result := Format('id=%0.4f',[value]);
      dec(values);
      lastToken := 0;
    end;
  end; {case}
end;

function TForm1.ProcessVertexValues(var lastToken,values,kind:integer;
  index:integer):string; 
var
  value: GLfloat;
begin
  value := buffer[index];  
  inc(kind);
  dec(values);
  case kind of
    1: result := Format('  x=%6.2f',[value]);
    2: result := Format('y=%6.2f',[value]);
    3: result := Format('z=%6.2f',[value]);
    4: result := Format('r=%4.2f',[value]);
    5: result := Format('g=%4.2f',[value]);
    6: result := Format('b=%4.2f',[value]);
    7: result := Format('a=%4.2f',[value]);
    8: result := Format('s=%4.2f',[value]);
    9: result := Format('t=%4.2f',[value]);
   10: result := Format('u=%4.2f',[value]);
   11: result := Format('v=%4.2f',[value]);    
  end; {case}
  if kind<ValuesPerVertex then
    result := result+' '
  else
    kind := 0; 
  if values=0 then
    lastToken := 0; 
end;

function TForm1.ValuesPerVertex: integer;
begin
  case bufType of
    GL_2D: result := 2;
    GL_3D: result := 3;
    GL_3D_COLOR: result := 7;
    GL_3D_COLOR_TEXTURE: result := 11;
  end; {case}
end;

procedure TForm1.TransformCubePaint(Sender: TObject);
begin
  Material1.Apply;
  glBegin(GL_TRIANGLE_STRIP);
   glTexCoord2f(00.0,0.0); glVertex3f(-0.4,+0.4,+0.4);
   glTexCoord2f(00.0,4.0); glVertex3f(-0.4,-0.4,+0.4);
   glTexCoord2f(04.0,0.0); glVertex3f(+0.4,+0.4,+0.4);
   glTexCoord2f(04.0,4.0); glVertex3f(+0.4,-0.4,+0.4);

   glTexCoord2f(08.0,0.0); glVertex3f(+0.4,+0.4,-0.4);
   glTexCoord2f(08.0,4.0); glVertex3f(+0.4,-0.4,-0.4);
   glTexCoord2f(12.0,0.0); glVertex3f(-0.4,+0.4,-0.4);
   glTexCoord2f(12.0,4.0); glVertex3f(-0.4,-0.4,-0.4);

   glTexCoord2f(16.0,0.0); glVertex3f(-0.4,+0.4,+0.4);
   glTexCoord2f(16.0,4.0); glVertex3f(-0.4,-0.4,+0.4);
  glEnd;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeMem(brick);
end;

end.
