{************************************************************}
{                   Delphi VCL Extensions                    }
{                                                            }
{                   STL files TGrapic class                  }
{                                                            }
{        Copyright (c) 2012-2014 SoftGold software company   }
{                                                            }
{************************************************************}

{$I SGDXF.INC}
unit sgSTLImage;

interface

uses Windows, SysUtils, Classes, Graphics, DXFConv, CADImage,
  sgFunction, sgConsts, Math, Clipbrd, sgLines, sgLists
  {$IFDEF SGDEL_2009}
  ,AnsiStrings
  {$ENDIF}
  ;

type
  PsgSTLVertex = ^TsgSTLVertex;
  TsgSTLVertex = packed record
    X: Single;
    Y: Single;
    Z: Single;
  end;

  TsgSTLFace = packed record
	  Normal: TsgSTLVertex;
	  Vertex1: TsgSTLVertex;
	  Vertex2: TsgSTLVertex;
	  Vertex3: TsgSTLVertex;
    Padding: array[0..1] of Byte;
  end;

  EsgSTLImageError = Exception;

  Tsg3DSolidImage = class(TsgVectorImage)
  end;

  TsgSTLImage = class(Tsg3DSolidImage)
  private
    FLayer: TsgDXFLayer;
    FStlFile: TStringList;
    procedure AddFace(const StlFace: TsgSTLFace);
    function GetHandle: UInt64;
    procedure SetHandleForEntity(const Entity: TsgDXFEntity);
    function IsBinary(const Stream: TStream): Boolean;
    procedure LoadSTL(S: TStream);
    function CheckVertex(const AVertex: TsgSTLVertex): Boolean;
    function MakeFPoint(const Vertex: TsgSTLVertex): TFPoint;
  protected
    function GetDefaultView: TsgDefaultView; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure LoadFromStream(S: TStream); override;
  end;

const
  sSTLImage = 'STL image';
  sInvalidNormalError: string = 'Invalid Normal';
  sInvalidVertex: string = 'Invalid Vertex';
  sInvalidLoop: string = 'End of Loop Not Found';
  sInvalidFace: string = 'End of Facet Not found';

var
  CF_STL: Word;

implementation
const
  cntSolidLbl = 'SOLID';
  cntFacetNormalLbl = 'FACET NORMAL ';
  cntOuterLoopLbl = 'OUTER LOOP';
  cntVertexLbl = 'VERTEX';
  cntEndLoopLbl = 'ENDLOOP';
  cntEndFacetLbl = 'ENDFACET';
  cntEndSolidLbl = 'ENDSOLID';
  cntFacetLbl = 'FACET';

type
  TsgDXFConverterAccess = class(TsgDXFConverter);

  TsgSTLFileHeader = packed record
    Dummy: array[0..79] of Byte;
    NumFaces: Integer;
  end;

{ TsgSTLImage }

procedure TsgSTLImage.AddFace(const StlFace: TsgSTLFace);
var
  vFace: TsgSTL3dFace;
begin
  if CheckVertex(StlFace.Vertex1) or CheckVertex(StlFace.Vertex2) or
    CheckVertex(StlFace.Vertex3) then
    Exit;
  vFace := TsgSTL3dFace.Create;
  vFace.Point := MakeFPoint(StlFace.Vertex1);
  vFace.Point1 := MakeFPoint(StlFace.Vertex2);
  vFace.Point2 := MakeFPoint(StlFace.Vertex3);
  vFace.Point3 := vFace.Point2;
  vFace.ColorCAD := cnstColorCADByLayer;
  vFace.Layer := FLayer;
  CurrentLayout.AddEntity(vFace);
  Converter.Loads(vFace);
  Converter.DoCreate(vFace);
end;

function TsgSTLImage.CheckVertex(const AVertex: TsgSTLVertex): Boolean;
begin
  Result := IsNan(AVertex.X) or IsNan(AVertex.Y) or IsNan(AVertex.Z);
  Result := Result or IsInfinite(AVertex.X) or IsInfinite(AVertex.Y) or IsInfinite(AVertex.Z);
