Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement