unit user1;

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;
    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);
  private
    frames,
    start,
    elapsed: integer;
    deltaAngle: GLfloat;
    deltaX: GLfloat;
    deltaY: GLfloat;
    deltaZ: GLfloat;
    signX: GLfloat;
    signY: GLfloat;
    signZ: GLfloat;
    procedure Idle(Sender:TObject;var Done:boolean);
    procedure ShowMenu;
    procedure SetXSpeed;
    procedure SetYSpeed;
    procedure SetZSpeed;
    procedure SetXAxis;
    procedure SetYAxis;
    procedure SetZAxis;
    procedure SetRotationRate;
    procedure Adjust;
    procedure AddDigit(Key:char);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Shapes;

{$R *.DFM}

var
  tnrFont: HFont;
  tnrBase: GLuint;
  msg: string;

procedure TForm1.FormCreate(Sender: TObject);
begin
  glPixelStorei(GL_UNPACK_ALIGNMENT,1);
  Application.OnIdle := Idle;
  CylinderBase;
  tnrFont := CreateFont(20,0,0,0,FW_NORMAL,0,0,0,ANSI_CHARSET,
    OUT_TT_PRECIS,CLIP_DEFAULT_PRECIS,DRAFT_QUALITY,DEFAULT_PITCH,
    'Times New Roman');
  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;
  TransformBitmap.Apply;
  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 UpCase(Key) of
    #27: Close;
    'M': ShowMenu;
    'A': SetXSpeed;
    'B': SetYSpeed;
    'C': SetZSpeed;
    'R': SetRotationRate;
    'X': SetXAxis;
    'Y': SetYAxis;
    'Z': SetZAxis;
    #13,'-','+','.','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 msg='' then
    Adjust;
  inc(frames);
  if frames>=1000 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);
var
  ymsg: GLfloat;
  cr: integer;
  tmsg,
  temp: string;
begin
  if msg='' then
    exit;
  MaterialBitmap.Apply;
  tmsg := msg;
  ymsg := 0.0;
  repeat
    cr := pos(#13,tmsg);
    temp := copy(tmsg,1,cr-1);
    ymsg := ymsg-0.1;
    glRasterPos3f(0.0,ymsg,0.0);
    glCallLists(length(temp),GL_UNSIGNED_BYTE,pointer(temp));
    system.delete(tmsg,1,cr);
  until tmsg='';
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.ShowMenu;
begin
  msg := 'Escape = Exit'#13
        +'M = Show Menu'#13
        +'A = Set X Speed'#13
        +'B = Set Y Speed'#13
        +'C = Set Z Speed'#13
        +'R = Set Rotation Rate'#13
        +'X = Set X Axis'#13
        +'Y = Set Y Axis'#13
        +'Z = Set Z Axis'#13
        ;
end;

procedure TForm1.SetXSpeed;
begin
  msg := 'A = Set X Speed:_'#13;
end;

procedure TForm1.SetYSpeed;
begin
  msg := 'B = Set Y Speed:_'#13;
end;

procedure TForm1.SetZSpeed;
begin
  msg := 'C = Set Z Speed:_'#13;
end;

procedure TForm1.SetRotationRate;
begin
  msg := 'R = Set Rotation Rate:_'#13;
end;

procedure TForm1.SetXAxis;
begin
  msg := 'X = Set X Axis:_'#13;
end;

procedure TForm1.SetYAxis;
begin
  msg := 'Y = Set Y Axis:_'#13;
end;

procedure TForm1.SetZAxis;
begin
  msg := 'Z = Set Z Axis:_'#13;
end;

procedure TForm1.AddDigit(Key:char);
var
  temp: string;
  und,
  err,
  colon: integer;
  start: char;
  number: GLfloat;
begin
  if msg='' then
    exit;
  start := msg[1];
  und := pos('_',msg);
  if und=0 then
    exit;
  if Key<>#13 then
    system.Insert(Key,msg,und)
  else
    dec(und);
  colon := pos(':',msg);
  temp := copy(msg,1,und);
  temp := copy(temp,colon+1,und);
  if Key=#13 then
  begin
    msg := '';
    val(temp,number,err);
    if err=0 then
    with TransformCyl do
    case start of
      'A': deltaX := abs(number);
      'B': deltaY := abs(number);
      'C': deltaZ := abs(number);
      'R': deltaAngle := number;
      'X': AxisX := number;
      'Y': AxisY := number;
      'Z': AxisZ := number;
    end; {case}
  end;
end;

end.
