fpvectorial: Vast improvements to the PostScript interpreter, fixes running procedures

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

applications/fpvviewer/fpvectorialsrc/epsvectorialreader.pas

@@ -12,11 +12,16 @@ unit epsvectorialreader;
 
 {$mode objfpc}{$H+}
 
+{.$define FPVECTORIALDEBUG_PATHS}
+{.$define FPVECTORIALDEBUG_COLORS}
+{.$define FPVECTORIALDEBUG_ROLL}
+
 interface
 
 uses
   Classes, SysUtils, Math, contnrs,
-  fpvectorial, fpimage, fpvutils;
+  fpimage, fpcanvas,
+  fpvectorial, fpvutils;
 
 type
   TPSTokenType = (ttComment, ttFloat);
@@ -27,6 +32,7 @@ type
     StrValue: string;
     FloatValue: double;
     IntValue: Integer;
+    BoolValue: Boolean;
     Line: Integer; // To help debugging
     function Duplicate: TPSToken; virtual;
   end;
@@ -57,6 +63,15 @@ type
 
   TPostScriptScannerState = (ssSearchingToken, ssInComment, ssInDefinition, ssInGroup, ssInExpressionElement);
 
+  { TGraphicState }
+
+  TGraphicState = class
+  public
+    Color: TFPColor;
+    TranslateX, TranslateY: Double;
+    function Duplicate: TGraphicState;
+  end;
+
   { TPSTokenizer }
 
   TPSTokenizer = class
@@ -76,7 +91,10 @@ type
   TvEPSVectorialReader = class(TvCustomVectorialReader)
   private
     Stack: TObjectStack;
+    GraphicStateStack: TObjectStack; // TGraphicState
     Dictionary: TStringList;
+    ExitCalled: Boolean;
+    CurrentGraphicState: TGraphicState;
     //
     procedure RunPostScript(ATokens: TPsTokens; AData: TvVectorialDocument);
     //
