fpvectorial: Merges large changes to the EPS reader and to the Canvas output from the Lazarus-ccr. Now it works perfectly with the testcases

git-svn-id: trunk@18977 -

packages/fpvectorial/src/epsvectorialreader.pas

@@ -7,6 +7,8 @@ License: The same modified LGPL as the Free Pascal RTL
 AUTHORS: Felipe Monteiro de Carvalho
 
 Documentation: http://www.tailrecursive.org/postscript/postscript.html
+
+Good reference: http://atrey.karlin.mff.cuni.cz/~milanek/PostScript/Reference/PSL2e.html
 }
 unit epsvectorialreader;
 
@@ -16,6 +18,11 @@ unit epsvectorialreader;
 {.$define FPVECTORIALDEBUG_COLORS}
 {.$define FPVECTORIALDEBUG_ROLL}
 {.$define FPVECTORIALDEBUG_CODEFLOW}
+{.$define FPVECTORIALDEBUG_INDEX}
+{.$define FPVECTORIALDEBUG_DICTIONARY}
+{.$define FPVECTORIALDEBUG_CONTROL}
+{.$define FPVECTORIALDEBUG_ARITHMETIC}
+{.$define FPVECTORIALDEBUG_CLIP_REGION}
 
 interface
 
@@ -51,7 +58,7 @@ type
     destructor Destroy; override;
   end;
 
-  TETType = (ettNamedElement, ettOperand, ettOperator);
+  TETType = (ettNamedElement, ettOperand, ettOperator, ettDictionary);
 
   { TExpressionToken }
 
@@ -71,8 +78,13 @@ type
   public
     Color: TFPColor;
     TranslateX, TranslateY: Double;
+    ScaleX, ScaleY: Double; // not used currently
     ClipPath: TPath;
     ClipMode: TvClipMode;
+    OverPrint: Boolean; // not used currently
+    //
+    PenWidth: Integer;
+    //
     function Duplicate: TGraphicState;
   end;
 
@@ -81,7 +93,8 @@ type
   TPSTokenizer = class
   public
     Tokens: TPSTokens;
-    constructor Create;
+    FCurLine: Integer;
+    constructor Create(ACurLine: Integer = -1);
     destructor Destroy; override;
     procedure ReadFromStream(AStream: TStream);
     procedure DebugOut();
@@ -146,7 +159,12 @@ begin
   Result.Color := Color;
   Result.TranslateX := TranslateX;
   Result.TranslateY := TranslateY;
+  Result.ScaleX := ScaleX;
+  Result.ScaleY := ScaleY;
   Result.ClipPath := ClipPath;
+  Result.ClipMode := ClipMode;
+  Result.OverPrint := OverPrint;
+  Result.PenWidth := PenWidth;
 end;
 
 { TPSToken }
@@ -202,10 +220,13 @@ end;
 
 { TPSTokenizer }
 
-constructor TPSTokenizer.Create;
+// ACurLine < 0 indicates that we should use the line of this list of strings
+// else we use ACurLine
+constructor TPSTokenizer.Create(ACurLine: Integer);
 begin
   inherited Create;
   Tokens := TPSTokens.Create;
+  FCurLine := ACurLine;
 end;
 
 destructor TPSTokenizer.Destroy;
@@ -243,6 +264,7 @@ begin
 
     lIsEndOfLine := IsEndOfLine(Byte(CurChar), AStream);
     if lIsEndOfLine then Inc(CurLine);
+    if FCurLine >= 0 then CurLine := FCurLine;
 
     case State of
       { Searching for a token }
@@ -540,7 +562,7 @@ begin
 
   if not AToken.Parsed then
   begin
-    ProcTokenizer := TPSTokenizer.Create;
+    ProcTokenizer := TPSTokenizer.Create(AToken.Line);
     lStream := TMemoryStream.Create;
     try
       // Copy the string to a Stream
@@ -773,13 +795,21 @@ begin
     Stack.Push(NewToken);
     Exit(True);
   end;
+  // anyn … any0 n index anyn … any0 anyn
   // Duplicate arbitrary element
   if AToken.StrValue = 'index' then
   begin
+    {$ifdef FPVECTORIALDEBUG_INDEX}
+    WriteLn('[TvEPSVectorialReader.ExecuteStackManipulationOperator] index');
+//    DebugStack();
+    {$endif}
+
     Param1 := TPSToken(Stack.Pop);
     lIndexN := Round(Param1.FloatValue);
     SetLength(lTokens, lIndexN+1);
 
+    if lIndexN < 0 then raise Exception.Create('[TvEPSVectorialReader.ExecuteStackManipulationOperator] index operator: n must be positive or zero');
+
     // Unroll all elements necessary
 
     for i := 0 to lIndexN do
@@ -788,8 +818,7 @@ begin
       Param2 := lTokens[i];
       if Param2 = nil then
       begin
-        // raise Exception.Create('[TvEPSVectorialReader.ExecuteStackManipulationOperator] nil element poped in operator index');
-        Exit(True);
+        raise Exception.Create(Format('[TvEPSVectorialReader.ExecuteStackManipulationOperator] Stack underflow in operation "index". Error at line %d', [AToken.Line]));
       end;
     end;
 
@@ -839,7 +868,7 @@ begin
     WriteLn(Format('[TvEPSVectorialReader] roll: N=%d J=%d', [lIndexN, lIndexJ]));
     {$endif}
 
-    if lIndexN < 0 then raise Exception.Create('[TvEPSVectorialReader.ExecuteStackManipulationOperator] rool operator: n must be positive');
+    if lIndexN < 0 then raise Exception.Create('[TvEPSVectorialReader.ExecuteStackManipulationOperator] rool operator: n must be positive or zero');
 
     if lIndexJ = 0 then Exit;
 
@@ -853,8 +882,8 @@ begin
       Param2 := lTokens[i];
       if Param2 = nil then
       begin
-        // raise Exception.Create('[TvEPSVectorialReader.ExecuteStackManipulationOperator] nil element poped in operator index');
-        Exit(True);
+        raise Exception.Create('[TvEPSVectorialReader.ExecuteStackManipulationOperator] nil element poped in operator index');
+        //Exit(True);
       end;
     end;
 
