unit monchr1;

interface

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

type
  TForm1 = class(TForm)
    OpenGL1: TOpenGL;
    Light1: TLight;
    TransformLight: TTransform;
    TransformCyl: TTransform;
    MaterialCyl: TMaterial;
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure TransformLightPaint(Sender: TObject);
    procedure TransformCylPaint(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    start,
    elapsed,
    frames: integer;
    LastKey: char; 
    Times: pointer;
    bmWidth,
    bmHeight:GLsizei;
    procedure Idle(Sender:TObject;var Done:boolean);
    procedure ShowBitmap;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Shapes;

{$R *.DFM}

function ReadMonochrome(const FilePath:string;var bmWidth,bmHeight:  
  GLsizei): pointer;
const
  szh=SizeOf(TBitmapFileHeader);
  szi=SizeOf(TBitmapInfoHeader);
var
  bmpfile: file;
  bfh: TBitmapFileHeader;
  bmi: TBitmapInfoHeader;
  siz,
  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
    bmWidth := biWidth;
    bmHeight := biHeight;
    siz := biSizeImage;
  end;
  if size>siz then {some more offset in this particular format}
    seek(bmpfile,szh+szi+size-siz);
  getmem(result,siz);
  blockread(bmpfile,result^,siz);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  glPixelStorei(GL_UNPACK_ALIGNMENT,1); 
  Times := ReadMonochrome('Times.bmp',bmWidth,bmHeight);
  glLightModeli(GL_LIGHT_MODEL_TWO_SIDE,GL_TRUE);
  CylinderBase;
  Application.OnIdle := Idle;
  start := TimeGetTime;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  TransformLight.Apply;
  TransformCyl.Apply;
  if LastKey='B' then
    ShowBitmap;
  OpenGL1.Swap;
  OpenGL1.ErrorCheck('FormPaint');
end;

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

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
  LastKey := UpCase(Key);
  if Key=#27 then
    Close;
end;

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

procedure TForm1.TransformCylPaint(Sender: TObject);
begin
  MaterialCyl.Apply;
  Cylinder;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  freemem(Times);
end;

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

procedure TForm1.ShowBitmap;
begin
  glRasterPos3f(-0.4,+0.9,-2.0);
  glBitmap(bmWidth,bmHeight,00,00,0,0,Times);
end;

end.
