unit tex1;

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;
    TransformBitmap: TTransform;
    MaterialBitmap: TMaterial;
    TransformInput: TTransform;
    TransformTex: TTransform;
    MaterialInput: 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 TransformBitmapPaint(Sender: TObject);
    procedure TransformInputPaint(Sender: TObject);
    procedure TransformTexPaint(Sender: TObject);
  private
    frames,
    start,
    elapsed: integer;
    deltaAngle: GLfloat;
    deltaX: GLfloat;
    deltaY: GLfloat;
    deltaZ: GLfloat;
    signX: GLfloat;
    signY: GLfloat;
    signZ: GLfloat;
    inStr: string;
    FieldNo: integer;
    procedure Idle(Sender:TObject;var Done:boolean);
    procedure Adjust;
    procedure AddDigit(Key:char);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

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
  tnrFont: HFont;
  tnrBase: GLuint;

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;
  Wrapper: pointer;
begin
  glPixelStorei(GL_UNPACK_ALIGNMENT,1);
  Application.OnIdle := Idle;
  CylinderBase; 
  glPixelStorei(GL_UNPACK_ALIGNMENT,1);

  glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_WRAP_S,GL_CLAMP);
  glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_WRAP_T,GL_CLAMP);
  glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MAG_FILTER,GL_NEAREST);
  glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MIN_FILTER,GL_NEAREST);
  Wrapper := ReadBitmap('input.bmp',sWidth,tHeight);
  glTexImage2D(GL_TEXTURE_2D,Level,ColorComps,sWidth,tHeight,Border,
    GL_RGB,GL_UNSIGNED_BYTE,Wrapper);
  freemem(Wrapper);
  glTexEnvf(GL_TEXTURE_ENV,GL_TEXTURE_ENV_MODE,GL_MODULATE);

  tnrFont := CreateFont(30,0,0,0,FW_NORMAL,0,0,0,ANSI_CHARSET,
    OUT_TT_PRECIS,CLIP_DEFAULT_PRECIS,DRAFT_QUALITY,DEFAULT_PITCH,
    'Courier New');
  SelectObject(OpenGL1.glDC,tnrFont);
  tnrBase := glGenLists(94);
  wglUseFontBitmaps(OpenGL1.glDC,32,94,tnrBase);
  glListBase(tnrBase-32);
  signX := 1.0;
  signY := 1.0;
  signZ := 1.0;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  TransformLight.Apply;
  TransformCyl.Apply; 
  if glIsEnabled(GL_TEXTURE_2D) then
  begin
    TransformTex.Apply;
    TransformInput.Apply;
    TransformBitmap.Apply;
  end;
  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
  case Key of
    #27: Close;
    'M','m': begin
      glEnable(GL_TEXTURE_2D);
      InStr := '_';
      FieldNo := 0;
    end;
    #09,' ': begin
      if FieldNo<6 then
        inc(FieldNo)
      else
        FieldNo := 0;
      InStr := '_';
    end;
    #13: begin
      glDisable(GL_TEXTURE_2D);
      InStr := '';
    end;
    '-','+','.','0'..'9': AddDigit(Key);
  end; {case}
end;

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

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

procedure TForm1.Idle(Sender:TObject;var Done:boolean);
const
  rollover=1000;
  mspersec=1000.0;
begin
  Done := false; 
  if not glIsEnabled(GL_TEXTURE_2D) then
    Adjust;
  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.TransformBitmapPaint(Sender: TObject);
begin
  MaterialBitmap.Apply;
  glRasterPos3f(0.0,0.69-FieldNo*0.25,0.0);
  glCallLists(length(inStr),GL_UNSIGNED_BYTE,pchar(inStr));
end;

procedure TForm1.Adjust;
var
  ratio: GLfloat;
begin
  with OpenGL1,TransformCyl do
  begin
    Angle := Angle+deltaAngle;
    if (Angle<0.0) and (deltaAngle<0.0) then
      Angle := 360.0
    else if (Angle>360.0) and (deltaAngle>0.0) then
      Angle := 0.0;
                
    ratio := abs(tranZ/prxNear);

    if (-TranZ<prxNear) then
      signZ := -1.0
    else if (-TranZ>prxFar) then
      signZ := 1.0;
    TranZ := TranZ+deltaZ*signZ;
    
    if (TranY<prxBottom*ratio) then
      signY := 1.0
    else if (TranY>prxTop*ratio) then
      signY := -1.0;
    TranY := TranY+deltaY*signY;

    if (TranX<prxLeft*ratio) then
      signX := 1.0
    else if (TranX>prxRight*ratio) then
      signX := -1.0;
    TranX := TranX+deltaX*signX;

  end;
end;

procedure TForm1.AddDigit(Key:char);
var
  und,
  err,
  colon: integer;
  number: GLfloat;
begin
  und := pos('_',inStr);
  if und=0 then
    exit;
  system.insert(Key,inStr,und);
  val(copy(inStr,1,und),number,err);
  if err=0 then
  with TransformCyl do
  case FieldNo of
    0: deltaX := abs(number);
    1: deltaY := abs(number);
    2: deltaZ := abs(number);
    3: deltaAngle := number;
    4: AxisX := number;
    5: AxisY := number;
    6: AxisZ := number;      
  end; {case} 
end;

procedure TForm1.TransformInputPaint(Sender: TObject);
begin
  MaterialInput.Apply;
  glBegin(GL_POLYGON);
    glTexCoord2D(-0.0,+1.0); glVertex3f(-1.0,+1.0,0.0);
    glTexCoord2D(-0.0,-0.0); glVertex3f(-1.0,-1.0,0.0);
    glTexCoord2D(+1.0,-0.0); glVertex3f(+1.0,-1.0,0.0);
    glTexCoord2D(+1.0,+1.0); glVertex3f(+1.0,+1.0,0.0);
  glEnd;
end;

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

end.