@@ -929,7 +958,7 @@ end;
 function TvEPSVectorialReader.ExecuteControlOperator(AToken: TExpressionToken;
   AData: TvVectorialDocument): Boolean;
 var
-  Param1, Param2, Param3, Param4: TPSToken;
+  Param1, Param2, Param3, Param4, CounterToken: TPSToken;
   NewToken: TExpressionToken;
   FloatCounter: Double;
 begin
@@ -972,9 +1001,33 @@ begin
 
     Exit(True);
   end;
-  // Establish context for catching stop
+  {
+    Establish context for catching stop
+
+     executes any, which is typically, but not necessarily, a procedure, executable file,
+     or executable string object. If any runs to completion normally, stopped returns false on the operand stack.
+
+     If any terminates prematurely as a result of executing stop, stopped returns
+     true on the operand stack. Regardless of the outcome, the interpreter resumes execution at the next object in normal sequence after stopped.
+     This mechanism provides an effective way for a PostScript language program
+     to "catch" errors or other premature terminations, retain control, and perhaps perform its own error recovery.
+
+     EXAMPLE:
+     { ... } stopped {handleerror} if
+
+     If execution of the procedure {...} causes an error,
+     the default error-reporting procedure is invoked (by handleerror).
+     In any event, normal execution continues at the token following the if.
+
+     ERRORS: stackunderflow
+  }
   if AToken.StrValue = 'stopped' then
   begin
+    {$ifdef FPVECTORIALDEBUG_CONTROL}
+    WriteLn('[TvEPSVectorialReader.ExecuteControlOperator] stopped');
+//    DebugStack();
+    {$endif}
+
     Param1 := TPSToken(Stack.Pop);
 
     if not (Param1 is TProcedureToken) then
@@ -1011,7 +1064,51 @@ begin
 
     Exit(True);
   end;
-  // initial increment limit proc for
+  { initial increment limit proc for -
+
+   executes proc repeatedly, passing it a sequence of values from initial
+   by steps of increment to limit. The for operator expects initial, increment,
+   and limit to be numbers. It maintains a temporary internal variable, known as
+   the control variable, which it first sets to initial. Then, before each
+   repetition, it compares the control variable with the termination value limit.
+   If limit has not been exceeded, it pushes the control variable on the operand
+   stack, executes proc, and adds increment to the control variable.
+
+   The termination condition depends on whether increment is positive or negative.
+   If increment is positive, for terminates when the control variable becomes
+   greater than limit. If increment is negative, for terminates when the control
+   variable becomes less than limit. If initial meets the termination condition,
+   for does not execute proc at all. If proc executes the exit operator,
+   for terminates prematurely.
+
+   Usually, proc will use the value on the operand stack for some purpose.
+   However, if proc does not remove the value, it will remain there.
+   Successive executions of proc will cause successive values of the control
+   variable to accumulate on the operand stack.
+
+   EXAMPLE:
+   0 1 1 4 {add} for -> 10
+   1 2 6 { } for -> 1 3 5
+   3 -.5 1 {-> } for -> 3.0 2.5 2.0 1.5 1.0
+
+   In the first example, the value of the control variable is added to whatever
+   is on the stack, so 1, 2, 3, and 4 are added in turn to a running sum whose
+   initial value is 0. The second example has an empty procedure, so the
+   successive values of the control variable are left on the stack. The
+   last example counts backward from 3 to 1 by halves, leaving the successive
+   values on the stack.
+
+   Beware of using reals instead of integers for any of the first three operands.
+   Most real numbers are not represented exactly. This can cause an error to
+   accumulate in the value of the control variable, with possibly surprising results.
+   In particular, if the difference between initial and limit is a multiple of
+   increment, as in the third line of the example, the control variable may not
+   achieve the limit value.
+
+   ERRORS: stackoverflow stackunderflow, typecheck
+
+   SEE ALSO: repeat, loop, forall, exit
+  }
   if AToken.StrValue = 'for' then
   begin
     Param1 := TPSToken(Stack.Pop);
@@ -1025,9 +1122,19 @@ begin
     FloatCounter := Param4.FloatValue;
     while FloatCounter < Param2.FloatValue do
     begin
+      CounterToken := Param4.Duplicate();
+      CounterToken.FloatValue := FloatCounter;
+      Stack.Push(CounterToken);
+
       ExecuteProcedureToken(TProcedureToken(Param1), AData);
 
       FloatCounter := FloatCounter + Param3.FloatValue;
+
+      if ExitCalled then
+      begin
+        ExitCalled := False;
+        Break;
+      end;
     end;
 
     Exit(True);
@@ -1036,6 +1143,11 @@ begin
   // if it is executable or false if it is literal
   if AToken.StrValue = 'xcheck' then
   begin
+//    {$ifdef FPVECTORIALDEBUG_CONTROL}
+//    WriteLn('[TvEPSVectorialReader.ExecuteControlOperator] xcheck');
+//    DebugStack();
+//    {$endif}
+
     Param1 := TPSToken(Stack.Pop);
 
     NewToken := TExpressionToken.Create;
@@ -1119,6 +1231,12 @@ begin
     {$ifdef FPVECTORIALDEBUG_PATHS}
     WriteLn('[TvEPSVectorialReader.ExecutePaintingOperator] stroke');
     {$endif}
+    AData.SetPenStyle(psSolid);
+    AData.SetBrushStyle(bsClear);
+    AData.SetPenColor(CurrentGraphicState.Color);
+    AData.SetClipPath(CurrentGraphicState.ClipPath, CurrentGraphicState.ClipMode);
+    AData.SetPenWidth(CurrentGraphicState.PenWidth);
+    AData.EndPath();
     Exit(True);
   end;
 
@@ -1128,6 +1246,10 @@ begin
     WriteLn('[TvEPSVectorialReader.ExecutePaintingOperator] eofill');
     {$endif}
     AData.SetBrushStyle(bsSolid);
