unit Terrain1;

interface

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

type
  TForm1 = class(TForm)
    OpenGL1: TOpenGL;
    TransformLight: TTransform;
    Light1: TLight;
    TransformLand: TTransform;
    MaterialLand: TMaterial;
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormPaint(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 TransformLandPaint(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    wx,
    wy,
    wz,
    tran,
    rot,
    speed,
    rspeed,
    theta,
    angl: GLfloat;
    start,
    elapsed,
    frames: integer;
    procedure DrawTerrain;
    procedure BuildTerrain;
    procedure Adjust;
    procedure Idle(Sender:TObject;var Done:boolean);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

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

type
  TRGB=packed record
    r,g,b: byte;
  end;
  TWrap=array[0..0]of TRGB;
  TPoint=packed record
    x,y,z: GLfloat;
  end;
  TTerrainRow=array[1..66] of TPoint;
  TTerrain=array[-32..32] of TTerrainRow;

var
  grass: pointer;
  sGrass,
  tGrass: GLsizei;
  ter: TTerrain;
  dlTerrain: GLuint;
  pi180: double=pi/180.0;

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);
  grass := ReadBitmap('fig13-19.bmp',sGrass,tGrass);
  glTexImage2D(GL_TEXTURE_2D,Level,ColorComps,sGrass,tGrass,Border,
    GL_RGB,GL_UNSIGNED_BYTE,Grass);
  glEnable(GL_TEXTURE_2D);
  Application.OnIdle := Idle;
  BuildTerrain;
  start := TimeGetTime;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeMem(grass);
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);
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;

  glRotatef(angl,0.0,1.0,0.0);
  glTranslatef(wx,wy,wz);

  TransformLight.Apply;
  TransformLand.Apply;

  OpenGL1.Swap;
  OpenGL1.ErrorCheck('FormPaint');
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;
  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.TransformLandPaint(Sender: TObject);
begin
  MaterialLand.Apply;
  DrawTerrain;
end;

procedure TForm1.Idle(Sender:TObject;var Done:boolean);
const
  rollover=100;
  mspersec=1000.0;
begin
  Done := false;
  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.Adjust;
begin
  angl := angl+rot;
  if angl>360.0 then
    angl := angl-360.0;
  if angl<0.0 then
    angl := angl+360.0;
  theta := angl*pi180;
  wx := wx-tran*sin(theta);
  wz := wz+tran*cos(theta);
end;

procedure TForm1.BuildTerrain;
var
  row,
  ix: integer;
  q: GLfloat;
begin
  Randomize;
  for row := -32 to +32 do
  begin
    q := -17.0;
    for ix := 1 to 66 do
    with ter[row,ix] do
    begin
      y := -1.5+0.001*Random(500);
      if odd(ix) then
      begin
        q := q+1.0;
        x := q+0.1-0.001*Random(201);
        z := 0.001*Random(450)+row;
      end else begin
        x := q;
        z := 1.0-0.001*Random(450)+row;
      end;
    end; {for}
  end; {for}
  for row := -32 to +31 do
  for ix := 1 to 33 do
    ter[row+1,2*ix-1] := ter[row,2*ix];
end;

procedure TForm1.DrawTerrain;
var
  ix,
  row,
  start,
  finish: integer;
  s: GLfloat;
  t: array[false..true] of GLfloat;
  tt: boolean;
begin
  start := -32;
  finish := +32;
  for row := start to finish do
  begin
    s := 0.0;
    t[false] := 0.0;
    t[true] := 2.0;
    tt := false;
    glBegin(GL_TRIANGLE_STRIP);
    for ix := 1 to 66 do
    with ter[row,ix] do
    begin
      glTexCoord2f(s,t[tt]);
      glVertex3f(x,y,z);
      if tt then
        s := s+1.0;
      tt := not tt;
    end; {for}
    glEnd;
  end; {for}
end;

end.
     