end;

constructor TsgSTLImage.Create;
begin
  inherited Create;
  FStlFile := TStringList.Create;
end;

destructor TsgSTLImage.Destroy;
begin
  FStlFile.Free;
  inherited Destroy;
end;

function TsgSTLImage.GetDefaultView: TsgDefaultView;
begin
  Result := df3D;
end;

function TsgSTLImage.GetHandle: UInt64;
begin
  Result := cnstBadHandle;
  TsgDXFConverterAccess(Converter).CheckHandle(Result);
end;

function TsgSTLImage.IsBinary(const Stream: TStream): Boolean;
const
  cnstAnalyzedSegmentSTLFile = $300;
  cnstNonAsciiChar = $7F;
  cntSTLFileHeaderLen = SizeOf(TsgSTLFileHeader)- SizeOf(Integer);
var
  I, vPos: Integer;
  vStream: TMemoryStream;
  vSTLPointerMem: PByte;
begin
  Result := False;
  if Stream.Size < cntSTLFileHeaderLen then
    Exit;
  vPos := Stream.Position;
  vStream := TMemoryStream.Create;
  try
    Stream.Position := cntSTLFileHeaderLen;
    vStream.CopyFrom(Stream, Min(Stream.Size - cntSTLFileHeaderLen,cnstAnalyzedSegmentSTLFile));
    vStream.Position := 0;
    vSTLPointerMem := vStream.Memory;
    for I := 0 to vStream.Size - 1 do
    begin
      if vSTLPointerMem^ >= cnstNonAsciiChar then
      begin
        Result := True;
        Break;
      end;
      Inc(vSTLPointerMem);
  end;
  finally
    vStream.Free;
    Stream.Position := vPos;
  end;
end;

procedure TsgSTLImage.LoadFromStream(S: TStream);
var
  vImage: TsgCADImage;
  vNeed2DViewByDefault: Boolean;
begin
  inherited LoadFromStream(S);
  FStlFile.Clear;
  vImage := Loading;
  if vImage <> nil then
    vImage.Converter.StopLoading;
  Loading := Self;
  try
    TsgDXFConverterAccess(Converter).SetLoading(True, nil);
    CurrentLayout := TsgDXFConverterAccess(Converter).Layouts[0];
    SetHandleForEntity(CurrentLayout);
    FLayer := Converter.LayerByName('0');
    FLayer.ColorCAD := ConvertARGBToColorCAD(clGray);
    LoadSTL(S);
    GetExtents;
    Set3DRotDef(Converter.Layouts[0].Box, vNeed2DViewByDefault);
    SetDefaultPlotSettings;
  finally
    TsgDXFConverterAccess(Converter).SetLoading(False, nil);
    Loading := nil;
  end;
end;

procedure TsgSTLImage.LoadSTL(S: TStream);
   procedure ReadSTLNormal(const NormalText: string; var Normal: TsgSTLVertex);
   begin
      FStlFile.CommaText := NormalText;
      if FStlFile.Count <> 5 then
        raise EsgSTLImageError.Create(sInvalidNormalError)
      else
      begin
         Normal.X := StrToDouble(FStlFile[2], '.');
         Normal.Y := StrToDouble(FStlFile[3], '.');
         Normal.Z := StrToDouble(FStlFile[4], '.');
      end;
   end;

   procedure ReadSTLVertex(const VertexText: string; Vertex: PsgSTLVertex);
   begin
      FStlFile.CommaText := VertexText;
      if (FStlFile.Count <> 4) or (Vertex = nil) or (CompareText(FStlFile[0], cntVertexLbl) <> 0) then
         raise EsgSTLImageError.Create(sInvalidVertex)
      else
      begin
         Vertex^.X := StrToDouble(FStlFile[1], '.');
         Vertex^.Y := StrToDouble(FStlFile[2], '.');
         Vertex^.Z := StrToDouble(FStlFile[3], '.');
      end;
   end;

   function ReadCurLine(const FileContent: TStringList; var Index: Integer): string;
   begin
     Result := Trim(UpperCase(FileContent[Index]));
     Inc(Index);
   end;

