GLGraph - z:=f(x,y)

Top  Previous  Next

GLGraph - z:=f(x,y)

disclaimer

For a sample application lookup glgraph_test

the code

 

{ GLScene component

 

generates the OpenGL primitives to draw a function z:=f(x,y)

which is external to this unit.

 

eg.

 

function GLGraph_callback(x,y:single):single;

begin

 result:=sin(2*pi*x)*cos(2*pi*y);

end;

 

myGraph.callback:=GLGraph_callback;

 

the functionvalues are buffered in a Float2DArray, as the function

may be more complicated and timeconsuming than the above example.

 

declare :

 

USES ..,Geometry, GLTexture, GLGraph,..

 

 TForm=class(..)

  ..

 public

  ..

  MyGraph:TGLGraph;

 end;

 

creation :  ( requires a dummycube )

 

mygraph:=TGLGraph(Dummycube1.addNewchild((TGLGraph)));

mygraph.callback:=GLGraph_callback;

mygraph.xlow:=0;  mygraph.ylow:=0;

mygraph.xhigh:=5; mygraph.yhigh:=5;

mygraph.dx:=0.05; mygraph.dy:=0.05;

mygraph.showaxes:=true;

mygraph.lowcolor:=clrBlack;

mygraph.highcolor:=clrYellow;

mygraph.getvalues;

mygraph.transformationmode:=tmParentNoPos;

 

}

unit GLGraph;

 

interface

 

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

OpenGL12, Geometry, GLTexture, GLMisc, GLScene;

 

type

ZofXY=function(x,y:single):single;  // the external callback for the z:=f(x,y)

 

Float2DArray=class // internal storage 2D Array of single

  protected

fdata:pointer;

fsizex,fsizey:integer;

function getitem(index1,Index2:integer):single;

procedure setitem(index1,Index2:integer;j:single);

  public

property Q[index1,Index2:integer]:single read getitem write setitem; default;

constructor create(x,y:integer);

destructor destroy; override;

procedure clear;

  published

property sizex:integer read fsizex;

property sizey:integer read fsizey;

end;

 

TGLGraph = class(TGLSceneObject)

private

   { Private declarations }

  fcallback:ZofXY;

  fdata:Float2DArray;

  fxlow,fxhigh,fylow,fyhigh,fdx,fdy:TGLFloat;

  fcenter:boolean;

  fminz,fmaxz:single;            // colorspread between them, filled by getvalues

  flowcolor,fhighcolor:TVector;

protected

   { Protected declarations }

public

   { Public declarations }

  constructor create(AOwner: TComponent); override;

  destructor destroy; override;

  procedure getvalues;                   // using the callback

  procedure BuildList; override;

  procedure Assign(Source: TPersistent); override;

  property callback:ZofXY read fcallback write fcallback;         // z:=f(x,y)

  property lowcolor:TVector read flowcolor write flowcolor;       // lower z color

  property highcolor:TVector read fhighcolor write fhighcolor;    // upper z color

published

   { Published declarations }

  property XLow:TGLFloat read fxlow write fxlow;        // lower x

  property XHigh:TGLFloat read fxhigh write fxhigh;     // upper x

  property YLow:TGLFloat read fylow write fylow;        // lower y

  property YHigh:TGLFloat read fyhigh write fyhigh;     // upper y

  property dx:TGLFloat read fdx write fdx;              // how many increments

  property dy:TGLFloat read fdy write fdy;              // how many increments

  property center:boolean read fcenter write fcenter;   // x/y center the graph ?

 

end;

 

procedure Register;

 

implementation

 

// ... Float2DArray ...........................................

// implements a dynamic 2D array of TGLFloats

 

type FloatPtr=^TGLFloat;

 

function Float2DArray.getitem(index1,Index2:integer):TGLFloat;

var p:FloatPtr;

   k:integer absolute p;

begin

p:=fdata;

k:=k+(index1+Index2*fsizex)*sizeof(TGLFloat);

result:=p^;

end;

