Sights & Sounds
Peter Dove and Don Peer
Object Pascal / Delphi 2

DIB DIB DIB 

This month we are going to enhance TGMP to the point where faster 3D graphics becomes a reality rather than a statement. The increase in speed that we will obtain with regard to TGMP graphics can best be explained with one word - DIB's (Device Independent Bitmaps).  To achieve this reality we will create our own DIB class that will be capable of handling it's own drawing routines, screen clearing routines and related procedures.  In addition, we will discover a little more about pointers and bit manipulation during the development process. The texture mapping theories that were explained in last month's article will be further expanded upon to enable TGMP to perform full shading of texture mapped objects. 

On the raw object side of the component we will enhance TGMP so that it will process extremely accurate graphic primitives through the use of a custom file reader. To close out the article, we will explain and implement the world coordinate system. An example of the graphics that we will output by the end of this article is shown in 'Figure 1' below. All in all this will be a cram-packed article with a lot of material to cover - let's get on with it.



Figure 1


The Class of DIB
To get started we will create a DIB class that will be derived from TObject.  We will take this approach because the class is not meant to be a component that you can drop onto a form. It is meant to be a supplement to other components like TGMP and will be declared accordingly in the uses clause. However, before we get to deep into the class development we think a small explanation of a DIB (Device Independent Bitmap) would be useful.  

A Device independent bitmap is what a BMP file is on your disk - it is not dependent on a particular device - such as a printer or a screen.  It is independent because it carries with it all the information that any device, be it a printer or a screen, will need to know in order to diplay the bimaps. A DIB holds color information, such as palette, the bit depth, and also holds information about the size of the bitmaps and any compression algorithms that may be in use.

For our purposes we want to create a DIB in memory rather than load it from disk. To accomplish this we are going to use a Windows API function called CreateDIBSection with the following parameters:

Handle of a device context.
Variable of TBitmapInfo (will be described later).
DIB_RGB_COLORS or DIB_PAL_COLORS to indicate the type of color data.
Variable to receive a pointer to the bitmap's bit values.
Optional handle to a file mapping object, which we will set to nil.
Offset to the bitmap bit values within the file-mapping object which we will set to 0.

To be able to call CreateDIBSection, which will create a DIB in memory, we need to understand the TBitmapInfo type.  This is best explained by following the creation of our TDIB16bit class.  Below is the declaration for the class.

TDIB16bit = class(Tobject)
  private
    {Privates}
    FDibHandle : HBitmap;
    FBheader : TBitMapInfo;
    FPointerToBitmap : Pointer;
    FScanWidth : Integer;
    FDeviceContext : HDC;
  protected
    { Protected declarations }
  public
    { Public declarations }
    procedure FlipBackPage(DeviceContext : HDC);
    procedure SetPixel(X, Y : Integer; Color : Word);
    procedure ClearBackPage(Color : Word);
    procedure DrawHorizontalLine (Y, X1, X2 : Integer; Color : Word) ;
    function GetHandle : HBitmap;
    constructor Create(Height, Width : Integer);
    destructor Destroy; Override;
  end;

FDibHandle is the handle to the DIB that is returned by the CreateDIBSection function.  FBHeader is the TBitmapInfo variable we mentioned.  FPointerToBitmap is another parameter we must pass to CreateDIBSection.  FScanWidth is the width of each line in bytes.  FDeviceContext is the device context that the bitmap is associated with.  Below is the create constructor of the TDIB16bit class which we will follow though line by line with a description of the code and what it does.

The constructor accepts two parameters; the width and height of the required DIB.

  constructor TDIB16Bit.Create(Height, Width : Integer);

Call the inherited Create.

  Inherited Create;

The biWidth and biHeight of FBHeader are obvious in that they specify the width and height.

  FBHeader.bmiHeader.biWidth := Width;
  FBHeader.bmiHeader.biHeight := Height;

biPlanes specifies the number of planes for the target device.  This is always set to 1.

  FBHeader.bmiHeader.biplanes := 1;

biBitCount specifies the color Depth and biCompression is set to BI_RGB which means no compression.

  FBHeader.bmiHeader.biBitCount := 16;
  FBHeader.bmiHeader.biCompression := BI_RGB;

The image size is dependent on the width of a line.  A bitmap scanline must end on a double-word boundary.  So, for instance, if the 16bit bitmap were 31 pixels wide the scanline would hold enough space for 32 pixels although the last pixel just wouldn't be used.  The formula to find the right width is: (((BitDepth * width) + 31) divided by 32) * 4. 

  FBHeader.bmiHeader.biSizeImage := ((((16*FBHeader.bmiHeader.biWidth)+31) div 32) * 4) * Height;

FScanWidth is stored so we won't have to calculate it again.

  FScanWidth := (((FBHeader.bmiHeader.biWidth * 16)+ 31) div 32) * 4;

The following are unimportant for us and can safely be set to zero.

  FBHeader.bmiHeader.biXPelsPerMeter := 0;
  FBHeader.bmiHeader.biYPelsPerMeter := 0;
  FBHeader.bmiHeader.biclrUsed := 0;
  FBHeader.bmiHeader.biclrImportant := 0;

biSize is the size of the bmiheader structure within the TBitmapInfo structure.

  FBheader.bmiheader.biSize := 40;

The bmiColors are unimportant for the moment because they really only relate to 256 color bitmaps.

  FBHeader.bmiColors[0].rgbRed := 255;
  FBHeader.bmiColors[0].rgbBlue := 255;
  FBHeader.bmiColors[0].rgbGreen := 255;
  FBHeader.bmiColors[0].rgbReserved := 255;

A device context that we can supply to CreateDIBSection must also be created. A device context allows the DIB to be drawn onto by other GDI (Graphical Device Interface) objects such as brushes and fonts.  Supplying 0 as a parameter to CreateCompataibleDC give us a device context that is compatible with the current screen.  Finally, passing the device context to CreateDIBSection with all the other parameters returns us a handle to the bitmap and tells us, by assigning an address to FPointerToBitmap, where the memory associated with the bitmap is.  You can also supply the bitmap handle to a TBitmap - this is useful if you want to things like use the TBitmap's ability to save to disk.

  FDeviceContext := CreateCompatibleDC(0);
  FDibHandle := CreateDibSection(FDeviceContext, FBHeader, DIB_RGB_COLORS, PointerToBitmap, nil, 0);

Now for the procedures and functions within the class.  This section will hopefully explain a lot about pointers and memory manipulation. The first procedure shown below is FlipBackPage.  This procedure accepts a device context as a parameter.  The device context could be the handle of a TCanvas object for instance.   In fact, this is exactly what we will send to it from our main TGMP class. The actual API call used in this procedure is StetchDIBits. This API call accepts a device context, the left, top, width and height of the source bitmap and the same parameters for the destination area.  It also takes the TBitmapInfo which tells StrectchDIBits about the bitmaps type and the copy mode, in this case SRCCOPY, which is a straight bit for bit copy. 

procedure TDIB16bit.FlipBackPage(DeviceContext : HDC);
begin
  StretchDIBits(DeviceContext, 0, 0, FBHeader.bmiheader.biwidth, FBHeader.bmiheader.biheight,
                          0, 0, FBHeader.bmiheader.biwidth, FBHeader.bmiheader.biheight, FPointerToBitmap, 
                          FBheader, DIB_RGB_COLORS, SRCCOPY);
end;

The procedure ClearBackPage does exactly that, it clears the backpage.  ClearBackPage takes a color, as a 16bit word, and clears the back buffer. We declare a pointer to a word value and then assign the FPointerToBitmap to it.  The X loop counter is worked out by taking the number of bytes in a scanline and dividing it by two. This is because there are two bytes in a word. The calculated value is then multiplied by the height of the DIB. 

To clarify, a pointer is a variable that holds an address to a position in memory.  So if we were to look at the contents of FPointerToBitmap we would find that the value in it would be a 32bit number which would relate to an address in memory at which the start of the bitmap resides.  In the body of the loop you see that the BasePointer variable is being assigned a color and then on the next line it is being incremented.  You will also notice that the BasePointer variable has the caret symbol after it.  This tells the compiler to assign the value of Color into the address referenced by BasePointer, not into the BasePointer variable itself.  On the next line the BasePointer is incremented.  When you increment a pointer, it is incremented by the size of the type that it references, in this case the pointer is incremented by 2 bytes (a word), in other words the pointer moves along the DIB memory by 2 bytes.

If your still a little stumped with pointers, imagine that you are handed a cinema ticket with your seat number on it.  The ticket will point you to the place in the cinema where you are meant to sit.  If you think of a pointer as your cinema ticket, it merely references where in memory you want to go.  Your cinema ticket is not your actual seat, but a pointer to it.

procedure TDIB16bit.ClearBackPage(Color : Word);
var
   X : Integer;
   BasePointer : ^Word;
begin
  BasePointer := FPointerToBitmap;
  for X := 0 to ((FScanWidth div 2) * (FBHeader.bmiHeader.biHeight)) - 1 do
    begin
      BasePointer^ := Color;
      inc(BasePointer);
    end;
end;

The function GetHandle is just one line of code which returns a handle to the DIB.  The next procedure, which is shown below, is SetPixel.  This procedure also uses pointers.  It accepts an X and Y position along with the color that the pixel is to be set to.  We again declare BasePointer, but this time we work out where in the DIB's memory the (X,Y) coordinate is.  We take the FpointerToBitmap as the start address, then add on (Y multiplied by the ScanWidth) to get onto the right line and then finally we add (X multiplied by 2).  The reason X is multiplied by two is because there are two bytes for every pixel and memory addresses are measured a byte at a time.  Then we assign the value of the Color variable to the address in memory that BasePointer points to.


procedure TDIB16bit.SetPixel(X, Y : Integer; Color : Word);
var
  BasePointer : ^Word;
begin
  BasePointer := Pointer(Integer(FPointerToBitmap) + (Y * FScanWidth) + (X * 2));
  BasePointer^ := Color;
end;

The procedure DrawHorizontal line works in a similar way to SetPixel.  It works out the start point in memory of the horizontal line and loops through by a count of the parameters (X2 - X1).  DrawHorizontal line is a half breed, in terms of coding, between ClearBackPage and SetPixel.

procedure TDIB16bit.DrawHorizontalLine (Y, X1, X2 : Integer; Color : Word) ;
var
  X : Integer;
  BasePointer : ^Word;
begin
  Integer(BasePointer) := Integer(FPointerToBitmap) + (Y * FScanWidth) + (X1 * 2);
  for X := 0 to (X2 - X1) do
    begin
      BasePointer^ := Color;
      inc(BasePointer);
    end;
end;

To close out our DIB class the destructor deletes the DIB and it's associated resources. This is accomplished by using the API call DeleteObject which accepts a handle to the object as a parameter.  The destructor also deletes the device context that we have held for the DIB before it calls Inherited Destroy. The call to Inherited Destroy ensures that any code in the classes ancestors destructor will be executed.

destructor TDIB16bit.Destroy;
begin
  DeleteObject(FDibHandle);
  DeleteDC(FDeviceContext);
  Inherited;
end;


