fpvectorial: Merges the initial eps reader and some font, pen and brush improvements

git-svn-id: trunk@17693 -

.gitattributes

@@ -2627,6 +2627,7 @@ packages/fpvectorial/src/avisocncgcodewriter.pas svneol=native#text/pascal
 packages/fpvectorial/src/avisozlib.pas svneol=native#text/pascal
 packages/fpvectorial/src/cdrvectorialreader.pas svneol=native#text/pascal
 packages/fpvectorial/src/dxfvectorialreader.pas svneol=native#text/pascal
+packages/fpvectorial/src/epsvectorialreader.pas svneol=native#text/pascal
 packages/fpvectorial/src/fpvectbuildunit.pas svneol=native#text/pascal
 packages/fpvectorial/src/fpvectorial.pas svneol=native#text/pascal
 packages/fpvectorial/src/fpvtocanvas.pas svneol=native#text/pascal

packages/fpvectorial/src/epsvectorialreader.pas

@@ -0,0 +1,203 @@
+{
+Reads EPS files
+
+License: The same modified LGPL as the Free Pascal RTL
+         See the file COPYING.modifiedLGPL for more details
+
+AUTHORS: Felipe Monteiro de Carvalho
+
+}
+unit epsvectorialreader;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Math,
+  fpvectorial, fpimage;
+
+type
+  TPSTokenType = (ttComment, ttFloat);
+
+  TPSTokens = TFPList;// TPSToken;
+
+  TPSToken = class
+    StrValue: string;
+    FloatValue: double;
+    IntValue: Integer;
+    Childs: TPSTokens;
+  end;
+
+  TCommentToken = class(TPSToken)
+  end;
+
+  TPostScriptScannerState = (ssSearchingToken, ssInComment);
+
+  { TPSTokenizer }
+
+  TPSTokenizer = class
+  public
+    Tokens: TPSTokens;
+    constructor Create;
+    destructor Destroy; override;
+    procedure ReadFromStream(AStream: TStream);
+    procedure DebugOut();
+    function IsValidPostScriptChar(AChar: Byte): Boolean;
+  end;
+
+  { TvEPSFVectorialReader }
+
+  { TvEPSVectorialReader }
+
+  TvEPSVectorialReader = class(TvCustomVectorialReader)
+  private
+    FPointSeparator: TFormatSettings;
+  public
+    { General reading methods }
+    Tokenizer: TPSTokenizer;
+    constructor Create; override;
+    Destructor Destroy; override;
+    procedure ReadFromStream(AStream: TStream; AData: TvVectorialDocument); override;
+  end;
+
+implementation
+
+{ TPSTokenizer }
+
+constructor TPSTokenizer.Create;
+begin
+  inherited Create;
+  Tokens := TPSTokens.Create;
+end;
+
+destructor TPSTokenizer.Destroy;
+begin
+  Tokens.Free;
+  inherited Destroy;
+end;
+
+{@@ Rules for parsing PostScript files:
+
+* Coments go from the first occurence of % outside a line to the next new line
+* The only accepted characters are printable ASCII ones, plus spacing ASCII chars
+  See IsValidPostScriptChar about that
+}
+procedure TPSTokenizer.ReadFromStream(AStream: TStream);
+var
+  i: Integer;
+  CurChar: Char;
+  State: TPostScriptScannerState = ssSearchingToken;
+  CommentToken: TCommentToken;
+begin
+  while AStream.Position < AStream.Size do
+  begin
+    CurChar := Char(AStream.ReadByte());
+    if not IsValidPostScriptChar(Byte(CurChar)) then
+      raise Exception.Create('[TPSTokenizer.ReadFromStream] Invalid char: ' + IntToHex(Byte(CurChar), 2));
+
+    case State of
+      { Searching for a token }
+      ssSearchingToken:
+      begin
+        case CurChar of
+          '%':
+          begin
+            CommentToken := TCommentToken.Create;
+            State := ssInComment;
+          end;
+        end;
+
+      end;
+
+      { Passing by comments }
+      ssInComment:
+      begin
+        CommentToken.StrValue := CommentToken.StrValue + CurChar;
+
+        case CurChar of
+          #13:
+          begin
+            // Check if this is a Windows-style #13#10 line end marker by getting one more char
+            if AStream.ReadByte() <> 10 then AStream.Seek(-1, soFromCurrent); // Go back if it wasnt a #13#10
+
+            Tokens.Add(CommentToken);
+            State := ssSearchingToken;
+          end;
+          #10:
+          begin
+            Tokens.Add(CommentToken);
+            State := ssSearchingToken;
+          end;
+        end; // case
+      end; // ssInComment
+
+    end; // case
+  end; // while
+end;
+
+procedure TPSTokenizer.DebugOut();
+var
+  i: Integer;
+  Token: TPSToken;
+begin
+  for i := 0 to Tokens.Count - 1 do
+  begin
+    Token := TPSToken(Tokens.Items[i]);
+
+    if Token is TCommentToken then
+    begin
+      WriteLn(Format('TCommentToken StrValue=%s', [Token.StrValue]));
+    end;
+  end;
+end;
+
+{@@ Valid PostScript Chars:
+
+All printable ASCII: a..zA..Z0..9 plus punctuation
+
+Plus the following white spaces
+000 00 0 Null (nul)
+011 09 9 Tab (tab)
+012 0A 10 Line feed (LF)
+014 0C 12 Form feed (FF)
+015 0D 13 Carriage return (CR)
+040 20 32 Space (SP)
+}
+function TPSTokenizer.IsValidPostScriptChar(AChar: Byte): Boolean;
+begin
+  Result := ((AChar > 32) and (AChar < 127)) or (AChar in [0, 9, 10, 12, 13, 32]);
+end;
+
+{$ifndef Windows}
+{$define FPVECTORIALDEBUG}
+{$endif}
+
+{ TvEPSVectorialReader }
+
+constructor TvEPSVectorialReader.Create;
+begin
+  inherited Create;
+
+  Tokenizer := TPSTokenizer.Create;
+end;
+
+destructor TvEPSVectorialReader.Destroy;
+begin
+  Tokenizer.Free;
+  inherited Destroy;
+end;
+
+procedure TvEPSVectorialReader.ReadFromStream(AStream: TStream;
+  AData: TvVectorialDocument);
+begin
+  Tokenizer.ReadFromStream(AStream);
+  Tokenizer.DebugOut();
+end;
+
+initialization
+
+  RegisterVectorialReader(TvEPSVectorialReader, vfEncapsulatedPostScript);
+
+end.
+