+    AData.SetPenStyle(psSolid);
+    AData.SetClipPath(CurrentGraphicState.ClipPath, CurrentGraphicState.ClipMode);
+    AData.SetPenWidth(CurrentGraphicState.PenWidth);
+    AData.EndPath();
 
     Exit(True);
   end;
@@ -1378,7 +1500,7 @@ begin
   Result := False;
 
   // Division
-  // Param2 Param1 div ==> Param2 div Param1
+  // Param2 Param1 div ==> (Param2 div Param1)
   if AToken.StrValue = 'div' then
   begin
     Param1 := TPSToken(Stack.Pop);
@@ -1386,12 +1508,15 @@ begin
     NewToken := TExpressionToken.Create;
     NewToken.ETType := ettOperand;
     NewToken.FloatValue := Param2.FloatValue / Param1.FloatValue;
-    NewToken.StrValue := FloatToStr(Param1.FloatValue);
+    NewToken.StrValue := FloatToStr(NewToken.FloatValue);
     Stack.Push(NewToken);
+    {$ifdef FPVECTORIALDEBUG_ARITHMETIC}
+    WriteLn(Format('[TvEPSVectorialReader.ExecuteArithmeticAndMathOperator] %f %f div %f', [Param2.FloatValue, Param1.FloatValue, NewToken.FloatValue]));
+    {$endif}
     Exit(True);
   end;
 
-  // Param2 Param1 mul ==> Param2 mul Param1
+  // Param2 Param1 mul ==> (Param2 mul Param1)
   if AToken.StrValue = 'mul' then
   begin
     Param1 := TPSToken(Stack.Pop);
@@ -1399,7 +1524,7 @@ begin
     NewToken := TExpressionToken.Create;
     NewToken.ETType := ettOperand;
     NewToken.FloatValue := Param2.FloatValue * Param1.FloatValue;
-    NewToken.StrValue := FloatToStr(Param1.FloatValue);
+    NewToken.StrValue := FloatToStr(NewToken.FloatValue);
     Stack.Push(NewToken);
     Exit(True);
   end;
@@ -1411,7 +1536,7 @@ begin
     Param1 := TPSToken(Stack.Pop); // num2
     Param2 := TPSToken(Stack.Pop); // num1
     NewToken.FloatValue := Param2.FloatValue - Param1.FloatValue;
-    NewToken.StrValue := FloatToStr(Param1.FloatValue);
+    NewToken.StrValue := FloatToStr(NewToken.FloatValue);
     Stack.Push(NewToken);
     Exit(True);
   end;
@@ -1464,62 +1589,71 @@ var
 begin
   Result := False;
 
-  //
+  // – newpath –              Initialize current path to be empty
   if AToken.StrValue = 'newpath' then
   begin
     {$ifdef FPVECTORIALDEBUG_PATHS}
     WriteLn('[TvEPSVectorialReader.ExecutePathConstructionOperator] newpath');
     {$endif}
-    AData.SetClipPath(CurrentGraphicState.ClipPath, CurrentGraphicState.ClipMode);
+//    AData.SetClipPath(CurrentGraphicState.ClipPath, CurrentGraphicState.ClipMode);
+//    AData.SetPenWidth(CurrentGraphicState.PenWidth);
+//    AData.SetClipPath(CurrentGraphicState.ClipPath, CurrentGraphicState.ClipMode);
+    AData.SetBrushStyle(bsClear);
+    AData.SetPenStyle(psClear);
     AData.EndPath();
     AData.StartPath();
 
     AData.SetPenColor(CurrentGraphicState.Color);
     AData.SetBrushColor(CurrentGraphicState.Color);
+    AData.SetPenStyle(psClear);
 
     Exit(True);
   end;
-  // Param2 Param1 moveto ===> moveto(X=Param2, Y=Param1);
+  // Param2 Param1 moveto - ===> moveto(X=Param2, Y=Param1);
   if AToken.StrValue = 'moveto' then
   begin
     Param1 := TPSToken(Stack.Pop);
     Param2 := TPSToken(Stack.Pop);
     PostScriptCoordsToFPVectorialCoords(Param1, Param2, PosX, PosY);
-    PosX := PosX + CurrentGraphicState.TranslateX;
-    PosY := PosY + CurrentGraphicState.TranslateY;
+    PosX2 := PosX + CurrentGraphicState.TranslateX;
+    PosY2 := PosY + CurrentGraphicState.TranslateY;
     {$ifdef FPVECTORIALDEBUG_PATHS}
-    WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] moveto %f, %f', [PosX, PosY]));
+    WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] moveto %f, %f CurrentGraphicState.Translate %f, %f Resulting Value %f, %f',
+      [PosX, PosY, CurrentGraphicState.TranslateX, CurrentGraphicState.TranslateY, PosX2, PosY2]));
     {$endif}
-    AData.AddMoveToPath(PosX, PosY);
+    AData.AddMoveToPath(PosX2, PosY2);
     Exit(True);
   end;
   // Absolute LineTo
+  // x y lineto –             Append straight line to (x, y)
   if AToken.StrValue = 'lineto' then
   begin
     Param1 := TPSToken(Stack.Pop);
     Param2 := TPSToken(Stack.Pop);
     PostScriptCoordsToFPVectorialCoords(Param1, Param2, PosX, PosY);
-    PosX := PosX + CurrentGraphicState.TranslateX;
-    PosY := PosY + CurrentGraphicState.TranslateY;
+    PosX2 := PosX + CurrentGraphicState.TranslateX;
+    PosY2 := PosY + CurrentGraphicState.TranslateY;
     {$ifdef FPVECTORIALDEBUG_PATHS}
-    WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] lineto %f, %f', [PosX, PosY]));
+    WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] lineto %f, %f Resulting value %f, %f', [PosX, PosY, PosX2, PosY2]));
     {$endif}
-    AData.AddLineToPath(PosX, PosY);
+    AData.AddLineToPath(PosX2, PosY2);
     Exit(True);
   end;
   // Relative LineTo
+  // dx dy rlineto –          Perform relative lineto
   if AToken.StrValue = 'rlineto' then
   begin
     Param1 := TPSToken(Stack.Pop);
     Param2 := TPSToken(Stack.Pop);
     PostScriptCoordsToFPVectorialCoords(Param1, Param2, PosX, PosY);
     AData.GetCurrentPathPenPos(BaseX, BaseY);