Bits and pieces
You have probably noticed that a lot of the procedures in the DIB class take a Word value (2 byte unsigned integer) as the color.  In 16bit color mode a pixel in a DIB takes up 2 bytes.  The RGB values are embedded in that value; the first bit of the 16 bits, the one with the highest value, is not used.  The next five bits are the red value, the next five are the green value and the last 5 bits are the blue value.  Each of the colors has a value of 0 to 31.  We have written a support method that converts TColor into a word value and other various methods that are tied into the shaded texturing model which will get into later in this article. A pictorial representation of where the bits reside in the Word Value is shown in 'Figure 2'. Below 'Figure 2' is the function CalculateRGBWord which takes a TColor as a parameter and returns the appropriate 16 bit value.



Figure 2

function TGMP.CalculateRGBWord(Color : TColor) : Word;
var
  Calc : single;
  R, G, B : Integer;
begin
  {GetRValue, GetGValue, GetBValue return a value which is based on the color scale of  0 to 255}

  {This gets the red value and rescales it from a 1/256 number to a 0/31 number}
  Calc := GetRValue(Color) / 2.56;
  Calc := Calc * 0.31;
  R := Round(Calc);

  {This gets the green value and rescales it from a 1/256 number to a 0/31 number}
  Calc := GetGValue(Color) / 2.56;
  Calc := Calc * 0.31;
  G := Round(Calc);

  {This gets the red value and rescales it from a 1/256 number to a 0/31 number}
  Calc := GetBValue(Color) / 2.56;
  Calc := Calc * 0.31;
  B := Round(Calc);

  {The B Value is the last 5 bits so it can be left alone}
  {R must be shifted left by 10 bits so that it sits at the position 15-11}
  R := R shl 10;
  {G must be shifted to the left 5 bits so that it sits at the position 10..6}
  G := G shl 5;
  {Then just add them together}
  Result := R + G + B;
end;


In the shade.
In our last article we explained the methodology behind texture mapping of polygons. This month we are going to add shading to those texture maps and bring a little light into the subject.  To accommodate texture shading and the new DIB class we will need to expand the current TPolygon and TObject3D structures.  Next to each line of the structure is an explanation of it purpose.

TPolygon = record
  Point : array [0..3] of TPoint3D; {only allow polygons for now if to 4 points}
  NumberPoints : Integer; {Number of Points in the polygon}
  Visible : Boolean; {Wether the polygon is visible or not - this is worked out by RemoveBackfacesAndShade}
  AverageZ : Single; {For Z Sorting}
  PolyColor : TColor; {The color of the polygon}
  DibColor : Word; {The 16bit value of the PolyColor}
  Intensity : Byte; {Stores the intensity of the light - used in shaded texture-mapping}
end;

TObject3D = record
  PolyStore  : array [0..MAXPOLYS] of TPolygon; {Stores the local cooridnates of the polygons of the object}
  PolyWorld  : array [0..MAXPOLYS] of TPolygon; {Stores the world cooridnates of the polygons of the object}
  NumberPolys : Integer; {The number of polygons in the object}
  Color : Tcolor; {Color used for solid shading and wireframe}
  DibColor : Word; {The 16bit value of the Color}
  World : TPoint3D; {Position of the object in the world}
end;

As you can see from the TPolygon we store an Intesity value which is the light intensity against that polygon.  We use this conjunction with a texel (textured pixel) to figure out the correct shade of the texel.  An extra line has been inserted into the RemoveBackfacesAndShade procedure, it is shown below above a line that already exists, this is to show you where the line must be inserted.

          AnObject.PolyStore[CurrentPoly].Intensity := Round(Intensity); {Line to add}
          AnObject.PolyStore[CurrentPoly].PolyColor := RGB(R, G, B); {existing line}

Next, for reasons of speed, we need to set up a 2 dimensional look up table.  This table will allow us to get out a shade for any R,G or B value.  Below is the procedure CalcIntensityLUT that works out our lookup table. We have provided explanatory comments where necessary.  

procedure TGMP.CalcIntensityLUT;
var
  X, Y: Integer;
  Upincrement, downincrement : Single;
