OpenGL terrain

the component

{
  TTerrain3D - a 3D terrain from a function

  The constructor defines the area, then the function
  has to be assigned and the stepwidth has to be set.

  given a function z:=f(x,y), the TTerrain3D.getvalues
  gets the values by calling this function and
  stores them in a 2D array.

  the display procedure builds triangle strips for OpenGL

}
unit Terrain3D;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Varrays,OpenGL;

type
  ZofXY=function(x,y:single):single;	// define callback function

  TTerrain3D = class(TObject)
  private
    { Private declarations }
   fcallback:ZofXY;
   fdata:Single2DArray;
   fxlow,fylow,fxhigh,fyhigh,fdx,fdy:single;
  protected
    { Protected declarations }
  public
    { Public declarations }
   constructor create(xlo,ylo,xhi,yhi:single);
   destructor destroy;
   procedure display;
   procedure getvalues;
   property callback:ZofXY read fcallback write fcallback;
  published
    { Published declarations }
   property xlow:single read fxlow;
   property ylow:single read fylow;
   property xhigh:single read fxhigh;
   property yhigh:single read fyhigh;
   property dx:single read fdx write fdx;
   property dy:single read fdy write fdy;

  end;

procedure Register;

implementation

constructor TTerrain3D.create(xlo,ylo,xhi,yhi:single);
begin
 inherited create;
 fdata:=nil;
 fcallback:=nil;
 fdx:=0; fdy:=0;
 fxlow:=xlo; fylow:=ylo; fxhigh:=xhi; fyhigh:=yhi;
end;

destructor TTerrain3D.destroy;
begin
 if fdata<>nil then fdata.destroy;
 inherited destroy;
end;

procedure TTerrain3D.display;
var h,v,xs,ys:integer;
 x,y1,y2,z:GLFLOAT;
begin
 ys:=fdata.sizey;
 xs:=fdata.sizex;
 y1:=fylow;
 for v:=0 to ys-2 do begin // horizontal strips
  glBegin(GL_TRIANGLE_STRIP);
   y2:=y1+fdy;
   x:=fxlow;
   for h:=0 to xs-1 do begin
    z:=fdata[h,v];
    glcolor(0.2,0.2,0.5+2*z);  // here for testing - replace
    glVertex3f(x,y1,z);
    z:=fdata[h,v+1];
    glVertex3f(x,y2,z);
    x:=x+fdx;
   end;
  glEnd;
  y1:=y1+fdy;
 end;
end;

procedure TTerrain3D.getvalues;		// called only once
var h,v,xs,ys:integer;
  x,y,z:single;
begin
 if (fdx<>0) and (fdy<>0) then begin
  xs:=round((fxhigh-fxlow)/dx);
  ys:=round((fyhigh-fylow)/dy);
  fdata:=Single2DArray.create(xs,ys);
  if assigned(fcallback) then begin
   for h:=0 to xs-1 do begin
    x:=fxlow+h*fdx;
    for v:=0 to ys-1 do begin
     y:=fylow+v*fdy;
     z:=fcallback(x,y);
     fdata[h,v]:=z;
    end;
   end;
  end; //callback exists
 end; // dx,dy<>0
end;

procedure Register;
begin
 // RegisterComponents('Samples', [TTerrain3D]);
end;

end.

and a test application

function terrain(x,y:single):single; // this is the actual function f(x,y)
begin
 result:=0.25*sin(6*x)*cos(6*y);
end;

procedure TForm1.FormClick(Sender: TObject);
begin
 t:=TTerrain3D.create(-3,-3,3,3);
 t.callback:=terrain;
 t.dx:=0.1;
 t.dy:=0.1;
 t.getvalues;
end;

procedure TForm1.Transform1Paint(Sender: TObject);
begin
 Light1.Apply;
 Material1.Apply;
 t.display;
end;

note