Unit swOpenGL;
Interface
Const
{...........................................................................}
GL_MODELVIEW = 0;
GL_PROJECTION = 1;
GL_TEXTURE = 2;
GL_COLOR = 3;
GL_MODELVIEW_MATRIX = 0;
GL_PROJECTION_MATRIX = 1;
GL_TEXTURE_MATRIX = 2;
GL_COLOR_MATRIX = 3;
GL_COLOR_BUFFER_BIT = 1;
GL_DEPTH_BUFFER_BIT = 2;
GL_ACCUM_BUFFER_BIT = 4;
GL_STENCIL_BUFFER_BIT = 8;
GL_DEPTH_TEST = 0;
GL_TEXTURE_2D = 1;
GL_POINTS = 0;
GL_LINES = 1;
GL_LINE_STRIP = 2;
GL_LINE_LOOP = 3;
GL_TRIANGLES = 4;
GL_TRIANGLE_STRIP = 5;
GL_TRIANGLE_FAN = 6;
GL_QUADS = 7;
GL_QUAD_STRIP = 8;
GL_POLYGON = 9;
GL_NONE = 1000;
cMaxVertices = 1000;
{...........................................................................}
Type
{...........................................................................}
TGLfloat = Single;
TGLint = LongInt;
TGLubyte = Byte;
PGLfloat = ^TGLfloat;
PGLint = ^TGLint;
PGLubyte = ^TGLubyte;
TGLenum = Cardinal;
TGLbitfield = Cardinal;
TGLsizei = LongInt;
PMatrix4f = ^TMatrix4f;
TMatrix4f = Array[0..15] Of TGLfloat;
PVector3f = ^TVector3f;
TVector3f = Array[0..2] Of TGLfloat;
PVector4f = ^TVector4f;
TVector4f = Array[0..3] Of TGLfloat;
TVector4i = Array[0..4] Of TGLint;
TVector4ub = Array[0..4] Of TGLubyte;
PMatrix44f = ^TMatrix44f;
TMatrix44f = Array[0..3,0..3] Of TGLfloat;
TRGB32Bit = Packed Record
Case Integer Of
0: (r,g,b,a : TGLubyte);
1: (rgba : LongWord);
End;
PVideoBuffer = ^TByteArray;
TByteArray = Array[0..(MaxInt Div SizeOf(TRGB32Bit)) - 1] Of TRGB32Bit;
Procedure glTranslatef(x,y,z: TGLfloat);
Procedure glScalef(x,y,z: TGLfloat);
Procedure glRotatef(angle,x,y,z: TGLfloat);
Procedure glLoadIdentity;
Procedure glPushMatrix;
Procedure glPopMatrix;
Procedure glMatrixMode(mode: TGLenum);
Procedure glMultMatrixf(t: PGLfloat);
Procedure glBegin(mode: TGLenum);
Procedure glEnd;
Procedure glClearColor(red,green,blue,alpha: TGLfloat);
Procedure glClear(mask: TGLbitfield);
Procedure glVertex2f(x,y: TGLfloat);
Procedure glVertex3f(x,y,z: TGLfloat);
Procedure glVertex3fv(v: PGLfloat);
Procedure glVertex4f(x,y,z,w: TGLfloat);
Procedure glColor3f(red,green,blue: TGLfloat);
Procedure glColor4f(red,green,blue,alpha: TGLfloat);
Procedure glViewPort(x,y: TGLint; width,height: TGLsizei);
Procedure gluPerspective(fovy, aspect, zNear, zFar: TGLfloat);
Function GetVideoBuffer: PVideoBuffer;
Implementation
Uses
SysUtils;
Const
{...........................................................................}
cIdentityMatrix: TMatrix44f = (
(1,0,0,0),
(0,1,0,0),
(0,0,1,0),
(0,0,0,1)
);
cModelViewMatrixStackSize = 32;
cProjectionMatrixStackSize = 2;
cTextureMatrixStackSize = 2;
cColorMatrixStackSize = 2;
cEpsilon = 0.001;
{...........................................................................}
Type
{...........................................................................}
TVideoBuffer = Array Of TRGB32Bit;
TDepthBuffer = Array Of Word;
TVertexInfo = Record
Mode : TGLenum;
Color : TVector4f;
Normal : TVector4f;
Vertex : TVector4f;
End;
TMatrixStackInfo = Record
Stack : Array[1..32] Of TMatrix44f;
Index : Integer;
MaxIndex : Integer;
End;
{...........................................................................}
TGLContext = Class
MatrixStacks : Array[0..3] Of TMatrixStackInfo;
MatrixMode : TGLenum;
ViewPort : TVector4i;
zbNear : TGLfloat;
zbFar : TGLfloat;
Vertices : Array[1..cMaxVertices] Of TVertexInfo;
VertexCount : Integer;
PointSize : TGLfloat;
CurrentColor : TVector4f;
CurrentNormal : TVector4f;
VertexMode : TGLenum;
ClearColor : TVector4f;
VideoBuffer : TVideoBuffer;
DepthBuffer : TDepthBuffer;
Constructor Create;
Destructor Destroy; Override;
Procedure TransformObjectCoordsToEyeCoords( ox,oy,oz,ow : TGLfloat;
Var ex,ey,ez,ew : TGLfloat);
Procedure TransformEyeCoordsToClipCoords( ex,ey,ez,ew : TGLfloat;
Var cx,cy,cz,cw : TGLfloat);
Procedure TransformClipCoordsToNDCoords( cx,cy,cz,cw : TGLfloat;
Var nx,ny,nz,nw : TGLfloat);
Procedure TransformNDCoordsToWindowCoords( nx,ny,nz : TGLfloat;
Var wx,wy,wz : TGLfloat);
Function GetVideoBuffer: PVideoBuffer;
Function BackFaceCullTriangle(Var v1,v2,v3: TVector4f): Boolean;
Procedure ResizeBuffers;
Procedure RenderPoint(Var v: TVertexInfo);
Procedure RenderLine(Var v1,v2: TVertexInfo);
Procedure RenderTriangle(Var v1,v2,v3: TVertexInfo);
Procedure ProcessPoints;
Procedure ProcessLines;
Procedure ProcessLineStrip;
Procedure ProcessLineLoop;
Procedure ProcessTriangles;
Procedure ProcessTriangleStrip;
Procedure ProcessTriangleFan;
Procedure ProcessQuads;
Procedure ProcessQuadStrip;
Procedure ProcessPolygon;
Procedure ProcessVertices;
Procedure AddVertexf(x,y,z,w: TGLfloat);
Procedure Init;
Procedure Close;
Function GetMatrix: PMatrix44f;
Procedure glTranslatef(x,y,z: TGLfloat);
Procedure glScalef(x,y,z: TGLfloat);
Procedure glRotatef(angle,x,y,z: TGLfloat);
Procedure glLoadIdentity;
Procedure glPushMatrix;
Procedure glPopMatrix;
Procedure glMatrixMode(mode: TGLenum);
Procedure glMultMatrixf(t: Pointer);
Procedure glBegin(mode: TGLenum);
Procedure glEnd;
Procedure glClearColor(red,green,blue,alpha: TGLfloat);
Procedure ClearVideoBuffer;
Procedure ClearDepthBuffer;
Procedure glClear(mask: TGLbitfield);
Procedure glVertex3fv(v: PGLfloat);
Procedure glVertex4f(x,y,z,w: TGLfloat);
Procedure glColor3f(red,green,blue: TGLfloat);
Procedure glColor4f(red,green,blue,alpha: TGLfloat);
Procedure glViewPort(x,y,width,height: TGLint);
Procedure gluPerspective(fovy, aspect, zNear, zFar: TGLfloat);
End;
{...........................................................................}
TGLDisplayListItem = Packed Record
// Case Integer Of
// End;
End;
TGLDisplayList = Array Of TGLDisplayListItem;
{...........................................................................}
Const
GLContext: TGLContext = Nil;
Function Vector4f(x,y,z,w: TGLfloat): TVector4f;
Begin
Result[0] := x;
Result[1] := y;
Result[2] := z;
Result[3] := w;
End;
{...........................................................................}
{...........................................................................}
Procedure ClampValuef(Var n: TGLfloat; l,h: TGLfloat);
Begin
If n < l Then
n := l
Else
If n > h Then
n := h;
End;
{...........................................................................}
{...........................................................................}
Procedure FloatToByte(n: TGLfloat; Var r: TGLubyte);
Var
w: Integer;
Begin
w := Round(255 * n);
If w < 0 Then
w := 0
Else
If w > 255 Then
w := 255;
r := w And 255;
End;
{...........................................................................}
{...........................................................................}
Procedure PrintMatrix(m: TMatrix44f);
Begin
WriteLn('[',m[0,0]:12:8,m[0,1]:12:8,m[0,2]:12:8,m[0,3]:10:8,']');
WriteLn('[',m[1,0]:12:8,m[1,1]:12:8,m[1,2]:12:8,m[1,3]:12:8,']');
WriteLn('[',m[2,0]:12:8,m[2,1]:12:8,m[2,2]:12:8,m[2,3]:12:8,']');
WriteLn('[',m[3,0]:12:8,m[3,1]:12:8,m[3,2]:12:8,m[3,3]:12:8,']');
WriteLn;
End;
{...........................................................................}
{...........................................................................}
Procedure MultMatrixf(Const a,b,r: PMatrix44f);
Begin
r^[0,0] := a^[0,0]*b^[0,0] + a^[0,1]*b^[1,0] + a^[0,2]*b^[2,0] + a^[0,3]*b^[3,0];
r^[0,1] := a^[0,0]*b^[0,1] + a^[0,1]*b^[1,1] + a^[0,2]*b^[2,1] + a^[0,3]*b^[3,1];
r^[0,2] := a^[0,0]*b^[0,2] + a^[0,1]*b^[1,2] + a^[0,2]*b^[2,2] + a^[0,3]*b^[3,2];
r^[0,3] := a^[0,0]*b^[0,3] + a^[0,1]*b^[1,3] + a^[0,2]*b^[2,3] + a^[0,3]*b^[3,3];
r^[1,0] := a^[1,0]*b^[0,0] + a^[1,1]*b^[1,0] + a^[1,2]*b^[2,0] + a^[1,3]*b^[3,0];
r^[1,1] := a^[1,0]*b^[0,1] + a^[1,1]*b^[1,1] + a^[1,2]*b^[2,1] + a^[1,3]*b^[3,1];
r^[1,2] := a^[1,0]*b^[0,2] + a^[1,1]*b^[1,2] + a^[1,2]*b^[2,2] + a^[1,3]*b^[3,2];
r^[1,3] := a^[1,0]*b^[0,3] + a^[1,1]*b^[1,3] + a^[1,2]*b^[2,3] + a^[1,3]*b^[3,3];
r^[2,0] := a^[2,0]*b^[0,0] + a^[2,1]*b^[1,0] + a^[2,2]*b^[2,0] + a^[2,3]*b^[3,0];
r^[2,1] := a^[2,0]*b^[0,1] + a^[2,1]*b^[1,1] + a^[2,2]*b^[2,1] + a^[2,3]*b^[3,1];
r^[2,2] := a^[2,0]*b^[0,2] + a^[2,1]*b^[1,2] + a^[2,2]*b^[2,2] + a^[2,3]*b^[3,2];
r^[2,3] := a^[2,0]*b^[0,3] + a^[2,1]*b^[1,3] + a^[2,2]*b^[2,3] + a^[2,3]*b^[3,3];
r^[3,0] := a^[3,0]*b^[0,0] + a^[3,1]*b^[1,0] + a^[3,2]*b^[2,0] + a^[3,3]*b^[3,0];
r^[3,1] := a^[3,0]*b^[0,1] + a^[3,1]*b^[1,1] + a^[3,2]*b^[2,1] + a^[3,3]*b^[3,1];
r^[3,2] := a^[3,0]*b^[0,2] + a^[3,1]*b^[1,2] + a^[3,2]*b^[2,2] + a^[3,3]*b^[3,2];
r^[3,3] := a^[3,0]*b^[0,3] + a^[3,1]*b^[1,3] + a^[3,2]*b^[2,3] + a^[3,3]*b^[3,3];
End;
{...........................................................................}
{...........................................................................}
Procedure MultMatrixVectorf(Const m: PMatrix44f; v,r: PVector4f);
Begin
r^[0] := m^[0,0]*v^[0] + m^[0,1]*v^[1] + m^[0,2]*v^[2] + m^[0,3]*v^[3];
r^[1] := m^[1,0]*v^[0] + m^[1,1]*v^[1] + m^[1,2]*v^[2] + m^[1,3]*v^[3];
r^[2] := m^[2,0]*v^[0] + m^[2,1]*v^[1] + m^[2,2]*v^[2] + m^[2,3]*v^[3];
r^[3] := m^[3,0]*v^[0] + m^[3,1]*v^[1] + m^[3,2]*v^[2] + m^[3,3]*v^[3];
End;
{...........................................................................}
{...........................................................................}
Procedure Rotatef(angle,x,y,z: TGLfloat; m: PMatrix44f);
Var
c : Double;
s : Double;
dd : Double;
d : Double;
Begin
m^ := cIdentityMatrix;
dd := x*x + y*y + z*z;
If dd < cEpsilon Then Exit;
If Abs(1 - dd) > cEpsilon Then
Begin
d := Sqrt(dd);
x := x / d;
y := y / d;
z := z / d;
End;
angle := angle * PI / 180;
c := Cos(angle);
s := Sin(angle);
m^[0,0] := x*x*(1-c)+c;
m^[0,1] := x*y*(1-c)-z*s;
m^[0,2] := x*z*(1-c)+y*s;
m^[0,3] := 0;
m^[1,0] := y*x*(1-c)+z*s;
m^[1,1] := y*y*(1-c)+c;
m^[1,2] := y*z*(1-c)-x*s;
m^[1,3] := 0;
m^[2,0] := x*z*(1-c)-y*s;
m^[2,1] := y*z*(1-c)+x*s;
m^[2,2] := z*z*(1-c)+c;
m^[2,3] := 0;
m^[3,0] := 0;
m^[3,1] := 0;
m^[3,2] := 0;
m^[3,3] := 1;
End;
{...........................................................................}
{...........................................................................}
Procedure Perspective(fovy, aspect, zNear, zFar: TGLfloat; t: PMatrix44f);
Var
xScale : TGLfloat;
yScale : TGLfloat;
m : TMatrix44f;
Begin
fovy := fovy * PI / 360.0;
yScale := Sin(fovy)/Cos(fovy);
xScale := aspect * yScale;
m[0,0] := 1.0 / xScale;
m[0,1] := 0;
m[0,2] := 0;
m[0,3] := 0;
m[1,0] := 0;
m[1,1] := 1.0 / yScale;
m[1,2] := 0;
m[1,3] := 0;
m[2,0] := 0;
m[2,1] := 0;
m[2,2] := -(zFar + zNear) / (zFar - zNear);
m[2,3] := -1;
m[3,0] := 0;
m[3,1] := 0;
m[3,2] := -(2.0 * zFar * zNear) / (zFar - zNear);
m[3,3] := 0;
t^ := m;
{ WriteLn('[',m[0,0]:12:8,m[0,1]:12:8,m[0,2]:12:8,m[0,3]:10:8,']');
WriteLn('[',m[1,0]:12:8,m[1,1]:12:8,m[1,2]:12:8,m[1,3]:12:8,']');
WriteLn('[',m[2,0]:12:8,m[2,1]:12:8,m[2,2]:12:8,m[2,3]:12:8,']');
WriteLn('[',m[3,0]:12:8,m[3,1]:12:8,m[3,2]:12:8,m[3,3]:12:8,']');}
End;
{...........................................................................}
{...........................................................................}
Function GetVideoBuffer: PVideoBuffer;
Begin
Result := GLContext.GetVideoBuffer;
End;
{...........................................................................}
{...........................................................................}
Procedure glTranslatef(x,y,z: TGLfloat);
Begin
GLContext.glTranslatef(x,y,z);
End;
{...........................................................................}
{...........................................................................}
Procedure glScalef(x,y,z: TGLfloat);
Begin
GLContext.glScalef(x,y,z);
End;
{...........................................................................}
{...........................................................................}
Procedure glRotatef(angle,x,y,z: TGLfloat);
Begin
GLContext.glRotatef(angle,x,y,z);
End;
{...........................................................................}
{...........................................................................}
Procedure glLoadIdentity;
Begin
GLContext.glLoadIdentity;
End;
{...........................................................................}
{...........................................................................}
Procedure glPushMatrix;
Begin
GLContext.glPushMatrix;
End;
{...........................................................................}
{...........................................................................}
Procedure glPopMatrix;
Begin
GLContext.glPopMatrix;
End;
{...........................................................................}
{...........................................................................}
Procedure glMatrixMode(mode: TGLenum);
Begin
GLContext.glMatrixMode(mode);
End;
{...........................................................................}
{...........................................................................}
Procedure glMultMatrixf(t: PGLfloat);
Begin
GLContext.glMultMatrixf(t);
End;
{...........................................................................}
{...........................................................................}
Procedure glBegin(mode: TGLenum);
Begin
GLContext.glBegin(mode);
End;
{...........................................................................}
{...........................................................................}
Procedure glEnd;
Begin
GLContext.glEnd;
End;
{...........................................................................}
{...........................................................................}
Procedure glClearColor(red,green,blue,alpha: TGLfloat);
Begin
GLContext.glClearColor(red,green,blue,alpha);
End;
{...........................................................................}
{...........................................................................}
Procedure glClear(mask: TGLbitfield);
Begin
GLContext.glClear(mask);
End;
{...........................................................................}
{...........................................................................}
Procedure glVertex2f(x,y: TGLfloat);
Begin
GLContext.glVertex4f(x,y,0,1);
End;
{...........................................................................}
{...........................................................................}
Procedure glVertex3f(x,y,z: TGLfloat);
Begin
GLContext.glVertex4f(x,y,z,1);
End;
{...........................................................................}
{...........................................................................}
Procedure glVertex3fv(v: PGLfloat);
Begin
GLContext.glVertex3fv(v);
End;
{...........................................................................}
{...........................................................................}
Procedure glVertex4f(x,y,z,w: TGLfloat);
Begin
GLContext.glVertex4f(x,y,z,w);
End;
{...........................................................................}
{...........................................................................}
Procedure glColor3f(red,green,blue: TGLfloat);
Begin
GLContext.glColor3f(red,green,blue);
End;
{...........................................................................}
{...........................................................................}
Procedure glColor4f(red,green,blue,alpha: TGLfloat);
Begin
GLContext.glColor4f(red,green,blue,alpha);
End;
{...........................................................................}
{...........................................................................}
Procedure glViewPort(x,y,width,height: TGLint);
Begin
GLContext.glViewPort(x,y,width,height);
End;
{...........................................................................}
{...........................................................................}
Procedure gluPerspective(fovy,aspect,zNear,zFar: TGLfloat);
Begin
GLContext.gluPerspective(fovy,aspect,zNear,zFar);
End;
{...........................................................................}
{...........................................................................}
Constructor TGLContext.Create;
Begin
Inherited Create;
Init;
End;
{...........................................................................}
{...........................................................................}
Destructor TGLContext.Destroy;
Begin
Close;
Inherited Destroy;
End;
{...........................................................................}
{...........................................................................}
Function TGLContext.GetVideoBuffer: PVideoBuffer;
Begin
Result := @VideoBuffer[0];
End;
{...........................................................................}
{...........................................................................}
Function TGLContext.GetMatrix: PMatrix44f;
Begin
Result := Nil;
If Not(MatrixMode In[GL_MODELVIEW,GL_PROJECTION,GL_TEXTURE,GL_COLOR]) Then Exit;
Result := @MatrixStacks[MatrixMode].Stack[MatrixStacks[MatrixMode].Index];
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.TransformObjectCoordsToEyeCoords( ox,oy,oz,ow : TGLfloat;
Var ex,ey,ez,ew : TGLfloat);
Var
m : PMatrix44f;
v : TVector4f;
r : TVector4f;
Begin
m := @MatrixStacks[GL_MODELVIEW].Stack[MatrixStacks[GL_MODELVIEW].Index];
v[0] := ox;
v[1] := oy;
v[2] := oz;
v[3] := ow;
MultMatrixVectorf(m,@v,@r);
ex := r[0];
ey := r[1];
ez := r[2];
ew := r[3];
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.TransformEyeCoordsToClipCoords( ex,ey,ez,ew : TGLfloat;
Var cx,cy,cz,cw : TGLfloat);
Var
m : PMatrix44f;
v : TVector4f;
r : TVector4f;
Begin
m := @MatrixStacks[GL_PROJECTION].Stack[MatrixStacks[GL_PROJECTION].Index];
v[0] := ex;
v[1] := ey;
v[2] := ez;
v[3] := ew;
MultMatrixVectorf(m,@v,@r);
cx := r[0];
cy := r[1];
cz := r[2];
cw := r[3];
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.TransformClipCoordsToNDCoords( cx,cy,cz,cw : TGLfloat;
Var nx,ny,nz,nw : TGLfloat);
Begin
nx := cx / cw;
ny := cy / cw;
nz := cz / cw;
nw := 1;
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.TransformNDCoordsToWindowCoords( nx,ny,nz : TGLfloat;
Var wx,wy,wz : TGLfloat);
Begin
wx := (nx + 1)*(ViewPort[2] / 2) + ViewPort[0];
wy := (ny + 1)*(ViewPort[3] / 2) + ViewPort[1];
wz := nz;
End;
{...........................................................................}
{...........................................................................}
Function ClipCoordIsVisible(Var v: TVector4f): Boolean;
Var
MinCoord : Single;
MaxCoord : Single;
Begin
MinCoord := -v[3] + cEpsilon;
MaxCoord := +v[3] - cEpsilon;
Result := (v[0] >= MinCoord) And (v[0] <= MaxCoord) And
(v[1] >= MinCoord) And (v[1] <= MaxCoord) And
(v[2] >= MinCoord) And (v[2] <= MaxCoord);
End;
{...........................................................................}
{...........................................................................}
Function Mini(a,b: Integer): Integer;
Begin
Result := a * Ord(a <= b) + b * Ord(b < a);
End;
{...........................................................................}
{...........................................................................}
Function Maxi(a,b: Integer): Integer;
Begin
Result := a * Ord(a >= b) + b * Ord(b > a);
End;
{...........................................................................}
{...........................................................................}
Function Minf(a,b: Single): Single;
Begin
Result := a * Ord(a <= b) + b * Ord(b < a);
End;
{...........................................................................}
{...........................................................................}
Function Maxf(a,b: Single): Single;
Begin
Result := a * Ord(a >= b) + b * Ord(b > a);
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.RenderPoint(Var v: TVertexInfo);
Var
px,py : Integer;
x,y : Integer;
x1,y1,x2,y2 : Single;
dd : Single;
r,g,b : Byte;
cr,cg,cb : Byte;
Begin
px := Round(v.Vertex[0]);
py := Round(v.Vertex[1]);
FloatToByte(CurrentColor[0],r);
FloatToByte(CurrentColor[1],g);
FloatToByte(CurrentColor[2],b);
FloatToByte(ClearColor[0],cr);
FloatToByte(ClearColor[1],cg);
FloatToByte(ClearColor[2],cb);
If Abs(1 - PointSize) < cEpsilon Then
Begin
VideoBuffer[px + py * ViewPort[2]].r := r;
VideoBuffer[px + py * ViewPort[2]].g := g;
VideoBuffer[px + py * ViewPort[2]].b := b;
Exit;
End;
x1 := Maxf(0,v.Vertex[0] - PointSize);
x2 := Minf(ViewPort[2]-1,v.Vertex[0] + PointSize);
y1 := Maxf(0,v.Vertex[1] - PointSize);
y2 := Minf(ViewPort[3]-1,v.Vertex[1] + PointSize);
For y := Round(y1) To Round(y2) Do
For x := Round(x1) To Round(x2) Do
Begin
dd := Sqr(x - px) + Sqr(y - py);
If dd <= PointSize Then
Begin
VideoBuffer[x + y * ViewPort[2]].r := r;
VideoBuffer[x + y * ViewPort[2]].g := g;
VideoBuffer[x + y * ViewPort[2]].b := b;
End
Else
Begin
VideoBuffer[x + y * ViewPort[2]].r := cr;
VideoBuffer[x + y * ViewPort[2]].g := cg;
VideoBuffer[x + y * ViewPort[2]].b := cb;
End;
End;
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.RenderLine(Var v1,v2: TVertexInfo);
Var
i, deltax, deltay, numpixels,
d, dinc1, dinc2,
x, xinc1, xinc2,
y, yinc1, yinc2 : integer;
addryinc1,addryinc2: Integer;
lineAddr : Integer;
x1,y1,x2,y2 : Integer;
r,g,b : Byte;
Begin
FloatToByte(CurrentColor[0],r);
FloatToByte(CurrentColor[1],g);
FloatToByte(CurrentColor[2],b);
x1 := Round(v1.Vertex[0]);
y1 := Round(v1.Vertex[1]);
x2 := Round(v2.Vertex[0]);
y2 := Round(v2.Vertex[1]);
// Calculate deltax and deltay for initialisation
deltax := abs(x2 - x1);
deltay := abs(y2 - y1);
// Initialize all vars based on which is the independent variable
If deltax >= deltay Then
Begin
// x is independent variable
numpixels := deltax + 1;
d := (2 * deltay) - deltax;
dinc1 := deltay Shl 1;
dinc2 := (deltay - deltax) Shl 1;
xinc1 := 1;
xinc2 := 1;
yinc1 := 0;
yinc2 := 1;
End
Else
Begin
// y is independent variable
numpixels := deltay + 1;
d := (2 * deltax) - deltay;
dinc1 := deltax Shl 1;
dinc2 := (deltax - deltay) Shl 1;
xinc1 := 0;
xinc2 := 1;
yinc1 := 1;
yinc2 := 1;
End;
// Make sure x and y move in the right directions
If x1 > x2 Then
Begin
xinc1 := - xinc1;
xinc2 := - xinc2;
End;
If y1 > y2 Then
Begin
yinc1 := - yinc1;
yinc2 := - yinc2;
End;
// Start drawing at
x := x1;
y := y1;
lineAddr := y * ViewPort[2];
addryinc1 := ViewPort[2] * yinc1;
addryinc2 := ViewPort[2] * yinc2;
// Draw the pixels
for i := 1 to numpixels do
Begin
VideoBuffer[lineAddr + x].r := r;
VideoBuffer[lineAddr + x].g := g;
VideoBuffer[lineAddr + x].b := b;
If d < 0 Then
Begin
d := d + dinc1;
x := x + xinc1;
// y := y + yinc1;
Inc(lineAddr,addryinc1);
End
Else
Begin
d := d + dinc2;
x := x + xinc2;
// y := y + yinc2;
Inc(lineAddr,addryinc2);
End;
End;
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.RenderTriangle(Var v1,v2,v3: TVertexInfo);
Begin
RenderLine(v1,v2);
RenderLine(v2,v3);
RenderLine(v3,v1);
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.ProcessPoints;
Var
i : Integer;
vi : TVertexInfo;
v : TVector4f;
Begin
For i := 1 To VertexCount Do
Begin
vi := Vertices[i];
v := vi.Vertex;
TransformObjectCoordsToEyeCoords(v[0],v[1],v[2],v[3],v[0],v[1],v[2],v[3]);
TransformEyeCoordsToClipCoords (v[0],v[1],v[2],v[3],v[0],v[1],v[2],v[3]);
If ClipCoordIsVisible(v) Then
Begin
TransformClipCoordsToNDCoords (v[0],v[1],v[2],v[3],v[0],v[1],v[2],v[3]);
TransformNDCoordsToWindowCoords(v[0],v[1],v[2],vi.Vertex[0],vi.Vertex[1],vi.Vertex[2]);
RenderPoint(vi);
End;
End;
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.ProcessLines;
Var
i : Integer;
vi1 : TVertexInfo;
vi2 : TVertexInfo;
v1 : TVector4f;
v2 : TVector4f;
Begin
VertexCount := (VertexCount Div 2) * 2;
i := 1;
While i < VertexCount Do
Begin
vi1 := Vertices[i + 0];
vi2 := Vertices[i + 1];
v1 := vi1.Vertex;
v2 := vi2.Vertex;
TransformObjectCoordsToEyeCoords(v1[0],v1[1],v1[2],v1[3],v1[0],v1[1],v1[2],v1[3]);
TransformEyeCoordsToClipCoords (v1[0],v1[1],v1[2],v1[3],v1[0],v1[1],v1[2],v1[3]);
TransformObjectCoordsToEyeCoords(v2[0],v2[1],v2[2],v2[3],v2[0],v2[1],v2[2],v2[3]);
TransformEyeCoordsToClipCoords (v2[0],v2[1],v2[2],v2[3],v2[0],v2[1],v2[2],v2[3]);
If ClipCoordIsVisible(v1) And
ClipCoordIsVisible(v2) Then
Begin
TransformClipCoordsToNDCoords (v1[0],v1[1],v1[2],v1[3],v1[0],v1[1],v1[2],v1[3]);
TransformNDCoordsToWindowCoords(v1[0],v1[1],v1[2],vi1.Vertex[0],vi1.Vertex[1],vi1.Vertex[2]);
TransformClipCoordsToNDCoords (v2[0],v2[1],v2[2],v2[3],v2[0],v2[1],v2[2],v2[3]);
TransformNDCoordsToWindowCoords(v2[0],v2[1],v2[2],vi2.Vertex[0],vi2.Vertex[1],vi2.Vertex[2]);
RenderLine(vi1,vi2);
End;
Inc(i,2);
End;
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.ProcessLineStrip;
Begin
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.ProcessLineLoop;
Begin
End;
{...........................................................................}
{...........................................................................}
Function TGLContext.BackFaceCullTriangle(Var v1,v2,v3: TVector4f): Boolean;
Var
d1: TVector4f;
d2: TVector4f;
Begin
d1[0] := v3[0] - v1[0];
d1[1] := v3[1] - v1[1];
d2[0] := v3[0] - v2[0];
d2[1] := v3[1] - v2[1];
Result := (d1[0] * d2[1]) - (d1[1] * d2[0]) > 0;
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.ProcessTriangles;
Var
i : Integer;
vi1 : TVertexInfo;
vi2 : TVertexInfo;
vi3 : TVertexInfo;
v1 : TVector4f;
v2 : TVector4f;
v3 : TVector4f;
Begin
VertexCount := (VertexCount Div 3) * 3;
i := 1;
While i < VertexCount Do
Begin
vi1 := Vertices[i + 0];
vi2 := Vertices[i + 1];
vi3 := Vertices[i + 2];
v1 := vi1.Vertex;
v2 := vi2.Vertex;
v3 := vi3.Vertex;
TransformObjectCoordsToEyeCoords(v1[0],v1[1],v1[2],v1[3],v1[0],v1[1],v1[2],v1[3]);
TransformEyeCoordsToClipCoords (v1[0],v1[1],v1[2],v1[3],v1[0],v1[1],v1[2],v1[3]);
TransformObjectCoordsToEyeCoords(v2[0],v2[1],v2[2],v2[3],v2[0],v2[1],v2[2],v2[3]);
TransformEyeCoordsToClipCoords (v2[0],v2[1],v2[2],v2[3],v2[0],v2[1],v2[2],v2[3]);
TransformObjectCoordsToEyeCoords(v3[0],v3[1],v3[2],v3[3],v3[0],v3[1],v3[2],v3[3]);
TransformEyeCoordsToClipCoords (v3[0],v3[1],v3[2],v3[3],v3[0],v3[1],v3[2],v3[3]);
If ClipCoordIsVisible(v1) And
ClipCoordIsVisible(v2) And
ClipCoordIsVisible(v3) Then
Begin
TransformClipCoordsToNDCoords (v1[0],v1[1],v1[2],v1[3],v1[0],v1[1],v1[2],v1[3]);
TransformNDCoordsToWindowCoords(v1[0],v1[1],v1[2],vi1.Vertex[0],vi1.Vertex[1],vi1.Vertex[2]);
TransformClipCoordsToNDCoords (v2[0],v2[1],v2[2],v2[3],v2[0],v2[1],v2[2],v2[3]);
TransformNDCoordsToWindowCoords(v2[0],v2[1],v2[2],vi2.Vertex[0],vi2.Vertex[1],vi2.Vertex[2]);
TransformClipCoordsToNDCoords (v3[0],v3[1],v3[2],v3[3],v3[0],v3[1],v3[2],v3[3]);
TransformNDCoordsToWindowCoords(v3[0],v3[1],v3[2],vi3.Vertex[0],vi3.Vertex[1],vi3.Vertex[2]);
If Not BackFaceCullTriangle(v1,v2,v3) Then
RenderTriangle(vi1,vi2,vi3);
End;
Inc(i,3);
End;
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.ProcessTriangleStrip;
Begin
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.ProcessTriangleFan;
Begin
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.ProcessQuads;
Begin
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.ProcessQuadStrip;
Begin
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.ProcessPolygon;
Begin
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.ProcessVertices;
Begin
If VertexCount <= 0 Then Exit;
// ClearPrimitives;
Case Vertices[1].Mode Of
GL_POINTS : ProcessPoints;
GL_LINES : ProcessLines;
GL_LINE_STRIP : ProcessLineStrip;
GL_LINE_LOOP : ProcessLineLoop;
GL_TRIANGLES : ProcessTriangles;
GL_TRIANGLE_STRIP : ProcessTriangleStrip;
GL_TRIANGLE_FAN : ProcessTriangleFan;
GL_QUADS : ProcessQuads;
GL_QUAD_STRIP : ProcessQuadStrip;
GL_POLYGON : ProcessPolygon;
End;
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.AddVertexf(x,y,z,w: TGLfloat);
Begin
If VertexMode = GL_NONE Then Exit;
If VertexCount >= cMaxVertices Then Exit;
Inc(VertexCount);
Vertices[VertexCount].Mode := VertexMode;
Vertices[VertexCount].Color := CurrentColor;
Vertices[VertexCount].Normal := CurrentNormal;
Vertices[VertexCount].Vertex := Vector4f(x,y,z,w);
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.glTranslatef(x,y,z: TGLfloat);
Var
t : TMatrix44f;
r : TMatrix44f;
m : PMatrix44f;
Begin
t := cIdentityMatrix;
t[0,3] := x;
t[1,3] := y;
t[2,3] := z;
m := GetMatrix;
MultMatrixf(m,@t,@r);
m^ := r;
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.glScalef(x,y,z: TGLfloat);
Var
t : TMatrix44f;
r : TMatrix44f;
m : PMatrix44f;
Begin
t := cIdentityMatrix;
t[0,0] := x;
t[1,1] := y;
t[2,2] := z;
m := GetMatrix;
MultMatrixf(m,@t,@r);
m^ := r;
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.glRotatef(angle,x,y,z: TGLfloat);
Var
t : TMatrix44f;
r : TMatrix44f;
m : PMatrix44f;
Begin
Rotatef(angle,x,y,z,@t);
m := GetMatrix;
MultMatrixf(m,@t,@r);
m^ := r;
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.glLoadIdentity;
Var
m : PMatrix44f;
Begin
m := GetMatrix;
m^ := cIdentityMatrix;
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.glPushMatrix;
Var
m : PMatrix44f;
Begin
If MatrixStacks[MatrixMode].Index >= MatrixStacks[MatrixMode].MaxIndex Then Exit;
m := @MatrixStacks[MatrixMode].Stack[MatrixStacks[MatrixMode].Index];
Inc(MatrixStacks[MatrixMode].Index);
MatrixStacks[MatrixMode].Stack[MatrixStacks[MatrixMode].Index] := m^;
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.glPopMatrix;
Begin
If MatrixStacks[MatrixMode].Index < 2 Then Exit;
Dec(MatrixStacks[MatrixMode].Index);
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.glMatrixMode(mode: TGLenum);
Begin
If Not(mode In[GL_MODELVIEW,GL_PROJECTION,GL_TEXTURE,GL_COLOR]) Then Exit;
MatrixMode := mode;
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.glMultMatrixf(t: Pointer);
Var
r : TMatrix44f;
m : PMatrix44f;
Begin
m := GetMatrix;
MultMatrixf(m,t,@r);
m^ := r;
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.glBegin(mode: TGLenum);
Begin
If VertexMode <> GL_NONE Then Exit;
If mode > GL_POLYGON Then Exit;
VertexMode := mode;
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.glEnd;
Begin
If VertexMode = GL_NONE Then Exit;
VertexMode := GL_NONE;
ProcessVertices;
VertexCount := 0;
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.glClearColor(red,green,blue,alpha: TGLfloat);
Begin
ClampValuef(red ,0,1);
ClampValuef(green ,0,1);
ClampValuef(blue ,0,1);
ClampValuef(alpha ,0,1);
ClearColor := Vector4f(red,green,blue,alpha);
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.ClearVideoBuffer;
Var
r : Byte;
g : Byte;
b : Byte;
a : Byte;
x,y : Integer;
addr : Integer;
Begin
FloatToByte(ClearColor[0],r);
FloatToByte(ClearColor[1],g);
FloatToByte(ClearColor[2],b);
FloatToByte(ClearColor[3],a);
addr := 0;
For y := 0 To ViewPort[3] - 1 Do
Begin
For x := 0 To ViewPort[2] - 1 Do
Begin
VideoBuffer[addr + x].r := r;
VideoBuffer[addr + x].g := g;
VideoBuffer[addr + x].b := b;
End;
Inc(addr,ViewPort[2]);
End;
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.ClearDepthBuffer;
Begin
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.glClear(mask: TGLbitfield);
Begin
If mask And GL_COLOR_BUFFER_BIT <> 0 Then
ClearVideoBuffer;
If mask And GL_DEPTH_BUFFER_BIT <> 0 Then
ClearDepthBuffer;
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.glVertex3fv(v: PGLfloat);
Begin
AddVertexf(PVector3f(v)^[0],PVector3f(v)^[1],PVector3f(v)^[2],1);
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.glVertex4f(x,y,z,w: TGLfloat);
Begin
AddVertexf(x,y,z,w);
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.glColor3f(red,green,blue: TGLfloat);
Begin
ClampValuef(red ,0,1);
ClampValuef(green ,0,1);
ClampValuef(blue ,0,1);
CurrentColor[0] := red;
CurrentColor[1] := green;
CurrentColor[2] := blue;
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.glColor4f(red,green,blue,alpha: TGLfloat);
Begin
ClampValuef(red ,0,1);
ClampValuef(green ,0,1);
ClampValuef(blue ,0,1);
ClampValuef(alpha ,0,1);
CurrentColor := Vector4f(red,green,blue,alpha);
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.gluPerspective(fovy,aspect,zNear,zFar: TGLfloat);
Var
r : TMatrix44f;
t : TMatrix44f;
m : PMatrix44f;
Begin
m := GetMatrix;
Perspective(fovy,aspect,zNear,zFar,@t);
MultMatrixf(m,@t,@r);
m^ := r;
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.ResizeBuffers;
Begin
SetLength(VideoBuffer,ViewPort[2] * ViewPort[3]);
SetLength(DepthBuffer,ViewPort[2] * ViewPort[3]);
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.glViewPort(x,y,width,height: TGLint);
Begin
ViewPort[0] := x;
ViewPort[1] := y;
ViewPort[2] := width;
ViewPort[3] := height;
ResizeBuffers;
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.Init;
Begin
zbNear := 0;
zbFar := 1;
glClearColor(0,0,0,1);
glColor4f(1,1,1,1);
PointSize := 1;
VertexMode := GL_NONE;
VertexCount := 0;
MatrixStacks[GL_MODELVIEW].Index := 1;
MatrixStacks[GL_MODELVIEW].MaxIndex := cModelViewMatrixStackSize;
MatrixStacks[GL_MODELVIEW].Stack[1] := cIdentityMatrix;
MatrixStacks[GL_PROJECTION].Index := 1;
MatrixStacks[GL_PROJECTION].MaxIndex := cProjectionMatrixStackSize;
MatrixStacks[GL_PROJECTION].Stack[1] := cIdentityMatrix;
MatrixStacks[GL_TEXTURE].Index := 1;
MatrixStacks[GL_TEXTURE].MaxIndex := cTextureMatrixStackSize;
MatrixStacks[GL_TEXTURE].Stack[1] := cIdentityMatrix;
MatrixStacks[GL_COLOR].Index := 1;
MatrixStacks[GL_COLOR].MaxIndex := cColorMatrixStackSize;
MatrixStacks[GL_COLOR].Stack[1] := cIdentityMatrix;
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
glViewPort(0,0,320,240);
gluPerspective(45,ViewPort[2]/ViewPort[3],1,100);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity;
End;
{...........................................................................}
{...........................................................................}
Procedure TGLContext.Close;
Begin
End;
{...........................................................................}
{...........................................................................}
Procedure InitGL;
Begin
GLContext := TGLContext.Create;
End;
{...........................................................................}
{...........................................................................}
Procedure CloseGL;
Begin
GLContext.Free;
End;
{...........................................................................}
{...........................................................................}
Initialization
InitGL;
Finalization
CloseGL;
End.