begin
  {loop through for every possible R,G or B Value - 0 to 31}
  for X := 0 to 31 do
    begin
      {The up increment is from the initial color value to it's brightest}
      UpIncrement := (31 - X) / 16;
      {The down increment is from the initial color value to it's darkest}
      DownIncrement := X / 15;
      {Loops through from color 0 to color 15 using the downincrement}
      for Y := 0 to 15 do
        begin
          IntensityLUT[X, Y] := Round(DownIncrement * Y);
        end;
      {Loops through from color 16 to color 31 using the UpIncrement}
      for Y := 1 to 16 do
        begin
          IntensityLUT[X, Y + 15] := Round((DownIncrement * 15) + (UpIncrement * Y));
        end;
    end;
end;

{Place this line in the Create Constructor of TGMP}
CalcIntensityLUT;


Now that we have our look up table we need a function that takes a  16bit color and an intensity value as parameters and returns a new  16bit color with each R,G,B element shaded correctly.  This is quite a complicated thing to do because the method has to extract the separate R,G,B values from the word value, then get the shades for each R,G,B and finally recombine them into a word value!  The method is called GetShadedWord, and it is quite interesting because it covers some new programming ground related to bitwise manipulation.  GetShadedWord shows how to use bit masking and  works on the principle that  you can AND values together to extract a new value.  'Figure 3' shows the logical results of ANDing different binary values together and then shows how to extract the 5bit G value from a 16bit value.  Immediately following 'figure 3' is the function GetShadedWord with explanatory comments.


Figure 3

function TGMP.GetShadedWord (Texture : Word; Intensity : Integer) : Word;
var
  intRed, intGreen, intBlue : Integer;
  intBitMask : Integer;
begin
  {Bitmask for 0000000000011111 is 31 - this gives us the last 5 bits for Blue}
  intBitMask := 31;
  intBlue := Texture and intBitMask;

  {Bitmask for 0000001111100000 is 992 - this gives us the the middle 5 bits for Green}
  intBitMask := 992;
  intGreen := Texture and intBitMask;
  intGreen := intGreen shr 5;

  {Bitmask for 0111110000000000 is 31744 - this gives the the bits for the Red element - bits 15-11}
  intBitMask := 31744;
  intRed := Texture and intBitMask;
  intRed := intRed shr 10;

  {Now get the new shades - this uses the lookup table that we worked out previously}
  intRed := IntensityLUT[intRed, Intensity];
  intGreen := IntensityLUT[intGreen, Intensity];
  intBlue := IntensityLUT[intBlue, Intensity];

  {Lastly we just shift the Red and Green into their correct places and add all the elements together}
  intRed := intRed shl 10;
  intGreen := intGreen shl 5;

  result := intRed + intBlue + intGreen;

end;

After all that preparation we can finally add  the rmShadedTexture element to TRenderMode and then place a new section of code to implement the shaded texturing in the RenderNow procedure.  The new section of code is listed below and please notice, but ignore for the moment, the fact that all the points are taken fromObject3D.PolyWorld rather than Object3D.Polystore. This will all be explained shortly along with the LocalToWorld procedure that is called. 

  //**********    Shaded  Texture *******************************
    rmShadedTexture :
      begin
        RemoveBackfacesAndShade(Object3D);
        OrderZ(Object3D);
        LocalToWorld(Object3D);
        for X := 0 to Object3D.NumberPolys - 1 do
          with Object3D.PolyWorld[x] do
            begin
              if Object3D.PolyWorld[x].Visible = False then
                Continue;
	      ClearYBuckets;
              FIntensity := Object3D.PolyWorld[x].Intensity;
              if NumberPoints = 3 then
                begin
                  TextureStart.X := 63;  TextureStart.Y := 0;
                  TextureEnd.X := 0; TextureEnd.Y := 127;
                  DrawTextureLine3D(Point[0], Point[1], TextureStart, TextureEnd);
                  TextureStart.X := 0; TextureStart.Y := 127;
                  TextureEnd.X := 127; TextureEnd.Y := 127;
                  DrawTextureLine3D(Point[1], Point[2], TextureStart, TextureEnd);
                  TextureStart.X := 127; TextureStart.Y := 127;
                  TextureEnd.X := 63; TextureEnd.Y := 0;
                  DrawTextureLine3D(Point[2], Point[0], TextureStart, TextureEnd);
                end
              else
                begin
                  TextureStart.X := 127; TextureStart.Y := 0;
                  TextureEnd.X := 127; TextureEnd.Y := 127;
                  DrawTextureLine3D(Point[0], Point[1], TextureStart, TextureEnd);
                  TextureStart.X := 127; TextureStart.Y := 127;
                  TextureEnd.X := 0; TextureEnd.Y := 127;
                  DrawTextureLine3D(Point[1], Point[2], TextureStart, TextureEnd);
                  TextureStart.X := 0; TextureStart.Y := 127;
                  TextureEnd.X := 0; TextureEnd.Y := 0;
                  DrawTextureLine3D(Point[2], Point[3], TextureStart, TextureEnd);
                  TextureStart.X := 0; TextureStart.Y := 0;
                  TextureEnd.X := 127; TextureEnd.Y := 0;
                  DrawTextureLine3D(Point[3], Point[0], TextureStart, TextureEnd);
                end;
       	      RenderYBuckets;
            end;  {end of with statement}
      end; {end of rmSolidTexture statement}

The next step in implementing the shaded texturing is adding the following line to the DrawLine3DTexture procedure.  We have given you a little more of the procedure listing than just the line so you can see where the line is to be added.

case RenderMode of
  rmSolidTexture : DrawTextureLine2D(NewStartPoint, NewEndPoint, TextStart, TextEnd); {existing line}
  rmShadedTexture : DrawTextureLine2D(NewStartPoint, NewEndPoint, TextStart, TextEnd); {The new line}
end;

Finally, finally, finally we show you the last change needed before we can move onto our object file reader.  This change is to the RenderYBuckets procedure.  The change is shown below and incorporates the information we have learnt in bit masking. Again it is commented to help you understand what is happening.

  if RenderMode = rmShadedTexture then
    begin
      {Loop through all the buckets}
      for Y := 0 to 479 do
      begin
        if YBuckets[Y].StartX = -16000 then
          Continue;
        {Calculate all the Texture X, Y increments - theses are the same as in article 3}
        Length := (YBuckets[Y].EndX - YBuckets[Y].StartX) + 1;
        TextXIncr := ((TextureBuckets[Y].EndPosition.X -  TextureBuckets[Y].StartPosition.X)) / length ;
        TextYIncr := ((TextureBuckets[Y].EndPosition.Y -  TextureBuckets[Y].StartPosition.Y)) / length ;
        TextX := TextureBuckets[Y].StartPosition.X;
        TextY := TextureBuckets[Y].StartPosition.Y;
        {Loop through all the pixrls on the Y line}
        for I := YBuckets[Y].StartX to YBuckets[Y].EndX do
          begin
            {Perform clipping if the pixels X value is less than 0}
            if I < 0 then
              begin
                TextX := TextX + TextXIncr;
                TextY := TextY + TextYIncr;
                Continue;
              end;
            {Perform clipping if the pixels X value is greater than width}
            if I > Width then
              begin
                TextX := TextX + TextXIncr;
                TextY := TextY + TextYIncr;
                Continue;
              end;
            {Use the DibClass to set the pixel.  Get the texel from FCurrentBitmap and use GetShadedWord to
            return the texel correctly shaded to pass into SetPixel}
            FDib.SetPixel(I, Y, GetShadedWord(FCurrentBitmap[Round(TextX), Round(TextY)], FIntensity));
            TextX := TextX + TextXIncr;
            TextY := TextY + TextYIncr;
          end;
      end;
    end; {End of RenderMode = rmShadedTexture}


Object of my desire
The thing that's been annoying us most about the TGMP class is the fact that you have type all the vertices of an object into the application code yourself.  To eliminate any further vertices typing  we are going to write a method that will read in objects that have been saved to disk.  The first object file format that TGMP will read in will be for GEO objects. The GEO object file format provides a useful generic way of storing data in a text file.  The file format is shown below with comments in red.

3DG1	{This identifies that this file is a geo file}
3	{This is the number of vetices}
1.000000 -1.000000 0.000000	{Verticle 0 - x,y,z}
0.923880 -1.000000 0.382683	{Vertice 1 - x,y,z}
0.707107 -1.000000 0.707107	{Vertice 2 - x,y,z}
3 0 1 2 25	
{The first number in the row indicates the number of points in the polygon.  The following three numbers tell you which three vertices, from the list, you must join.  The final number (25) is a number that you can use to store color information or in fact anything you want to about the polygon.  It could be a number into an array of textures for instance.}

The GEO file format was used by us because it is an easy file format to use and we had a lot of Lightwave generated objects that came with a converter to take the binary Lightwave file and output it to an ASCII GEO file.  There are several major modellers that you can create similar objects with.  Some examples would be 3D Studio, SoftImage and ElectricImage. The GEO file format is not widely used, but is similar in many respects to the PLG file format (PLG files can easily be edited into a GEO file format).  The PLG format was invented by the writers of the real-time renderer REND386 and has become quite a popular format.  You can find a large number of converters on the Internet that will take things like 3D Studio binary files and convert them to PLG.

You can find a lot of information on 3D modellers and converters at the following URL :

http://www.hit1.washington.edu/people/poup/internet/3D.html

'Listing 1' is the cube.geo file used by the sample application for article four. It is completely commented and has full explanations for all lines contained in the file. Below is the full implementation of the GEO file reader function. We have placed explanatory comments where appropriate.

function TGMP.LoadGeoObject(var AnObject : TObject3D; Filename : String) : Integer;
{Function accepts a TObject3D variable and a filename and returns a integer success/error code}
var
  GeoFile : System.Text; {GEO text file}
  Counter, X, Int1, Int2, Int3, Int4, Int5 : Integer; {Integer variables for reading in data}
  TextLine : String; {String variable for reading in a whole line of text}
  PointArray : array [0..MAXPOINTS] of TPoint3D; {Temp storage for reading in vertices up to MAXPOINTS = MAXPOLYS * 4}
begin
  {Try to open the GEO file - if it doesn't exist send back an error code}
  try
    AssignFile(GeoFile, Filename);
    Except
      Result := -1; {-1 means file doesn't exist}
      exit;
    end;
  Reset(GeoFile); {Sets the file up for reading}

  {Just read in the header and make sure this is a GEO file}
  ReadLn(GeoFile, TextLine);
  if TextLine <> '3DG1' then
    begin
      Result := -2; {-2 means file is not a valid GEO file}
      exit;
    end;

  {Now read in the number of Vertices into the variable counter}
  ReadLn(GeoFile, Counter);

  {Loop through all the vertices and store them in a temporary array}
  for x := 0 to Counter - 1 do
    begin
      Readln(GeoFile, PointArray[x].x, PointArray[x].y, PointArray[x].z);
    end;

  {Now insert the polygons into the Object and keep a count of how many there are}
  Counter := 0;
  while not EOF(GeoFile) do
    begin
      {Read in the polygon line - this tells us what vertices to join up and how many vertices there are in the polygon}		
      Readln(GeoFile, int1, int2, int3, int4, int5);
      with AnObject.PolyStore[Counter] do
        begin
          {Point 1 in the polygon}
          Point[0].X := PointArray[int2].X;
          Point[0].Y := PointArray[int2].Y;
          Point[0].Z := PointArray[int2].Z;
          {Point 2 in the polygon}
          Point[1].X := PointArray[int3].X;
          Point[1].Y := PointArray[int3].Y;
          Point[1].Z := PointArray[int3].Z;
          {Point 3 in the polygon}
          Point[2].X := PointArray[int4].X;
          Point[2].Y := PointArray[int4].Y;
          Point[2].Z := PointArray[int4].Z;
          if int1 = 4 then
            begin
              {Point 4 in the polygon}
              Point[3].X := PointArray[int5].X;
              Point[3].Y := PointArray[int5].Y;
              Point[3].Z := PointArray[int5].Z;
              {Record the number of points in this polygon}
              NumberPoints := 4;
            end
          else
            {Record the number of points in this polygon}
            NumberPoints := 3;
        end;

      {Increment counter to keep track of how many polygons we have}	
      inc(Counter);
    end;

  {Record the number of Polygons}
  AnObject.NumberPolys := Counter;

  {Close the file}
  CloseFile(GeoFile);

  {Return Success}
  Result := 1;

end;


World Coordinate System.
The last subject that we are going to cover in this article is the world coordinate system.  So far we have been using the local coordinate system and we have just added a Z value onto the local coordinates to move the object back and forth. We are now going to introduce the ability to move the object around.  As you saw earlier, when we listed the TObject3D structure, there was a PolyWorld array and a World TPoint3D structure.  The World holds the X, Y, Z position of the object in 3D space.  In addition, if you look back at the rmShadedTexture section of the RenderNow procedure you will see a procedure being called, namely LocalToWorld(Object3D).  This procedure copies all the polygon information from Polystore to Polyworld and adds the World's X,Y,Z coordinates onto the local coordinates as it copies them.  This means that we have translated the object from it's local coordinates to it's world coordinates. We won't list the LocalToWorld(Object3D) procedure here as it is fairly simple and is available with the source code. However, we have provided a visual comparison of Local to World coordinates in 'Figure 4'. 



Figure 4


A world of changes.
A lot of the code for TGMP has been changed in minor ways, for instance when the procedure RenderNow is called, all of the Polystore references have been changed to Polyworld to incorporate the world coordinate system.  Also, a call to the procedure LocalToWorld has been inserted into each of the TRendermode case statements.  A LightStrength property has been added to allow you to control the brightness of the light, a value of 1 is 100 percent.  Another property is an event called BeforeFlip which is sent to TCanvas as a parameter. This allows you to add any text/drawing on top of what has been rendered before it is drawn onto the Canvas of TGMP.  The necessary code for BeforeFlip is shown below along with the code to declare our new three mouse movement properties. These three mouse movement properties are the familiar OnMouseMove, OnMouseUp, and OnMouseDown that are used throughout most Delphi components. These mouse properties are defined similar to the Align property. They have already been declared in the class that TGMP was inherited from, so just a simple declaration will suffice to cause them to appear in the object inspector of TGMP. 

type
  TBeforeFlip = procedure (Canvas : TCanvas) of object;

  {Place in the private section}
  FBeforeFlip : TBeforeFlip;
  FLightStrength : Single;

  {Place as the first line in the TGMP.FlipBackPage procedure}
   If Assigned(FBeforeFlip) then FBeforeFlip(FBackBuffer.Canvas);

  {Place in the published section}
    property LightStength : Single read LightStrength write LightStrength;
    property BeforeFlip : TBeforeFlip read FBeforeFlip write FBeforeFlip;
    property OnMouseMove;
    property OnMouseDown;
    property OnMouseUp;

Other changes are that we have introduced are two new constants called MAXPOLYS and  MAXPOINTS. These constants control how many points and polygons we want to allow for TObject3D.  Other minor changes are, for instance, that the call in ClearBackPage is:      

  FDib.ClearBackPage(CalculateRGBWord(FColor));

which now uses the DIB class to do the work and you notice how we use the CalculateRGBWord function to return the 16bit value that the FDib.ClearBackPage requires.  There are a number of small changes throughout the code that are similar in nature to those already mentioned.  Merely looking through the source code for TGMP will show you the small differences between article 3 TGMP and article 4 TGMP because the comments in the source code readily draw your attention to them.


Our fourth application
In our fourth application we have added a new menu item to allow for the selection of various textures and introduced some limited movement control of the objects through the use of the mouse and keyboard. You should also notice rather quickly that the arrays for the objects have been removed. These arrays are no longer necessary as the objects are now read into memory through the use of the file reader that we have created. Once again, you must  remember to set your display driver to 16bit color rather than 256 color, otherwise you'll think that we have placed a mud texture onto the rendered objects!

'Listing 2' shows the complete source listing for our fourth application developed with the 'TGMP' component.


Conclusion
This has been a long article, and unfortunately we have had to leave a number of things out until the next article. However, we think this should be enough to keep you going until then.  Next month we are going to cover a number of topics that will make TGMP a truly useful games tool.  First we will add the final coordinate system; the Camera Coordinate System. This will allow you to move the camera through your virtual world.  We will also optimize the structure of the component to easily allow multiple objects to be seen at once.  In addition, we will cover many optimization techniques that will make TGMP process polygons at a much faster rate than now.  These optimization techniques include look-up tables, pre-calculation, fast multiplication techniques, clipping techniques, method parameter reduction, loop optimization, fixed point math's and a some common sense!  We are going to add a few design time features such as positioning of objects, setting a background bitmap and lightsource positioning.  Very soon we will be ready to make a game using TGMP. 'Listing 3' shows the complete code for TGMP.


Bio's :
Peter Dove: 
Peter Dove is a partner in Graphical Magick Productions. Graphical Magick Productions specializes in graphics, training and component development. He can be reached via the Internet at peterd@graphicalmagick.com. 

Don Peer: 
Don Peer is a Technical Associate with Greenway Group Holdings Incorporated (GGHI). He can be reached via the Internet at dpeer@mgl.ca. 


Listing 1

3DG1 { The header of a Geo File}
8 {How many vertices there are}
-1.000000 -1.000000 -1.000000 {Vertice 0}
-1.000000 1.000000 1.000000   {Vertice 1}
-1.000000 1.000000 -1.000000  {Vertice 2}
-1.000000 -1.000000 1.000000  {Vertice 3}
1.000000 -1.000000 -1.000000  {Vertice 4}
1.000000 1.000000 1.000000     {Vertice 5}
1.000000 1.000000 -1.000000    {Vertice 6}
1.000000 -1.000000 1.000000    {Vertice 7}

4 0 3 1 2 25 {Polygon 1}
{1st number in Polygon 1 is how many points there are.  Then follows which vertices to join up.
Join (Vertice 0) to (Vertice 3) to (Vertice 1) to (Vertice 2).
The number 25 can be used to specify a color}

4 4 0 2 6 25 {Polygon 2}
{1st number in Polygon 2 is how many points there are.  Then follows which vertices to join up.
Join (Vertice 4) to (Vertice 0) to (Vertice 2) to (Vertice 6).
The number 25 can be used to specify a color}

4 6 2 1 5 25 {Polygon 3}
{1st number in Polygon 3 is how many points there are.  Then follows which vertices to join up.
Join (Vertice 6) to (Vertice 2) to (Vertice 1) to (Vertice 5).
The number 25 can be used to specify a color}

4 5 1 3 7 25 {Polygon 4}
{1st number in Polygon 4 is how many points there are.  Then follows which vertices to join up.
Join (Vertice 5) to (Vertice 1) to (Vertice 3) to (Vertice 7).
The number 25 can be used to specify a color}

4 7 3 0 4 25 {Polygon 5}
{1st number in Polygon 5 is how many points there are.  Then follows which vertices to join up.
Join (Vertice 7) to (Vertice 3) to (Vertice 0) to (Vertice 4).
The number 25 can be used to specify a color}

4 4 6 5 7 25 {Polygon 6}
{1st number in Polygon 6 is how many points there are.  Then follows which vertices to join up.
Join (Vertice 4) to (Vertice 6) to (Vertice 5) to (Vertice 6).
The number 25 can be used to specify a color}


Listing 2

unit Article4;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  gmp, ExtCtrls, Menus, StdCtrls;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    Object1: TMenuItem;
    Cube1: TMenuItem;
    Pyramid1: TMenuItem;
    RenderMode1: TMenuItem;
    Wireframe1: TMenuItem;
    Solid1: TMenuItem;
    SolidShading1: TMenuItem;
    SolidTextured1: TMenuItem;
    Timer1: TTimer;
    Sphere1: TMenuItem;
    ShadedTexture1: TMenuItem;
    Textures1: TMenuItem;
    Texture1: TMenuItem;
    Texture2: TMenuItem;
    Texture3: TMenuItem;
    Texture4: TMenuItem;
    Panel1: TPanel;
    GMP1: TGMP;
    Asteriod1: TMenuItem;
    Texture5: TMenuItem;
    Texture6: TMenuItem;
    Texture7: TMenuItem;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure GMP1BeforeFlip(Canvas: TCanvas);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure GMP1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure GMP1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure GMP1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Cube1Click(Sender: TObject);
    procedure Pyramid1Click(Sender: TObject);
    procedure Sphere1Click(Sender: TObject);
    procedure Asteriod1Click(Sender: TObject);
    procedure Wireframe1Click(Sender: TObject);
    procedure Solid1Click(Sender: TObject);
    procedure SolidShading1Click(Sender: TObject);
    procedure SolidTextured1Click(Sender: TObject);
    procedure ShadedTexture1Click(Sender: TObject);
    procedure Texture1Click(Sender: TObject);
    procedure Texture2Click(Sender: TObject);
    procedure Texture3Click(Sender: TObject);
    procedure Texture4Click(Sender: TObject);
    procedure Texture5Click(Sender: TObject);
    procedure Texture6Click(Sender: TObject);
    procedure Texture7Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);

  private
    { Private declarations }
  public
    { Public declarations }
    Pyramid : TObject3D;
    Cube : TObject3D;
    Asteriod : TObject3D;
    CurrentObject : TPObject3D;
    MyBitmap : TBitmap;
    Sphere : TObject3D;
    LastY, LastX : Integer;
    blnLeftMouse, blnRightMouse : Boolean;
    procedure ClearMenuCheck(MenuItem : String);
    procedure TextureSelectionUpdate(TextureItem : TMenuItem; selectedBmp : String);
  end;
var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  GMP1.ClearBackPage;
  GMP1.Rotate(1,1,0,0.1, CurrentObject^);
  GMP1.RenderNow(CurrentObject^);
  GMP1.FlipBackPage;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  blnLeftMouse := False;
  blnRightMouse := False;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  {Load the Sphere}
  GMP1.LoadGeoObject(Sphere, ExtractFilePath(Application.ExeName) + 'sph-96.geo');
  GMP1.ChangeObjectColor(Sphere, RGB(100, 100, 0));
  Sphere.World.X := 0;
  Sphere.World.Y := 0;
  Sphere.World.Z := -3;

  {Load the Asteriod}
  GMP1.LoadGeoObject(Asteriod, ExtractFilePath(Application.ExeName) + 'Asteriod.geo');
  GMP1.ChangeObjectColor(Asteriod, RGB(100, 100, 0));
  Asteriod.World.X := 0;
  Asteriod.World.Y := 0;
  Asteriod.World.Z := -6;

  {Load the pyramid}
  GMP1.LoadGeoObject(Pyramid, ExtractFilePath(Application.ExeName) + 'cone.geo');
  GMP1.ChangeObjectColor(Pyramid, RGB(100, 100, 0));
  Pyramid.World.X := 0;
  Pyramid.World.Y := 0;
  Pyramid.World.Z := -8;

  {Load the cube}
  GMP1.LoadGeoObject(Cube, ExtractFilePath(Application.ExeName) + 'cube.geo');
  GMP1.ChangeObjectColor(Cube, RGB(100, 100, 0));
  Cube.World.X := 0;
  Cube.World.Y := 0;
  Cube.World.Z := -7;

  {Load the cube}
  CurrentObject := @Cube;

  MyBitmap := TBitmap.Create;
  MyBitmap.LoadfromFile(ExtractFilePath(Application.ExeName) + 'texture1.bmp');
  GMP1.SetCurrentBitmap(MyBitmap);
  MyBitmap.Free;
  Timer1.enabled := true;
end;

procedure TForm1.GMP1BeforeFlip(Canvas: TCanvas);
begin
  Canvas.Font.Name := 'Arial';
  Canvas.Font.Style := [fsBold, fsItalic];
  Canvas.Font.Size := 26;
  Canvas.Brush.Style := bsClear;
  Canvas.Font.Color := clyellow;
  Canvas.Textout (60, 5, 'This is TGMP');
  Canvas.Font.Size := 12;
  Canvas.Font.Color := clWhite;
  Canvas.Textout (60, GMP1.Height - 40, '(Applied using the BeforeFlip event)');
  Canvas.Brush.Style := bsSolid;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_UP then CurrentObject^.World.Y := CurrentObject^.World.Y + 0.05;
  if Key = VK_DOWN then CurrentObject^.World.Y := CurrentObject^.World.Y - 0.05;
end;

procedure TForm1.GMP1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbRight then blnRightMouse := False;
  if Button = mbLeft then blnLeftMouse := False;
end;

procedure TForm1.GMP1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbRight then blnRightMouse := True;
  if Button = mbLeft then blnLeftMouse := True;
end;

procedure TForm1.GMP1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if (blnLeftMouse = True) and (blnRightMouse = true) then
    begin
      if LastY < Y then
        begin
          CurrentObject^.World.Z := CurrentObject^.World.Z + 0.25;
        end;
      if LastY > Y then
        begin
          CurrentObject^.World.Z := CurrentObject^.World.Z - 0.25;
        end;
      if LastX < (X - 2) then
        begin
          CurrentObject^.World.X := CurrentObject^.World.X - 0.05;
        end;
      if LastX > (X + 2) then
        begin
          CurrentObject^.World.X := CurrentObject^.World.X + 0.05;
        end;
    end;
    LastY := Y;
    LastX := X;
end;

procedure TForm1.Cube1Click(Sender: TObject);
begin
  if Cube1.Checked = True then
    exit;

  ClearMenuCheck(Object1.Name);
  Cube1.Checked := True;
  CurrentObject := @cube;
end;

procedure TForm1.Pyramid1Click(Sender: TObject);
begin
  if Pyramid1.Checked = True then
    exit;

  ClearMenuCheck(Object1.Name);
  Pyramid1.Checked := True;
  CurrentObject := @pyramid;
end;

procedure TForm1.Sphere1Click(Sender: TObject);
begin
  if Sphere1.Checked = True then
    exit;
  ClearMenuCheck(Object1.Name);
  Sphere1.Checked := True;
  CurrentObject := @sphere;
end;

procedure TForm1.Asteriod1Click(Sender: TObject);
begin
  if Asteriod1.Checked = True then
    exit;
  ClearMenuCheck(Object1.Name);
  Asteriod1.Checked := True;
  CurrentObject := @Asteriod;
end;

procedure TForm1.Wireframe1Click(Sender: TObject);
begin
  GMP1.RenderMode := rmWireframe;
  ClearMenuCheck(RenderMode1.Name);
  Wireframe1.Checked := True;
end;

procedure TForm1.Solid1Click(Sender: TObject);
begin
  GMP1.RenderMode := rmSolid;
  ClearMenuCheck(RenderMode1.Name);
  Solid1.Checked := True;
end;

procedure TForm1.SolidShading1Click(Sender: TObject);
begin
  GMP1.RenderMode := rmSolidShade;
  ClearMenuCheck(RenderMode1.Name);
  SolidShading1.Checked := True;
end;

procedure TForm1.SolidTextured1Click(Sender: TObject);
begin
  GMP1.RenderMode := rmSolidTexture;
  ClearMenuCheck(RenderMode1.Name);
  SolidTextured1.Checked := True;
end;

procedure TForm1.ShadedTexture1Click(Sender: TObject);
begin
  GMP1.RenderMode := rmShadedTexture;
  ClearMenuCheck(RenderMode1.Name);
  ShadedTexture1.Checked := True;
end;

procedure TForm1.Texture1Click(Sender: TObject);
begin
  TextureSelectionUpdate(Texture1, 'texture1.bmp');
end;

procedure TForm1.Texture2Click(Sender: TObject);
begin
  TextureSelectionUpdate(Texture2, 'texture2.bmp');
end;

procedure TForm1.Texture3Click(Sender: TObject);
begin
  TextureSelectionUpdate(Texture3, 'texture3.bmp');
end;

procedure TForm1.Texture4Click(Sender: TObject);
begin
  TextureSelectionUpdate(Texture4, 'texture4.bmp');
end;

procedure TForm1.Texture5Click(Sender: TObject);
begin
  TextureSelectionUpdate(Texture5, 'texture5.bmp');
end;

procedure TForm1.Texture6Click(Sender: TObject);
begin
  TextureSelectionUpdate(Texture6, 'texture6.bmp');
end;

procedure TForm1.Texture7Click(Sender: TObject);
begin
  TextureSelectionUpdate(Texture7, 'texture7.bmp');
end;

procedure TForm1.ClearMenuCheck(MenuItem : String);
var
  Count : Integer;
begin
  {Clear the Menu Checkmarks}
  for Count := 0 to Form1.ComponentCount -1 do
    if Form1.Components[Count] is TMenuItem then
      if TMenuItem(Components[Count]).Parent.Name = MenuItem then
        begin
          TMenuItem(Components[Count]).Checked := False;
        end;
end;

procedure TForm1.TextureSelectionUpdate(TextureItem : TmenuItem; SelectedBmp : String);
begin
  MyBitmap := TBitmap.Create;
  MyBitmap.LoadfromFile(ExtractFilePath(Application.ExeName) + SelectedBmp);
  GMP1.SetCurrentBitmap(MyBitmap);
  ClearMenuCheck(Textures1.Name);
  TextureItem.Checked := True;
  MyBitmap.Free;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  Timer1.enabled := False;
  Application.ProcessMessages;
  Timer1.enabled := True;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Timer1.Enabled := False;
end;

end.

Listing 3

unit gmp;

interface

uses
  Windows, Messages, WinProcs, WinTypes, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, stdctrls, ExtCtrls, DIB16;

const
  {You can just change these constants instead of hunting through the code
  to restrict the number of polygons.  The MaxPoints should allways be 4*
  the number of MaxPolys}
  MAXPOLYS = 100;
  MAXPOINTS = 400;

type

TRenderMode = (rmWireframe, rmSolid, rmSolidShade, rmSolidTexture, rmShadedTexture);

TYBucket = record
  StartX, EndX : Integer;
end;

TTextureBucket = record
  StartPosition, EndPosition : TPoint;
end;

TPoint3D = record
  X, Y, Z : single;
end;

TLine3D = record
  StartPoint, EndPoint : TPoint3D;
end;

TPolygon = record
  Point : array [0..3] of TPoint3D; {only allow polygons for now if to 4 points}
  NumberPoints : Integer;
  Visible : Boolean;
  AverageZ : Single;
  PolyColor : TColor;  {Color of the polygon}
  DibColor : Word;     {Word color value of PolyColor}
  Intensity : Byte;    {The light intensity of the polygon}
end;

TObject3D = record
  PolyStore  : array [0..MAXPOLYS] of TPolygon; {Stores the local coordinates}
  PolyWorld  : array [0..MAXPOLYS] of TPolygon; {Stores the world coordinates}
  NumberPolys : Integer; {Number of Polygons}
  Color : Tcolor; {Color of whole object - used in wireframe and solid color modes}
  DibColor : Word; {16bit color of whole object - used in wireframe and solid color modes}
  World : TPoint3D; {Position of the object in the world}
end;

TPObject3D = ^TObject3D; {Pointer to TObject3D}

TBeforeFlip = procedure (Canvas : TCanvas) of object; {Declaration for an event}

TBitmapStorage = array [0..127, 0..127] of Word; {Declaration for Bitmap Storage}

TGMP = class(TCustomControl)
  private
    { Private declarations }
    FCurrentBitmap : TBitmapStorage; {Storage for the current bitmap}
    FDib : TDib16Bit; {The DIB class back buffer}
    FAlign: TAlign; {Alignment of TGMP window}
    FBeforeFlip : TBeforeFlip; {Flip event member}
    FBackBuffer : TBitmap;  {Used to assign the FDIB handle to for use with the GDI}
    FColor : TColor;  {Used to hold a temporary color value in drawing polygons}
    FDibColor : Word; {Used to hold a temporary color value in drawing polygons}
    FIntensity : Byte; {Used to hold a temporary light intensity value in drawing polygons}
    ViewWidth, ViewHeight : Integer;
    FRenderMode : TRenderMode;
    HalfScreenWidth, HalfScreenHeight, ViewingDistance : Integer;
    FPointer : Pointer;
    YBuckets : array [0..479] of TYBucket; {480 being the most we will allow the screen height to go up to}
    TextureBuckets : array [0..479] of TTextureBucket; {480 being the most we will allow the screen height to go up to}
    IntensityLUT : Array [0..31, 0..31] of Integer; {The light intensity lookup table}
    ViewPoint, LightSource : TPoint3D; {LightSource and Viewpoint positions}
    FLightStrength : Single;
    AmbientLight : Integer; {The amount of ambient light in the scene}
    procedure DrawLine3D(X1, Y1, Z1, X2, Y2, Z2 : Single);
    procedure DrawLine2DWireframe(X1, Y1, X2, Y2 : Integer);
    procedure DrawLine2DSolid(X1, Y1, X2, Y2 : Integer);
    procedure SetBackColor(Value : TColor);
    procedure GetVector3D(var EndPoint, StartPoint, Vector : TPoint3D);
    procedure CrossProduct(var U, V, Normal : TPoint3D);
    procedure GetNormal(var P1, P2, P3, normal : TPoint3D);
    function VectorMagnitude(var Normal : TPoint3D) : single;
    function DotProduct(var U, V : TPoint3D) : single;
    procedure RemoveBackfacesAndShade(var AnObject : TObject3D);
    procedure ClearYBuckets;
    procedure DrawHorizontalLine (Y, X1, X2 : Integer) ;
    procedure RenderYBuckets ;
    procedure OrderZ(var Object3D : TObject3D);
    procedure Paint; Override;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure DrawLine3DTexture(var StartPoint, EndPoint : TPoint3D; var TextStart, TextEnd : TPoint);
    procedure DrawLine2DTexture(var StartPoint, EndPoint, TextStart, TextEnd : TPoint);
    function CalculateRGBWord(Color : TColor) : Word;
    procedure LocalToWorld(var AnObject : TObject3D);
    Procedure CalcIntensityLUT;
    function GetShadedWord (Texture : Word; Intensity : Integer) : Word;
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner : TComponent) ; override;
    destructor Destroy; override;
    procedure ClearBackPage;
    procedure RenderNow(var Object3D : TObject3D);
    procedure FlipBackPage;
    procedure Rotate(X, Y, Z, Angle : Single; var Object3D : TObject3D);
    procedure ChangeObjectColor(var Object3D : TObject3D; Color : TColor);
    procedure SetLightSourcePosition(Position, Direction : TPoint3D);
    procedure SetCurrentBitmap(Bitmap : TBitmap);
    function LoadGeoObject(var AnObject : TObject3D; Filename : String) : Integer;
  published
    { Published declarations }
    property Align;
    property LightStrength : Single read FLightStrength write FLightStrength;
    property BackColor : TColor read FColor write SetBackColor;
    property RenderMode : TRenderMode read FRenderMode write FRenderMode;
    property BeforeFlip : TBeforeFlip read FBeforeFlip write FBeforeFlip;
    property OnMouseMove;
    property OnMouseDown;
    property OnMouseUp;
  end;

procedure Register;

implementation

function TGMP.GetShadedWord (Texture : Word; Intensity : Integer) : Word;
var
  intRed, intGreen, intBlue : Integer;
  intBitMask : Integer;
begin
  {Bitmask for 0000000000011111 is 31 - this gives us the last 5 bits for Blue}
  intBitMask := 31;
  intBlue := Texture and intBitMask;

  {Bitmask for 0000001111100000 is 992 - this gives us the the middle 5 bits for Green}
  intBitMask := 992;
  intGreen := Texture and intBitMask;
  intGreen := intGreen shr 5;

  {Bitmask for 0111110000000000 is 31744 - this gives the the bits for the Red element - bits 15-11}
  intBitMask := 31744;
  intRed := Texture and intBitMask;
  intRed := intRed shr 10;

  {Now get the new shades - this uses the lookup table that we worked out previously}
  intRed := IntensityLUT[intRed, Intensity];
  intGreen := IntensityLUT[intGreen, Intensity];
  intBlue := IntensityLUT[intBlue, Intensity];

  {Lastly we just shift the Red and Green into their correct places and add all the elements together}
  intRed := intRed shl 10;
  intGreen := intGreen shl 5;

  result := intRed + intBlue + intGreen;
end;

Procedure TGMP.CalcIntensityLUT;
var
  X, Y: Integer;
  UpIncrement, DownIncrement : Single;
begin
  {loop through for every possible R,G or B Value - 0 to 31}
  for X := 0 to 31 do
    begin
      {The up increment is from the initial color value to it's brightest}
      UpIncrement := (31 - X) / 16;
      {The down increment is from the initial color value to it's darkest}
      DownIncrement := X / 15;
      {Loops through from color 0 to color 15 using the downincrement}
      for Y := 0 to 15 do
        begin
          IntensityLUT[X, Y] := Round(DownIncrement * Y);
        end;
      {Loops through from color 16 to color 31 using the UpIncrement}
      for Y := 1 to 16 do
        begin
          IntensityLUT[X, Y + 15] := Round((DownIncrement * 15) + (UpIncrement * Y));
        end;
    end;
end;

procedure TGMP.LocalToWorld(var AnObject : TObject3D);
var
  X : Integer;
begin
  {Loops though all of the polygons transfering them to Polyworld adding the world
  coordinates to the local coordinates}
  for X := 0 to AnObject.NumberPolys -1 do
    begin
      AnObject.PolyWorld[X] := AnObject.PolyStore[X];

      AnObject.PolyWorld[X].Point[0].X := AnObject.PolyStore[X].Point[0].X + AnObject.World.X;
      AnObject.PolyWorld[X].Point[0].Y := AnObject.PolyStore[X].Point[0].Y + AnObject.World.Y;
      AnObject.PolyWorld[X].Point[0].Z := AnObject.PolyStore[X].Point[0].Z + AnObject.World.Z;

      AnObject.PolyWorld[X].Point[1].X := AnObject.PolyStore[X].Point[1].X + AnObject.World.X;
      AnObject.PolyWorld[X].Point[1].Y := AnObject.PolyStore[X].Point[1].Y + AnObject.World.Y;
      AnObject.PolyWorld[X].Point[1].Z := AnObject.PolyStore[X].Point[1].Z + AnObject.World.Z;

      AnObject.PolyWorld[X].Point[2].X := AnObject.PolyStore[X].Point[2].X + AnObject.World.X;
      AnObject.PolyWorld[X].Point[2].Y := AnObject.PolyStore[X].Point[2].Y + AnObject.World.Y;
      AnObject.PolyWorld[X].Point[2].Z := AnObject.PolyStore[X].Point[2].Z + AnObject.World.Z;

      AnObject.PolyWorld[X].Point[3].X := AnObject.PolyStore[X].Point[3].X + AnObject.World.X;
      AnObject.PolyWorld[X].Point[3].Y := AnObject.PolyStore[X].Point[3].Y + AnObject.World.Y;
      AnObject.PolyWorld[X].Point[3].Z := AnObject.PolyStore[X].Point[3].Z + AnObject.World.Z;

      AnObject.PolyWorld[X].Intensity := AnObject.PolyStore[X].Intensity;
      AnObject.PolyWorld[X].NumberPoints := AnObject.PolyStore[X].NumberPoints;
      AnObject.PolyWorld[X].Visible := AnObject.PolyStore[X].Visible;
      AnObject.PolyWorld[X].AverageZ := AnObject.PolyStore[X].AverageZ;
      AnObject.PolyWorld[X].PolyColor := AnObject.PolyStore[X].PolyColor;
      AnObject.PolyWorld[X].DibColor := AnObject.PolyStore[X].DibColor;
    end;
end;

function TGMP.LoadGeoObject(var AnObject : TObject3D; Filename : String) : Integer;
{function accepts a TObject3D variable and a filename and returns a integer succes/error code}
var
  GeoFile : System.Text; {Geo text file}
  Counter, X, Int1, Int2, Int3, Int4, Int5 : Integer; {Integer variables for reading in data}
  TextLine : String; {String variable for reading in a whole line of text}
  PointArray : array [0..MAXPOINTS] of TPoint3D; {Temp storage for reading in vertices up to MAXPOINTS = MAXPOLYS * 4}
begin
  {Try to open the geo file - if it doesn't exist send back an error code}
  try
    AssignFile(GeoFile, Filename);
    except
      Result := -1; {-1 means file doesn't exist}
      exit;
    end;
  Reset(GeoFile); {Sets the file up for reading}

  {Just read in the header and make sure this is a geo file}
  ReadLn(GeoFile, TextLine);
  if TextLine <> '3DG1' then
    begin
      Result := -2; {-2 means file is not a valid GEO file}
      exit;
    end;

  {Now read in the number of Vertices into the variable counter}
  ReadLn(GeoFile, Counter);

  {loop through all the vertices and store them in a temporary array}
  for X := 0 to Counter - 1 do
    begin
      Readln(GeoFile, PointArray[x].x, PointArray[x].y, PointArray[x].z);
    end;

  {Now insert the polygons into the Object and keep a count of how many there are}
  Counter := 0;
  while not EOF(GeoFile) do
    begin
      {Read in the polygon line - this tells us what vertices to join up and how many vertices there are in the polygon}
      Readln(GeoFile, int1, int2, int3, int4, int5);
      with AnObject.PolyStore[Counter] do
        begin
          {Point 1 in the polygon}
          Point[0].X := PointArray[int2].X;
          Point[0].Y := PointArray[int2].Y;
          Point[0].Z := PointArray[int2].Z;
          {Point 2 in the polygon}
          Point[1].X := PointArray[int3].X;
          Point[1].Y := PointArray[int3].Y;
          Point[1].Z := PointArray[int3].Z;
          {Point 3 in the polygon}
          Point[2].X := PointArray[int4].X;
          Point[2].Y := PointArray[int4].Y;
          Point[2].Z := PointArray[int4].Z;
          if int1 = 4 then
            begin
              {Point 4 in the polygon}
              Point[3].X := PointArray[int5].X;
              Point[3].Y := PointArray[int5].Y;
              Point[3].Z := PointArray[int5].Z;
              {Record the number of points in this polygon}
              NumberPoints := 4;
            end
          else
            {Record the number of points in this polygon}
            NumberPoints := 3;
      end;
    {Increment counter to keep track of how many polygons we have}
    inc(Counter);
    end;

  {Record the number of Polygons}
  AnObject.NumberPolys := Counter;

  {Close the file}
  CloseFile(GeoFile);

  {Return Success}
  Result := 1;
end;

function TGMP.CalculateRGBWord(Color : TColor) : Word;
var
  Calc : Single;
  R,G,B : Integer;
begin
  {GetRValue, GetGValue, GetBValue return a value which is based on the color scale of  0 to 255}

  {This gets the red value and rescales it from a 1/256 number to a 0/31 number}
  Calc := GetRValue(Color) / 2.56;
  Calc := Calc * 0.31;
  R := Round(Calc);

  {This gets the green value and rescales it from a 1/256 number to a 0/31 number}
  Calc := GetGValue(Color) / 2.56;
  Calc := Calc * 0.31;
  G := Round(Calc);

  {This gets the red value and rescales it from a 1/256 number to a 0/31 number}
  Calc := GetBValue(Color) / 2.56;
  Calc := Calc * 0.31;
  B := Round(Calc);

  {The B Value is the last 5 bits so it can be left alone}
  {R must be shifted left by 10 bits so that it sits at the position 15-11}
  R := R shl 10;
  {G must be shifted to the left 5 bits so that it sits at the position 10..6}
  G := G shl 5;
  {Then just add them together}
  Result := R + G + B;
end;

procedure TGMP.DrawLine3DTexture(var StartPoint, EndPoint : TPoint3D; var TextStart, TextEnd : TPoint);
var
  NewStartPoint, NewEndPoint : TPoint;
begin
  {We no longer need to have the property Z distance because that is all included in the
  world coordinate system}
  NewStartPoint.X := HalfScreenWidth + Round(StartPoint.X * ViewingDistance / (StartPoint.Z));
  NewStartPoint.Y := Round(HalfScreenHeight - StartPoint.Y * ViewingDistance / (StartPoint.Z));
  NewEndPoint.X := HalfScreenWidth + Round(EndPoint.X * ViewingDistance / (EndPoint.Z));
  NewEndPoint.Y := round(HalfScreenHeight - EndPoint.Y * ViewingDistance / (EndPoint.Z));
  case RenderMode of
    rmSolidTexture : DrawLine2DTexture(NewStartPoint, NewEndPoint, TextStart, TextEnd);
    rmShadedTexture : DrawLine2DTexture(NewStartPoint, NewEndPoint, TextStart, TextEnd);
  end;
end;

procedure TGMP.DrawLine2DTexture(var StartPoint, EndPoint, TextStart, TextEnd : TPoint);
var
  CurrentX, XIncr : Single;
  TextX, TextY, TextXIncr, TextYIncr : Single;
  Y , Length : Integer;
  TempPoint : TPoint;
begin
  {No point in drawing horizontal lines! The rest of the polygon will define the edges}
  if StartPoint.Y = EndPoint.Y then exit;

  {Swap if Y1 is less than Y2 so we are always drawing from top to bottom}
  if EndPoint.Y < StartPoint.Y then
    begin
      TempPoint.X := StartPoint.X;
      TempPoint.Y := StartPoint.Y;
      StartPoint.X  := EndPoint.X;
      StartPoint.Y  := EndPoint.Y;
      EndPoint.X  := TempPoint.X;
      EndPoint.Y  := TempPoint.Y;
      TempPoint.X := TextEnd.X;
      TempPoint.Y := TextEnd.Y;
      TextEnd.X := TextStart.X;
      TextEnd.Y := TextStart.Y;
      TextStart.X := TempPoint.X;
      TextStart.Y := TempPoint.Y;
    end;

  Length := (EndPoint.Y - StartPoint.Y) + 1;

  {Xincr is how much the X must increment though each Y increment.}
  XIncr := (EndPoint.X - StartPoint.X) / Length;
  CurrentX := StartPoint.X;

  {Work out the TextX Increment and TextY Increment}
  TextXIncr := (TextEnd.X - TextStart.X) / Length;
  TextYIncr := (TextEnd.Y - TextStart.Y) / Length;
  TextX := TextStart.X;
  TextY := TextStart.Y;

  {Now to loop through the Y Values and fill up the Y buckets}
  for Y := StartPoint.y to EndPoint.y do
    begin
      {Basic Y Clipping}
      if (Y < 0) or (Y > ViewHeight) then
        begin
          TextX := TextX + TextXIncr;
          TextY := TextY + TextYIncr;
          CurrentX := CurrentX + XIncr;
          Continue;
        end;
      {All Y buckets are initialized to -16000}
      if YBuckets[Y].StartX = -16000 then
        begin
	  YBuckets[Y].StartX := Round(CurrentX);
	  YBuckets[Y].EndX := Round(CurrentX);
          TextureBuckets[Y].StartPosition.X := Round(TextX);
          TextureBuckets[Y].StartPosition.Y := Round(TextY);
          TextureBuckets[Y].EndPosition.X := Round(TextX);
          TextureBuckets[Y].EndPosition.Y := Round(TextY);
	end
      else
        begin
          if CurrentX > YBuckets[Y].EndX then
            begin
              YBuckets[Y].EndX := Round(CurrentX);
              TextureBuckets[Y].EndPosition.X := Round(TextX);
              TextureBuckets[Y].EndPosition.Y := Round(TextY);
            end;
          if CurrentX < YBuckets[Y].StartX then
            begin
              YBuckets[Y].StartX := Round(CurrentX);
              TextureBuckets[Y].startPosition.X := Round(TextX);
              TextureBuckets[Y].startPosition.Y := Round(TextY);
            end;
	end;
      CurrentX := CurrentX + XIncr;
      TextX := TextX + TextXIncr;
      TextY := TextY + TextYIncr;
    end;
end;

procedure TGMP.Paint;
begin
  inherited;
  {New ClearBackPage using the DIB class' methods.  Notice that it now passed
  a 16bit color value rather than a TColor}
  FDib.ClearBackPage(CalculateRGBWord(FColor));
  FlipBackPage;
end;

procedure TGMP.SetBackColor(Value : TColor);
begin
  FColor := Value;
  Paint;
end;

procedure TGMP.WMSize(var Message: TWMSize);
begin
  Inherited;
  {Check height does not exceed our allow maximim}
  If Height > 480 then Height := 480;

  {Get the height and width of the window}
  ViewHeight := Height;
  ViewWidth := Width;

  {set the bitmaps height}
  FBackBuffer.Height := ViewHeight;
  FBackBuffer.Width := ViewWidth;

  {Set up viewport}
  HalfScreenHeight := ViewHeight div 2;
  HalfScreenWidth := ViewWidth div 2;

  {Free's the current DIB}
  FDib.Free;
  {Set's it up with the new Height and Width}
  FDib := TDib16Bit.Create(ViewHeight, ViewWidth);
  {Set FDib's bitmap handle to a FBackBuffer for use with the
  BeforeFlip event}
  FBackBuffer.Handle  := FDib.GetHandle;
end;

procedure TGMP.SetCurrentBitmap(Bitmap : TBitmap);
var
  X, Y : Integer;
begin
  {The FCurrentBitmap now holds the coverted 16bit values rather
  than the TColor values}
  for X := 0 to 127 do
    for Y := 0 to 127 do
      FCurrentBitmap[x,y] := CalculateRGBWord(Bitmap.Canvas.Pixels[X,Y]);
end;

procedure TGMP.OrderZ(var Object3D : TObject3D);
var
  X, Y : Integer;
  Temp : TPolygon;
begin
  for Y := 0 to Object3D.NumberPolys - 1 do
    begin
      if Object3D.PolyStore[Y].NumberPoints = 3 then
        Object3D.PolyStore[Y].AverageZ := (Object3D.PolyStore[Y].Point[0].Z + Object3D.PolyStore[Y].Point[1].Z +
                                           Object3D.PolyStore[Y].Point[2].Z) * 0.333;

      if Object3D.PolyStore[Y].NumberPoints = 4 then
        Object3D.PolyStore[Y].AverageZ := (Object3D.PolyStore[Y].Point[0].Z + Object3D.PolyStore[Y].Point[1].Z +
                                           Object3D.PolyStore[Y].Point[2].Z + Object3D.PolyStore[Y].Point[2].Z) * 0.25;
    end;

  for X := 0 to Object3D.NumberPolys - 1 do
    for Y := 0 to Object3D.NumberPolys - 2 do
      begin
        if Object3D.PolyStore[Y].AverageZ > Object3D.PolyStore[Y + 1].AverageZ then
          begin
            Temp := Object3D.Polystore[Y];
            Object3D.PolyStore[Y] := Object3D.PolyStore[Y + 1];
            Object3D.PolyStore[Y + 1] := Temp;
          end;
      end;
end;

procedure TGMP.SetLightSourcePosition(Position, Direction : TPoint3D);
var
  Result : TPoint3D;
  Length : Single;
begin
  GetVector3D(Position, Direction, Result);
  Length := VectorMagnitude(Result);
  Result.X := Result.X / Length;
  Result.Y := Result.Y / Length;
  Result.Z := Result.Z / Length;
  LightSource.X := Result.X;
  LightSource.Y := Result.Y;
  LightSource.Z := Result.Z;
end;

procedure TGMP.GetVector3D(var EndPoint, StartPoint, Vector : TPoint3D);
begin
  Vector.X := EndPoint.x - StartPoint.X;
  Vector.y := EndPoint.y - StartPoint.y;
  Vector.z := EndPoint.z  - StartPoint.z;
end;

procedure TGMP.CrossProduct(var U, V, Normal : TPoint3D);
begin
  Normal.X := (V.Y * U.Z - V.Z * U.Y);
  Normal.Y := -(V.X * U.Z  - V.Z * U.X);
  Normal.Z := (V.X * U.Y - V.Y * U.X);
end;

procedure TGMP.GetNormal(var P1, P2, P3, Normal : TPoint3D);
var
  U, V : TPoint3D;
begin
  GetVector3D(P2, P1, U);
  GetVector3D(P3, P1, V);
  CrossProduct(U, V, Normal);
end;

function TGMP.VectorMagnitude(var Normal : TPoint3D) : single;
var
  X1 : single;
begin
  X1 := sqrt((Normal.X * Normal.X) + (Normal.Y * Normal.Y) + (Normal.Z * Normal.Z));
  {Makes sure that the result is not zero - this is to avoid any divide by zero errors}
  if X1 = 0 then
    X1 := 0.0000001;

  result := X1;
end;

function TGMP.DotProduct(var U, V : TPoint3D) : single;
begin
  Result := (((U.X * V.X) + (U.Y * V.Y) + (U.Z * V.Z)));
end;

procedure TGMP.RemoveBackfacesAndShade(var AnObject : TObject3D);
var
  CurrentPoly : LongInt;
  Dp, Intensity : single;
  Sight, Normal : TPoint3D;
  R, G, B : LongInt;
begin
  for CurrentPoly := 0 to AnObject.NumberPolys - 1 do
    begin
      {Calculate the line of sight vector (from veiwpoint to a point on the polygon}
      Sight.X := ViewPoint.X - (AnObject.PolyStore[CurrentPoly].Point[0].X - AnObject.World.X);
      Sight.Y := ViewPoint.Y - (AnObject.PolyStore[CurrentPoly].Point[0].Y - AnObject.World.Y);
      Sight.Z := ViewPoint.Z - (AnObject.PolyStore[CurrentPoly].Point[0].Z - AnObject.World.Z);

      {Get a normal to the current polygon}
      GetNormal(AnObject.PolyStore[CurrentPoly].Point[0], AnObject.PolyStore[CurrentPoly].Point[1],
      AnObject.PolyStore[CurrentPoly].Point[2], Normal);

      {Now calculate the dot product for the line of sight vector and the normal to the polygon}
      Dp := DotProduct(Normal, Sight);

      {If the dot product is greater than zero then the polygon is visible from the viewpoint}
      if dp > 0 then
        begin
          AnObject.PolyStore[CurrentPoly].Visible := True;

          {Now find the dot product of the light source vector and the normal of the polygon}
          Dp := DotProduct(Normal, LightSource);

          {Now to work out the intensity of the light striking the polygons based on the angle that the light
          hits the polygon}
          Intensity := Dp * (31 / VectorMagnitude(Normal) ) * LightStrength; {LightStrength is defined as 1}
          if Intensity < 0 then
            Intensity := 0;

          {Now add the ambient light to the Intensity}
          Intensity := Intensity + AmbientLight;
          if Intensity > 31 then
            Intensity := 31;

          R := Round(((255 - GetRValue(AnObject.Color)) / 31)  * Intensity) + GetRValue(AnObject.Color);
          G := Round(((255 - GetGValue(AnObject.Color)) / 31)  * Intensity) + GetGValue(AnObject.Color);
          B := Round(((255 - GetBValue(AnObject.Color)) / 31)  * Intensity) + GetBValue(AnObject.Color);

          if R < 0 then
            R := 0;
          if R > 255 then
            R := 255;
          if G < 0 then
            G := 0;
          if G > 255 then
            G := 255;
          if B < 0 then
            B := 0;
          if B > 255 then
            B := 255;

          AnObject.PolyStore[CurrentPoly].Intensity := Round(Intensity);
          AnObject.PolyStore[CurrentPoly].PolyColor := RGB(R, G, B);
          AnObject.PolyStore[CurrentPoly].DibColor := CalculateRGBWord(RGB(R, G, B));
        end
      else
        begin
	{Polygon is not visible}
        AnObject.polystore[CurrentPoly].Visible := False;
        end;
    end;
end;

procedure TGMP.ClearYBuckets;
var
  X : Integer;
begin
  for X := 0 to 479 do
    YBuckets[X].StartX := -16000;
end;

procedure TGMP.DrawHorizontalLine (Y, X1, X2 : Integer) ;
begin
  {This now uses the FDib method DrawHorizontalLine passing
  it a 16bit color value}
  FDib.DrawHorizontalLine(Y, X1, X2, FDibColor);
end;

procedure TGMP.RenderYBuckets ;
var
  Y, I, Length : Integer;
  TextX, TextY, TextXIncr, TextYIncr : Single;
begin
  if (RenderMode <>  rmSolidTexture) and (RenderMode <>  rmShadedTexture) then
    begin
      for Y := 0 to 479 do
        begin
	  if YBuckets[Y].StartX = -16000 then continue;
          if YBuckets[Y].StartX < 0 then YBuckets[Y].StartX := 0;
          if YBuckets[Y].StartX > Width then continue;
          if YBuckets[Y].EndX > Width then YBuckets[Y].EndX := Width;
          if YBuckets[Y].EndX < 0 then continue;
	  DrawHorizontalLine(Y, YBuckets[Y].StartX, YBuckets[Y].EndX);
	end;
    end
  else
    begin
      if RenderMode = rmSolidTexture then
        begin
          for Y := 0 to 479 do
            begin
              if YBuckets[Y].StartX = -16000 then
                continue;
              Length := (YBuckets[Y].EndX - YBuckets[Y].StartX) + 1;
              TextXIncr := ((TextureBuckets[Y].EndPosition.X -  TextureBuckets[Y].StartPosition.X)) / length ;
              TextYIncr := ((TextureBuckets[Y].EndPosition.Y -  TextureBuckets[Y].StartPosition.Y)) / length ;
              TextX := TextureBuckets[Y].StartPosition.X;
              TextY := TextureBuckets[Y].StartPosition.Y;
              for I := YBuckets[Y].StartX to YBuckets[Y].EndX do
                begin
                  if I < 0 then
                    begin
                      TextX := TextX + TextXIncr;
                      TextY := TextY + TextYIncr;
                      Continue;
                    end;
                  if I > Width then
                    begin
                      TextX := TextX + TextXIncr;
                      TextY := TextY + TextYIncr;
                      Continue;
                    end;
                  {Uses the FDib SetPixel method instead of the Windows GDI SetPixel}
                  FDib.SetPixel(I, Y, FCurrentBitmap[Round(TextX), Round(TextY)]) ;
                  TextX := TextX + TextXIncr;
                  TextY := TextY + TextYIncr;
                end;
            end;
        end; {End of RenderMode = rmSolidTexture}
      if RenderMode = rmShadedTexture then
        begin
          for Y := 0 to 479 do
            begin
	      if YBuckets[Y].StartX = -16000 then
                continue;
              Length := (YBuckets[Y].EndX - YBuckets[Y].StartX) + 1;
              TextXIncr := ((TextureBuckets[Y].EndPosition.X -  TextureBuckets[Y].StartPosition.X)) / length ;
              TextYIncr := ((TextureBuckets[Y].EndPosition.Y -  TextureBuckets[Y].StartPosition.Y)) / length ;
              TextX := TextureBuckets[Y].StartPosition.X;
              TextY := TextureBuckets[Y].StartPosition.Y;
              for I := YBuckets[Y].StartX to YBuckets[Y].EndX do
                begin
                  if I < 0 then
                    begin
                      TextX := TextX + TextXIncr;
                      TextY := TextY + TextYIncr;
                      Continue;
                    end;
                  if I > Width then
                    begin
                      TextX := TextX + TextXIncr;
                      TextY := TextY + TextYIncr;
                      Continue;
                    end;
                  {Uses the FDib SetPixel method instead of the Windows GDI SetPixel
                  and get the correctly shaded texel using GetShadedWord}
                  FDib.SetPixel(I, Y, GetShadedWord(FCurrentBitmap[Round(TextX), Round(TextY)], FIntensity));
                  TextX := TextX + TextXIncr;
                  TextY := TextY + TextYIncr;
                end;
            end;
        end; {End of RenderMode = rmShadedTexture}
    end;
end;

procedure TGMP.DrawLine2DSolid(X1, Y1, X2, Y2 : Integer);
var
  CurrentX, XIncr : Single;
  Y, Temp, Length : Integer;
begin

  {No point in drawing horizontal lines! The rest of the polygon will define the edges}
  if Y1 = Y2 then
    exit;

  {Swap if Y1 is less than Y2 so we are always drawing from top to bottom}
  if Y2 < Y1 then
    begin
      Temp := Y1;
      Y1 := Y2;
      Y2 := Temp;
      Temp := X1;
      X1 := X2;
      X2 := Temp;
    end;

  Length := (Y2 - Y1) + 1;

  {Xincr is how much the X must increment though each Y increment.}
  XIncr := ((X2 - X1) + 1) / Length;

  CurrentX := X1;

  {Now to loop through the Y Values and fill up the Y buckets}
  for Y := Y1 to Y2 do
    begin
      {Some basic line clipping in the Y Dimension}
      if (Y < 0) or (Y > ViewHeight) then
        begin
          CurrentX := CurrentX + XIncr;
          Continue;
        end;
      {All Y buckets are initialized to -16000}
      if YBuckets[Y].StartX = -16000 then
        begin
	  YBuckets[Y].StartX := Round(CurrentX);
	  YBuckets[Y].EndX := Round(CurrentX);
	end
      else
        begin
	  {Is Current X less than the Y startx - if so update startx}
	  if CurrentX < YBuckets[Y].StartX then
            YBuckets[Y].StartX := Round(CurrentX);

	  {Is Current X greater than the Y endx - if so update endx}
	  if CurrentX > YBuckets[Y].EndX then
            YBuckets[Y].EndX := Round(CurrentX);
	end;
      CurrentX := CurrentX + XIncr;
    end;
end;


procedure TGMP.RenderNow(var Object3D : TObject3D);
var
  X, I : Integer;
  TextureStart, TextureEnd : TPoint;
begin
  {Check to see which rendering mode is to be used}
  Case RenderMode of

    //**********    Wireframe **************************
    rmWireframe :
      begin
        {Converts local coordinates to world coordinates}
        LocalToWorld(Object3D);
        FBackBuffer.Canvas.Pen.Color := Object3D.Color;
        for X := 0 to Object3D.NumberPolys - 1 do
          {Uses PolyWord (world coordinates) intead of PolyStore (local coordinates}
          with Object3D.PolyWorld[x] do
            begin
              DrawLine3D(Point[0].X, Point[0].Y, Point[0].Z,
                         Point[1].X, Point[1].Y, Point[1].Z);
              DrawLine3D(Point[1].X, Point[1].Y, Point[1].Z,
                         Point[2].X, Point[2].Y, Point[2].Z);
              if NumberPoints = 3 then
                DrawLine3D(Point[2].X, Point[2].Y, Point[2].Z,
                           Point[0].X, Point[0].Y, Point[0].Z )
              else
                begin
                  DrawLine3D(Point[2].X, Point[2].Y, Point[2].Z,
                             Point[3].X, Point[3].Y, Point[3].Z);
                  DrawLine3D(Point[3].X, Point[3].Y, Point[3].Z,
                             Point[0].X, Point[0].Y, Point[0].Z );
                end;
            end; {end of with statment}
      end; {end of rmWireFrame block}

  //**********    Solid  *******************************
    rmSolid :
      begin
        {Converts local coordinates to world coordinates}
        LocalToWorld(Object3D);
        FDibColor := Object3D.DibColor;
        for X := 0 to Object3D.NumberPolys - 1 do
         {Uses PolyWord (world coordinates) intead of PolyStore (local coordinates}
          with Object3D.PolyWorld[X] do
            begin
              ClearYBuckets;
              for I := 0 to NumberPoints -1 do
                if  I <  (NumberPoints - 1) then
                  DrawLine3D(Point[I].X, Point[I].Y, Point[I].Z,
                             Point[I + 1].X, Point[I + 1].Y, Point[I + 1].Z)
                else
                  DrawLine3D(Point[I].X, Point[I].Y, Point[I].Z,
                             Point[0].X, Point[0].Y, Point[0].Z );
              RenderYBuckets;
            end; {end of with statement}
      end; {end of rmSolid block}

  //**********    Solid  Shading ***************************
    rmSolidShade :
      begin
        RemoveBackfacesAndShade(Object3D);
        OrderZ(Object3D);
        {Converts local coordinates to world coordinates}
        LocalToWorld(Object3D);
        for X := 0 to Object3D.NumberPolys - 1 do
         {Uses PolyWord (world coordinates) intead of PolyStore (local coordinates}
          with Object3D.PolyWorld[X] do
            begin
              if Object3D.PolyWorld[X].Visible = False then
                continue;
              FDibColor := DibColor;
              ClearYBuckets;
              for I := 0 to NumberPoints -1 do
                if I < (NumberPoints - 1) then
                  DrawLine3D(Point[I].X, Point[I].Y, Point[I].Z,
                             Point[I + 1].X, Point[I + 1].Y, Point[I + 1].Z )
                else
                  DrawLine3D(Point[I].X, Point[I].Y, Point[I].Z,
                             Point[0].X, Point[0].Y, Point[0].Z );
              RenderYBuckets;
            end;  {end of with statement}
      end; {end of rmSolidShade Block}

  //**********    Solid  Texture *******************************
    rmSolidTexture :
      begin
        RemoveBackfacesAndShade(Object3D);
        OrderZ(Object3D);
        {Converts local coordinates to world coordinates}
        LocalToWorld(Object3D);
        for X := 0 to Object3D.NumberPolys - 1 do
         {Uses PolyWord (world coordinates) intead of PolyStore (local coordinates}
          with Object3D.PolyWorld[x] do
            begin
              if Object3D.PolyWorld[x].Visible = False then
                continue;
	      ClearYBuckets;
              if NumberPoints = 3 then
                begin
                  TextureStart.X := 63;  TextureStart.Y := 0;
                  TextureEnd.X := 0; TextureEnd.Y := 127;
                  DrawLine3DTexture(Point[0], Point[1], TextureStart, TextureEnd);
                  TextureStart.X := 0; TextureStart.Y := 127;
                  TextureEnd.X := 127; TextureEnd.Y := 127;
                  DrawLine3DTexture(Point[1], Point[2], TextureStart, TextureEnd);
                  TextureStart.X := 127; TextureStart.Y := 127;
                  TextureEnd.X := 63; TextureEnd.Y := 0;
                  DrawLine3DTexture(Point[2], Point[0], TextureStart, TextureEnd);
                end
              else
                begin
                  TextureStart.X := 127; TextureStart.Y := 0;
                  TextureEnd.X := 127; TextureEnd.Y := 127;
                  DrawLine3DTexture(Point[0], Point[1], TextureStart, TextureEnd);
                  TextureStart.X := 127; TextureStart.Y := 127;
                  TextureEnd.X := 0; TextureEnd.Y := 127;
                  DrawLine3DTexture(Point[1], Point[2], TextureStart, TextureEnd);
                  TextureStart.X := 0; TextureStart.Y := 127;
                  TextureEnd.X := 0; TextureEnd.Y := 0;
                  DrawLine3DTexture(Point[2], Point[3], TextureStart, TextureEnd);
                  TextureStart.X := 0; TextureStart.Y := 0;
                  TextureEnd.X := 127; TextureEnd.Y := 0;
                  DrawLine3DTexture(Point[3], Point[0], TextureStart, TextureEnd);
                end;
       	      RenderYBuckets;
            end;  {end of with statement}
      end; {end of rmSolidTexture statement}
  //**********    Shaded  Texture *******************************
    rmShadedTexture :
      begin
        RemoveBackfacesAndShade(Object3D);
        OrderZ(Object3D);
        {Converts local coordinates to world coordinates}
        LocalToWorld(Object3D);
        for X := 0 to Object3D.NumberPolys - 1 do
         {Uses PolyWord (world coordinates) intead of PolyStore (local coordinates}
          with Object3D.PolyWorld[x] do
            begin
              if Object3D.PolyWorld[x].Visible = False then
                continue;
	      ClearYBuckets;
              FIntensity := Object3D.PolyWorld[x].Intensity;
              if NumberPoints = 3 then
                begin
                  TextureStart.X := 63;  TextureStart.Y := 0;
                  TextureEnd.X := 0; TextureEnd.Y := 127;
                  DrawLine3DTexture(Point[0], Point[1], TextureStart, TextureEnd);
                  TextureStart.X := 0; TextureStart.Y := 127;
                  TextureEnd.X := 127; TextureEnd.Y := 127;
                  DrawLine3DTexture(Point[1], Point[2], TextureStart, TextureEnd);
                  TextureStart.X := 127; TextureStart.Y := 127;
                  TextureEnd.X := 63; TextureEnd.Y := 0;
                  DrawLine3Dtexture(Point[2], Point[0], TextureStart, TextureEnd);
                end
              else
                begin
                  TextureStart.X := 127; TextureStart.Y := 0;
                  TextureEnd.X := 127; TextureEnd.Y := 127;
                  DrawLine3DTexture(Point[0], Point[1], TextureStart, TextureEnd);
                  TextureStart.X := 127; TextureStart.Y := 127;
                  TextureEnd.X := 0; TextureEnd.Y := 127;
                  DrawLine3DTexture(Point[1], Point[2], TextureStart, TextureEnd);
                  TextureStart.X := 0; TextureStart.Y := 127;
                  TextureEnd.X := 0; TextureEnd.Y := 0;
                  DrawLine3DTexture(Point[2], Point[3], TextureStart, TextureEnd);
                  TextureStart.X := 0; TextureStart.Y := 0;
                  TextureEnd.X := 127; TextureEnd.Y := 0;
                  DrawLine3DTexture(Point[3], Point[0], TextureStart, TextureEnd);
                end;
       	      RenderYBuckets;
            end;  {end of with statement}
      end; {end of rmSolidTexture statement}
  end; {end of case statement}
end;

procedure TGMP.ChangeObjectColor(var Object3D : TObject3D; Color : TColor);
begin
  Object3D.Color := Color;
  Object3D.DibColor := CalculateRGBWord(Color);
end;


procedure TGMP.DrawLine3D(X1, Y1, Z1, X2, Y2, Z2 : Single);
var
  ScreenX1, ScreenX2, ScreenY1, ScreenY2 : Integer;
begin
  ScreenX1 := HalfScreenWidth + Round(X1 * ViewingDistance / Z1 );
  ScreenY1 := Round(HalfScreenHeight - Y1 * ViewingDistance / Z1 );
  ScreenX2 := HalfScreenWidth + round(X2 * ViewingDistance / Z2 );
  ScreenY2 := Round(HalfScreenHeight - Y2 * ViewingDistance / Z2 );
  case RenderMode of
    rmWireframe :
      begin
        {The DIB is created bottum up and as wireframe uses the GDI
        and the GDI thinks tops down we must reverse the Y coordinates}
        ScreenY1 := Round(HalfScreenHeight - -Y1 * ViewingDistance / Z1 );
        ScreenY2 := Round(HalfScreenHeight - -Y2 * ViewingDistance / Z2 );
        DrawLine2DWireframe(ScreenX1, ScreenY1, ScreenX2, ScreenY2);
      end;

    rmSolid : DrawLine2DSolid(ScreenX1, ScreenY1, ScreenX2, ScreenY2);
    rmSolidShade : DrawLine2DSolid(ScreenX1, ScreenY1, ScreenX2, ScreenY2);
  end;
end;

procedure TGMP.Rotate(X, Y, Z, Angle : Single; var Object3D : TObject3D);
var
  P, I : Integer;
  NewX, NewY, NewZ : Single;
  PreCalCos, PreCalSin : Single;
begin
  PreCalCos := cos(Angle);
  PreCalSin := sin(Angle);
  for P := 0 to Object3D.NumberPolys - 1 do
    begin
      with Object3D.PolyStore[P] do
        begin
          if Z <> 0 then
            begin
              for I := 0 to NumberPoints - 1 do
                begin
                  NewX := Point[I].X * PreCalCos - Point[I].Y * PreCalSin;
                  NewY := Point[I].X * PreCalSin + Point[I].Y * PreCalCos;
                  Point[I].X := NewX;
                  Point[I].y := NewY;
                end;
            end;

          if X <> 0 then
            begin
              for I := 0 to NumberPoints - 1 do
                begin
                  NewY := Point[I].Y * PreCalCos - Point[I].Z * PreCalSin;
                  NewZ := Point[I].Y * PreCalSin + Point[I].Z * PreCalCos;
                  Point[I].Y := NewY;
                  Point[I].Z := NewZ;
                end;
            end;

          if Y <> 0 then
            begin
              for I := 0 to NumberPoints - 1 do
                begin
                  NewZ := Point[I].Z * PreCalCos - Point[I].X * PreCalSin;
                  NewX := Point[I].X * PreCalCos + Point[I].Z * PreCalSin;
                  Point[I].Z := NewZ;
                  Point[I].X := NewX;
                end;
            end;
        end;
    end;
end;

procedure TGMP.DrawLine2DWireframe(X1, Y1, X2, Y2 : Integer);
begin
  FBackBuffer.Canvas.Penpos := Point(X1, Y1);
  FBackBuffer.Canvas.LineTo(X2, Y2);
end;

procedure TGMP.ClearBackPage;
begin
  FDib.ClearBackPage(CalculateRGBWord(FColor));
end;

procedure TGMP.FlipBackPage;
begin
  if Assigned(FBeforeFlip) then
    FBeforeFlip(FBackBuffer.Canvas);
  FDib.FlipBackPage(Canvas.Handle);
end;

Constructor TGMP.Create(AOwner : TComponent);
Var
  Position, Direction : TPoint3D;
begin
  {we must call the inherited create of the Tcomponent from which we derived this class}
  inherited Create(AOwner);

  Height := 200;
  Width := 200;

  {create the bitmap canvas}
  FBackBuffer := TBitmap.Create;

  {Get the height and width of the window}
  ViewHeight := Height;
  ViewWidth := Width;

  {set the bitmaps height and clear the screen with default color}
  FBackBuffer.Height := ViewHeight;
  FBackBuffer.Width := ViewWidth;


  {Set up viewport}
  HalfScreenHeight := ViewHeight div 2;
  HalfScreenWidth := ViewWidth div 2;

  {Set the viewing distance}
  ViewingDistance := 500;

  {Set up the lighting conditions}
  LightStrength := 0.75;
  AmbientLight := 7;

  Position.X := 100;
  Position.Y := 0;
  Position.Z := -100;

  Direction.X := 0;
  Direction.Y := 0;
  Direction.Z := 0;

  ViewPoint.X := 0;
  ViewPoint.Y := 0;
  ViewPoint.Z := 0;

  SetLightSourcePosition(Position, Direction);
  FDib := TDib16Bit.Create(ViewHeight, ViewWidth);
  FBackBuffer.Handle  := FDib.GetHandle;

  {Set up the light calculation lookup table}
  CalcIntensityLUT;
end;

destructor TGMP.Destroy;
begin
  {Free the TBitmap}
  Fbackbuffer.Free;
  FDib.Free;
  inherited;
end;

procedure Register;
begin
  RegisterComponents('Graphics', [TGMP]);
end;

end.
