ObjFile.pas

unit ObjFile;

interface

uses
  Windows, SysUtils, Messages, Types, Classes, rgl;

type
  ERglObjFileError = class(Exception);

function ParseObjData(const AData: TArray<string>): TArray<GLfloat6>;
function PrintRawBuffer(ABuffer: Pointer; ALength:
  Integer; const ASep: string = ''): string; overload;
function PrintRawBuffer(ABuffer: TArray<GLfloat6>;
  const ASep: string = ''): string; overload;

implementation

uses
  Math, Generics.Defaults, Generics.Collections, Character;

var
  InvFS: TFormatSettings;

function Tokenize(const S: string; ADefs: TDictionary<string, string>): TArray<string>;

  function TDA(const AToken: string): string;
  begin
    if (ADefs = nil) or (ADefs.Count = 0) or
      not ADefs.TryGetValue(AToken, Result)
    then
      Result := AToken;
  end;

begin

  var ActualLength := 0;
  SetLength(Result, 32);

  var InToken := False;
  var p := 0;

  for var i := 1 to S.Length do
  begin

    if InToken then
    begin
      if S[i].IsWhiteSpace then
      begin
        InToken := False;
        Result[ActualLength] := TDA(Copy(S, p, i - p));
        Inc(ActualLength);
        if ActualLength = Length(Result) then
          Break;
      end;
    end
    else
    begin
      if not S[i].IsWhiteSpace then
      begin
        InToken := True;
        p := i;
      end;
    end;

  end;

  if InToken and (ActualLength < Length(Result)) then
  begin
    Result[ActualLength] := TDA(Copy(S, p));
    Inc(ActualLength);
  end;

  SetLength(Result, ActualLength);

end;

procedure ParseVec(AList: TList<rglv>; const AData: TArray<string>;
  ANormalize: Boolean);
begin

  if Length(AData) < 4 then
    raise ERglObjFileError.Create('Vector is of too small dimension.');

  var v := vec(
    StrToFloat(AData[1], InvFS),
    StrToFloat(AData[2], InvFS),
    StrToFloat(AData[3], InvFS)
  );

  if ANormalize and not IsZero(v.Norm) then
    v := v.Normalized;

  if Assigned(AList) then
    AList.Add(v);

end;

type
  TVertexData = record
    VertexIndex: Integer;
    TextureIndex: Integer;
    NormalIndex: Integer;
    FaceData: GLr3n3v;
  end;

function ParseVertex(const AData: string): TVertexData;
begin

  Result := Default(TVertexData);

  var P := AData.Split(['/']);

  if Length(P) >= 1 then
    Result.VertexIndex := StrToInt(P[0]);

  if Length(P) >= 2 then
  begin
    if (Length(P) = 2) or not P[1].IsEmpty then
      Result.TextureIndex := StrToInt(P[1]);
  end;

  if Length(P) >= 3 then
    Result.NormalIndex := StrToInt(P[2]);

end;

procedure TranslateVertex(var Vertex: TVertexData; AVertices: TList<rglv>);
begin
  case Sign(Vertex.VertexIndex) of
    NegativeValue:
      Vertex.FaceData.r := AVertices[AVertices.Count + Vertex.VertexIndex];
    PositiveValue:
      Vertex.FaceData.r := AVertices[Vertex.VertexIndex - 1];
  else
    raise ERglObjFileError.Create('Invalid vertex index.');
  end;
end;

procedure TranslateNormal(var Vertex: TVertexData; ANormals: TList<rglv>;
  const ADefNormal: rglv);
begin
  case Sign(Vertex.NormalIndex) of
    NegativeValue:
      Vertex.FaceData.n := ANormals[ANormals.Count + Vertex.NormalIndex];
    PositiveValue:
      Vertex.FaceData.n := ANormals[Vertex.NormalIndex - 1];
  else
    Vertex.FaceData.n := ADefNormal;
  end;
end;

procedure ParseFace(AVertices, ANormals: TList<rglv>; AFaces: TList<GLfloat6>;
  AData: TArray<string>);
