glfileobj.pas

这是三Ｄ开发的一些源码

//
// This unit is part of the GLScene Project, http://glscene.org
//
{: GLFileOBJ<p>

    Support-Code to load Wavefront OBJ Files into TGLFreeForm-Components
    in GLScene.<p>
    Note that you must manually add this unit to one of your project's uses
    to enable support for OBJ & OBJF at run-time.<p>

	<b>History : </b><font size=-1><ul>
      <li>30/03/07 - DaStr - Added $I GLScene.inc
      <li>24/03/07 - DaStr - Added explicit pointer dereferencing
                             (thanks Burkhard Carstens) (Bugtracker ID = 1678644)
      <li>11/07/05 - DaStr - Improved Cross-Platform compatibility (BugTracker ID = 1684432)
      <li>11/07/05 - Wet - Added multi meshobject support
      <li>09/09/03 - Jaj - Added TriangleStrip and TriangleFan support to save..
      <li>10/07/03 - Egg - Improved robustness of material loading
      <li>02/06/03 - Egg - Undone Jaj changes, they broke standard OBJ support
      <li>30/01/03 - Egg - Normals extraction
      <li>29/01/03 - Jaj - Fixed to allow load of simple triangle meshes... ('V','VN','VT')
      <li>23/01/03 - Egg - Can now export TFGIndexTexCoordList (untextured)
      <li>25/11/02 - Egg - Improved mtl import (d and illum commands)
      <li>22/11/02 - Egg - Supports OBJ files using #9 in place of #32,
                           fixed leak, some code cleanup/rearrangements,
                           support for mtllib and usemtl commands
      <li>18/08/01 - Egg - '$' now allowed as alternate comment,
                           AddToTriangles override 
      <li>03/10/00 - Egg - Fixed TGLOBJVectorFile.LoadFromStream.ReadFace
      <li>08/10/00 - Egg - Added standard header, basic htmlification of old header,
                           removed specific trim funcs,
                           renamed TMBAGLOBJVectorFile to TGLOBJVectorFile
   </ul><p>

   (c) 2000 Marian Aldenh鰒el<br>
       Hainstra遝 8<br>
       53121 Bonn<br>
       [e-mail]<p>

  License:<br>

    Contributed to Eric Grange and GLScene,
    same licensing, batteries not included.<p>

  History:<p>

    26.9.2000:  - OBJF-Support (t- and q-lines) see
                  http://www.cs.sunysb.edu/~stripe/<br>
    18.9.2000:  - Bugfixing.
                - SaveTo-Methods.<br>
    14.9.2000:  - Calculate normals where missing in the file.
                - Collect Facegroups by Name and do not start a new
      				  one for every 'g'-line in the file.
                - Relative indexing in 'f'-lines.<br>
    13.9.2000:  - Start of this project as an exercise to get familiar with<br>
                    a) the OBJ-Format and<br>
                    b) GLScene internals<br>
                  Midterm-goal: Import what Poser 4 exports and display it
                                correctly in an GLScene.<br>
}
unit GLFileObj;

{$I GLScene.inc}
{.$DEFINE STATS} { Define to display statistics after loading. }

interface

uses GLCrossPlatform, Classes, SysUtils, GLScene, ApplicationFileIO,
     VectorGeometry, GLMisc, GLVectorFileObjects, VectorLists, GLTexture;

const
   BufSize = 10240; { Load input data in chunks of BufSize Bytes. }
   LineLen = 100;   { Allocate memory for the current line in chunks
                      of LineLen Bytes. }

type

   // TGLOBJVectorFile
   //
   TGLOBJVectorFile = class (TVectorFile)
      private
         FSourceStream : TStream;     { Load from this stream }
         FBuffer, FLine : String;     { Buffer and current line }
         FLineNo : Integer;           { current Line number - for error messages }
         FEof : Boolean;              { Stream done? }
         FBufPos : Integer;           { Position in the buffer }

      protected
         // Read a single line of text from the source stream, set FEof to true when done.
         procedure ReadLine;
         // Raise a class-specific exception
         procedure Error(const msg : String);

         procedure CalcMissingOBJNormals(mesh : TMeshObject);

      public
         class function Capabilities : TDataFileCapabilities; override;

         procedure LoadFromStream(aStream:TStream); override;
         procedure SaveToStream(aStream:TStream); override;
   end;

   // EGLOBJFileError
   //
   EGLOBJFileError = class (Exception)
      private
         FLineNo : Integer;

      public
         property LineNo : Integer read FLineNo;

   end;

   // TGLMTLFile
   //
   {: A simple class that know how to extract infos from a mtl file.<p>
      mtl files are companion files of the obj, they store material
      information. Guessed content (imported ones denoted with a '*',
      please help if you know more):<ul>
      <li>materials begin with a 'newmtl' command followed by material name
      <li>*Kd command defines the diffuse color
      <li>*map_Kd command defines the diffuse texture image
      <li>*Ka/map_Ka define the ambient color and texmap
      <li>*Ks/map_Ks define the specular color and texmap
      <li>map_Bump specifies the bump map
      <li>*d specifies transparency (alpha-channel, range [0; 1])
      <li>map_d specifies the opcaity texture map
      <li>Ns defines the specular exponent or shininess or phong specular (?)
      <li>Ni is the refraction index (greater than 1)
      <li>*illum defines the illumination model (0 for no lighting, 1 for
           ambient and diffuse, 2 for full lighting)
      </ul> }
   TGLMTLFile = class (TStringList)
      public
         procedure Prepare;

         function MaterialStringProperty(const materialName, propertyName : String) : String;
         function MaterialVectorProperty(const materialName, propertyName : String;
                                         const defaultValue : TVector) : TVector;
   end;

