From 50067bf42ae6508cdf58fb992565d9e293a68a88 Mon Sep 17 00:00:00 2001 From: sekelsenmat Date: Mon, 5 Sep 2011 09:48:00 +0000 Subject: [PATCH] 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 - --- .../fpvectorial/src/epsvectorialreader.pas | 363 +++++++++++++++--- packages/fpvectorial/src/fpvtocanvas.pas | 105 +++-- packages/fpvectorial/src/fpvutils.pas | 90 ++++- 3 files changed, 454 insertions(+), 104 deletions(-) diff --git a/packages/fpvectorial/src/epsvectorialreader.pas b/packages/fpvectorial/src/epsvectorialreader.pas index 4d3e4218db..702d819dcf 100644 --- a/packages/fpvectorial/src/epsvectorialreader.pas +++ b/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; diff --git a/packages/fpvectorial/src/fpvtocanvas.pas b/packages/fpvectorial/src/fpvtocanvas.pas index 9924ace5a7..fc05fec087 100644 --- a/packages/fpvectorial/src/fpvtocanvas.pas +++ b/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( diff --git a/packages/fpvectorial/src/fpvutils.pas b/packages/fpvectorial/src/fpvutils.pas index 9920beb3e6..a3805f313a 100644 --- a/packages/fpvectorial/src/fpvutils.pas +++ b/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}