@@ -92,6 +110,8 @@ type
     function  ExecuteControlOperator(AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
     function  ExecutePaintingOperator(AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
     function  ExecuteDeviceSetupAndOutputOperator(AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
+    function  ExecuteArrayOperator(AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
+    function  ExecuteStringOperator(AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
     //
     procedure PostScriptCoordsToFPVectorialCoords(AParam1, AParam2: TPSToken; var APosX, APosY: Double);
     procedure DictionarySubstituteOperator(ADictionary: TStringList; var ACurToken: TPSToken);
@@ -108,6 +128,16 @@ implementation
 var
   FPointSeparator: TFormatSettings;
 
+{ TGraphicState }
+
+function TGraphicState.Duplicate: TGraphicState;
+begin
+  Result := TGraphicState(Self.ClassType.Create);
+  Result.Color := Color;
+  Result.TranslateX := TranslateX;
+  Result.TranslateY := TranslateY;
+end;
+
 { TPSToken }
 
 function TPSToken.Duplicate: TPSToken;
@@ -291,6 +321,13 @@ begin
 
     end; // case
   end; // while
+
+  // If the stream finished, there might be a token still being built
+  // so lets finish it
+  if State = ssInExpressionElement then
+  begin
+    Tokens.Add(ExpressionToken);
+  end;
 end;
 
 procedure TPSTokenizer.DebugOut();
@@ -372,27 +409,44 @@ var
   i: Integer;
   CurToken: TPSToken;
 begin
-  {$ifdef FPVECTORIALDEBUG}
+  {$ifdef FPVECTORIALDEBUG_CODEFLOW}
   WriteLn('[TvEPSVectorialReader.RunPostScript] START');
   {$endif}
+  if ExitCalled then
+  begin
+    {$ifdef FPVECTORIALDEBUG_CODEFLOW}
+    WriteLn('[TvEPSVectorialReader.RunPostScript] ExitCalled');
+    {$endif}
+    Exit;
+  end;
   for i := 0 to ATokens.Count - 1 do
   begin
     CurToken := TPSToken(ATokens.Items[i]);
 
     if CurToken is TCommentToken then
     begin
+      {$ifdef FPVECTORIALDEBUG_CODEFLOW}
+      WriteLn(Format('[TvEPSVectorialReader.RunPostScript] Type: TCommentToken Token: %s', [CurToken.StrValue]));
+      {$endif}
 //      ProcessCommentToken(CurToken as TCommentToken, AData);
       Continue;
     end;
 
     if CurToken is TProcedureToken then
     begin
+      {$ifdef FPVECTORIALDEBUG_CODEFLOW}
+      WriteLn(Format('[TvEPSVectorialReader.RunPostScript] Type: TProcedureToken Token: %s', [CurToken.StrValue]));
+      {$endif}
       Stack.Push(CurToken);
       Continue;
     end;
 
     if CurToken is TExpressionToken then
     begin
+      {$ifdef FPVECTORIALDEBUG_CODEFLOW}
+      WriteLn(Format('[TvEPSVectorialReader.RunPostScript] Type: TExpressionToken Token: %s', [CurToken.StrValue]));
+      {$endif}
+
       if TExpressionToken(CurToken).ETType <> ettOperator then
       begin
         Stack.Push(CurToken);
@@ -404,9 +458,11 @@ begin
 
       if CurToken is TProcedureToken then ExecuteProcedureToken(TProcedureToken(CurToken), AData)
       else ExecuteOperatorToken(TExpressionToken(CurToken), AData);
+
+      if ExitCalled then Break;
     end;
   end;
-  {$ifdef FPVECTORIALDEBUG}
+  {$ifdef FPVECTORIALDEBUG_CODEFLOW}
   WriteLn('[TvEPSVectorialReader.RunPostScript] END');
   {$endif}
 end;
@@ -419,9 +475,17 @@ var
   lOldTokens: TPSTokens;
   i: Integer;
 begin
-  {$ifdef FPVECTORIALDEBUG}
+  {$ifdef FPVECTORIALDEBUG_CODEFLOW}
   WriteLn('[TvEPSVectorialReader.ExecuteProcedureToken] START');
   {$endif}
+  if ExitCalled then
+  begin
+    {$ifdef FPVECTORIALDEBUG_CODEFLOW}
+    WriteLn('[TvEPSVectorialReader.ExecuteProcedureToken] ExitCalled');
+    {$endif}
+    Exit;
+  end;
+
   if not AToken.Parsed then
   begin
     ProcTokenizer := TPSTokenizer.Create;
@@ -432,14 +496,15 @@ begin
         lStream.WriteByte(Byte(AToken.StrValue[i]));
 
       // Change the Tokens so that it writes directly to AToken.Childs
-      lOldTokens := Tokenizer.Tokens;
+      lOldTokens := ProcTokenizer.Tokens;
-      Tokenizer.Tokens := AToken.Childs;
+      ProcTokenizer.Tokens := AToken.Childs;
 
       // Now parse the procedure code
+      lStream.Position := 0;
       ProcTokenizer.ReadFromStream(lStream);
 
       // Recover the old tokens for usage in .Free
-      Tokenizer.Tokens := lOldTokens;
+      ProcTokenizer.Tokens := lOldTokens;
     finally
       lStream.Free;
       ProcTokenizer.Free;
@@ -450,7 +515,7 @@ begin
 
   // Now run the procedure
   RunPostScript(AToken.Childs, AData);
-  {$ifdef FPVECTORIALDEBUG}
+  {$ifdef FPVECTORIALDEBUG_CODEFLOW}
   WriteLn('[TvEPSVectorialReader.ExecuteProcedureToken] END');
   {$endif}
 end;
@@ -482,77 +547,14 @@ begin
 
   if ExecuteDeviceSetupAndOutputOperator(AToken, AData) then Exit;
 
+  if ExecuteArrayOperator(AToken, AData) then Exit;
+
+  if ExecuteStringOperator(AToken, AData) then Exit;
+
   // If we got here, there the command not yet implemented
   raise Exception.Create(Format('[TvEPSVectorialReader.ProcessExpressionToken] Unknown PostScript Command "%s" in Line %d',
     [AToken.StrValue, AToken.Line]));
 
-  { Array Operators
-
-  int array array Create array of length int
-  – [ mark Start array construction
-  mark obj0 … objn-1 ] array End array construction
-  array length int Return number of elements in array
-  array index get any Return array element indexed by index
-  array index any put – Put any into array at index
-  array index count getinterval subarray Return subarray of array starting at index for
-  count elements
-  array1 index array2|packedarray2 putinterval – Replace subarray of array1 starting at index
-  by array2|packedarray2
-  any0 … anyn-1 array astore array Pop elements from stack into array
-  array aload any0 … anyn-1 array Push all elements of array on stack
-  array1 array2 copy subarray2 Copy elements of array1 to initial subarray of
-  array2
-  array proc forall – Execute proc for each element of array
-  Packed Array Operators
-  any0 … anyn-1 n packedarray packedarray Create packed array consisting of n elements
-  from stack
-  bool setpacking – Set array packing mode for { … } syntax
-  (true = packed array)
-  – currentpacking bool Return array packing mode
-  packedarray length int Return number of elements in packedarray
-  packedarray index get any Return packedarray element indexed by index
-  packedarray index count getinterval subarray Return subarray of packedarray starting at
-  index for count elements
-  packedarray aload any0 … anyn-1 packedarray
-  Push all elements of packedarray on stack
-  packedarray1 array2 copy subarray2 Copy elements of packedarray1 to initial
-  subarray of array2
-  packedarray proc forall – Execute proc for each element of packedarray
-}
-{ String Operators
-
-  int string string Create string of length int
-  string length int Return number of elements in string
-  string index get int Return string element indexed by index
-  string index int put – Put int into string at index
-  string index count getinterval substring Return substring of string starting at index
-  for count elements
-  string1 index string2 putinterval – Replace substring of string1 starting at index
-  by string2
-  string1 string2 copy substring2 Copy elements of string1 to initial substring
-  of string2
-  string proc forall – Execute proc for each element of string
-  string seek anchorsearch post match true Search for seek at start of string
-  or string false
-  string seek search post match pre true Search for seek in string
-  or string false
-  string token post any true Read token from start of string
-  or false
-  Relational, Boolean, and Bitwise Operators
-  any1 any2 eq bool Test equal
-  any1 any2 ne bool Test not equal
-  num1|str1 num2|str2 ge bool Test greater than or equal
-  num1|str1 num2|str2 gt bool Test greater than
-  num1|str1 num2|str2 le bool Test less than or equal
-  num1|str1 num2|str2 lt bool Test less than
-  bool1|int1 bool2|int2 and bool3|int3 Perform logical|bitwise and
-  bool1|int1 not bool2|int2 Perform logical|bitwise not
-  bool1|int1 bool2|int2 or bool3|int3 Perform logical|bitwise inclusive or
-  bool1|int1 bool2|int2 xor bool3|int3 Perform logical|bitwise exclusive or
-  – true true Return boolean value true
-  – false false Return boolean value false
-  int1 shift bitshift int2 Perform bitwise shift of int1 (positive is left)
-}
 {  File Operators
 
   filename access file file Open named file with specified access
@@ -688,11 +690,29 @@ end;
 function TvEPSVectorialReader.ExecuteStackManipulationOperator(
   AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
 var
-  Param1, NewToken: TPSToken;
+  Param1, Param2, NewToken: TPSToken;
+  lIndexN, lIndexJ: Integer;
+  lTokens: array of TPSToken;
+  i: Integer;
 begin
   Result := False;
 
-  //
+  // Discard top element
+  if AToken.StrValue = 'pop' then
+  begin
+    Param1 := TPSToken(Stack.Pop);
+    Exit(True);
+  end;
+  // Exchange top two elements
+  if AToken.StrValue = 'exch' then
+  begin
+    Param1 := TPSToken(Stack.Pop);
+    Param2 := TPSToken(Stack.Pop);
+    Stack.Push(Param2);
+    Stack.Push(Param1);
+    Exit(True);
+  end;
+  // Duplicate top element
   if AToken.StrValue = 'dup' then
   begin
     Param1 := TPSToken(Stack.Pop);
@@ -701,14 +721,130 @@ begin
     Stack.Push(NewToken);
     Exit(True);
   end;
+  // Duplicate arbitrary element
+  if AToken.StrValue = 'index' then
+  begin
+    Param1 := TPSToken(Stack.Pop);
+    lIndexN := Round(Param1.FloatValue);
+    SetLength(lTokens, lIndexN+1);
+
+    // Unroll all elements necessary
+
+    for i := 0 to lIndexN do
+    begin
+      lTokens[i] := TPSToken(Stack.Pop);
+      Param2 := lTokens[i];
+      if Param2 = nil then
+      begin
+        // raise Exception.Create('[TvEPSVectorialReader.ExecuteStackManipulationOperator] nil element poped in operator index');
+        Exit(True);
+      end;
+    end;
+
+    // Duplicate the disired token
+
+    NewToken := lTokens[lIndexN].Duplicate();
+
+    // Roll them back
+
+    for i := lIndexN downto 0 do
+    begin
+      Stack.Push(lTokens[i]);
+    end;
+
+    // Roll the duplicated element too
+
+    Stack.Push(NewToken);
+
+    Exit(True);
+  end;
+  // anyn-1 … any0 n j roll any(j-1) mod n … any0 anyn-1 … anyj mod n
+  //
+  // performs a circular shift of the objects anyn-1 through any0 on the operand stack
+  // by the amount j. Positive j indicates upward motion on the stack, whereas negative
+  // j indicates downward motion.
+  // n must be a nonnegative integer and j must be an integer. roll first removes these
+  // operands from the stack; there must be at least n additional elements. It then performs
+  // a circular shift of these n elements by j positions.
+  // If j is positive, each shift consists of removing an element from the top of the stack
+  // and inserting it between element n - 1 and element n of the stack, moving all in8.2
+  // tervening elements one level higher on the stack. If j is negative, each shift consists
+  // of removing element n - 1 of the stack and pushing it on the top of the stack,
+  // moving all intervening elements one level lower on the stack.
+  //
+  // Examples    N J
+  // (a) (b) (c) 3 -1 roll => (b) (c) (a)
+  // (a) (b) (c) 3 1 roll  => (c) (a) (b)
+  // (a) (b) (c) 3 0 roll  => (a) (b) (c)
+  if AToken.StrValue = 'roll' then
+  begin
+    Param1 := TPSToken(Stack.Pop);
+    Param2 := TPSToken(Stack.Pop);
+    lIndexJ := Round(Param1.FloatValue);
+    lIndexN := Round(Param2.FloatValue);
+
+    {$ifdef FPVECTORIALDEBUG_ROLL}
+    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 lIndexJ = 0 then Exit;
+
+    SetLength(lTokens, lIndexN);
+
+    // Unroll all elements necessary
+
+    for i := 0 to lIndexN-1 do
+    begin
+      lTokens[i] := TPSToken(Stack.Pop());
+      Param2 := lTokens[i];
+      if Param2 = nil then
+      begin
+        // raise Exception.Create('[TvEPSVectorialReader.ExecuteStackManipulationOperator] nil element poped in operator index');
+        Exit(True);
+      end;
+    end;
+
+    // Roll them back
+
+    if lIndexJ > 0 then
+    begin
+      for i := lIndexJ-1 downto 0 do
+      begin
+        Stack.Push(lTokens[i]);
+      end;
+      for i := lIndexN-1 downto lIndexJ do
+      begin
+        Stack.Push(lTokens[i]);
+      end;
+    end
+    else
+    begin
+      lIndexJ := -lIndexJ;
+
+      for i := lIndexN-lIndexJ-1 downto 0 do
+      begin
+        Stack.Push(lTokens[i]);
+      end;
+      for i := lIndexN-1 downto lIndexN-lIndexJ do
+      begin
+        Stack.Push(lTokens[i]);
+      end;
+    end;
+
+    Exit(True);
+  end;
 end;
 
 {  Control Operators
 
   any exec –          Execute arbitrary object
   bool proc if –      Execute proc if bool is true
-  bool proc1 proc2 ifelse – Execute proc1 if bool is true, proc2 if false
+  bool proc1 proc2 ifelse –
-  initial increment limit proc for – Execute proc with values from initial by steps
+                      Execute proc1 if bool is true, proc2 if false
+  initial increment limit proc for –
+                      Execute proc with values from initial by steps
                       of increment to limit
   int proc repeat –   Execute proc int times
   proc loop –         Execute proc an indefinite number of times
@@ -742,10 +878,87 @@ function TvEPSVectorialReader.ExecuteControlOperator(AToken: TExpressionToken;
   AData: TvVectorialDocument): Boolean;
 var
   Param1, Param2, Param3, Param4: TPSToken;
+  NewToken: TExpressionToken;
   FloatCounter: Double;
 begin
   Result := False;
 
+  // Execute proc if bool is true
+  if AToken.StrValue = 'if' then
+  begin
+    Param1 := TPSToken(Stack.Pop); // proc
+    Param2 := TPSToken(Stack.Pop); // bool
+
+    if not (Param1 is TProcedureToken) then
+      raise Exception.Create(Format('[TvEPSVectorialReader.ExecuteControlOperator] The operator if requires a procedure. Error at line %d', [AToken.Line]));
+
+    if Param2.BoolValue then ExecuteProcedureToken(TProcedureToken(Param1), AData);
+
+    Exit(True);
+  end;
+  // Execute proc1 if bool is true, proc2 if false
+  if AToken.StrValue = 'ifelse' then
+  begin
+    Param1 := TPSToken(Stack.Pop); // proc2
+    Param2 := TPSToken(Stack.Pop); // proc1
+    Param3 := TPSToken(Stack.Pop); // bool
+
+    if not (Param1 is TProcedureToken) then
+      raise Exception.Create(Format('[TvEPSVectorialReader.ExecuteControlOperator] The operator ifelse requires a procedure. Error at line %d', [AToken.Line]));
+    if not (Param2 is TProcedureToken) then
+      raise Exception.Create(Format('[TvEPSVectorialReader.ExecuteControlOperator] The operator ifelse requires a procedure. Error at line %d', [AToken.Line]));
+
+    if Param3.BoolValue then ExecuteProcedureToken(TProcedureToken(Param2), AData)
+    else ExecuteProcedureToken(TProcedureToken(Param1), AData);
+
+    Exit(True);
+  end;
+  // Exit innermost active loop
+  if AToken.StrValue = 'exit' then
+  begin
+    ExitCalled := True;
+
+    Exit(True);
+  end;
+  // Establish context for catching stop
+  if AToken.StrValue = 'stopped' then
+  begin
+    Param1 := TPSToken(Stack.Pop);
+
+    if not (Param1 is TProcedureToken) then
+      raise Exception.Create(Format('[TvEPSVectorialReader.ExecuteControlOperator] The operator stopped requires a procedure. Error at line %d', [AToken.Line]));
+
+    ExecuteProcedureToken(TProcedureToken(Param1), AData);
+
+    NewToken := TExpressionToken.Create;
+    NewToken.ETType := ettOperand;
+    NewToken.BoolValue := False;
+    NewToken.StrValue := 'false';
+    Stack.Push(NewToken);
+
+    Exit(True);
+  end;
+  // Execute proc an indefinite number of times
+  if AToken.StrValue = 'loop' then
+  begin
+    Param1 := TPSToken(Stack.Pop);
+
+    if not (Param1 is TProcedureToken) then
+      raise Exception.Create(Format('[TvEPSVectorialReader.ExecuteControlOperator] The operator loop requires a procedure. Error at line %d', [AToken.Line]));
+
+    while True do
+    begin
+      ExecuteProcedureToken(TProcedureToken(Param1), AData);
+
+      if ExitCalled then
+      begin
+        ExitCalled := False;
+        Break;
+      end;
+    end;
+
+    Exit(True);
+  end;
   // initial increment limit proc for
   if AToken.StrValue = 'for' then
   begin
@@ -765,6 +978,22 @@ begin
       FloatCounter := FloatCounter + Param3.FloatValue;
     end;
 
+    Exit(True);
+  end;
+  // tests whether the operand has the executable or the literal attribute, returning true
+  // if it is executable or false if it is literal
+  if AToken.StrValue = 'xcheck' then
+  begin
+    Param1 := TPSToken(Stack.Pop);
+
+    NewToken := TExpressionToken.Create;
+    NewToken.ETType := ettOperand;
+    NewToken.BoolValue := (Param1 is TProcedureToken) or
+      ((Param1 is TExpressionToken) and (TExpressionToken(Param1).ETType = ettOperator));
+    if NewToken.BoolValue then NewToken.StrValue := 'true'
+    else NewToken.StrValue := 'false';
+    Stack.Push(NewToken);
+
     Exit(True);
   end;
 end;
@@ -837,6 +1066,13 @@ begin
   begin
     Exit(True);
   end;
+
+  if AToken.StrValue = 'eofill' then
+  begin
+    AData.SetBrushStyle(bsDiagCross);
+
+    Exit(True);
+  end;
 end;
 
 { Device Setup and Output Operators
@@ -929,6 +1165,127 @@ begin
   end;
 end;
 
+{ Array Operators
+
+  int array array Create array of length int
+  – [ mark Start array construction
+  mark obj0 … objn-1 ] array End array construction
+  array length int Return number of elements in array
+  array index get any Return array element indexed by index
+  array index any put – Put any into array at index
+  array index count getinterval subarray Return subarray of array starting at index for
+  count elements
+  array1 index array2|packedarray2 putinterval – Replace subarray of array1 starting at index
+  by array2|packedarray2
+  any0 … anyn-1 array astore array Pop elements from stack into array
+  array aload any0 … anyn-1 array Push all elements of array on stack
+  array1 array2 copy subarray2 Copy elements of array1 to initial subarray of
+  array2
+  array proc forall – Execute proc for each element of array
+  Packed Array Operators
+  any0 … anyn-1 n packedarray packedarray Create packed array consisting of n elements
+  from stack
+  bool setpacking – Set array packing mode for { … } syntax
+  (true = packed array)
+  – currentpacking bool Return array packing mode
+  packedarray length int Return number of elements in packedarray
+  packedarray index get any Return packedarray element indexed by index
+  packedarray index count getinterval subarray Return subarray of packedarray starting at
+  index for count elements
+  packedarray aload any0 … anyn-1 packedarray
+  Push all elements of packedarray on stack
+  packedarray1 array2 copy subarray2 Copy elements of packedarray1 to initial
+  subarray of array2
+  packedarray proc forall – Execute proc for each element of packedarray
+}
+function TvEPSVectorialReader.ExecuteArrayOperator(AToken: TExpressionToken;
+  AData: TvVectorialDocument): Boolean;
+begin
+  Result := False;
+
+end;
+
+{ String Operators
+
+  int string string Create string of length int
+  string length int Return number of elements in string
+  string index get int Return string element indexed by index
+  string index int put – Put int into string at index
+  string index count getinterval substring Return substring of string starting at index
+  for count elements
+  string1 index string2 putinterval – Replace substring of string1 starting at index
+  by string2
+  string1 string2 copy substring2 Copy elements of string1 to initial substring
+  of string2
+  string proc forall – Execute proc for each element of string
+  string seek anchorsearch post match true Search for seek at start of string
+  or string false
+  string seek search post match pre true Search for seek in string
+  or string false
+  string token post any true Read token from start of string
+  or false
+  Relational, Boolean, and Bitwise Operators
+  any1 any2 eq bool Test equal
+  any1 any2 ne bool Test not equal
+  num1|str1 num2|str2 ge bool Test greater than or equal
+  num1|str1 num2|str2 gt bool Test greater than
+  num1|str1 num2|str2 le bool Test less than or equal
+  num1|str1 num2|str2 lt bool Test less than
+  bool1|int1 bool2|int2 and bool3|int3 Perform logical|bitwise and
+  bool1|int1 not bool2|int2 Perform logical|bitwise not
+  bool1|int1 bool2|int2 or bool3|int3 Perform logical|bitwise inclusive or
+  bool1|int1 bool2|int2 xor bool3|int3 Perform logical|bitwise exclusive or
+  – true true Return boolean value true
+  – false false Return boolean value false
+  int1 shift bitshift int2 Perform bitwise shift of int1 (positive is left)
+}
+function TvEPSVectorialReader.ExecuteStringOperator(AToken: TExpressionToken;
+  AData: TvVectorialDocument): Boolean;
+var
+  Param1, Param2: TPSToken;
+  NewToken: TExpressionToken;
+begin
+  Result := False;
+
+  // any1 any2 ne bool Test not equal
+  if AToken.StrValue = 'ne' then
+  begin
+    Param1 := TPSToken(Stack.Pop);
+    Param2 := TPSToken(Stack.Pop);
+
+    NewToken := TExpressionToken.Create;
+    NewToken.ETType := ettOperand;
+    NewToken.BoolValue := Param1.StrValue = Param2.StrValue;
+    if NewToken.BoolValue then NewToken.StrValue := 'true'
+    else NewToken.StrValue := 'false';
+    Stack.Push(NewToken);
+
+    Exit(True);
+  end;
+  // num1 num2 lt bool
+  // string1 string2 lt bool
+  // pops two objects from the operand stack and pushes true if the first operand is less
+  // than the second, or false otherwise. If both operands are numbers, lt compares
+  // their mathematical values. If both operands are strings, lt compares them element
+  // by element, treating the elements as integers in the range 0 to 255, to determine
+  // whether the first string is lexically less than the second. If the operands are of
+  // other types or one is a string and the other is a number, a typecheck error occurs.
+  if AToken.StrValue = 'lt' then
+  begin
+    Param1 := TPSToken(Stack.Pop);
+    Param2 := TPSToken(Stack.Pop);
+
+    NewToken := TExpressionToken.Create;
+    NewToken.ETType := ettOperand;
+    NewToken.BoolValue := Param1.FloatValue > Param2.FloatValue;
+    if NewToken.BoolValue then NewToken.StrValue := 'true'
+    else NewToken.StrValue := 'false';
+    Stack.Push(NewToken);
+
+    Exit(True);
+  end;
+end;
+
 {  Arithmetic and Math Operators
 
   num1 num2 add sum        Return num1 plus num2
@@ -983,6 +1340,16 @@ begin
     Stack.Push(Param1);
     Exit(True);
   end;
+  // num1 num2 sub difference Return num1 minus num2
+  if AToken.StrValue = 'sub' then
+  begin
+    Param1 := TPSToken(Stack.Pop); // num2
+    Param2 := TPSToken(Stack.Pop); // num1
+    Param1.FloatValue := Param2.FloatValue - Param1.FloatValue;
+    Param1.StrValue := '00'; // Just to mark it as a number
+    Stack.Push(Param1);
+    Exit(True);
+  end;
 end;
 
 { Path Construction Operators
@@ -1032,8 +1399,14 @@ begin
   //
   if AToken.StrValue = 'newpath' then
   begin
+    {$ifdef FPVECTORIALDEBUG_PATHS}
+    WriteLn('[TvEPSVectorialReader.ExecutePathConstructionOperator] newpath');
+    {$endif}
     AData.EndPath();
     AData.StartPath();
+
+    AData.SetPenColor(CurrentGraphicState.Color);
+
     Exit(True);
   end;
   // Param2 Param1 moveto ===> moveto(X=Param2, Y=Param1);
@@ -1042,6 +1415,11 @@ begin
     Param1 := TPSToken(Stack.Pop);
     Param2 := TPSToken(Stack.Pop);
     PostScriptCoordsToFPVectorialCoords(Param1, Param2, PosX, PosY);
+    PosX := PosX + CurrentGraphicState.TranslateX;
+    PosY := PosY + CurrentGraphicState.TranslateY;
+    {$ifdef FPVECTORIALDEBUG_PATHS}
+    WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] moveto %f, %f', [PosX, PosY]));
+    {$endif}
     AData.AddMoveToPath(PosX, PosY);
     Exit(True);
   end;
@@ -1051,6 +1429,11 @@ begin
     Param1 := TPSToken(Stack.Pop);
     Param2 := TPSToken(Stack.Pop);
     PostScriptCoordsToFPVectorialCoords(Param1, Param2, PosX, PosY);
+    PosX := PosX + CurrentGraphicState.TranslateX;
+    PosY := PosY + CurrentGraphicState.TranslateY;
+    {$ifdef FPVECTORIALDEBUG_PATHS}
+    WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] lineto %f, %f', [PosX, PosY]));
+    {$endif}
     AData.AddLineToPath(PosX, PosY);
     Exit(True);
   end;
@@ -1061,23 +1444,61 @@ begin
     Param2 := TPSToken(Stack.Pop);
     PostScriptCoordsToFPVectorialCoords(Param1, Param2, PosX, PosY);
     AData.GetCurrenPathPenPos(BaseX, BaseY);
+    PosX := PosX + CurrentGraphicState.TranslateX;
+    PosY := PosY + CurrentGraphicState.TranslateY;
+    {$ifdef FPVECTORIALDEBUG_PATHS}
+    WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] rlineto %f, %f', [BaseX + PosX, BaseY + PosY]));
+    {$endif}
     AData.AddLineToPath(BaseX + PosX, BaseY + PosY);
     Exit(True);
   end;
-  // dx1 dy1 dx2 dy2 dx3 dy3 rcurveto – Perform relative curveto
+  // dx1 dy1 dx2 dy2 dx3 dy3 rcurveto –
+  // (relative curveto) appends a section of a cubic Bézier curve to the current path in
+  // the same manner as curveto. However, the operands are interpreted as relative
+  // displacements from the current point rather than as absolute coordinates. That is,
+  // rcurveto constructs a curve between the current point (x0, y0) and the endpoint
+  // (x0 + dx3, y0 + dy3), using (x0 + dx1, y0 + dy1) and (x0 + dx2, y0 + dy2) as the Bézier
+  // control points. In all other respects, the behavior of rcurveto is identical to that of
+  // curveto.
   if AToken.StrValue = 'rcurveto' then
+  begin
+    Param1 := TPSToken(Stack.Pop); // dy3
+    Param2 := TPSToken(Stack.Pop); // dx3
+    Param3 := TPSToken(Stack.Pop); // dy2
+    Param4 := TPSToken(Stack.Pop); // dx2
+    Param5 := TPSToken(Stack.Pop); // dy1
+    Param6 := TPSToken(Stack.Pop); // dx1
+    PostScriptCoordsToFPVectorialCoords(Param5, Param6, PosX, PosY);
+    PostScriptCoordsToFPVectorialCoords(Param3, Param4, PosX2, PosY2);
+    PostScriptCoordsToFPVectorialCoords(Param1, Param2, PosX3, PosY3);
+    AData.GetCurrenPathPenPos(BaseX, BaseY);
+    BaseX := BaseX + CurrentGraphicState.TranslateX;
+    BaseY := BaseY + CurrentGraphicState.TranslateY;
+    {$ifdef FPVECTORIALDEBUG_PATHS}
+    WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] 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]));
+    {$endif}
+    AData.AddBezierToPath(BaseX + PosX, BaseY + PosY, BaseX + PosX2, BaseY + PosY2, BaseX + PosX3, BaseY + PosY3);
+    Exit(True);
+  end;
+  // x y r angle1 angle2 arc – Append counterclockwise arc
+  if AToken.StrValue = 'arc' then
   begin
     Param1 := TPSToken(Stack.Pop);
     Param2 := TPSToken(Stack.Pop);
     Param3 := TPSToken(Stack.Pop);
     Param4 := TPSToken(Stack.Pop);
     Param5 := TPSToken(Stack.Pop);
-    Param6 := TPSToken(Stack.Pop);
+    PostScriptCoordsToFPVectorialCoords(Param4, Param5, PosX, PosY);
-    PostScriptCoordsToFPVectorialCoords(Param1, Param2, PosX, PosY);
+//    {$ifdef FPVECTORIALDEBUG}
-    PostScriptCoordsToFPVectorialCoords(Param3, Param4, PosX2, PosY2);
+//    WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] rcurveto %f, %f', [BaseX + PosX, BaseY + PosY]));
-    PostScriptCoordsToFPVectorialCoords(Param5, Param6, PosX3, PosY3);
+//    {$endif}
-    AData.GetCurrenPathPenPos(BaseX, BaseY);
+//    AData.AddBezierToPath(BaseX + PosX, BaseY + PosY, BaseX + PosX2, BaseY + PosY2, BaseX + PosX3, BaseY + PosY3);
-    AData.AddBezierToPath(BaseX + PosX, BaseY + PosY, BaseX + PosX2, BaseY + PosY2, BaseX + PosX3, BaseY + PosY3);
+    {$ifdef FPVECTORIALDEBUG_PATHS}
+    WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] arc %f, %f', [PosX, PosY]));
+    {$endif}
     Exit(True);
   end;
   // – eoclip – Clip using even-odd rule
@@ -1139,10 +1560,33 @@ end;
 function TvEPSVectorialReader.ExecuteGraphicStateOperatorsDI(
   AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
 var
-  Param1, Param2: TPSToken;
+  Param1, Param2, Param3: TPSToken;
+  lRed, lGreen, lBlue: Double;
+  lGraphicState: TGraphicState;
 begin
   Result := False;
 
+  //
+  if AToken.StrValue = 'gsave' then
+  begin
+    GraphicStateStack.Push(CurrentGraphicState.Duplicate());
+    {$ifdef FPVECTORIALDEBUG_PATHS}
+    WriteLn('[TvEPSVectorialReader.ExecuteGraphicStateOperatorsDI] gsave');
+    {$endif}
+    Exit(True);
+  end;
+  //
+  if AToken.StrValue = 'grestore' then
+  begin
+    lGraphicState := TGraphicState(GraphicStateStack.Pop());
+    if lGraphicState = nil then raise Exception.Create('[TvEPSVectorialReader.ExecuteGraphicStateOperatorsDI] grestore: call to grestore without corresponding gsave');
+    CurrentGraphicState.Free;
+    CurrentGraphicState := lGraphicState;
+    {$ifdef FPVECTORIALDEBUG_PATHS}
+    WriteLn('[TvEPSVectorialReader.ExecuteGraphicStateOperatorsDI] grestore');
+    {$endif}
+    Exit(True);
+  end;
   //
   if AToken.StrValue = 'setlinewidth' then
   begin
@@ -1155,6 +1599,35 @@ begin
     Param1 := TPSToken(Stack.Pop);
     Exit(True);
   end;
+  // red green blue setrgbcolor –
+  // sets the current color space in the graphics state to DeviceRGB and the current color
+  // to the component values specified by red, green, and blue. Each component
+  // must be a number in the range 0.0 to 1.0. If any of the operands is outside this
+  // range, the nearest valid value is substituted without error indication.
+  if AToken.StrValue = 'setrgbcolor' then
+  begin
+    Param1 := TPSToken(Stack.Pop);
+    Param2 := TPSToken(Stack.Pop);
+    Param3 := TPSToken(Stack.Pop);
+
+    lRed := EnsureRange(Param3.FloatValue, 0, 1);
+    lGreen := EnsureRange(Param2.FloatValue, 0, 1);
+    lBlue := EnsureRange(Param1.FloatValue, 0, 1);
+
+    CurrentGraphicState.Color.Red := Round(lRed * $FFFF);
+    CurrentGraphicState.Color.Green := Round(lGreen * $FFFF);
+    CurrentGraphicState.Color.Blue := Round(lBlue * $FFFF);
+    CurrentGraphicState.Color.alpha := alphaOpaque;
+
+    AData.SetPenColor(CurrentGraphicState.Color);
+
+    {$ifdef FPVECTORIALDEBUG_COLORS}
+    WriteLn(Format('[TvEPSVectorialReader.ExecuteGraphicStateOperatorsDI] setrgbcolor r=%f g=%f b=%f',
+      [Param3.FloatValue, Param2.FloatValue, Param1.FloatValue]));
+    {$endif}
+
+    Exit(True);
+  end;
 end;
 
 {  Graphics State Operators (Device-Dependent)
@@ -1243,6 +1716,29 @@ begin
     Param2 := TPSToken(Stack.Pop);
     Exit(True);
   end;
+  // tx ty translate –        Translate user space by (tx , ty)
+  if AToken.StrValue = 'translate' then
+  begin
+    Param1 := TPSToken(Stack.Pop); // ty
+    Param2 := TPSToken(Stack.Pop); // tx
+
+    if Param2 = nil then Exit(True);
+
+    {$ifdef FPVECTORIALDEBUG_PATHS}
+    WriteLn(Format('[TvEPSVectorialReader.ExecuteGraphicStateOperatorsDI] translate %f, %f', [Param2.FloatValue, Param1.FloatValue]));
+    {$endif}
+
+    CurrentGraphicState.TranslateX := Param2.FloatValue;
+    CurrentGraphicState.TranslateY := Param1.FloatValue;
+
+    Exit(True);
+  end;
+  //
+  if AToken.StrValue = 'rotate' then
+  begin
+    Param1 := TPSToken(Stack.Pop);
+    Exit(True);
+  end;
 end;
 
 {  Dictionary Operators
@@ -1284,6 +1780,7 @@ function TvEPSVectorialReader.ExecuteDictionaryOperators(
   AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
 var
   Param1, Param2: TPSToken;
+  NewToken: TExpressionToken;
 begin
   Result := False;
 
@@ -1301,6 +1798,17 @@ begin
   begin
     Exit(True);
   end;
+
+  // Find dictionary in which key is defined
+  if AToken.StrValue = 'where' then
+  begin
+    Param1 := TPSToken(Stack.Pop);
+    NewToken := TExpressionToken.Create;
+    NewToken.ETType := ettOperand;
+    NewToken.BoolValue := False;
+    Stack.Push(NewToken);
+    Exit(True);
+  end;
 end;
 
 {  Miscellaneous Operators
@@ -1372,14 +1880,18 @@ begin
 
   Tokenizer := TPSTokenizer.Create;
   Stack := TObjectStack.Create;
+  GraphicStateStack := TObjectStack.Create;
   Dictionary := TStringList.Create;
+  CurrentGraphicState := TGraphicState.Create;
 end;
 
 destructor TvEPSVectorialReader.Destroy;
 begin
   Tokenizer.Free;
   Stack.Free;
+  GraphicStateStack.Free;
   Dictionary.Free;
+  CurrentGraphicState.Free;
 
   inherited Destroy;
 end;
@@ -1388,7 +1900,7 @@ procedure TvEPSVectorialReader.ReadFromStream(AStream: TStream;
   AData: TvVectorialDocument);
 begin
   Tokenizer.ReadFromStream(AStream);
-  Tokenizer.DebugOut();
+//  Tokenizer.DebugOut();
 
   // Make sure we have at least one path
   AData.StartPath();

applications/fpvviewer/fpvectorialsrc/fpvtocanvas.pas

@@ -31,7 +31,7 @@ procedure DrawFPVTextToCanvas(ASource: TvVectorialDocument; CurText: TvText;
 implementation
 
 {$ifndef Windows}
-{$define FPVECTORIALDEBUG}
+{.$define FPVECTORIAL_TOCANVAS_DEBUG}
 {$endif}
 
 function Rotate2DPoint(P,Fix :TPoint; alpha:double): TPoint;
@@ -112,6 +112,10 @@ begin
 
   for i := 0 to ASource.GetEntitiesCount - 1 do
   begin
+    {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
+    Write(Format('[Path] ID=%d', [i]));
+    {$endif}
+
     CurEntity := ASource.GetEntity(i);
 
     if CurEntity is TPath then DrawFPVPathToCanvas(ASource, TPath(CurEntity), ADest, ADestX, ADestY, AMulX, AMulY)
@@ -119,7 +123,7 @@ begin
     else DrawFPVEntityToCanvas(ASource, CurEntity, ADest, ADestX, ADestY, AMulX, AMulY);
   end;
 
-  {$ifdef FPVECTORIALDEBUG}
+  {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
   WriteLn(':<DrawFPVectorialToCanvas');
   {$endif}
 end;
@@ -140,7 +144,8 @@ procedure DrawFPVPathToCanvas(ASource: TvVectorialDocument; CurPath: TPath;
 
 var
   j, k: Integer;
-  PosX, PosY: Integer; // Not modified by ADestX, etc
+  PosX, PosY: Double; // Not modified by ADestX, etc
+  CoordX, CoordY: Integer;
   CurSegment: TPathSegment;
   Cur2DSegment: T2DSegment absolute CurSegment;
   Cur2DBSegment: T2DBezierSegment absolute CurSegment;
@@ -164,10 +169,6 @@ begin
   ADest.Pen.FPColor := CurPath.Pen.Color;
   ADest.Brush.FPColor := CurPath.Brush.Color;
 
-  {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
-  Write(Format('[Path] ID=%d', [i]));
-  {$endif}
-
   for j := 0 to CurPath.Len - 1 do
   begin
     //WriteLn('j = ', j);
@@ -176,9 +177,13 @@ begin
     case CurSegment.SegmentType of
     stMoveTo:
     begin
-      ADest.MoveTo(CoordToCanvasX(Cur2DSegment.X), CoordToCanvasY(Cur2DSegment.Y));
+      CoordX := CoordToCanvasX(Cur2DSegment.X);
+      CoordY := CoordToCanvasY(Cur2DSegment.Y);
+      ADest.MoveTo(CoordX, CoordY);
+      PosX := Cur2DSegment.X;
+      PosY := Cur2DSegment.Y;
       {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
-      Write(Format(' M%d,%d', [CoordToCanvasX(Cur2DSegment.X), CoordToCanvasY(Cur2DSegment.Y)]));
+      Write(Format(' M%d,%d', [CoordY, CoordY]));
       {$endif}
     end;
     // This element can override temporarely the Pen
@@ -186,7 +191,11 @@ begin
     begin
       ADest.Pen.FPColor := T2DSegmentWithPen(Cur2DSegment).Pen.Color;
 
-      ADest.LineTo(CoordToCanvasX(Cur2DSegment.X), CoordToCanvasY(Cur2DSegment.Y));
+      CoordX := CoordToCanvasX(Cur2DSegment.X);
+      CoordY := CoordToCanvasY(Cur2DSegment.Y);
+      ADest.LineTo(CoordX, CoordY);
+      PosX := Cur2DSegment.X;
+      PosY := Cur2DSegment.Y;
 
       ADest.Pen.FPColor := CurPath.Pen.Color;
 
@@ -196,9 +205,13 @@ begin
     end;
     st2DLine, st3DLine:
     begin
-      ADest.LineTo(CoordToCanvasX(Cur2DSegment.X), CoordToCanvasY(Cur2DSegment.Y));
+      CoordX := CoordToCanvasX(Cur2DSegment.X);
+      CoordY := CoordToCanvasY(Cur2DSegment.Y);
+      ADest.LineTo(CoordX, CoordY);
+      PosX := Cur2DSegment.X;
+      PosY := Cur2DSegment.Y;
       {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
-      Write(Format(' L%d,%d', [CoordToCanvasX(Cur2DSegment.X), CoordToCanvasY(Cur2DSegment.Y)]));
+      Write(Format(' L%d,%d', [CoordX, CoordY]));
       {$endif}
     end;
     { To draw a bezier we need to divide the interval in parts and make
@@ -206,8 +219,8 @@ begin
     st2DBezier, st3DBezier:
     begin
       CurveLength :=
-        Round(sqrt(sqr(Cur2DBSegment.X3 - PosX) + sqr(Cur2DBSegment.Y3 - PosY))) +
+        Round(sqrt(sqr(Cur2DBSegment.X2 - PosX) + sqr(Cur2DBSegment.Y2 - PosY))) +
-        Round(sqrt(sqr(Cur2DBSegment.X2 - Cur2DBSegment.X3) + sqr(Cur2DBSegment.Y2 - Cur2DBSegment.Y3))) +
+        Round(sqrt(sqr(Cur2DBSegment.X3 - Cur2DBSegment.X2) + sqr(Cur2DBSegment.Y3 - Cur2DBSegment.Y2))) +
         Round(sqrt(sqr(Cur2DBSegment.X - Cur2DBSegment.X3) + sqr(Cur2DBSegment.Y - Cur2DBSegment.Y3)));
 
       for k := 1 to CurveLength do
@@ -215,10 +228,23 @@ 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);
-        ADest.LineTo(CoordToCanvasX(CurX), CoordToCanvasY(CurY));
+        CoordX := CoordToCanvasX(CurX);
+        CoordY := CoordToCanvasY(CurY);
+        ADest.LineTo(CoordX, CoordY);
+//        {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
+//        Write(Format(' CL%d,%d', [CoordX, CoordY]));
+//        {$endif}
       end;
-      PosX := Round(Cur2DBSegment.X);
+      PosX := Cur2DSegment.X;
-      PosY := Round(Cur2DBSegment.Y);
+      PosY := Cur2DSegment.Y;
+
+      {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
+      Write(Format(' ***C%d,%d %d,%d %d,%d %d,%d',
+        [CoordToCanvasX(PosX), CoordToCanvasY(PosY),
+         CoordToCanvasX(Cur2DBSegment.X2), CoordToCanvasY(Cur2DBSegment.Y2),
+         CoordToCanvasX(Cur2DBSegment.X3), CoordToCanvasY(Cur2DBSegment.Y3),
+         CoordToCanvasX(Cur2DBSegment.X), CoordToCanvasY(Cur2DBSegment.Y)]));
+      {$endif}
     end;
     end;
   end;

applications/fpvviewer/fpvv_mainform.lfm

@@ -37,9 +37,10 @@ object frmFPVViewer: TfrmFPVViewer
     Top = 72
     Width = 168
     DecimalPlaces = 6
-    Increment = 1
+    Increment = 0.1
     MaxValue = 100
     MinValue = 0
+    OnChange = spinScaleChange
     TabOrder = 2
     Value = 1
   end
@@ -76,8 +77,8 @@ object frmFPVViewer: TfrmFPVViewer
     object pageViewer: TPage
     end
     object Page2: TPage
-      ClientWidth = 67584
+      ClientWidth = 135
-      ClientHeight = 79872
+      ClientHeight = 159
       object DXFTreeView: TTreeView
         Left = 8
         Height = 313

applications/fpvviewer/fpvv_mainform.pas

@@ -31,6 +31,7 @@ type
     procedure buttonRenderingTestClick(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
+    procedure spinScaleChange(Sender: TObject);
   private
     { private declarations }
   public
@@ -190,5 +191,12 @@ begin
   Drawer.Free;
 end;
 
+procedure TfrmFPVViewer.spinScaleChange(Sender: TObject);
+begin
+  if spinScale.Value <= 0.2 then spinScale.Increment := 0.01
+  else if spinScale.Value <= 2 then spinScale.Increment := 0.1
+  else spinScale.Increment := 1;
+end;
+
 end.