var CurrentMatName: string = 'default.mtl';   
// ------------------------------------------------------------------
// ------------------------------------------------------------------
// ------------------------------------------------------------------
implementation
// ------------------------------------------------------------------
// ------------------------------------------------------------------
// ------------------------------------------------------------------

uses OpenGL1x, MeshUtils, XOpenGL, GLUtils;

// StreamEOF
//
function StreamEOF(S : TStream) : Boolean;
begin
   { Is the stream at its end? }
   Result:=(S.Position>=S.Size);
end;

function Rest(const s:string;Count:integer):string;
{ Return the right part of s including s[Count]. }
begin
  Result:=copy(s,Count,Length(s)-Count+1);
end;

// NextToken
//
function NextToken(var s : String; delimiter : Char) : String;
{ Return the next Delimiter-delimited Token from the string s and
  remove it from s }
var
   p : Integer;
begin
   p:=Pos(Delimiter, s);
   if p=0 then begin
      Result:=s;
      s:='';
   end else begin
      Result:=copy(s, 1, p-1);
      s:=TrimLeft(Rest(s, p+1));
   end;
end;

{ ** TOBJFGVertexNormalTexIndexList ****************************************** }
{ - based on TFGVertexNormalTexIndexList (GLVectorFileObjects.pas)
  - adds support for polygons and for "missing" normals and
    texture-coordinates. Pass -1 to Add for the index of a missing object.
  - Polygons are defined by counting off the number of vertices added to the
    PolygonVertices-property. So a PolygonVertices-List of

      [3,4,6]

    says "Vertex indices 0,1 and 2 make up a triangle, 3,4,5 and 6 a quad and
    7,8,9,10,11 and 12 a hexagon".

}
type
   TOBJFGMode=(objfgmmPolygons,objfgmmTriangleStrip);

   TOBJFGVertexNormalTexIndexList = class (TFGVertexNormalTexIndexList)
       private
         FMode:TOBJFGMode;
         FName:string;
         FPolygonVertices:TIntegerList;
         FCurrentVertexCount:integer;
         FShowNormals:boolean;
         procedure PolygonComplete; { Current polygon completed. Adds FCurrentVertexCount
                                      to FPolygonVertices and sets the variable to 0 }

         procedure SetMode(aMode:TOBJFGMode);

       public
         constructor CreateOwned(aOwner : TFaceGroups); override;
         destructor Destroy; override;

         procedure Add(VertexIdx,NormalIdx,TexCoordIdx:Integer);
         procedure BuildList(var mrci : TRenderContextInfo); override;
         procedure AddToTriangles(aList : TAffineVectorList;
                                  aTexCoords : TAffineVectorList = nil;
                                  aNormals : TAffineVectorList = nil); override;
         function TriangleCount : Integer; override;

         property Mode:TOBJFGMode read FMode write SetMode;
         property Name:string read FName write FName;
         property PolygonVertices:TIntegerList read FPolygonVertices;
         property ShowNormals:boolean read FShowNormals write FShowNormals;
       end;

constructor TOBJFGVertexNormalTexIndexList.CreateOwned(aOwner:TFaceGroups);
begin
  inherited CreateOwned(aOwner);
  FMode:=objfgmmTriangleStrip;
  //FShowNormals:=True;
end;

destructor TOBJFGVertexNormalTexIndexList.Destroy;
begin
  FPolygonVertices.Free;
  inherited Destroy;
end;

procedure TOBJFGVertexNormalTexIndexList.Add(VertexIdx,NormalIdx,TexCoordIdx:Integer);
begin
  inherited Add(VertexIdx,NormalIdx,TexCoordIdx);
  inc(FCurrentVertexCount);
end;

procedure TOBJFGVertexNormalTexIndexList.PolygonComplete;
begin
  Assert(FMode=objfgmmPolygons,'PolygonComplete may only be called for Facegroups with Mode=objfgmmPolygons.');
  FPolygonVertices.Add(FCurrentVertexCount);
  FCurrentVertexCount:=0;
end;

procedure TOBJFGVertexNormalTexIndexList.SetMode(aMode:TOBJFGMode);
begin
  if aMode=FMode then exit;
  Assert(VertexIndices.Count=0,'Decide on the mode before adding vertices.');
  FMode:=aMode;
  if FMode=objfgmmPolygons
    then FPolygonVertices:=TIntegerList.Create
    else
      begin
        FPolygonVertices.Free;
        FPolygonVertices:=NIL;
      end;