packages/fpvectorial/src/fpvectbuildunit.pas

@@ -4,7 +4,7 @@ interface
 Uses
    avisocncgcodereader,avisocncgcodewriter,avisozlib,fpvectorial,
    fpvtocanvas,pdfvectorialreader,pdfvrlexico,pdfvrsemantico,pdfvrsintatico,
-   svgvectorialwriter,cdrvectorialreader;
+   svgvectorialwriter,cdrvectorialreader,epsvectorialreader;
 
 implementation
-end.
+end.

packages/fpvectorial/src/fpvectorial.pas

@@ -24,9 +24,11 @@ uses
 type
   TvVectorialFormat = (
     { Multi-purpose document formats }
-    vfPDF, vfPostScript, vfSVG, vfCorelDrawCDR, vfWindowsMetafileWMF,
+    vfPDF, vfSVG, vfCorelDrawCDR, vfWindowsMetafileWMF,
     { CAD formats }
     vfDXF,
+    { Printing formats }
+    vfPostScript, vfEncapsulatedPostScript,
     { GCode formats }
     vfGCodeAvisoCNCPrototipoV5, vfGCodeAvisoCNCPrototipoV6);
 
@@ -39,6 +41,7 @@ const
   STR_CORELDRAW_EXTENSION = '.cdr';
   STR_WINMETAFILE_EXTENSION = '.wmf';
   STR_AUTOCAD_EXCHANGE_EXTENSION = '.dxf';
+  STR_ENCAPSULATEDPOSTSCRIPT_EXTENSION = '.eps';
 
 type
   {@@ We need our own format because TFPColor is too big for our needs and TColor has no Alpha }
@@ -62,6 +65,7 @@ const
   FPValphaOpaque = $FF;
 
   clvBlack: TvColor = (Red: $00; Green: $00; Blue: $00; Alpha: FPValphaOpaque);
+  clvBlue: TvColor = (Red: $00; Green: $00; Blue: $FF; Alpha: FPValphaOpaque);
 
 type
   T3DPoint = record
@@ -149,6 +153,18 @@ type
     function Next(): TPathSegment;
   end;
 
