From 26832a9a73e434c31f901b6c5efec2292b77d19c Mon Sep 17 00:00:00 2001 From: sekelsenmat Date: Thu, 1 Sep 2011 11:56:28 +0000 Subject: [PATCH] fpvectorial: Advances the eps reader, but still didnt find out why a part of the drawing ends up with negative coords git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1884 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../fpvectorialsrc/epsvectorialreader.pas | 259 +++++++++++++++--- 1 file changed, 218 insertions(+), 41 deletions(-) diff --git a/applications/fpvviewer/fpvectorialsrc/epsvectorialreader.pas b/applications/fpvviewer/fpvectorialsrc/epsvectorialreader.pas index 4d3e4218d..543c43830 100644 --- a/applications/fpvviewer/fpvectorialsrc/epsvectorialreader.pas +++ b/applications/fpvviewer/fpvectorialsrc/epsvectorialreader.pas @@ -7,15 +7,21 @@ 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; {$mode objfpc}{$H+} -{.$define FPVECTORIALDEBUG_PATHS} +{$define FPVECTORIALDEBUG_PATHS} {.$define FPVECTORIALDEBUG_COLORS} {.$define FPVECTORIALDEBUG_ROLL} -{.$define FPVECTORIALDEBUG_CODEFLOW} +{$define FPVECTORIALDEBUG_CODEFLOW} +{$define FPVECTORIALDEBUG_INDEX} +{$define FPVECTORIALDEBUG_DICTIONARY} +{$define FPVECTORIALDEBUG_CONTROL} +{$define FPVECTORIALDEBUG_ARITHMETIC} interface @@ -51,7 +57,7 @@ type destructor Destroy; override; end; - TETType = (ettNamedElement, ettOperand, ettOperator); + TETType = (ettNamedElement, ettOperand, ettOperator, ettDictionary); { TExpressionToken } @@ -71,8 +77,10 @@ type public Color: TFPColor; TranslateX, TranslateY: Double; + ScaleX, ScaleY: Double; // not used currently ClipPath: TPath; ClipMode: TvClipMode; + OverPrint: Boolean; // not used currently function Duplicate: TGraphicState; end; @@ -81,7 +89,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(); @@ -147,6 +156,7 @@ begin Result.TranslateX := TranslateX; Result.TranslateY := TranslateY; Result.ClipPath := ClipPath; + Result.OverPrint := OverPrint; end; { TPSToken } @@ -202,10 +212,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 +256,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 +554,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 +787,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,7 +810,7 @@ begin Param2 := lTokens[i]; if Param2 = nil then begin - // raise Exception.Create('[TvEPSVectorialReader.ExecuteStackManipulationOperator] nil element poped in operator index'); + //raise Exception.Create(Format('[TvEPSVectorialReader.ExecuteStackManipulationOperator] nil element poped in operator index. Error at line %d', [AToken.Line])); Exit(True); end; end; @@ -839,7 +861,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 +875,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; @@ -972,9 +994,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 @@ -1028,6 +1074,12 @@ begin ExecuteProcedureToken(TProcedureToken(Param1), AData); FloatCounter := FloatCounter + Param3.FloatValue; + + if ExitCalled then + begin + ExitCalled := False; + Break; + end; end; Exit(True); @@ -1036,6 +1088,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; @@ -1378,7 +1435,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 +1443,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 +1459,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 +1471,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,7 +1524,7 @@ var begin Result := False; - // + // – newpath – Initialize current path to be empty if AToken.StrValue = 'newpath' then begin {$ifdef FPVECTORIALDEBUG_PATHS} @@ -1479,21 +1539,23 @@ begin 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); + {$ifdef FPVECTORIALDEBUG_PATHS} + WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] moveto %f, %f CurrentGraphicState.Translate %f, %f', + [PosX, PosY, CurrentGraphicState.TranslateX, CurrentGraphicState.TranslateY])); + {$endif} 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; // Absolute LineTo + // x y lineto – Append straight line to (x, y) if AToken.StrValue = 'lineto' then begin Param1 := TPSToken(Stack.Pop); @@ -1508,6 +1570,7 @@ begin Exit(True); end; // Relative LineTo + // dx dy rlineto – Perform relative lineto if AToken.StrValue = 'rlineto' then begin Param1 := TPSToken(Stack.Pop); @@ -1554,6 +1617,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 @@ -1613,12 +1677,23 @@ begin 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 AData.SetPenStyle(psClear); AData.EndPath(); - CurrentGraphicState.ClipPath := AData.GetPath(AData.GetPathCount()-1); - CurrentGraphicState.ClipMode := vcmEvenOddRule; + //CurrentGraphicState.ClipPath := AData.GetPath(AData.GetPathCount()-1); + //CurrentGraphicState.ClipMode := vcmEvenOddRule; Exit(True); end end; @@ -1681,7 +1756,7 @@ var begin Result := False; - // + // – gsave – Push graphics state if AToken.StrValue = 'gsave' then begin GraphicStateStack.Push(CurrentGraphicState.Duplicate()); @@ -1690,7 +1765,7 @@ begin {$endif} Exit(True); end; - // + // – grestore - Pop graphics state if AToken.StrValue = 'grestore' then begin lGraphicState := TGraphicState(GraphicStateStack.Pop()); @@ -1702,19 +1777,21 @@ begin {$endif} Exit(True); end; - // + // num setlinewidth – Set line width if AToken.StrValue = 'setlinewidth' then begin Param1 := TPSToken(Stack.Pop); 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 +1907,84 @@ 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 + {$ifdef FPVECTORIALDEBUG_PATHS} + WriteLn('[TvEPSVectorialReader.ExecuteGraphicStateOperatorsDI] translate with stack underflow'); + {$endif} + + Exit(True); + 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 +2033,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 +2042,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 +2123,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 +2180,7 @@ begin FPointSeparator.DecimalSeparator := '.'; FPointSeparator.ThousandSeparator := ','; - Tokenizer := TPSTokenizer.Create; + Tokenizer := TPSTokenizer.Create(-1); Stack := TObjectStack.Create; GraphicStateStack := TObjectStack.Create; Dictionary := TStringList.Create;