paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-18 00:09:23 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: trunk@18977 -
This commit is contained in:
sekelsenmat 2011-09-05 09:48:00 +00:00
parent b526bb4dfa
commit 50067bf42a
3 changed files with 454 additions and 104 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

363
packages/fpvectorial/src/epsvectorialreader.pas
View File

@ -7,6 +7,8 @@ License: The same modified LGPL as the Free Pascal RTL
AUTHORS: Felipe Monteiro de Carvalho AUTHORS: Felipe Monteiro de Carvalho
Documentation: http://www.tailrecursive.org/postscript/postscript.html Documentation: http://www.tailrecursive.org/postscript/postscript.html
Good reference: http://atrey.karlin.mff.cuni.cz/~milanek/PostScript/Reference/PSL2e.html
} }
unit epsvectorialreader; unit epsvectorialreader;
@ -16,6 +18,11 @@ unit epsvectorialreader;
{.$define FPVECTORIALDEBUG_COLORS} {.$define FPVECTORIALDEBUG_COLORS}
{.$define FPVECTORIALDEBUG_ROLL} {.$define FPVECTORIALDEBUG_ROLL}
{.$define FPVECTORIALDEBUG_CODEFLOW} {.$define FPVECTORIALDEBUG_CODEFLOW}
{.$define FPVECTORIALDEBUG_INDEX}
{.$define FPVECTORIALDEBUG_DICTIONARY}
{.$define FPVECTORIALDEBUG_CONTROL}
{.$define FPVECTORIALDEBUG_ARITHMETIC}
{.$define FPVECTORIALDEBUG_CLIP_REGION}
interface interface
@ -51,7 +58,7 @@ type
destructor Destroy; override; destructor Destroy; override;
end; end;
TETType = (ettNamedElement, ettOperand, ettOperator); TETType = (ettNamedElement, ettOperand, ettOperator, ettDictionary);
{ TExpressionToken } { TExpressionToken }
@ -71,8 +78,13 @@ type
public public
Color: TFPColor; Color: TFPColor;
TranslateX, TranslateY: Double; TranslateX, TranslateY: Double;
ScaleX, ScaleY: Double; // not used currently
ClipPath: TPath; ClipPath: TPath;
ClipMode: TvClipMode; ClipMode: TvClipMode;
OverPrint: Boolean; // not used currently
//
PenWidth: Integer;
//
function Duplicate: TGraphicState; function Duplicate: TGraphicState;
end; end;
@ -81,7 +93,8 @@ type
TPSTokenizer = class TPSTokenizer = class
public public
Tokens: TPSTokens; Tokens: TPSTokens;
constructor Create; FCurLine: Integer;
constructor Create(ACurLine: Integer = -1);
destructor Destroy; override; destructor Destroy; override;
procedure ReadFromStream(AStream: TStream); procedure ReadFromStream(AStream: TStream);
procedure DebugOut(); procedure DebugOut();
@ -146,7 +159,12 @@ begin
Result.Color := Color; Result.Color := Color;
Result.TranslateX := TranslateX; Result.TranslateX := TranslateX;
Result.TranslateY := TranslateY; Result.TranslateY := TranslateY;
Result.ScaleX := ScaleX;
Result.ScaleY := ScaleY;
Result.ClipPath := ClipPath; Result.ClipPath := ClipPath;
Result.ClipMode := ClipMode;
Result.OverPrint := OverPrint;
Result.PenWidth := PenWidth;
end; end;
{ TPSToken } { TPSToken }
@ -202,10 +220,13 @@ end;
{ TPSTokenizer } { 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 begin
inherited Create; inherited Create;
Tokens := TPSTokens.Create; Tokens := TPSTokens.Create;
FCurLine := ACurLine;
end; end;
destructor TPSTokenizer.Destroy; destructor TPSTokenizer.Destroy;
@ -243,6 +264,7 @@ begin
lIsEndOfLine := IsEndOfLine(Byte(CurChar), AStream); lIsEndOfLine := IsEndOfLine(Byte(CurChar), AStream);
if lIsEndOfLine then Inc(CurLine); if lIsEndOfLine then Inc(CurLine);
if FCurLine >= 0 then CurLine := FCurLine;
case State of case State of
{ Searching for a token } { Searching for a token }
@ -540,7 +562,7 @@ begin
if not AToken.Parsed then if not AToken.Parsed then
begin begin
ProcTokenizer := TPSTokenizer.Create; ProcTokenizer := TPSTokenizer.Create(AToken.Line);
lStream := TMemoryStream.Create; lStream := TMemoryStream.Create;
try try
// Copy the string to a Stream // Copy the string to a Stream
@ -773,13 +795,21 @@ begin
Stack.Push(NewToken); Stack.Push(NewToken);
Exit(True); Exit(True);
end; end;
// anyn … any0 n index anyn … any0 anyn
// Duplicate arbitrary element // Duplicate arbitrary element
if AToken.StrValue = 'index' then if AToken.StrValue = 'index' then
begin begin
{$ifdef FPVECTORIALDEBUG_INDEX}
WriteLn('[TvEPSVectorialReader.ExecuteStackManipulationOperator] index');
// DebugStack();
{$endif}
Param1 := TPSToken(Stack.Pop); Param1 := TPSToken(Stack.Pop);
lIndexN := Round(Param1.FloatValue); lIndexN := Round(Param1.FloatValue);
SetLength(lTokens, lIndexN+1); 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 // Unroll all elements necessary
for i := 0 to lIndexN do for i := 0 to lIndexN do
@ -788,8 +818,7 @@ begin
Param2 := lTokens[i]; Param2 := lTokens[i];
if Param2 = nil then if Param2 = nil then
begin begin
// raise Exception.Create('[TvEPSVectorialReader.ExecuteStackManipulationOperator] nil element poped in operator index'); raise Exception.Create(Format('[TvEPSVectorialReader.ExecuteStackManipulationOperator] Stack underflow in operation "index". Error at line %d', [AToken.Line]));
Exit(True);
end; end;
end; end;
@ -839,7 +868,7 @@ begin
WriteLn(Format('[TvEPSVectorialReader] roll: N=%d J=%d', [lIndexN, lIndexJ])); WriteLn(Format('[TvEPSVectorialReader] roll: N=%d J=%d', [lIndexN, lIndexJ]));
{$endif} {$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; if lIndexJ = 0 then Exit;
@ -853,8 +882,8 @@ begin
Param2 := lTokens[i]; Param2 := lTokens[i];
if Param2 = nil then if Param2 = nil then
begin begin
// raise Exception.Create('[TvEPSVectorialReader.ExecuteStackManipulationOperator] nil element poped in operator index'); raise Exception.Create('[TvEPSVectorialReader.ExecuteStackManipulationOperator] nil element poped in operator index');
Exit(True); //Exit(True);
end; end;
end; end;
@ -929,7 +958,7 @@ end;
function TvEPSVectorialReader.ExecuteControlOperator(AToken: TExpressionToken; function TvEPSVectorialReader.ExecuteControlOperator(AToken: TExpressionToken;
AData: TvVectorialDocument): Boolean; AData: TvVectorialDocument): Boolean;
var var
Param1, Param2, Param3, Param4: TPSToken; Param1, Param2, Param3, Param4, CounterToken: TPSToken;
NewToken: TExpressionToken; NewToken: TExpressionToken;
FloatCounter: Double; FloatCounter: Double;
begin begin
@ -972,9 +1001,33 @@ begin
Exit(True); Exit(True);
end; 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 if AToken.StrValue = 'stopped' then
begin begin
{$ifdef FPVECTORIALDEBUG_CONTROL}
WriteLn('[TvEPSVectorialReader.ExecuteControlOperator] stopped');
// DebugStack();
{$endif}
Param1 := TPSToken(Stack.Pop); Param1 := TPSToken(Stack.Pop);
if not (Param1 is TProcedureToken) then if not (Param1 is TProcedureToken) then
@ -1011,7 +1064,51 @@ begin
Exit(True); Exit(True);
end; 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 if AToken.StrValue = 'for' then
begin begin
Param1 := TPSToken(Stack.Pop); Param1 := TPSToken(Stack.Pop);
@ -1025,9 +1122,19 @@ begin
FloatCounter := Param4.FloatValue; FloatCounter := Param4.FloatValue;
while FloatCounter < Param2.FloatValue do while FloatCounter < Param2.FloatValue do
begin begin
CounterToken := Param4.Duplicate();
CounterToken.FloatValue := FloatCounter;
Stack.Push(CounterToken);
ExecuteProcedureToken(TProcedureToken(Param1), AData); ExecuteProcedureToken(TProcedureToken(Param1), AData);
FloatCounter := FloatCounter + Param3.FloatValue; FloatCounter := FloatCounter + Param3.FloatValue;
if ExitCalled then
begin
ExitCalled := False;
Break;
end;
end; end;
Exit(True); Exit(True);
@ -1036,6 +1143,11 @@ begin
// if it is executable or false if it is literal // if it is executable or false if it is literal
if AToken.StrValue = 'xcheck' then if AToken.StrValue = 'xcheck' then
begin begin
// {$ifdef FPVECTORIALDEBUG_CONTROL}
// WriteLn('[TvEPSVectorialReader.ExecuteControlOperator] xcheck');
// DebugStack();
// {$endif}
Param1 := TPSToken(Stack.Pop); Param1 := TPSToken(Stack.Pop);
NewToken := TExpressionToken.Create; NewToken := TExpressionToken.Create;
@ -1119,6 +1231,12 @@ begin
{$ifdef FPVECTORIALDEBUG_PATHS} {$ifdef FPVECTORIALDEBUG_PATHS}
WriteLn('[TvEPSVectorialReader.ExecutePaintingOperator] stroke'); WriteLn('[TvEPSVectorialReader.ExecutePaintingOperator] stroke');
{$endif} {$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); Exit(True);
end; end;
@ -1128,6 +1246,10 @@ begin
WriteLn('[TvEPSVectorialReader.ExecutePaintingOperator] eofill'); WriteLn('[TvEPSVectorialReader.ExecutePaintingOperator] eofill');
{$endif} {$endif}
AData.SetBrushStyle(bsSolid); AData.SetBrushStyle(bsSolid);
AData.SetPenStyle(psSolid);
AData.SetClipPath(CurrentGraphicState.ClipPath, CurrentGraphicState.ClipMode);
AData.SetPenWidth(CurrentGraphicState.PenWidth);
AData.EndPath();
Exit(True); Exit(True);
end; end;
@ -1378,7 +1500,7 @@ begin
Result := False; Result := False;
// Division // Division
// Param2 Param1 div ==> Param2 div Param1 // Param2 Param1 div ==> (Param2 div Param1)
if AToken.StrValue = 'div' then if AToken.StrValue = 'div' then
begin begin
Param1 := TPSToken(Stack.Pop); Param1 := TPSToken(Stack.Pop);
@ -1386,12 +1508,15 @@ begin
NewToken := TExpressionToken.Create; NewToken := TExpressionToken.Create;
NewToken.ETType := ettOperand; NewToken.ETType := ettOperand;
NewToken.FloatValue := Param2.FloatValue / Param1.FloatValue; NewToken.FloatValue := Param2.FloatValue / Param1.FloatValue;
NewToken.StrValue := FloatToStr(Param1.FloatValue); NewToken.StrValue := FloatToStr(NewToken.FloatValue);
Stack.Push(NewToken); Stack.Push(NewToken);
{$ifdef FPVECTORIALDEBUG_ARITHMETIC}
WriteLn(Format('[TvEPSVectorialReader.ExecuteArithmeticAndMathOperator] %f %f div %f', [Param2.FloatValue, Param1.FloatValue, NewToken.FloatValue]));
{$endif}
Exit(True); Exit(True);
end; end;
// Param2 Param1 mul ==> Param2 mul Param1 // Param2 Param1 mul ==> (Param2 mul Param1)
if AToken.StrValue = 'mul' then if AToken.StrValue = 'mul' then
begin begin
Param1 := TPSToken(Stack.Pop); Param1 := TPSToken(Stack.Pop);
@ -1399,7 +1524,7 @@ begin
NewToken := TExpressionToken.Create; NewToken := TExpressionToken.Create;
NewToken.ETType := ettOperand; NewToken.ETType := ettOperand;
NewToken.FloatValue := Param2.FloatValue * Param1.FloatValue; NewToken.FloatValue := Param2.FloatValue * Param1.FloatValue;
NewToken.StrValue := FloatToStr(Param1.FloatValue); NewToken.StrValue := FloatToStr(NewToken.FloatValue);
Stack.Push(NewToken); Stack.Push(NewToken);
Exit(True); Exit(True);
end; end;
@ -1411,7 +1536,7 @@ begin
Param1 := TPSToken(Stack.Pop); // num2 Param1 := TPSToken(Stack.Pop); // num2
Param2 := TPSToken(Stack.Pop); // num1 Param2 := TPSToken(Stack.Pop); // num1
NewToken.FloatValue := Param2.FloatValue - Param1.FloatValue; NewToken.FloatValue := Param2.FloatValue - Param1.FloatValue;
NewToken.StrValue := FloatToStr(Param1.FloatValue); NewToken.StrValue := FloatToStr(NewToken.FloatValue);
Stack.Push(NewToken); Stack.Push(NewToken);
Exit(True); Exit(True);
end; end;
@ -1464,62 +1589,71 @@ var
begin begin
Result := False; Result := False;
// // – newpath – Initialize current path to be empty
if AToken.StrValue = 'newpath' then if AToken.StrValue = 'newpath' then
begin begin
{$ifdef FPVECTORIALDEBUG_PATHS} {$ifdef FPVECTORIALDEBUG_PATHS}
WriteLn('[TvEPSVectorialReader.ExecutePathConstructionOperator] newpath'); WriteLn('[TvEPSVectorialReader.ExecutePathConstructionOperator] newpath');
{$endif} {$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.EndPath();
AData.StartPath(); AData.StartPath();
AData.SetPenColor(CurrentGraphicState.Color); AData.SetPenColor(CurrentGraphicState.Color);
AData.SetBrushColor(CurrentGraphicState.Color); AData.SetBrushColor(CurrentGraphicState.Color);
AData.SetPenStyle(psClear);
Exit(True); Exit(True);
end; end;
// Param2 Param1 moveto ===> moveto(X=Param2, Y=Param1); // Param2 Param1 moveto - ===> moveto(X=Param2, Y=Param1);
if AToken.StrValue = 'moveto' then if AToken.StrValue = 'moveto' then
begin begin
Param1 := TPSToken(Stack.Pop); Param1 := TPSToken(Stack.Pop);
Param2 := TPSToken(Stack.Pop); Param2 := TPSToken(Stack.Pop);
PostScriptCoordsToFPVectorialCoords(Param1, Param2, PosX, PosY); PostScriptCoordsToFPVectorialCoords(Param1, Param2, PosX, PosY);
PosX := PosX + CurrentGraphicState.TranslateX; PosX2 := PosX + CurrentGraphicState.TranslateX;
PosY := PosY + CurrentGraphicState.TranslateY; PosY2 := PosY + CurrentGraphicState.TranslateY;
{$ifdef FPVECTORIALDEBUG_PATHS} {$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} {$endif}
AData.AddMoveToPath(PosX, PosY); AData.AddMoveToPath(PosX2, PosY2);
Exit(True); Exit(True);
end; end;
// Absolute LineTo // Absolute LineTo
// x y lineto – Append straight line to (x, y)
if AToken.StrValue = 'lineto' then if AToken.StrValue = 'lineto' then
begin begin
Param1 := TPSToken(Stack.Pop); Param1 := TPSToken(Stack.Pop);
Param2 := TPSToken(Stack.Pop); Param2 := TPSToken(Stack.Pop);
PostScriptCoordsToFPVectorialCoords(Param1, Param2, PosX, PosY); PostScriptCoordsToFPVectorialCoords(Param1, Param2, PosX, PosY);
PosX := PosX + CurrentGraphicState.TranslateX; PosX2 := PosX + CurrentGraphicState.TranslateX;
PosY := PosY + CurrentGraphicState.TranslateY; PosY2 := PosY + CurrentGraphicState.TranslateY;
{$ifdef FPVECTORIALDEBUG_PATHS} {$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} {$endif}
AData.AddLineToPath(PosX, PosY); AData.AddLineToPath(PosX2, PosY2);
Exit(True); Exit(True);
end; end;
// Relative LineTo // Relative LineTo
// dx dy rlineto – Perform relative lineto
if AToken.StrValue = 'rlineto' then if AToken.StrValue = 'rlineto' then
begin begin
Param1 := TPSToken(Stack.Pop); Param1 := TPSToken(Stack.Pop);
Param2 := TPSToken(Stack.Pop); Param2 := TPSToken(Stack.Pop);
PostScriptCoordsToFPVectorialCoords(Param1, Param2, PosX, PosY); PostScriptCoordsToFPVectorialCoords(Param1, Param2, PosX, PosY);
AData.GetCurrentPathPenPos(BaseX, BaseY); AData.GetCurrentPathPenPos(BaseX, BaseY);
PosX := PosX + CurrentGraphicState.TranslateX; PosX2 := PosX + BaseX;
PosY := PosY + CurrentGraphicState.TranslateY; PosY2 := PosY + BaseY;
{$ifdef FPVECTORIALDEBUG_PATHS} {$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} {$endif}
AData.AddLineToPath(BaseX + PosX, BaseY + PosY); AData.AddLineToPath(PosX2, PosY2);
Exit(True); Exit(True);
end; end;
// dx1 dy1 dx2 dy2 dx3 dy3 rcurveto – // dx1 dy1 dx2 dy2 dx3 dy3 rcurveto –
@ -1543,10 +1677,10 @@ begin
PostScriptCoordsToFPVectorialCoords(Param1, Param2, PosX3, PosY3); PostScriptCoordsToFPVectorialCoords(Param1, Param2, PosX3, PosY3);
AData.GetCurrentPathPenPos(BaseX, BaseY); AData.GetCurrentPathPenPos(BaseX, BaseY);
// First move to the start of the arc // First move to the start of the arc
BaseX := BaseX + CurrentGraphicState.TranslateX; // BaseX := BaseX + CurrentGraphicState.TranslateX;
BaseY := BaseY + CurrentGraphicState.TranslateY; // BaseY := BaseY + CurrentGraphicState.TranslateY;
{$ifdef FPVECTORIALDEBUG_PATHS} {$ifdef FPVECTORIALDEBUG_PATHS}
WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] translate %f, %f', WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] rcurveto translate %f, %f',
[CurrentGraphicState.TranslateX, CurrentGraphicState.TranslateY])); [CurrentGraphicState.TranslateX, CurrentGraphicState.TranslateY]));
WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] rcurveto from %f, %f via %f, %f %f, %f to %f, %f', 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])); [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); AData.AddBezierToPath(BaseX + PosX, BaseY + PosY, BaseX + PosX2, BaseY + PosY2, BaseX + PosX3, BaseY + PosY3);
Exit(True); Exit(True);
end; end;
// – closepath –
// //
// Don't do anything, because a stroke or fill might come after closepath // Don't do anything, because a stroke or fill might come after closepath
// and newpath will be called after stroke and fill anyway // and newpath will be called after stroke and fill anyway
@ -1604,18 +1739,33 @@ begin
AData.AddMoveToPath(P1.X, P1.Y); AData.AddMoveToPath(P1.X, P1.Y);
AData.AddBezierToPath(P2.X, P2.Y, P3.X, P3.Y, P4.X, P4.Y); AData.AddBezierToPath(P2.X, P2.Y, P3.X, P3.Y, P4.X, P4.Y);
end; end;
// {$ifdef FPVECTORIALDEBUG}
// WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] rcurveto %f, %f', [BaseX + PosX, BaseY + PosY]));
// {$endif}
{$ifdef FPVECTORIALDEBUG_PATHS} {$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} {$endif}
Exit(True); Exit(True);
end; end;
// – eoclip – Clip using even-odd rule // – 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 if AToken.StrValue = 'eoclip' then
begin begin
{$ifdef FPVECTORIALDEBUG_PATHS}
WriteLn('[TvEPSVectorialReader.ExecutePathConstructionOperator] eoclip');
{$endif}
{$ifndef FPVECTORIALDEBUG_CLIP_REGION}
AData.SetPenStyle(psClear); AData.SetPenStyle(psClear);
{$endif}
AData.SetBrushStyle(bsClear);
AData.EndPath(); AData.EndPath();
CurrentGraphicState.ClipPath := AData.GetPath(AData.GetPathCount()-1); CurrentGraphicState.ClipPath := AData.GetPath(AData.GetPathCount()-1);
CurrentGraphicState.ClipMode := vcmEvenOddRule; CurrentGraphicState.ClipMode := vcmEvenOddRule;
@ -1681,7 +1831,7 @@ var
begin begin
Result := False; Result := False;
// // – gsave – Push graphics state
if AToken.StrValue = 'gsave' then if AToken.StrValue = 'gsave' then
begin begin
GraphicStateStack.Push(CurrentGraphicState.Duplicate()); GraphicStateStack.Push(CurrentGraphicState.Duplicate());
@ -1690,7 +1840,7 @@ begin
{$endif} {$endif}
Exit(True); Exit(True);
end; end;
// // – grestore - Pop graphics state
if AToken.StrValue = 'grestore' then if AToken.StrValue = 'grestore' then
begin begin
lGraphicState := TGraphicState(GraphicStateStack.Pop()); lGraphicState := TGraphicState(GraphicStateStack.Pop());
@ -1702,19 +1852,22 @@ begin
{$endif} {$endif}
Exit(True); Exit(True);
end; end;
// // num setlinewidth – Set line width
if AToken.StrValue = 'setlinewidth' then if AToken.StrValue = 'setlinewidth' then
begin begin
Param1 := TPSToken(Stack.Pop); Param1 := TPSToken(Stack.Pop);
CurrentGraphicState.PenWidth := Round(Param1.FloatValue);
Exit(True); Exit(True);
end; end;
// // int setlinecap – Set shape of line ends for stroke (0 = butt,
// 1 = round, 2 = square)
if AToken.StrValue = 'setlinecap' then if AToken.StrValue = 'setlinecap' then
begin begin
Param1 := TPSToken(Stack.Pop); Param1 := TPSToken(Stack.Pop);
Exit(True); Exit(True);
end; end;
// // int setlinejoin – Set shape of corners for stroke (0 = miter,
// 1 = round, 2 = bevel)
if AToken.StrValue = 'setlinejoin' then if AToken.StrValue = 'setlinejoin' then
begin begin
Param1 := TPSToken(Stack.Pop); Param1 := TPSToken(Stack.Pop);
@ -1830,34 +1983,80 @@ var
begin begin
Result := False; 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 if AToken.StrValue = 'scale' then
begin begin
Param1 := TPSToken(Stack.Pop); Param1 := TPSToken(Stack.Pop);
Param2 := 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); Exit(True);
end; 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 if AToken.StrValue = 'translate' then
begin begin
Param1 := TPSToken(Stack.Pop); // ty Param1 := TPSToken(Stack.Pop); // ty
Param2 := TPSToken(Stack.Pop); // tx 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} {$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} {$endif}
CurrentGraphicState.TranslateX := Param2.FloatValue; CurrentGraphicState.TranslateX := CurrentGraphicState.TranslateX + Param2.FloatValue;
CurrentGraphicState.TranslateY := Param1.FloatValue; CurrentGraphicState.TranslateY := CurrentGraphicState.TranslateY + Param1.FloatValue;
Exit(True); Exit(True);
end; end;
// // angle rotate – Rotate user space by angle degrees
if AToken.StrValue = 'rotate' then if AToken.StrValue = 'rotate' then
begin begin
Param1 := TPSToken(Stack.Pop); Param1 := TPSToken(Stack.Pop);
{$ifdef FPVECTORIALDEBUG_PATHS}
WriteLn(Format('[TvEPSVectorialReader.ExecuteGraphicStateOperatorsDI] rotate angle=%f', [Param1.FloatValue]));
DebugStack();
{$endif}
Exit(True); Exit(True);
end; end;
end; end;
@ -1906,6 +2105,7 @@ begin
Result := False; Result := False;
// Adds a dictionary definition // Adds a dictionary definition
// key value def – Associate key and value in current dictionary
if AToken.StrValue = 'def' then if AToken.StrValue = 'def' then
begin begin
Param1 := TPSToken(Stack.Pop); Param1 := TPSToken(Stack.Pop);
@ -1914,20 +2114,61 @@ begin
Exit(True); Exit(True);
end; 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 if AToken.StrValue = 'load' then
begin begin
// {$ifdef FPVECTORIALDEBUG_DICTIONARY}
// WriteLn('[TvEPSVectorialReader.ExecuteDictionaryOperators] load');
// DebugStack();
// {$endif}
Exit(True); Exit(True);
end; end;
// Find dictionary in which key is defined // 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 if AToken.StrValue = 'where' then
begin begin
{$ifdef FPVECTORIALDEBUG_DICTIONARY}
WriteLn('[TvEPSVectorialReader.ExecuteDictionaryOperators] where');
DebugStack();
{$endif}
Param1 := TPSToken(Stack.Pop); Param1 := TPSToken(Stack.Pop);
NewToken := TExpressionToken.Create;
NewToken.ETType := ettOperand; if Dictionary.IndexOf(Param1.StrValue) >= 0 then
NewToken.BoolValue := False; begin
Stack.Push(NewToken); // 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); Exit(True);
end; end;
end; end;
@ -1954,8 +2195,16 @@ begin
Result := False; Result := False;
// Just a hint for more efficient parsing, we can ignore // 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 if AToken.StrValue = 'bind' then
begin begin
{$ifdef FPVECTORIALDEBUG_CONTROL}
WriteLn('[TvEPSVectorialReader.ExecuteControlOperator] bind');
DebugStack();
{$endif}
Exit(True); Exit(True);
end; end;
end; end;
@ -2003,7 +2252,7 @@ begin
FPointSeparator.DecimalSeparator := '.'; FPointSeparator.DecimalSeparator := '.';
FPointSeparator.ThousandSeparator := ','; FPointSeparator.ThousandSeparator := ',';
Tokenizer := TPSTokenizer.Create; Tokenizer := TPSTokenizer.Create(-1);
Stack := TObjectStack.Create; Stack := TObjectStack.Create;
GraphicStateStack := TObjectStack.Create; GraphicStateStack := TObjectStack.Create;
Dictionary := TStringList.Create; Dictionary := TStringList.Create;

105
packages/fpvectorial/src/fpvtocanvas.pas
View File

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

90
packages/fpvectorial/src/fpvutils.pas
View File

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