-    PosX := PosX + CurrentGraphicState.TranslateX;
-    PosY := PosY + CurrentGraphicState.TranslateY;
+    PosX2 := PosX + BaseX;
+    PosY2 := PosY + BaseY;
     {$ifdef FPVECTORIALDEBUG_PATHS}
-    WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] rlineto %f, %f', [BaseX + PosX, BaseY + PosY]));
+    WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] rlineto %f, %f Base %f, %f Resulting %f, %f',
+      [PosX, PosY, BaseX, BaseY, PosX2, PosY2]));
     {$endif}
-    AData.AddLineToPath(BaseX + PosX, BaseY + PosY);
+    AData.AddLineToPath(PosX2, PosY2);
     Exit(True);
   end;
   // dx1 dy1 dx2 dy2 dx3 dy3 rcurveto –
@@ -1543,10 +1677,10 @@ begin
     PostScriptCoordsToFPVectorialCoords(Param1, Param2, PosX3, PosY3);
     AData.GetCurrentPathPenPos(BaseX, BaseY);
     // First move to the start of the arc
-    BaseX := BaseX + CurrentGraphicState.TranslateX;
-    BaseY := BaseY + CurrentGraphicState.TranslateY;
+//    BaseX := BaseX + CurrentGraphicState.TranslateX;
+//    BaseY := BaseY + CurrentGraphicState.TranslateY;
     {$ifdef FPVECTORIALDEBUG_PATHS}
-    WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] translate %f, %f',
+    WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] rcurveto translate %f, %f',
       [CurrentGraphicState.TranslateX, CurrentGraphicState.TranslateY]));
     WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] rcurveto from %f, %f via %f, %f %f, %f to %f, %f',
       [BaseX, BaseY, BaseX + PosX, BaseY + PosY, BaseX + PosX2, BaseY + PosY2, BaseX + PosX3, BaseY + PosY3]));
@@ -1554,6 +1688,7 @@ begin
     AData.AddBezierToPath(BaseX + PosX, BaseY + PosY, BaseX + PosX2, BaseY + PosY2, BaseX + PosX3, BaseY + PosY3);
     Exit(True);
   end;
+  // – closepath –
   //
   // Don't do anything, because a stroke or fill might come after closepath
   // and newpath will be called after stroke and fill anyway
@@ -1604,18 +1739,33 @@ begin
       AData.AddMoveToPath(P1.X, P1.Y);
       AData.AddBezierToPath(P2.X, P2.Y, P3.X, P3.Y, P4.X, P4.Y);
     end;
-//    {$ifdef FPVECTORIALDEBUG}
-//    WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] rcurveto %f, %f', [BaseX + PosX, BaseY + PosY]));
-//    {$endif}
     {$ifdef FPVECTORIALDEBUG_PATHS}
-    WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] arc %f, %f', [PosX, PosY]));
+    WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] arc X,Y=%f, %f Resulting X,Y=%f, %f R=%f Angles Start,End=%f,%f',
+      [Param5.FloatValue, Param4.FloatValue, PosX, PosY, Param3.FloatValue, Param2.FloatValue, Param1.FloatValue]));
     {$endif}
     Exit(True);
   end;
   // – eoclip – Clip using even-odd rule
+  //
+  // intersects the inside of the current clipping path with the inside
+  // of the current path to produce a new, smaller current clipping path.
+  // The inside of the current path is determined by the even-odd rule,
+  // while the inside of the current clipping path is determined by whatever
+  // rule was used at the time that path was created.
+  //
+  // Except for the choice of insideness rule, the behavior of eoclip is identical to that of clip.
+  //
+  // ERRORS: limitcheck
+  //
   if AToken.StrValue = 'eoclip' then
   begin
+    {$ifdef FPVECTORIALDEBUG_PATHS}
+    WriteLn('[TvEPSVectorialReader.ExecutePathConstructionOperator] eoclip');
+    {$endif}
+    {$ifndef FPVECTORIALDEBUG_CLIP_REGION}
     AData.SetPenStyle(psClear);
+    {$endif}
+    AData.SetBrushStyle(bsClear);
     AData.EndPath();
     CurrentGraphicState.ClipPath := AData.GetPath(AData.GetPathCount()-1);
     CurrentGraphicState.ClipMode := vcmEvenOddRule;
@@ -1681,7 +1831,7 @@ var
 begin
   Result := False;
 
-  //
+  // – gsave – Push graphics state
   if AToken.StrValue = 'gsave' then
   begin
     GraphicStateStack.Push(CurrentGraphicState.Duplicate());
@@ -1690,7 +1840,7 @@ begin
     {$endif}
     Exit(True);
   end;
-  //
+  // – grestore -                 Pop graphics state
   if AToken.StrValue = 'grestore' then
   begin
     lGraphicState := TGraphicState(GraphicStateStack.Pop());
@@ -1702,19 +1852,22 @@ begin
     {$endif}
     Exit(True);
   end;
-  //
+  // num setlinewidth –           Set line width
   if AToken.StrValue = 'setlinewidth' then
   begin
     Param1 := TPSToken(Stack.Pop);
+    CurrentGraphicState.PenWidth := Round(Param1.FloatValue);
     Exit(True);
   end;
-  //
+  // int setlinecap –             Set shape of line ends for stroke (0 = butt,
+  //                             1 = round, 2 = square)
   if AToken.StrValue = 'setlinecap' then
   begin
     Param1 := TPSToken(Stack.Pop);
     Exit(True);
   end;
-  //
+  // int setlinejoin –            Set shape of corners for stroke (0 = miter,
+  //                             1 = round, 2 = bevel)
   if AToken.StrValue = 'setlinejoin' then
   begin
     Param1 := TPSToken(Stack.Pop);
@@ -1830,34 +1983,80 @@ var
 begin
   Result := False;
 
