Code:
unit Polygon;
interface
uses DGLOpenGL;
type
TPoint = packed record
x: single;
y: single;
z: single;
r: single;
g: single;
b: single;
a: single;
end;
TPolygon = class
private
FPoints: array of TPoint; //polygon point
FVertex: array of TPoint; //triangulated data
FColor: TPoint;
FCount: integer;
FVertexCount: integer;
FTesselated: boolean;
procedure SetPoint(I: integer; Value: TPoint);
procedure AddVertex(x: single; y: single; z: single; r: single; g: single; b: single; a:single);
function GetPoint(I: integer): TPoint;
function GetCount(): integer;
procedure tessBegin(which: GLenum);
procedure tessEnd();
procedure tessVertex(x: single; y: single; z: single; r: single; g: single; b: single; a:single);
public
constructor Create();
destructor Destroy();
procedure SetColor(R: single; G: single; B: single;A: single);
procedure Add(X: single; Y: single); overload;
procedure Add(X: single; Y: single; Z: single); overload;
procedure Add(X: single; Y: single; Z: single; R: single; G: single; B: single; A: single); overload;
procedure Render();
procedure Tesselate();
property Points[I: integer]: TPoint read GetPoint write SetPoint;
property Count: integer read GetCount;
end;
implementation
type
TGLArrayd6 = array[0..5] of GLDouble;
PGLArrayd6 = ^TGLArrayd6;
TGLArrayvertex4 = array[0..3] of PGLArrayd6;
PGLArrayvertex4 = ^TGLArrayvertex4;
PGLArrayf4 = ^TGLArrayf4;
threadvar
PolygonClass: TPolygon;
procedure TPolygon.SetColor(R: single; G: single; B: single;A: single);
begin
FColor.r := R;
FColor.g := G;
FColor.b := B;
FColor.a := A;
end;
procedure TPolygon.tessBegin(which: GLenum);
begin
glBegin(which);
end;
procedure TPolygon.tessEnd();
begin
glEnd();
end;
procedure TPolygon.tessVertex(x: single; y: single; z: single; r: single; g: single; b: single; a:single);
begin
glcolor3f(r,g,b);
glVertex3f(x,y,z);
end;
procedure TPolygon.AddVertex(x: single; y: single; z: single; r: single; g: single; b: single; a:single);
begin
FVertexCount := FVertexCount + 1;
SetLength(FVertex, FVertexCount);
FVertex[FVertexCount-1].R := R;
FVertex[FVertexCount-1].G := G;
FVertex[FVertexCount-1].B := B;
FVertex[FVertexCount-1].X := X;
FVertex[FVertexCount-1].Y := Y;
FVertex[FVertexCount-1].Z := Z;
end;
constructor TPolygon.Create();
begin
inherited Create();
FCount := 0;
FVertexCount := 0;
FTesselated := false;
FColor.R := 0.0;
FColor.G := 0.0;
FColor.B := 0.0;
FColor.A := 0.0;
end;
destructor TPolygon.Destroy();
begin
FTesselated := false;
FCount := 0;
FVertexCount := 0;
SetLength(FPoints, FCount);
SetLength(FVertex, FVertexCount);
inherited Destroy;
end;
procedure TPolygon.SetPoint(I: integer; Value: TPoint);
begin
FTesselated := false; //check first on changed values
FPoints[I] := Value;
end;
function TPolygon.GetPoint(I: integer): TPoint;
begin
result := FPoints[I];
end;
function TPolygon.GetCount(): integer;
begin
result := FCount;
end;
procedure TPolygon.Add(X: single; Y: single);
begin
FTesselated := false;
FCount := FCount + 1;
SetLength(FPoints, FCount);
FPoints[FCount-1].X := X;
FPoints[FCount-1].Y := Y;
FPoints[FCount-1].Z := 0.0;
FPoints[FCount-1].R := FColor.R;
FPoints[FCount-1].G := FColor.G;
FPoints[FCount-1].B := FColor.B;
FPoints[FCount-1].A := FColor.A;
end;
procedure TPolygon.Add(X: single; Y: single; Z: single);
begin
FTesselated := false;
FCount := FCount + 1;
SetLength(FPoints, FCount);
FPoints[FCount-1].X := X;
FPoints[FCount-1].Y := Y;
FPoints[FCount-1].Z := Z;
FPoints[FCount-1].R := FColor.R;
FPoints[FCount-1].G := FColor.G;
FPoints[FCount-1].B := FColor.B;
FPoints[FCount-1].A := FColor.A;
end;
procedure TPolygon.Add(X: single; Y: single; Z: single; R: single; G: single; B: single; A: single);
begin
FTesselated := false;
FCount := FCount + 1;
SetLength(FPoints, FCount);
FPoints[FCount-1].X := X;
FPoints[FCount-1].Y := Y;
FPoints[FCount-1].Z := Z;
FPoints[FCount-1].R := R;
FPoints[FCount-1].G := G;
FPoints[FCount-1].B := B;
FPoints[FCount-1].A := A;
end;
Procedure TPolygon.Render();
var
loop: integer;
begin
if FTesselated = false then Tesselate;
glbegin(GL_TRIANGLES);
for loop:=0 to FVertexCount-1 do
begin
glcolor3f(FVertex[loop].R,FVertex[loop].G,FVertex[loop].B);
glvertex3f(FVertex[loop].X,FVertex[loop].Y,FVertex[loop].Z);
end;
glend;
end;
procedure TPolygon.Tesselate();
var
loop: integer;
tess: pointer;
test: TGLArrayd3;
pol: PGLArrayd6;
MyTest: string;
procedure iTessBeginCB(which: GLenum); {$IFDEF Win32}stdcall; {$ELSE}cdecl; {$ENDIF}
begin
//PolygonClass.tessBegin(which);
end;
procedure iTessEndCB(); {$IFDEF Win32}stdcall; {$ELSE}cdecl; {$ENDIF}
begin
//PolygonClass.tessEnd();
end;
procedure iTessEdgeCB(flag: GLboolean; lpContext: pointer); {$IFDEF Win32}stdcall; {$ELSE}cdecl; {$ENDIF}
begin
//just do nothing to force GL_TRIANGLES !!!
end;
procedure iTessVertexCB(data: PGLArrayd6); {$IFDEF Win32}stdcall; {$ELSE}cdecl; {$ENDIF}
begin
//PolygonClass.tessVertex(data[0], data[1], data[2], data[3], data[4], data[5],0);
PolygonClass.AddVertex(data[0], data[1], data[2], data[3], data[4], data[5],0);
end;
procedure iTessCombineCB(newVertex : PGLArrayd6; neighborVertex : Pointer;
neighborWeight : Pointer; var outData : Pointer); {$IFDEF Win32}stdcall; {$ELSE}cdecl; {$ENDIF}
var
vertex: PGLArrayd6;
loop: integer;
colorloop: integer;
color: double;
begin
new(vertex);
vertex[0] := newVertex^[0];
vertex[1] := newVertex^[1];
vertex[2] := newVertex^[2];
for colorloop := 3 to 5 do
begin
vertex[colorloop] := 0.0;
for loop:=0 to 3 do
begin
if PGLArrayf4(neighborWeight)^[loop] <> 0 then
begin
vertex[colorloop] := vertex[colorloop] +
PGLArrayf4(neighborWeight)^[loop] *
PGLArrayvertex4(neighborVertex)^[loop][colorloop]
end;
end;
end;
// return output data (vertex coords and others)
outData:= vertex;
end;
begin
PolygonClass := Self;
tess := gluNewTess();
gluTessCallback(tess, GLU_TESS_BEGIN, @iTessBeginCB );
gluTessCallback(tess, GLU_TESS_END, @iTessEndCB);
gluTessCallback(tess, GLU_TESS_VERTEX, @iTessVertexCB);
gluTessCallback(tess, GLU_TESS_COMBINE, @iTessCombineCB); //does not work for font?
gluTessCallback(tess, GLU_TESS_EDGE_FLAG_DATA, @iTessEdgeCB); //force triangles
gluTessProperty(tess, GLU_TESS_WINDING_RULE, GLU_TESS_WINDING_NONZERO );
gluTessBeginPolygon(tess, nil); // with NULL data
gluTessBeginContour(tess);
for loop := 0 to FCount-1 do
begin
new(pol);
pol[3]:=FPoints[loop].R; //color
pol[4]:=FPoints[loop].G;
pol[5]:=FPoints[loop].B;
pol[0]:=FPoints[loop].X;
pol[1]:=FPoints[loop].Y;
pol[2]:=0;
test[0] := pol[0];
test[1] := pol[1];
test[2] := pol[2];
gluTessVertex(tess, test, pol);
end;
gluTessEndContour(tess);
gluTessEndPolygon(tess);
gluDeleteTess(tess); // delete after tessellation
PolygonClass := nil;
FTesselated := true;
end;
end.
Bookmarks