glfileobj.pas

这是三Ｄ开发的一些源码

                                       texCoordList[VertexIndices[n-1]],
                                       texCoordList[VertexIndices[n]])
                     else aTexCoords.AddNulls(3);
                  end;
                  if Assigned(aNormals) then begin
                     if normalsList.Count>0 then
                        aNormals.Add(normalsList[VertexIndices[n0]],
                                     normalsList[VertexIndices[n-1]],
                                     normalsList[VertexIndices[n]])
                     else aNormals.AddNulls(3);
                  end;
               end;
               Inc(n);
            end;
         end;
      end;
      objfgmmTriangleStrip : begin
         ConvertStripToList(vertexList, VertexIndices, aList);
         n:=(VertexIndices.Count-2)*3;
         if Assigned(aTexCoords) then begin
            if texCoordList.Count>0 then
               ConvertStripToList(texCoordList, VertexIndices, aTexCoords)
            else aTexCoords.AddNulls(n);
         end;
         if Assigned(aNormals) then begin
            if normalsList.Count>0 then
               ConvertStripToList(normalsList, VertexIndices, aNormals)
            else aNormals.AddNulls(n);
         end;
      end;
   else
      Assert(False);
   end;
end;

// TriangleCount
//
function TOBJFGVertexNormalTexIndexList.TriangleCount : Integer;
var
   i : Integer;
begin
   case FMode of
      objfgmmPolygons : begin
         Result:=0;
         for i:=0 to FPolygonVertices.Count-1 do begin
            Result:=Result+FPolygonVertices[i]-2;
         end;
      end;
      objfgmmTriangleStrip : begin
         Result:=VertexIndices.Count-2;
         if Result<0 then Result:=0;
      end;
   else
      Result:=0;
      Assert(False);
   end;
end;

// ------------------
// ------------------ TGLOBJVectorFile ------------------
// ------------------

// ReadLine
//
procedure TGLOBJVectorFile.ReadLine;
var
   j : Integer;

   procedure FillBuffer;
   var
      l : Integer;
   begin
      l:=FSourceStream.Size-FSourceStream.Position;
      if l>BufSize then
         l:=BufSize;
      SetLength(FBuffer, l);
      FSourceStream.Read(FBuffer[1], l);
      FBufPos:=1;
   end;