-  //
+  // bool setoverprint – Set overprint parameter
+  if AToken.StrValue = 'setoverprint' then
+  begin
+    Param1 := TPSToken(Stack.Pop);
+
+    CurrentGraphicState.OverPrint := Param1.BoolValue;
+
+    Exit(True);
+  end;
+  // sx sy scale – Scale user space by sx and sy
   if AToken.StrValue = 'scale' then
   begin
     Param1 := TPSToken(Stack.Pop);
     Param2 := TPSToken(Stack.Pop);
+
+    if Param2 = nil then
+    begin
+      Exit(True);
+    end;
+
+    CurrentGraphicState.ScaleX := Param2.FloatValue;
+    CurrentGraphicState.ScaleY := Param1.FloatValue;
+    {$ifdef FPVECTORIALDEBUG_PATHS}
+    WriteLn(Format('[TvEPSVectorialReader.ExecuteGraphicStateOperatorsDI] scale %f %f',
+     [CurrentGraphicState.ScaleX, CurrentGraphicState.ScaleY]));
+    {$endif}
+
     Exit(True);
   end;
-  // tx ty translate –        Translate user space by (tx , ty)
+  {
+    translate tx ty translate
+    - tx ty matrix translate matrix
+
+    With no matrix operand, translate builds a temporary matrix and concatenates
+    this matrix with the current transformation matrix (CTM). Precisely, translate
+    replaces the CTM by T x CTM. The effect of this is to move the origin of the
+    user coordinate system by tx units in the x direction and ty units in the y
+    direction relative to the former user coordinate system. The sizes of the x
+    and y units and the orientation of the axes are unchanged.
+
+    If the matrix operand is supplied, translate replaces the value of matrix by
+    T and pushes the modified matrix back on the operand stack.
+    In this case, translate does not affect the CTM.
+  }
   if AToken.StrValue = 'translate' then
   begin
     Param1 := TPSToken(Stack.Pop); // ty
     Param2 := TPSToken(Stack.Pop); // tx
 
-    if Param2 = nil then Exit(True);
+    if Param2 = nil then
+    begin
+      raise Exception.Create('[TvEPSVectorialReader.ExecuteGraphicStateOperatorsDI] Stack underflow in operator "translate"');
+    end;
 
     {$ifdef FPVECTORIALDEBUG_PATHS}
-    WriteLn(Format('[TvEPSVectorialReader.ExecuteGraphicStateOperatorsDI] translate %f, %f', [Param2.FloatValue, Param1.FloatValue]));
+    WriteLn(Format('[TvEPSVectorialReader.ExecuteGraphicStateOperatorsDI] translate %f, %f CurrentGraphicState.Translate %f %f',
+      [Param2.FloatValue, Param1.FloatValue, CurrentGraphicState.TranslateX, CurrentGraphicState.TranslateY]));
     {$endif}
 
-    CurrentGraphicState.TranslateX := Param2.FloatValue;
-    CurrentGraphicState.TranslateY := Param1.FloatValue;
+    CurrentGraphicState.TranslateX := CurrentGraphicState.TranslateX + Param2.FloatValue;
+    CurrentGraphicState.TranslateY := CurrentGraphicState.TranslateY + Param1.FloatValue;
 
     Exit(True);
   end;
-  //
+  // angle rotate – Rotate user space by angle degrees
   if AToken.StrValue = 'rotate' then
   begin
     Param1 := TPSToken(Stack.Pop);
+
+    {$ifdef FPVECTORIALDEBUG_PATHS}
+    WriteLn(Format('[TvEPSVectorialReader.ExecuteGraphicStateOperatorsDI] rotate angle=%f', [Param1.FloatValue]));
+    DebugStack();
+    {$endif}
+
     Exit(True);
   end;
 end;
@@ -1906,6 +2105,7 @@ begin
   Result := False;
 
   // Adds a dictionary definition
+  // key value def –       Associate key and value in current dictionary
   if AToken.StrValue = 'def' then
   begin
     Param1 := TPSToken(Stack.Pop);
@@ -1914,20 +2114,61 @@ begin
     Exit(True);
   end;
 
-  // Can be ignored
+  // Can be ignored, because in the files found it only loads
+  // standard routines, like /moveto ...
+  //
+  // key load value        Search dictionary stack for key and return
+  //                      associated value
   if AToken.StrValue = 'load' then
   begin
+//    {$ifdef FPVECTORIALDEBUG_DICTIONARY}
+//    WriteLn('[TvEPSVectorialReader.ExecuteDictionaryOperators] load');
+//    DebugStack();
+//    {$endif}
+
     Exit(True);
   end;
 
   // Find dictionary in which key is defined
+  //key where dict true   Find dictionary in which key is defined
+  //           or false
   if AToken.StrValue = 'where' then
   begin
+    {$ifdef FPVECTORIALDEBUG_DICTIONARY}
+    WriteLn('[TvEPSVectorialReader.ExecuteDictionaryOperators] where');
+    DebugStack();
+    {$endif}
+
     Param1 := TPSToken(Stack.Pop);
-    NewToken := TExpressionToken.Create;
-    NewToken.ETType := ettOperand;
-    NewToken.BoolValue := False;
-    Stack.Push(NewToken);
+
+    if Dictionary.IndexOf(Param1.StrValue) >= 0 then
+    begin
+      // We use only 1 dictionary, so this is just a representation of our single dictionary
+      NewToken := TExpressionToken.Create;
+      NewToken.ETType := ettDictionary;
+      Stack.Push(NewToken);
+
+      NewToken := TExpressionToken.Create;
+      NewToken.ETType := ettOperand;
+      NewToken.BoolValue := True;
+      Stack.Push(NewToken);
+
+      {$ifdef FPVECTORIALDEBUG_DICTIONARY}
+      WriteLn('[TvEPSVectorialReader.ExecuteDictionaryOperators] where True');
+      {$endif}
+    end
+    else
+    begin
+      NewToken := TExpressionToken.Create;
+      NewToken.ETType := ettOperand;
+      NewToken.BoolValue := False;
+      Stack.Push(NewToken);
+
+      {$ifdef FPVECTORIALDEBUG_DICTIONARY}
+      WriteLn('[TvEPSVectorialReader.ExecuteDictionaryOperators] where False');
+      {$endif}
+    end;
+
     Exit(True);
   end;
 end;