procedure Float2DArray.setitem(index1,Index2:integer;j:TGLFloat);

var p:FloatPtr;

   k:integer absolute p;

begin

p:=fdata;

k:=k+(index1+Index2*fsizex)*sizeof(TGLFloat);

p^:=j;

end;

constructor Float2DArray.create(x,y:integer);

begin

inherited create;

fsizex:=x; fsizey:=y;

GetMem(fdata,fsizex*fsizey*sizeof(TGLFloat));

end;

destructor Float2DArray.destroy;

begin

FreeMem(fdata,fsizex*fsizey*sizeof(TGLFloat));

inherited destroy;

end;

procedure Float2DArray.clear;

begin

FillChar(fdata^,fsizex*fsizey*sizeof(TGLFloat),0);

end;

 

//...  TGLGraph ...............................................

 

constructor TGLGraph.create(AOwner: TComponent);

begin

inherited create(AOwner);

fdata:=nil;

fcallback:=nil;

fcenter:=true;

fdx:=0; fdy:=0; fxlow:=0; fylow:=0; fxhigh:=1; fyhigh:=1;

fminz:=0;fmaxz:=1;

flowcolor:=clrNavy;

fhighcolor:=clrYellow;

end;

 

destructor TGLGraph.destroy;

begin

if (fdata < > nil) then fdata.destroy;

inherited destroy;

end;

 

procedure TGLGraph.BuildList;

var h,v,xs,ys:integer;

x,y1,y2,z,xh,yh:TGLFLOAT;

color:TVector;

begin

inherited buildlist;

gldisable(GL_CULL_FACE);

ys:=fdata.sizey;

xs:=fdata.sizex;

y1:=fylow;

xh:=(fxlow+fxhigh)/2;     // for centering

yh:=(fylow+fyhigh)/2;     // for centering

for v:=0 to ys-2 do begin // horizontal strips

glBegin(GL_TRIANGLE_STRIP);

//  glColor3f(0.4,0.3,0.5);

  y2:=y1+fdy;

  x:=fxlow;

  for h:=0 to xs-1 do begin

   z:=fdata[h,v];

   color:=VectorLerp(flowcolor,fhighcolor,(z-fminz)/(fmaxz-fminz));

   //glcolor3f(0.2,0.2,0.5+z/2);

   glcolor3f(color[0],color[1],color[2]);

   if fcenter then glVertex3f(x-xh,y1-yh,z)

   else glVertex3f(x,y1,z);

   z:=fdata[h,v+1];

   if fcenter then glVertex3f(x-xh,y2-yh,z)

   else glVertex3f(x,y2,z);

   x:=x+fdx;

  end;

glEnd;

y1:=y1+fdy;

end;

end;

 

procedure TGLGraph.getvalues;

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);

if fdata < > nil then fdata.destroy;

fdata:=Float2DArray.create(xs,ys);

if assigned(fcallback) then begin

  fmaxz:=-1e20; fminz:=1e20;     // preset

  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);

    if (z > fmaxz) then fmaxz:=z;  // get max z

    if (z < fminz) then fminz:=z;  // get min z

    fdata[h,v]:=z;

   end;

  end;

end; //callback exists

end; // dx,dy < > 0

StructureChanged;

end;

 

 

procedure TGLGraph.Assign(Source: TPersistent); 

begin

if assigned(Source) and (Source is TGLGraph) then

begin

  fcallback:=TGLGraph(Source).fcallback;

  fxlow:=TGLGraph(Source).fxlow;

  fxhigh:=TGLGraph(Source).fxhigh;

  fylow:=TGLGraph(Source).fylow;

  fyhigh:=TGLGraph(Source).fyhigh;

  fdx:=TGLGraph(Source).fdx;

  fdy:=TGLGraph(Source).fdy;

  fdata:=nil;

  fcenter:=TGLGraph(Source).fcenter;

  getvalues;

end;

inherited Assign(Source);

end;

 

 

procedure Register;

begin

RegisterComponents('GLScene', [TGLGraph]);

end;

 

end.