begin
   Inc(FLineNo);

   if FBufPos<1 then FillBuffer;

   j:=1;
   while True do begin
      if FBufPos>Length(FBuffer) then begin
         if StreamEof(FSourceStream) then begin
            FEof:=True;
            break;
         end else FillBuffer
      end else begin
         case FBuffer[FBufPos] of
            #10, #13 : begin
               Inc(FBufPos);
               if FBufPos>Length(FBuffer) then
                  if StreamEof(FSourceStream) then
                     break
                  else FillBuffer;
               if (FBuffer[FBufPos]=#10) or (FBuffer[FBufPos]=#13) then
                  Inc(FBufPos);
               break;
            end;
         else
            if j>Length(FLine) then
               SetLength(FLine, Length(FLine)+LineLen);
            if FBuffer[FBufPos]=#9 then
               FLine[j]:=#32
            else FLine[j]:=FBuffer[FBufPos];
            Inc(FBufPos);
            Inc(j);
         end;
      end;
   end;

   SetLength(FLine,j-1);
end;

// Error
//
procedure TGLOBJVectorFile.Error(const msg : String);
var
   E : EGLOBJFileError;
begin
   E:=EGLOBJFileError.Create(Msg);
   E.FLineNo:=FLineNo;
   raise E;
end;

// Capabilities
//
class function TGLOBJVectorFile.Capabilities : TDataFileCapabilities;
begin
   Result:=[dfcRead, dfcWrite];
end;
                   
// CalcMissingOBJNormals
//
procedure TGLOBJVectorFile.CalcMissingOBJNormals(mesh : TMeshObject);
var
   vertexPool : PAffineVectorArray;
   n : TAffineVector;
   p : array [1..3] of PAffineVector;
   face, index : Integer;
   fg : TOBJFGVertexNormalTexIndexList;

   procedure DoCalcNormal;
   var
      idx : Integer;
   begin
      idx:=TOBJFGVertexNormalTexIndexList(Mesh.FaceGroups[Face]).NormalIndices.List^[Index];
      if idx<0 then begin
         n:=CalcPlaneNormal(p[1]^, p[2]^, p[3]^);
         idx:=Mesh.Normals.Add(n);
         TOBJFGVertexNormalTexIndexList(Mesh.FaceGroups[Face]).NormalIndices.List^[Index]:=idx;
      end;
   end;

   procedure CalcForPolygons;
   var
      polygon, firstVertexIndex, j : Integer;
   begin
      with FG do begin
         { Walk the polygons and calculate normals for those vertices that
           are missing. }
         Index:=0; { Current index into the Index-List of this Facegroup. }

         { For every Polygon }
         for Polygon:=0 to FPolygonVertices.Count-1 do begin
            { Init }
            FirstVertexIndex:=Index;
            FillChar(p,SizeOf(p),0);
            { Last Vertex in this polygon }
            p[2]:=@VertexPool^[VertexIndices.List^[Index+FPolygonVertices[Polygon]-1]];
            { First Vertex in this polygon }
            p[3]:=@VertexPool^[VertexIndices.List^[Index]];
            { For every Vertex in the current Polygon but the last. }
            for j:=0 to FPolygonVertices[Polygon]-2 do begin
               Move(p[2],p[1],2*SizeOf(PAffineVector));
               p[3]:=@VertexPool^[VertexIndices.List^[Index+1]];
               DoCalcNormal;
               Inc(Index);
            end;

            { For the last vertex use the first as partner to span the plane. }
            Move(p[2],p[1],2*SizeOf(PAffineVector));
            p[3]:=@VertexPool^[VertexIndices.List^[FirstVertexIndex]];
            DoCalcNormal;
            inc(Index);
         end; { of for FPolygonVertices }
      end; { of with Facegroup }
   end;

   procedure CalcForTriangleStrip;
   begin
   end;

begin
   { Shorthand notations. }
   VertexPool:=Mesh.Vertices.List;

   for Face:=0 to Mesh.FaceGroups.Count-1 do begin
      FG:=TOBJFGVertexNormalTexIndexList(Mesh.FaceGroups[Face]);
      case FG.Mode of
         objfgmmPolygons :      CalcForPolygons;
         objfgmmTriangleStrip : CalcForTriangleStrip;
      end;
   end;
end;

// LoadFromStream
//
procedure TGLOBJVectorFile.LoadFromStream(aStream:TStream);
var
   hv : THomogeneousVector;
   av : TAffineVector;
   mesh : TMeshObject;
   faceGroup : TOBJFGVertexNormalTexIndexList;
   faceGroupNames : TStringList;

   procedure ReadHomogeneousVector;
   { Read a vector with a maximum of 4 elements from the current line. }
   var
      i, c : Integer;
      f : String;
   begin
      FillChar(hv, SizeOf(hv), 0);
      i:=0;
      while (FLine<>'') and (i<4) do begin
         f:=NextToken(FLine, ' ');
         Val(f, hv[i], c);
         if c<>0 then
            Error(Format('''%s'' is not a valid floating-point constant.', [f]));
         Inc(i);
      end;
   end;

   procedure ReadAffineVector;
   { Read a vector with a maximum of 3 elements from the current line. }
   var
      i, c : integer;
      f : String;
   begin
      FillChar(av,SizeOf(av),0);
      i:=0;
      while (FLine<>'') and (i<3) do begin
         f:=NextToken(FLine, ' ');
         Val(f, av[i], c);
         if c<>0 then
            Error(Format('''%s'' is not a valid floating-point constant.',[f]));
         inc(i);
      end;
   end;

   procedure SetCurrentFaceGroup(aName : String; const matlName : String);
   var
      i : Integer;
   begin
      i:=faceGroupNames.IndexOf(aName);
      if i>=0 then begin
         faceGroup:=TOBJFGVertexNormalTexIndexList(faceGroupNames.Objects[i]);
         if faceGroup.MaterialName<>matlName then begin
            aName:=aName+'-'+matlName;
            i:=faceGroupNames.IndexOf(aName);
            if i>=0 then begin
               faceGroup:=TOBJFGVertexNormalTexIndexList(faceGroupNames.Objects[i]);
               if faceGroup.MaterialName<>matlName then
                  faceGroup:=nil;
            end;
         end;
      end;

      if (faceGroup=nil) or (faceGroup.Name<>aName)
            or (faceGroup.PolygonVertices.Count>0)
            or (faceGroup.MaterialName<>matlName) then begin
         faceGroup:=TOBJFGVertexNormalTexIndexList.CreateOwned(Mesh.FaceGroups);
         faceGroup.FName:=aName;
         faceGroup.Mode:=objfgmmPolygons;
         faceGroup.MaterialName:=matlName;
         faceGroupNames.AddObject(aName, faceGroup);
      end;
   end;

   procedure AddFaceVertex(faceVertices : String);
   var
      s : String;
      vIdx, tIdx, nIdx : Integer;

      function GetIndex(Count : Integer) : Integer;
      begin
         s:=NextToken(FaceVertices, '/');
         Result:=StrToIntDef(s, 0);
         if Result=0 then
            Result:=-1 // Missing
         else if Result<0 then begin
            { Relative, make absolute. "-1" means last, "-2" second last. }
            Result:=Count+Result
         end else begin
            { Absolute, correct for zero-base. }
            Dec(Result);
         end;
      end;

   begin
      vIdx:=GetIndex(mesh.Vertices.Count);
      tIdx:=GetIndex(mesh.TexCoords.Count);
      nIdx:=GetIndex(mesh.Normals.Count);

      faceGroup.Add(vIdx, nIdx, tIdx);
   end;

   procedure ReadFace(const curMtlName : String);
   var
      faceVertices : String;
   begin
      if FLine<>'' then begin
         if not Assigned(FaceGroup) then
            SetCurrentFaceGroup('', curMtlName);
         try
            while FLine<>'' do begin
               faceVertices:=NextToken(FLine, ' ');
               AddFaceVertex(faceVertices);
            end;
         finally
            FaceGroup.PolygonComplete;
         end;
      end;
   end;

   procedure ReadTriangleStripContinued;
   var
      faceVertices : String;
   begin
      if faceGroup=nil then
         Error('q-line without preceding t-line.');
      while FLine<>'' do begin
         FaceVertices:=NextToken(FLine, ' ');
         AddFaceVertex(FaceVertices);
      end;
   end;

   procedure ReadTriangleStrip;
   begin
      { Start a new Facegroup, mode=triangle strip }
      faceGroup:=TOBJFGVertexNormalTexIndexList.CreateOwned(Mesh.FaceGroups);
      faceGroup.Mode:=objfgmmTriangleStrip;
      { The rest is the same as for continuation of a strip. }
      ReadTriangleStripContinued;
   end;

   function GetOrAllocateMaterial(const libName, matName : String) : String;
   var
      fs : TStream;
      objMtl : TGLMTLFile;
      matLib : TGLMaterialLibrary;
      libMat : TGLLibMaterial;
      texName : String;
   begin
      if GetOwner is TGLBaseMesh then begin
         // got a linked material library?
         matLib:=TGLBaseMesh(GetOwner).MaterialLibrary;
         if Assigned(matLib) then begin
            Result:=matName;
            libMat:=matLib.Materials.GetLibMaterialByName(matName);
            if not Assigned(libMat) then begin
               // spawn a new material
               libMat:=matLib.Materials.Add;
               libMat.Name:=matName;
               try
                  fs:=CreateFileStream(libName);
               except
                  fs:=nil;
               end;
               if Assigned(fs) then begin
                  objMtl:=TGLMTLFile.Create;
                  try
                     objMtl.LoadFromStream(fs);
                     objMtl.Prepare;
                     // setup material colors
                     with libMat.Material.FrontProperties do begin
                        Ambient.Color:=objMtl.MaterialVectorProperty(matName, 'Ka', clrGray20);
                        Diffuse.Color:=objMtl.MaterialVectorProperty(matName, 'Kd', clrGray80);
                        Diffuse.Alpha:=StrToFloatDef(objMtl.MaterialStringProperty(matName, 'd'), 1);
                        if Diffuse.Alpha<1 then
                           libMat.Material.BlendingMode:=bmTransparency;
                        case StrToIntDef(objMtl.MaterialStringProperty(matName, 'illum'), 1) of
                           0 : begin // non-lit material
                              libMat.Material.MaterialOptions:=[moNoLighting];
                           end;
                           1 : ; // flat, non-shiny material
                           2 : begin // specular material
                              Specular.Color:=objMtl.MaterialVectorProperty(matName, 'Ks', clrTransparent);
                           end;
                        else
                           // unknown, assume unlit
                           libMat.Material.MaterialOptions:=[moNoLighting];
                           Diffuse.Color:=clrGray80;
                        end;
                        Shininess:=StrToIntDef(objMtl.MaterialStringProperty(matName, 'Ns'), 1);
                     end;
                     // setup texture
                     texName:=objMtl.MaterialStringProperty(matName, 'map_Kd');
                     if texName<>'' then begin