@@ -1954,8 +2195,16 @@ begin
   Result := False;
 
   // Just a hint for more efficient parsing, we can ignore
+  //
+  // proc bind proc Replace operator names in proc with
+  // operators; perform idiom recognition
   if AToken.StrValue = 'bind' then
   begin
+    {$ifdef FPVECTORIALDEBUG_CONTROL}
+    WriteLn('[TvEPSVectorialReader.ExecuteControlOperator] bind');
+    DebugStack();
+    {$endif}
+
     Exit(True);
   end;
 end;
@@ -2003,7 +2252,7 @@ begin
   FPointSeparator.DecimalSeparator := '.';
   FPointSeparator.ThousandSeparator := ',';
 
-  Tokenizer := TPSTokenizer.Create;
+  Tokenizer := TPSTokenizer.Create(-1);
   Stack := TObjectStack.Create;
   GraphicStateStack := TObjectStack.Create;
   Dictionary := TStringList.Create;

packages/fpvectorial/src/fpvtocanvas.pas

@@ -5,6 +5,13 @@ unit fpvtocanvas;
 interface
 
 {.$define USE_LCL_CANVAS}
+{$ifdef USE_LCL_CANVAS}
+  {$define USE_CANVAS_CLIP_REGION}
+  {.$define DEBUG_CANVAS_CLIP_REGION}
+{$endif}
+{$ifndef Windows}
+{.$define FPVECTORIAL_TOCANVAS_DEBUG}
+{$endif}
 
 uses
   Classes, SysUtils, Math,
@@ -30,10 +37,6 @@ procedure DrawFPVTextToCanvas(ASource: TvVectorialDocument; CurText: TvText;
 
 implementation
 
-{$ifndef Windows}
-{.$define FPVECTORIAL_TOCANVAS_DEBUG}
-{$endif}
-
 function Rotate2DPoint(P,Fix :TPoint; alpha:double): TPoint;
 var
   sinus, cosinus : Extended;
@@ -98,7 +101,6 @@ end;
 
   DrawFPVectorialToCanvas(ASource, ADest, 0, ASource.Height, 1.0, -1.0);
 }