begin

  if Length(AData) < 4 then
    raise ERglObjFileError.Create('Vector is of too small dimension.');

  if Length(AData) >= 5 then
  begin
    ParseFace(AVertices, ANormals, AFaces, Copy(AData, 0, 4));
    for var i := 3 to High(AData) - 1 do
      ParseFace(AVertices, ANormals, AFaces, ['f', AData[1], AData[i], AData[Succ(i)]]);
    Exit;
  end;

  var A := ParseVertex(AData[1]);
  var B := ParseVertex(AData[2]);
  var C := ParseVertex(AData[3]);

  TranslateVertex(A, AVertices);
  TranslateVertex(B, AVertices);
  TranslateVertex(C, AVertices);

  var LComputedNormal := rglv.Zero;

  if (A.NormalIndex = 0) or (B.NormalIndex = 0) or (C.NormalIndex = 0) then
  begin
    var u := B.FaceData.r - A.FaceData.r;
    var v := C.FaceData.r - B.FaceData.r;
    LComputedNormal := u xor v;
    if not IsZero(LComputedNormal.Norm) then
      LComputedNormal := LComputedNormal.Normalized;
  end;

  TranslateNormal(A, ANormals, LComputedNormal);
  TranslateNormal(B, ANormals, LComputedNormal);
  TranslateNormal(C, ANormals, LComputedNormal);

  if Assigned(AFaces) then
  begin
    AFaces.Add(GLfloat6(A.FaceData));
    AFaces.Add(GLfloat6(B.FaceData));
    AFaces.Add(GLfloat6(C.FaceData));
  end;

end;

function ParseObjData(const AData: TArray<string>): TArray<GLfloat6>;
begin

  var Defines := TDictionary<string, string>.Create;
  try
    var Vertices := TList<rglv>.Create;
    try
      var Normals := TList<rglv>.Create;
      try
        var Faces := TList<GLfloat6>.Create;
        try

          var i := 0;

          try

            while i <= High(AData) do
            begin

              var L := AData[i].Trim;
              Inc(i);

              if L.IsEmpty or L.StartsWith('#') then
                Continue;

              var P := Tokenize(L, Defines);

              if Length(P) = 0 then
                Continue;

              if P[0] = 'v' then
                ParseVec(Vertices, P, False)
              else if P[0] = 'vn' then
                ParseVec(Normals, P, True)
              else if P[0] = 'f' then
                ParseFace(Vertices, Normals, Faces, P)
              else if (P[0] = 'def') and (Length(P) >= 2) then
                Defines.Add(P[1], string.Join(#32, Copy(P, 2)));

            end;

          except
            on E: Exception do
              raise ERglObjFileError.CreateFmt('Couldn''t parse OBJ file at line %d.'#32 + E.Message, [i]);
          end;

          Result := Faces.ToArray;

        finally
          Faces.Free;
        end;
      finally
        Normals.Free;
      end;
    finally
      Vertices.Free;
    end;
  finally
    Defines.Free;
  end;

end;

{$POINTERMATH ON}
type
  PFloat = ^Single;
{$POINTERMATH OFF}

function FormatFloat(p: Single): string;
begin
  Result := SysUtils.FormatFloat('0.########', p, InvFS);
end;

function FormatFloat6(p: PFloat; const ASep: string): string;
begin
  var LSep := ASep;
  if LSep = '' then
    LSep := #32;
  Result := FormatFloat(p^);
  Inc(p); Result := Result + LSep + FormatFloat(p^);
  Inc(p); Result := Result + LSep + FormatFloat(p^);
  Inc(p); Result := Result + LSep + FormatFloat(p^);
  Inc(p); Result := Result + LSep + FormatFloat(p^);
  Inc(p); Result := Result + LSep + FormatFloat(p^) + LSep.TrimRight;
end;

function PrintRawBuffer(ABuffer: Pointer; ALength: Integer;
  const ASep: string): string;
begin

  const FloatCount = ALength div SizeOf(Single);
  const VertexCount = FloatCount div 6;

  var L: TArray<string> := nil;

  SetLength(L, VertexCount);

  var p: PFloat := PFloat(ABuffer);
  for var i := 0 to High(L) do
  begin
    L[i] := FormatFloat6(p, ASep);
    Inc(p, 6);
  end;

  Result := string.Join(#13#10, L);

end;

function PrintRawBuffer(ABuffer: TArray<GLfloat6>;
  const ASep: string): string;
begin
  Result := PrintRawBuffer(Pointer(ABuffer), Length(ABuffer) * SizeOf(GLfloat6),
    ASep);
end;

initialization
  InvFS := TFormatSettings.Invariant;

end.