+  TvFont = record
+    Color: TvColor;
+    Size: integer;
+    Name: utf8string;
+    {@@
+      Font orientation is measured in degrees and uses the
+      same direction as the LCL TFont.orientation, which is counter-clockwise.
+      Zero is the normal, horizontal, orientation.
+    }
+    Orientation: Double;
+  end;
+
   {@@
     TvText represents a text in memory.
 
@@ -159,17 +175,19 @@ type
   public
     X, Y, Z: Double; // Z is ignored in 2D formats
     Value: utf8string;
-    FontColor: TvColor;
-    FontSize: integer;
-    FontName: utf8string;
+    Font: TvFont;
   end;
 
   {@@
   }
+
+  { TvEntity }
+
   TvEntity = class
   public
     Pen: TvPen;
     Brush: TvBrush;
+    constructor Create; virtual;
   end;
 
   {@@
@@ -205,6 +223,11 @@ type
   end;
 
   {@@
+   DimensionLeft ---text--- DimensionRight
+                 |        |
+                 |        | BaseRight
+                 |
+                 | BaseLeft
   }
 
   { TvAlignedDimension }
@@ -340,6 +363,7 @@ procedure RegisterVectorialReader(
 procedure RegisterVectorialWriter(
   AWriterClass: TvVectorialWriterClass;
   AFormat: TvVectorialFormat);
+function Make2DPoint(AX, AY: Double): T3DPoint;
 
 implementation
 
@@ -430,6 +454,23 @@ begin
   end;
 end;
 
+function Make2DPoint(AX, AY: Double): T3DPoint;
+begin
+  Result.X := AX;
+  Result.Y := AY;
+  Result.Z := 0;
+end;
+
+{ TvEntity }
+
+constructor TvEntity.Create;
+begin
+  Pen.Style := psSolid;
+  Pen.Color := clvBlack;
+  Brush.Style := bsClear;
+  Brush.Color := clvBlue;
+end;
+
 { TvEllipse }
 
 procedure TvEllipse.CalculateBoundingRectangle;
@@ -713,8 +754,8 @@ begin
   lText.X := AX;
   lText.Y := AY;
   lText.Z := AZ;
-  lText.FontName := FontName;
-  lText.FontSize := FontSize;
+  lText.Font.Name := FontName;
+  lText.Font.Size := FontSize;
   FTexts.Add(lText);
 end;
 
@@ -839,6 +880,10 @@ begin
   FTmpPath.Points := nil;
   FTmpPath.PointsEnd := nil;
   FTmpPath.Len := 0;
+  FTmpPath.Brush.Color := clvBlue;
+  FTmpPath.Brush.Style := bsClear;
+  FTmpPath.Pen.Color := clvBlack;
+  FTmpPath.Pen.Style := psSolid;
 end;
 
 procedure TvVectorialDocument.AppendSegmentToTmpPath(ASegment: TPathSegment);
@@ -1000,6 +1045,7 @@ begin
   else if AnsiCompareText(lExt, STR_CORELDRAW_EXTENSION) = 0 then Result := vfCorelDrawCDR
   else if AnsiCompareText(lExt, STR_WINMETAFILE_EXTENSION) = 0 then Result := vfWindowsMetafileWMF
   else if AnsiCompareText(lExt, STR_AUTOCAD_EXCHANGE_EXTENSION) = 0 then Result := vfDXF
+  else if AnsiCompareText(lExt, STR_ENCAPSULATEDPOSTSCRIPT_EXTENSION) = 0 then Result := vfEncapsulatedPostScript
   else
     raise Exception.Create('TvVectorialDocument.GetFormatFromExtension: The extension (' + lExt + ') doesn''t match any supported formats.');
 end;

packages/fpvectorial/src/fpvtocanvas.pas

@@ -4,7 +4,7 @@ unit fpvtocanvas;
 
 interface
 
-{$define USE_LCL_CANVAS}
+{.$define USE_LCL_CANVAS}
 
 uses
   Classes, SysUtils, Math,
@@ -42,6 +42,11 @@ begin
 end;
 {$endif}
 
+function VColorToFPColor(AVColor: TvColor): TFPColor; inline;
+begin
+  Result := FPColor(AVColor.Red*$100, AVColor.Green*$100, AVColor.Blue*$100);
+end;
+
 function Rotate2DPoint(P,Fix :TPoint; alpha:double): TPoint;
 var
   sinus, cosinus : Extended;
@@ -142,6 +147,7 @@ procedure DrawFPVPathsToCanvas(ASource: TvVectorialDocument;
 var
   i, j, k: Integer;
   PosX, PosY: Integer; // Not modified by ADestX, etc
+  CurPath: TPath;
   CurSegment: TPathSegment;
   Cur2DSegment: T2DSegment absolute CurSegment;
   Cur2DBSegment: T2DBezierSegment absolute CurSegment;
@@ -160,16 +166,28 @@ begin
   for i := 0 to ASource.PathCount - 1 do
   begin
     //WriteLn('i = ', i);
-    ASource.Paths[i].PrepareForSequentialReading;
+    CurPath := ASource.Paths[i];
+    CurPath.PrepareForSequentialReading;
+
+    // Set the path Pen and Brush options
+    ADest.Pen.Style := CurPath.Pen.Style;
+    ADest.Brush.Style := CurPath.Brush.Style;
+    {$ifdef USE_LCL_CANVAS}
+    ADest.Pen.Color := VColorToTColor(CurPath.Pen.Color);
+    ADest.Brush.Color := VColorToTColor(CurPath.Brush.Color);
+    {$else}
+    ADest.Pen.FPColor := VColorToFPColor(CurPath.Pen.Color);
+    ADest.Brush.FPColor := VColorToFPColor(CurPath.Brush.Color);
+    {$endif}
 
     {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
     Write(Format('[Path] ID=%d', [i]));
     {$endif}
 
-    for j := 0 to ASource.Paths[i].Len - 1 do
+    for j := 0 to CurPath.Len - 1 do
     begin
       //WriteLn('j = ', j);
-      CurSegment := TPathSegment(ASource.Paths[i].Next());
+      CurSegment := TPathSegment(CurPath.Next());
 
       case CurSegment.SegmentType of
       stMoveTo:
@@ -179,11 +197,18 @@ begin
         Write(Format(' M%d,%d', [CoordToCanvasX(Cur2DSegment.X), CoordToCanvasY(Cur2DSegment.Y)]));
         {$endif}
       end;
+      // This element can override temporarely the Pen
       st2DLineWithPen:
       begin
-        {$ifdef USE_LCL_CANVAS}ADest.Pen.Color := VColorToTColor(T2DSegmentWithPen(Cur2DSegment).Pen.Color);{$endif}
+        {$ifdef USE_LCL_CANVAS}
+          ADest.Pen.Color := VColorToTColor(T2DSegmentWithPen(Cur2DSegment).Pen.Color);
+        {$endif}
+
         ADest.LineTo(CoordToCanvasX(Cur2DSegment.X), CoordToCanvasY(Cur2DSegment.Y));
-        {$ifdef USE_LCL_CANVAS}ADest.Pen.Color := clBlack;{$endif}
+
+        {$ifdef USE_LCL_CANVAS}
+          ADest.Pen.Color := VColorToTColor(CurPath.Pen.Color);
+        {$endif}
         {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
         Write(Format(' L%d,%d', [CoordToCanvasX(Cur2DSegment.X), CoordToCanvasY(Cur2DSegment.Y)]));
         {$endif}
@@ -252,12 +277,21 @@ var
   Points: array of TPoint;
   UpperDim, LowerDim: T3DPoint;
 begin
-  ADest.Brush.Style := bsClear;
-
   // Draws all entities
   for i := 0 to ASource.GetEntityCount - 1 do
   begin
     CurEntity := ASource.GetEntity(i);
+
+    ADest.Brush.Style := CurEntity.Brush.Style;
+    ADest.Pen.Style := CurEntity.Pen.Style;
+    {$ifdef USE_LCL_CANVAS}
+    ADest.Pen.Color := VColorToTColor(CurEntity.Pen.Color);
+    ADest.Brush.Color := VColorToTColor(CurEntity.Brush.Color);
+    {$else}
+    ADest.Pen.FPColor := VColorToFPColor(CurEntity.Pen.Color);
+    ADest.Brush.FPColor := VColorToFPColor(CurEntity.Brush.Color);
+    {$endif}
+
     if CurEntity is TvCircle then
     begin
       CurCircle := CurEntity as TvCircle;
@@ -457,7 +491,8 @@ begin
   for i := 0 to ASource.GetTextCount - 1 do
   begin
     CurText := ASource.GetText(i);
-    ADest.Font.Size := Round(AmulX * CurText.FontSize);
+
+    ADest.Font.Size := Round(AmulX * CurText.Font.Size);
     ADest.Pen.Style := psSolid;
     {$ifdef USE_LCL_CANVAS}
     ADest.Pen.Color := clBlack;
@@ -465,7 +500,9 @@ begin
     ADest.Pen.FPColor := colBlack;
     {$endif}
     ADest.Brush.Style := bsClear;
-    LowerDim.Y := CurText.Y + CurText.FontSize;
+    ADest.Font.Orientation := Round(CurText.Font.Orientation * 16);
+
+    LowerDim.Y := CurText.Y + CurText.Font.Size;
     ADest.TextOut(CoordToCanvasX(CurText.X), CoordToCanvasY(LowerDim.Y), CurText.Value);
   end;
 end;

packages/fpvectorial/src/svgvectorialwriter.pas

@@ -243,7 +243,7 @@ begin
         AData, lText.X, lText.Y, PtX, PtY);
 
     TextStr := lText.Value;
-    FontSize:= ceil(lText.FontSize / FLOAT_MILIMETERS_PER_PIXEL);
+    FontSize:= ceil(lText.Font.Size / FLOAT_MILIMETERS_PER_PIXEL);
     SVGFontFamily := 'Arial, sans-serif';//lText.FontName;
 
     AStrings.Add('  <text ');