end;

procedure TOBJFGVertexNormalTexIndexList.BuildList(var mrci : TRenderContextInfo);
var
   VertexPool:PAffineVectorArray;
   NormalPool:PAffineVectorArray;
   TexCoordPool:PAffineVectorArray;

  procedure BuildPolygons;
  var Polygon,Index,j,idx:Integer;
      N:TAffineVector;
  begin
    { Build it. Ignoring texture-coordinates and normals that are missing. }
    Index:=0; { Current index into the Index-Lists. }
    { For every Polygon }
    for Polygon:=0 to FPolygonVertices.Count-1 do
      begin
        glBegin(GL_POLYGON);
        try
          { For every Vertex in the current Polygon }
          for j:=0 to FPolygonVertices[Polygon]-1 do begin
              idx:=NormalIndices.List^[Index];
              if idx>=0 then glNormal3fv(@NormalPool[idx]);

              if Assigned(TexCoordPool) then begin
                 idx:=TexCoordIndices.List^[Index];
                 if idx>=0 then glTexCoord2fv(@TexCoordPool[idx]);
              end;

              glVertex3fv(@VertexPool[VertexIndices.List^[Index]]);
              Inc(Index);
          end;
        finally
          glEnd;
        end;
      end;

    { Visible normals, rather moronic and mainly for debugging. }
    if FShowNormals then
      begin
        Index:=0;
        for Polygon:=0 to FPolygonVertices.Count-1 do
          begin
            { For every Vertex in the current Polygon }
            for j:=0 to FPolygonVertices[Polygon]-1 do
              begin
                idx:=NormalIndices.List^[Index];
                if idx<>-1 then
                  begin
                    glBegin(GL_LINES);
                    try
                      glVertex3fv(@VertexPool^[VertexIndices.List^[Index]]);
                      N:=VectorAdd(VertexPool^[VertexIndices.List^[Index]],VectorScale(NormalPool^[idx],0.1));
                      glVertex3fv(@N);
                    finally
                      glEnd;
                    end;
                  end;
                inc(Index);
              end;
          end;
      end;
  end;

  procedure BuildTriangleStrip;
  (*
  begin
    Owner.Owner.DeclareArraysToOpenGL(False);
    glDrawElements(GL_TRIANGLE_STRIP,VertexIndices.Count,
                   GL_UNSIGNED_INT,VertexIndices.List);
  end;
  *)
  var Index,idx:Integer;
  begin
    { Build it. Ignoring texture-coordinates and normals that are missing. }
    glBegin(GL_TRIANGLE_STRIP);
    try
      for Index:=0 to VertexIndices.Count-1 do
        begin
          idx:=NormalIndices.List^[Index];
          if idx<>-1 then glNormal3fv(@NormalPool^[idx]);

          if Assigned(TexCoordPool) then begin
             idx:=TexCoordIndices.List^[Index];
             if idx<>-1 then xglTexCoord2fv(@TexCoordPool^[idx]);
          end;

          glVertex3fv(@VertexPool^[VertexIndices.List^[Index]]);
        end;
    finally
      glEnd;
    end;
  end;

begin
  Assert(    ((TexCoordIndices.Count=0) or (VertexIndices.Count<=TexCoordIndices.Count))
         and (VertexIndices.Count<=NormalIndices.Count),
         'Number of Vertices does not match number of Normals or Texture coordinates.');

  { Shorthand notations. }
  VertexPool:=Owner.Owner.Vertices.List;
  NormalPool:=Owner.Owner.Normals.List;
  if TexCoordIndices.Count=0 then
     TexCoordPool:=nil
  else TexCoordPool:=Owner.Owner.TexCoords.List;

  case FMode of
    objfgmmPolygons :      BuildPolygons;
    objfgmmTriangleStrip : BuildTriangleStrip;
  end;
end;

// AddToTriangles
//
procedure TOBJFGVertexNormalTexIndexList.AddToTriangles(aList : TAffineVectorList;
                                                        aTexCoords : TAffineVectorList = nil;
                                                        aNormals : TAffineVectorList = nil);
var
   i, j, n, n0 : Integer;
   vertexList, texCoordList, normalsList : TAffineVectorList;
begin
   vertexList:=Owner.Owner.Vertices;
   texCoordList:=Owner.Owner.TexCoords;
   normalsList:=Owner.Owner.Normals;
   case FMode of
      objfgmmPolygons : begin
         n:=0;
         for i:=0 to FPolygonVertices.Count-1 do begin
            n0:=n;
            for j:=0 to FPolygonVertices[i]-1 do begin
               if j>1 then begin
                  aList.Add(vertexList[VertexIndices[n0]],
                            vertexList[VertexIndices[n-1]],
                            vertexList[VertexIndices[n]]);
                  if Assigned(aTexCoords) then begin
                     if texCoordList.Count>0 then
                        aTexCoords.Add(texCoordList[VertexIndices[n0]],