GLFileOBJ.pas, TGLOBJVectorFile.LoadFromStream, mtl Invalid name

[Roman]

Unit: GLFileOBJ.pas
Type: TGLOBJVectorFile
Procedure: LoadFromStream(aStream: TStream); override;
Line: 1075

objMtlFileName := NextToken(FLine, ' '); // <- Invalid name, no load "Test file.mtl"
objMtlFileName := NextToken(FLine, #13); // <- fix

...

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.V[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.V[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
        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);

    function GetIndex(Count: Integer): Integer;
    var
      s: string;
    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;

  var
    vIdx, tIdx, nIdx: Integer;
  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, libMat2: TGLLibMaterial;
    texName: string;
    libFilename: 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;

          // get full path for material file to be load
          if matLib.TexturePaths = EmptyStr then
            libFilename := libName
          else
            libFilename := IncludeTrailingPathDelimiter(matLib.TexturePaths) + libName;

          try
            fs := CreateFileStream(libFilename);
          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 := GLUtils.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
                try
                  with libMat.Material.Texture do
                  begin
                    Image.LoadFromFile(texName);
                    Disabled := False;
                    TextureMode := tmModulate;
                  end;
                except
                  on E: ETexture do
                  begin
                    if not Owner.IgnoreMissingTextures then
                      raise;
                  end;
                end;
              end;
              // setup lightmap (self-illumination) texture
              texName := objMtl.MaterialStringProperty(matName, 'map_Ke');
              if texName <> '' then
              begin
                // spawn a new material
                libMat2 := matLib.Materials.Add;
                libMat2.Name := matName + '_lm';
                // Use the GLScene built-in second texture support (note: the mesh LightmapProperty MUST be empty)
                libMat.Texture2Name := libMat2.Name;
                try
                  with libMat2.Material.Texture do
                  begin
                    Image.LoadFromFile(texName);
                    Disabled := False;
                    minFilter := miLinear;
                    TextureWrap := twNone;
                    TextureFormat := tfRGB;
                    TextureMode := tmModulate;
                  end;
                except
                  on E: ETexture do
                  begin
                    if not Owner.IgnoreMissingTextures then
                      raise;
                  end;
                end;
              end;

            finally
              objMtl.Free;
              fs.Free;
            end;
          end;
        end
        else
          Result := matName;
      end
      else
        Result := '';
    end;
  end;

  procedure SplitMesh;
  var
    i, j, count: Integer;
    newMesh: TMeshObject;
    newfaceGroup: TOBJFGVertexNormalTexIndexList;
    VertexIdx, NormalIdx, TexCoordIdx: Integer;
    AffineVector: TAffineVector;
  begin
    for i := 0 to mesh.FaceGroups.Count-1 do
    begin
      faceGroup := mesh.FaceGroups[i] as TOBJFGVertexNormalTexIndexList;

      newMesh := TMeshObject.CreateOwned(Owner.MeshObjects);
      newMesh.Mode := momFaceGroups;
      newMesh.Name := faceGroup.Name;

      newfaceGroup := TOBJFGVertexNormalTexIndexList.CreateOwned(newMesh.FaceGroups);
      newfaceGroup.Assign(faceGroup);
      newfaceGroup.FName := faceGroup.Name;
      newfaceGroup.Mode := faceGroup.Mode;
      newfaceGroup.MaterialName := faceGroup.MaterialName;

      //SendInteger('VertexIndices', faceGroup.VertexIndices.Count);
      //SendInteger('TexCoords', faceGroup.TexCoordIndices.Count);
      //SendInteger('Normals', faceGroup.NormalIndices.Count);

      count := faceGroup.VertexIndices.Count;
      for j := 0 to count-1 do
      begin
        VertexIdx := faceGroup.VertexIndices[j];
        AffineVector := mesh.Vertices[VertexIdx];
        VertexIdx := newMesh.Vertices.Add(AffineVector);

        TexCoordIdx := faceGroup.TexCoordIndices[j];
        AffineVector := mesh.TexCoords[TexCoordIdx];
        TexCoordIdx := newMesh.TexCoords.Add(AffineVector);

        NormalIdx := faceGroup.NormalIndices[j];
        AffineVector := mesh.Normals[NormalIdx];
        NormalIdx := newMesh.Normals.Add(AffineVector);

        newfaceGroup.Add(VertexIdx, NormalIdx, TexCoordIdx);
      end;

    end;

    Owner.MeshObjects.RemoveAndFree(mesh);
  end;

var
  command, objMtlFileName, curMtlName: string;
{$IFDEF STATS}
  t0, t1, t2: Integer;
{$ENDIF}
begin
{$IFDEF STATS}
  t0 := GLGetTickCount;
{$ENDIF}

  FEof := False;
  FSourceStream := aStream;
  FLineNo := 0;
  objMtlFileName := '';
  curMtlName := '';

  mesh := TMeshObject.CreateOwned(Owner.MeshObjects);
  mesh.Mode := momFaceGroups;

  faceGroupNames := TStringList.Create;
  faceGroupNames.Duplicates := dupAccept;
  faceGroupNames.Sorted := True;
  try

    faceGroup := nil;

    while not FEof do
    begin
      ReadLine;
      if FLine = '' then
        Continue; { Skip blank line }
      if CharInSet(FLine[1], ['#', '$']) then
        Continue; { Skip comment and alternate comment }

      command := AnsiUpperCase(NextToken(FLine, ' '));

      if command = 'V' then
      begin
        ReadHomogeneousVector;
        Mesh.Vertices.Add(hv.X, hv.Y, hv.Z);
      end
      else if command = 'VT' then
      begin
        ReadAffineVector;
        Mesh.TexCoords.Add(av.X, av.Y, 0);
      end
      else if command = 'VN' then
      begin
        ReadAffineVector;
        Mesh.Normals.Add(av.X, av.Y, av.Z);
      end
      else if command = 'VP' then
      begin
        { Parameter Space Vertex: Ignore }
      end
      else if command = 'G' then
      begin
        { Only the first name on the line, multiple groups not supported. }
        SetCurrentFaceGroup(NextToken(FLine, ' '), curMtlName);
      end
      else if command = 'F' then
      begin
        ReadFace(curMtlName);
      end
      else if command = 'O' then
      begin
        { Object Name:  Ignore }
      end
      else if command = 'MTLLIB' then
      begin
        //objMtlFileName := NextToken(FLine, ' ');
        objMtlFileName := NextToken(FLine, #13); //<- Fix
      end
      else if command = 'USEMTL' then
      begin
        curMtlName := GetOrAllocateMaterial(objMtlFileName, NextToken(FLine, ' '));
        if faceGroup = nil then
          SetCurrentFaceGroup('', curMtlName)
        else
          SetCurrentFaceGroup(faceGroup.FName, curMtlName);
      end
      else if command = 'S' then
      begin
        { Smooth Group: Ignore }
      end
      else if command = 'T' then
      begin
        ReadTriangleStrip;
      end
      else if command = 'Q' then
      begin
        ReadTriangleStripContinued;
      end
      else
        Error('Unsupported Command ''' + command + '''');
    end;

    mesh.FaceGroups.SortByMaterial;

{$IFDEF STATS}
    t1 := GLGetTickCount;
{$ENDIF}

    CalcMissingOBJNormals(mesh);

{$IFDEF STATS}
    t2 := GLGetTickCount;
    InformationDlg(Format('TGLOBJVectorFile Loaded in %dms'#13 +
      #13 +
      '    %dms spent reading'#13 +
      '    %dms spent calculating normals'#13 +
      '    %d Geometric Vertices'#13 +
      '    %d Texture Vertices'#13 +
      '    %d Normals'#13 +
      '    %d FaceGroups/Strips',
      [t2 - t0,
      t1 - t0,
        t2 - t1,
        Mesh.Vertices.Count,
        Mesh.TexCoords.Count,
        Mesh.Normals.Count,
        Mesh.FaceGroups.Count]));
{$ENDIF}

    if vGLFileOBJ_SplitMesh then
      SplitMesh;

  finally
    faceGroupNames.Free;
  end;
end;

[Roman]

Unit: GLTexture.pas
Type: TGLPersistentImage
Procedure: TGLPersistentImage.LoadFromFile(const fileName: string);
Line: 1658

Support search textures in the 3D model directory.

procedure TGLPersistentImage.LoadFromFile(const fileName: string);
var
  fn,buf: string;
  gr: TGLGraphic;
begin
  if FileExists(fileName)=False then fn:=ExtractFileName(fileName) else fn:=fileName;
  buf := fn;
  FResourceFile := fn;
  if Assigned(FOnTextureNeeded) then
    FOnTextureNeeded(Self, buf);
  if ApplicationFileIODefined then
  begin
    gr := CreateGraphicFromFile(buf);
    if Assigned(gr) then
    begin
      Picture.Graphic := gr;
      gr.Free;
      Exit;
    end;
  end
  else if FileExists(buf) then
  begin
    Picture.LoadFromFile(buf);
    Exit;
  end;
  Picture.Graphic := nil;
  raise ETexture.CreateFmt(strFailedOpenFile, [fn]);
end;

[Pavel Vassiliev]

Ok Roman,
Usually you don't need to attach entire unit with a fixed line of code, so you can use TortoiseSVN merge tool to get a diff one. Apply a sample project and make comments, please, about your proposal.
PW

[Pavel Vassiliev]

Roman,
I've added your fixed line in GLFileOBj and here is imported armrobe.obj file in GLSceneViewer adv demos. Thanks.
PW