fpvectorial: Solves the error in for loops in the EPS reader

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1890 8e941d3f-bd1b-0410-a28a-d453659cc2b4

applications/fpvviewer/fpvectorialsrc/epsvectorialreader.pas

@@ -14,13 +14,13 @@ unit epsvectorialreader;
 
 {$mode objfpc}{$H+}
 
-{.$define FPVECTORIALDEBUG_PATHS}
+{$define FPVECTORIALDEBUG_PATHS}
 {.$define FPVECTORIALDEBUG_COLORS}
 {.$define FPVECTORIALDEBUG_ROLL}
 {.$define FPVECTORIALDEBUG_CODEFLOW}
-{.$define FPVECTORIALDEBUG_INDEX}
+{$define FPVECTORIALDEBUG_INDEX}
 {.$define FPVECTORIALDEBUG_DICTIONARY}
-{.$define FPVECTORIALDEBUG_CONTROL}
+{$define FPVECTORIALDEBUG_CONTROL}
 {.$define FPVECTORIALDEBUG_ARITHMETIC}
 
 interface
@@ -796,7 +796,7 @@ begin
   begin
     {$ifdef FPVECTORIALDEBUG_INDEX}
     WriteLn('[TvEPSVectorialReader.ExecuteStackManipulationOperator] index');
-    DebugStack();
+//    DebugStack();
     {$endif}
 
     Param1 := TPSToken(Stack.Pop);
@@ -813,8 +813,7 @@ begin
       Param2 := lTokens[i];
       if Param2 = nil then
       begin
-        //raise Exception.Create(Format('[TvEPSVectorialReader.ExecuteStackManipulationOperator] nil element poped in operator index. Error at line %d', [AToken.Line]));
+        raise Exception.Create(Format('[TvEPSVectorialReader.ExecuteStackManipulationOperator] Stack underflow in operation "index". Error at line %d', [AToken.Line]));
-        Exit(True);
       end;
     end;
 
@@ -954,7 +953,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
@@ -1021,7 +1020,7 @@ begin
   begin
     {$ifdef FPVECTORIALDEBUG_CONTROL}
     WriteLn('[TvEPSVectorialReader.ExecuteControlOperator] stopped');
-    DebugStack();
+//    DebugStack();
     {$endif}
 
     Param1 := TPSToken(Stack.Pop);
@@ -1060,7 +1059,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);
@@ -1074,6 +1117,10 @@ 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;
@@ -1091,10 +1138,10 @@ begin
   // if it is executable or false if it is literal
   if AToken.StrValue = 'xcheck' then
   begin
-    {$ifdef FPVECTORIALDEBUG_CONTROL}
+//    {$ifdef FPVECTORIALDEBUG_CONTROL}
-    WriteLn('[TvEPSVectorialReader.ExecuteControlOperator] xcheck');
+//    WriteLn('[TvEPSVectorialReader.ExecuteControlOperator] xcheck');
-    DebugStack();
+//    DebugStack();
-    {$endif}
+//    {$endif}
 
     Param1 := TPSToken(Stack.Pop);
 
@@ -1549,13 +1596,13 @@ begin
     Param1 := TPSToken(Stack.Pop);
     Param2 := TPSToken(Stack.Pop);
     PostScriptCoordsToFPVectorialCoords(Param1, Param2, PosX, PosY);
+    PosX2 := PosX + CurrentGraphicState.TranslateX;
+    PosY2 := PosY + CurrentGraphicState.TranslateY;
     {$ifdef FPVECTORIALDEBUG_PATHS}
-    WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] moveto %f, %f CurrentGraphicState.Translate %f, %f',
+    WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] moveto %f, %f CurrentGraphicState.Translate %f, %f Resulting Value %f, %f',
-      [PosX, PosY, CurrentGraphicState.TranslateX, CurrentGraphicState.TranslateY]));
+      [PosX, PosY, CurrentGraphicState.TranslateX, CurrentGraphicState.TranslateY, PosX2, PosY2]));
     {$endif}
-    PosX := PosX + CurrentGraphicState.TranslateX;
+    AData.AddMoveToPath(PosX2, PosY2);
-    PosY := PosY + CurrentGraphicState.TranslateY;
-    AData.AddMoveToPath(PosX, PosY);
     Exit(True);
   end;
   // Absolute LineTo
@@ -1565,12 +1612,12 @@ begin
     Param1 := TPSToken(Stack.Pop);
     Param2 := TPSToken(Stack.Pop);
     PostScriptCoordsToFPVectorialCoords(Param1, Param2, PosX, PosY);
-    PosX := PosX + CurrentGraphicState.TranslateX;
+    PosX2 := PosX + CurrentGraphicState.TranslateX;
-    PosY := PosY + CurrentGraphicState.TranslateY;
+    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
@@ -1581,12 +1628,13 @@ begin
     Param2 := TPSToken(Stack.Pop);
     PostScriptCoordsToFPVectorialCoords(Param1, Param2, PosX, PosY);
     AData.GetCurrentPathPenPos(BaseX, BaseY);
-    PosX := PosX + CurrentGraphicState.TranslateX;
+    PosX2 := PosX + BaseX;//CurrentGraphicState.TranslateX;
-    PosY := PosY + CurrentGraphicState.TranslateY;
+    PosY2 := PosY + BaseY;//CurrentGraphicState.TranslateY;
     {$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 –
@@ -1963,11 +2011,7 @@ begin
 
     if Param2 = nil then
     begin
-      {$ifdef FPVECTORIALDEBUG_PATHS}
+      raise Exception.Create('[TvEPSVectorialReader.ExecuteGraphicStateOperatorsDI] Stack underflow in operator "translate"');
-      WriteLn('[TvEPSVectorialReader.ExecuteGraphicStateOperatorsDI] translate with stack underflow');
-      {$endif}
-
-      Exit(True);
     end;
 
     {$ifdef FPVECTORIALDEBUG_PATHS}

applications/fpvviewer/fpvectorialsrc/fpvtocanvas.pas

@@ -5,6 +5,9 @@ unit fpvtocanvas;
 interface
 
 {$define USE_LCL_CANVAS}
+{$ifdef USE_LCL_CANVAS}
+  {$define USE_CANVAS_CLIP_REGION}
+{$endif}
 
 uses
   Classes, SysUtils, Math,
@@ -98,7 +101,7 @@ end;
 
   DrawFPVectorialToCanvas(ASource, ADest, 0, ASource.Height, 1.0, -1.0);
 }
-{.$define FPVECTORIAL_TOCANVAS_DEBUG}
+{$define FPVECTORIAL_TOCANVAS_DEBUG}
 procedure DrawFPVectorialToCanvas(ASource: TvVectorialDocument;
   ADest: TFPCustomCanvas;
   ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
@@ -175,7 +178,7 @@ begin
   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();
@@ -301,7 +304,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