-{.$define FPVECTORIAL_TOCANVAS_DEBUG}
 procedure DrawFPVectorialToCanvas(ASource: TvVectorialDocument;
   ADest: TFPCustomCanvas;
   ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
@@ -151,6 +153,7 @@ var
   Cur2DBSegment: T2DBezierSegment absolute CurSegment;
   // For bezier
   CurX, CurY: Integer; // Not modified by ADestX, etc
+  CoordX2, CoordY2, CoordX3, CoordY3, CoordX4, CoordY4: Integer;
   CurveLength: Integer;
   t: Double;
   // For polygons
@@ -169,12 +172,13 @@ begin
 
   // Set the path Pen and Brush options
   ADest.Pen.Style := CurPath.Pen.Style;
-  ADest.Pen.Width := CurPath.Pen.Width;
+  ADest.Pen.Width := Round(CurPath.Pen.Width * AMulX);
+  if ADest.Pen.Width < 1 then ADest.Pen.Width := 1;
   ADest.Pen.FPColor := CurPath.Pen.Color;
   ADest.Brush.FPColor := CurPath.Brush.Color;
 
   // Prepare the Clipping Region, if any
-  {$ifdef USE_LCL_CANVAS}
+  {$ifdef USE_CANVAS_CLIP_REGION}
   if CurPath.ClipPath <> nil then
   begin
     OldClipRegion := LCLIntf.CreateEmptyRegion();
@@ -182,16 +186,24 @@ begin
     ClipRegion := ConvertPathToRegion(CurPath.ClipPath, ADestX, ADestY, AMulX, AMulY);
     SelectClipRgn(ACanvas.Handle, ClipRegion);
     DeleteObject(ClipRegion);
+    // debug info
+    {$ifdef DEBUG_CANVAS_CLIP_REGION}
+    ConvertPathToPoints(CurPath.ClipPath, ADestX, ADestY, AMulX, AMulY, Points);
+    ACanvas.Polygon(Points);
+    {$endif}
   end;
   {$endif}
 
   //
-  // For solid paths, draw a polygon instead
+  // For solid paths, draw a polygon for the main internal area
   //
-  CurPath.PrepareForSequentialReading;
-
-  if CurPath.Brush.Style = bsSolid then
+  if CurPath.Brush.Style <> bsClear then
   begin
+    CurPath.PrepareForSequentialReading;
+
+    {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
+    Write(' Solid Path Internal Area');
+    {$endif}
     ADest.Brush.Style := CurPath.Brush.Style;
 
     SetLength(Points, CurPath.Len);
@@ -206,16 +218,24 @@ begin
 
       Points[j].X := CoordX;
       Points[j].Y := CoordY;
+
+      {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
+      Write(Format(' P%d,%d', [CoordY, CoordY]));
+      {$endif}
     end;
 
     ADest.Polygon(Points);
 
-    Exit;
+    {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
+    Write(' Now the details ');
+    {$endif}
   end;
 
   //
   // For other paths, draw more carefully
   //
+  CurPath.PrepareForSequentialReading;
+
   for j := 0 to CurPath.Len - 1 do
   begin
     //WriteLn('j = ', j);
@@ -238,9 +258,12 @@ begin
     begin
       ADest.Pen.FPColor := T2DSegmentWithPen(Cur2DSegment).Pen.Color;
 
-      CoordX := CoordToCanvasX(Cur2DSegment.X);
-      CoordY := CoordToCanvasY(Cur2DSegment.Y);
-      ADest.LineTo(CoordX, CoordY);
+      CoordX := CoordToCanvasX(PosX);
+      CoordY := CoordToCanvasY(PosY);
+      CoordX2 := CoordToCanvasX(Cur2DSegment.X);
+      CoordY2 := CoordToCanvasY(Cur2DSegment.Y);
+      ADest.Line(CoordX, CoordY, CoordX2, CoordY2);
+
       PosX := Cur2DSegment.X;
       PosY := Cur2DSegment.Y;
 
@@ -252,9 +275,11 @@ begin
     end;
     st2DLine, st3DLine:
     begin
-      CoordX := CoordToCanvasX(Cur2DSegment.X);
-      CoordY := CoordToCanvasY(Cur2DSegment.Y);
-      ADest.LineTo(CoordX, CoordY);
+      CoordX := CoordToCanvasX(PosX);
+      CoordY := CoordToCanvasY(PosY);
+      CoordX2 := CoordToCanvasX(Cur2DSegment.X);
+      CoordY2 := CoordToCanvasY(Cur2DSegment.Y);
+      ADest.Line(CoordX, CoordY, CoordX2, CoordY2);
       PosX := Cur2DSegment.X;
       PosY := Cur2DSegment.Y;
       {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
@@ -265,23 +290,27 @@ begin
       lines between this parts }
     st2DBezier, st3DBezier:
     begin
-      CurveLength :=
-        Round(sqrt(sqr(Cur2DBSegment.X2 - PosX) + sqr(Cur2DBSegment.Y2 - PosY))) +
-        Round(sqrt(sqr(Cur2DBSegment.X3 - Cur2DBSegment.X2) + sqr(Cur2DBSegment.Y3 - Cur2DBSegment.Y2))) +
-        Round(sqrt(sqr(Cur2DBSegment.X - Cur2DBSegment.X3) + sqr(Cur2DBSegment.Y - Cur2DBSegment.Y3)));
+      CoordX := CoordToCanvasX(PosX);
+      CoordY := CoordToCanvasY(PosY);
+      CoordX2 := CoordToCanvasX(Cur2DBSegment.X2);
+      CoordY2 := CoordToCanvasY(Cur2DBSegment.Y2);
+      CoordX3 := CoordToCanvasX(Cur2DBSegment.X3);
+      CoordY3 := CoordToCanvasY(Cur2DBSegment.Y3);
+      CoordX4 := CoordToCanvasX(Cur2DBSegment.X);
+      CoordY4 := CoordToCanvasY(Cur2DBSegment.Y);
+      SetLength(Points, 0);
+      AddBezierToPoints(
+        Make2DPoint(CoordX, CoordY),
+        Make2DPoint(CoordX2, CoordY2),
+        Make2DPoint(CoordX3, CoordY3),
+        Make2DPoint(CoordX4, CoordY4),
+        Points
+      );
+
+      ADest.Brush.Style := CurPath.Brush.Style;
+      if Length(Points) >= 3 then
+        ADest.Polygon(Points);
 
-      for k := 1 to CurveLength do
-      begin
-        t := k / CurveLength;
-        CurX := Round(sqr(1 - t) * (1 - t) * PosX + 3 * t * sqr(1 - t) * Cur2DBSegment.X2 + 3 * t * t * (1 - t) * Cur2DBSegment.X3 + t * t * t * Cur2DBSegment.X);
-        CurY := Round(sqr(1 - t) * (1 - t) * PosY + 3 * t * sqr(1 - t) * Cur2DBSegment.Y2 + 3 * t * t * (1 - t) * Cur2DBSegment.Y3 + t * t * t * Cur2DBSegment.Y);
-        CoordX := CoordToCanvasX(CurX);
-        CoordY := CoordToCanvasY(CurY);
-        ADest.LineTo(CoordX, CoordY);
-//        {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
-//        Write(Format(' CL%d,%d', [CoordX, CoordY]));
-//        {$endif}
-      end;
       PosX := Cur2DSegment.X;
       PosY := Cur2DSegment.Y;
 
@@ -300,7 +329,7 @@ begin
   {$endif}
 
   // Restores the previous Clip Region
-  {$ifdef USE_LCL_CANVAS}
+  {$ifdef USE_CANVAS_CLIP_REGION}
   if CurPath.ClipPath <> nil then
   begin
     SelectClipRgn(ACanvas.Handle, OldClipRegion); //Using OldClipRegion crashes in Qt
@@ -407,9 +436,9 @@ begin
       BoundsBottom := IntTmp;
     end;
     // Arc(ALeft, ATop, ARight, ABottom, Angle16Deg, Angle16DegLength: Integer);
-    {$ifdef FPVECTORIALDEBUG}
-    WriteLn(Format('Drawing Arc Center=%f,%f Radius=%f StartAngle=%f AngleLength=%f',
-      [CurArc.CenterX, CurArc.CenterY, CurArc.Radius, IntStartAngle/16, IntAngleLength/16]));
+    {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
+//    WriteLn(Format('Drawing Arc Center=%f,%f Radius=%f StartAngle=%f AngleLength=%f',
+//      [CurArc.CenterX, CurArc.CenterY, CurArc.Radius, IntStartAngle/16, IntAngleLength/16]));
     {$endif}
     ADest.Pen.FPColor := CurArc.Pen.Color;
     ALCLDest.Arc(

packages/fpvectorial/src/fpvutils.pas

@@ -12,6 +12,7 @@ AUTHORS: Felipe Monteiro de Carvalho
 unit fpvutils;
 
 {.$define USE_LCL_CANVAS}
+{.$define FPVECTORIAL_BEZIERTOPOINTS_DEBUG}
 
 {$ifdef fpc}
   {$mode delphi}
@@ -28,6 +29,7 @@ uses
 
 type
   T10Strings = array[0..9] of shortstring;
+  TPointsArray = array of TPoint;
 
 // Color Conversion routines
 function FPColorToRGBHexString(AColor: TFPColor): string;
@@ -42,6 +44,8 @@ function SeparateString(AString: string; ASeparator: char): T10Strings;
 // Mathematical routines
 procedure EllipticalArcToBezier(Xc, Yc, Rx, Ry, startAngle, endAngle: Double; var P1, P2, P3, P4: T3DPoint);
 procedure CircularArcToBezier(Xc, Yc, R, startAngle, endAngle: Double; var P1, P2, P3, P4: T3DPoint);
+procedure AddBezierToPoints(P1, P2, P3, P4: T3DPoint; var Points: TPointsArray);
+procedure ConvertPathToPoints(APath: TPath; ADestX, ADestY: Integer; AMulX, AMulY: Double; var Points: TPointsArray);
 // LCL-related routines
 {$ifdef USE_LCL_CANVAS}
 function ConvertPathToRegion(APath: TPath; ADestX, ADestY: Integer; AMulX, AMulY: Double): HRGN;
@@ -186,20 +190,53 @@ begin
   EllipticalArcToBezier(Xc, Yc, R, R, startAngle, endAngle, P1, P2, P3, P4);
 end;
 
-{$ifdef USE_LCL_CANVAS}
-function ConvertPathToRegion(APath: TPath; ADestX, ADestY: Integer; AMulX, AMulY: Double): HRGN;
+{ This routine converts a Bezier to a Polygon and adds the points of this poligon
+  to the end of the provided Points output variables }
+procedure AddBezierToPoints(P1, P2, P3, P4: T3DPoint; var Points: TPointsArray);
 var
-  i: Integer;
-  WindingMode: Integer;
-  Points: array of TPoint;
+  CurveLength, k, CurX, CurY, LastPoint: Integer;
+  t: Double;
+begin
+  {$ifdef FPVECTORIAL_BEZIERTOPOINTS_DEBUG}
+  Write(Format('[AddBezierToPoints] P1=%f,%f P2=%f,%f P3=%f,%f P4=%f,%f =>', [P1.X, P1.Y, P2.X, P2.Y, P3.X, P3.Y, P4.X, P4.Y]));
+  {$endif}
+
+  CurveLength :=
+    Round(sqrt(sqr(P2.X - P1.X) + sqr(P2.Y - P1.Y))) +
+    Round(sqrt(sqr(P3.X - P2.X) + sqr(P3.Y - P2.Y))) +
+    Round(sqrt(sqr(P4.X - P4.X) + sqr(P4.Y - P3.Y)));
+
+  LastPoint := Length(Points)-1;
+  SetLength(Points, Length(Points)+CurveLength);
+  for k := 1 to CurveLength do
+  begin
+    t := k / CurveLength;
+    CurX := Round(sqr(1 - t) * (1 - t) * P1.X + 3 * t * sqr(1 - t) * P2.X + 3 * t * t * (1 - t) * P3.X + t * t * t * P4.X);
+    CurY := Round(sqr(1 - t) * (1 - t) * P1.Y + 3 * t * sqr(1 - t) * P2.Y + 3 * t * t * (1 - t) * P3.Y + t * t * t * P4.Y);
+    Points[LastPoint+k].X := CurX;
+    Points[LastPoint+k].Y := CurY;
+    {$ifdef FPVECTORIAL_BEZIERTOPOINTS_DEBUG}
+    Write(Format(' P=%d,%d', [CurX, CurY]));
+    {$endif}
+  end;
+  {$ifdef FPVECTORIAL_BEZIERTOPOINTS_DEBUG}
+  WriteLn(Format(' CurveLength=%d', [CurveLength]));
+  {$endif}
+end;
+
+procedure ConvertPathToPoints(APath: TPath; ADestX, ADestY: Integer; AMulX, AMulY: Double; var Points: TPointsArray);
+var
+  i, LastPoint: Integer;
   CoordX, CoordY: Integer;
+  CoordX2, CoordY2, CoordX3, CoordY3, CoordX4, CoordY4: Integer;
   // Segments
   CurSegment: TPathSegment;
   Cur2DSegment: T2DSegment absolute CurSegment;
+  Cur2DBSegment: T2DBezierSegment absolute CurSegment;
 begin
   APath.PrepareForSequentialReading;
 
-  SetLength(Points, APath.Len);
+  SetLength(Points, 0);
 
   for i := 0 to APath.Len - 1 do
   begin
@@ -208,14 +245,49 @@ begin
     CoordX := CoordToCanvasX(Cur2DSegment.X, ADestX, AMulX);
     CoordY := CoordToCanvasY(Cur2DSegment.Y, ADestY, AMulY);
 
-    Points[i].X := CoordX;
-    Points[i].Y := CoordY;
+    case CurSegment.SegmentType of
+    st2DBezier, st3DBezier:
+    begin
+      LastPoint := Length(Points)-1;
+      CoordX4 := CoordX;
+      CoordY4 := CoordY;
+      CoordX := Points[LastPoint].X;
+      CoordY := Points[LastPoint].Y;
+      CoordX2 := CoordToCanvasX(Cur2DBSegment.X2, ADestX, AMulX);
+      CoordY2 := CoordToCanvasY(Cur2DBSegment.Y2, ADestY, AMulY);
+      CoordX3 := CoordToCanvasX(Cur2DBSegment.X3, ADestX, AMulX);
+      CoordY3 := CoordToCanvasY(Cur2DBSegment.Y3, ADestY, AMulY);
+      AddBezierToPoints(
+        Make2DPoint(CoordX, CoordY),
+        Make2DPoint(CoordX2, CoordY2),
+        Make2DPoint(CoordX3, CoordY3),
+        Make2DPoint(CoordX4, CoordY4),
+        Points);
+    end;
+    else
+      LastPoint := Length(Points);
+      SetLength(Points, Length(Points)+1);
+      Points[LastPoint].X := CoordX;
+      Points[LastPoint].Y := CoordY;
+    end;
   end;
+end;
+
+{$ifdef USE_LCL_CANVAS}
+function ConvertPathToRegion(APath: TPath; ADestX, ADestY: Integer; AMulX, AMulY: Double): HRGN;
+var
+  WindingMode: Integer;
+  Points: array of TPoint;
+begin
+  APath.PrepareForSequentialReading;
+
+  SetLength(Points, 0);
+  ConvertPathToPoints(APath, ADestX, ADestY, AMulX, AMulY, Points);
 
   if APath.ClipMode = vcmEvenOddRule then WindingMode := LCLType.ALTERNATE
   else WindingMode := LCLType.WINDING;
 
-  Result := LCLIntf.CreatePolygonRgn(@Points[0], APath.Len, WindingMode);
+  Result := LCLIntf.CreatePolygonRgn(@Points[0], Length(Points), WindingMode);
 end;
 {$endif}