var
  vSTLFileContent: TStringList;
  vCurLine: string;
  I, J, vCount: Integer;
  vHeader: TsgSTLFileHeader;
  vStlFace: TsgSTLFace;
  P: PsgSTLVertex;
begin
  vCount := 100;
  try
    if IsBinary(S) then
    begin
      S.Read(vHeader, SizeOf(vHeader));
      // We can not rely on it, do the calculation
      // vCount := vHeader.NumFaces - 1;
      //if vCount < 0 then
        vCount := (S.Size - S.Position) div SizeOf(TsgSTLFace);
      DoOnProgress(psStarting, 1, vCount);
      for I := 0 to vCount - 1 do
      begin
        S.Read(vStlFace, SizeOf(TsgSTLFace));
        AddFace(vStlFace);
        DoOnProgress(psRunning, I + 1, vCount);
      end;
    end
    else
    begin
      vSTLFileContent := TStringList.Create;
      try
        vSTLFileContent.LoadFromStream(S);
        I := 0;
        vCount := vSTLFileContent.Count;
        DoOnProgress(psStarting, 1, vCount);
        while I <= vSTLFileContent.Count - 1 do
        begin
          vCurLine := ReadCurLine(vSTLFileContent, I);
          if Pos(cntFacetNormalLbl, vCurLine) = 1 then
          begin
            FillChar(vStlFace, SizeOf(vStlFace), 0);
            ReadSTLNormal(vCurLine, vStlFace.Normal);
            if Pos(cntOuterLoopLbl, ReadCurLine(vSTLFileContent, I)) = 1 then
            begin
              for J := 1 to 3 do
              begin
                case J of
                  1 : P := @vStlFace.Vertex1;
                  2 : P := @vStlFace.Vertex2;
                  3 : P := @vStlFace.Vertex3;
                else
                  P := nil;
                end;
                ReadSTLVertex(ReadCurLine(vSTLFileContent, I), P);
              end;
              if Pos(cntEndLoopLbl, ReadCurLine(vSTLFileContent, I)) <> 1 then
                raise EsgSTLImageError.Create(sInvalidLoop)
              else
                AddFace(vStlFace);
              if Pos(cntEndFacetLbl, ReadCurLine(vSTLFileContent, I)) <> 1 then
                raise EsgSTLImageError.Create(sInvalidFace);
              if Pos(cntEndSolidLbl, ReadCurLine(vSTLFileContent, I)) = 1 then
                Break
              else
                Dec(I);
             end;
          end;
          DoOnProgress(psRunning, I + 1, vCount);
        end;
       finally
        vSTLFileContent.Free;
      end;
    end;
  finally
    DoOnProgress(psEnding, vCount, vCount);
  end;
end;

function TsgSTLImage.MakeFPoint(const Vertex: TsgSTLVertex): TFPoint;
begin
  Result.X := Vertex.X;
  Result.Y := Vertex.Y;
  Result.Z := Vertex.Z;
end;

procedure TsgSTLImage.SetHandleForEntity(const Entity: TsgDXFEntity);
begin
  if Entity.Handle = cnstBadHandle then
    Entity.Handle := GetHandle;
end;

initialization
  CF_STL := RegisterClipboardFormat('SoftGold STL Image');
  TPicture.RegisterClipboardFormat(CF_STL, TsgSTLImage);
  TPicture.RegisterFileFormat('stl', sSTLImage, TsgSTLImage);
{$IFDEF SG_XREF_EXTENDED}
  TsgDXFConverterAccess.RegisterXRefGraphicClass('stl', TsgSTLImage);
{$ENDIF}

finalization
  TPicture.UnRegisterGraphicClass(TsgSTLImage);

end.
