paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2026-01-04 01:22:46 +01:00
Code Issues Packages Projects Releases Wiki Activity

fpvectorial-eps: Fixes setting the current graphic state (translate and scale) to bezier curves

Browse Source 
git-svn-id: trunk@42281 -
This commit is contained in:
sekelsenmat 2013-08-03 14:22:19 +00:00
parent e2aff28251
commit e59bc52695
2 changed files with 44 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
components/fpvectorial/epsvectorialreader.pas
View File

@ -124,7 +124,7 @@ type
public
Color: TFPColor;
TranslateX, TranslateY: Double;
ScaleX, ScaleY: Double; // not used currently
ScaleX, ScaleY: Double;
ClipPath: TPath;
ClipMode: TvClipMode;
OverPrint: Boolean; // not used currently
@ -150,6 +150,7 @@ type
//
PenWidth: Integer;
//
constructor Create;
function Duplicate: TGraphicState;
procedure CTMNeeded;
procedure SetCTM(ANewCTM: TArrayToken);
@ -205,6 +206,7 @@ type
function ExecuteErrorOperator(AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean;
//
procedure PostScriptCoordsToFPVectorialCoords(AParam1, AParam2: TPSToken; var APosX, APosY: Double);
procedure PostScriptCoordsToFPVectorialCoordsWithCGS(AParam1, AParam2: TPSToken; var APosX, APosY: Double);
function DictionarySubstituteOperator(ADictionary: TStringList; var ACurToken: TPSToken): Boolean;
public
{ General reading methods }
@ -320,6 +322,14 @@ end;
{ TGraphicState }
constructor TGraphicState.Create;
begin
inherited Create;
ScaleX := 1;
ScaleY := 1;
end;
function TGraphicState.Duplicate: TGraphicState;
begin
Result := TGraphicState(Self.ClassType.Create);
@ -2524,8 +2534,7 @@ begin
Param1 := TPSToken(Stack.Pop);
Param2 := TPSToken(Stack.Pop);
PostScriptCoordsToFPVectorialCoords(Param1, Param2, PosX, PosY);
PosX2 := PosX + CurrentGraphicState.TranslateX;
PosY2 := PosY + CurrentGraphicState.TranslateY;
PostScriptCoordsToFPVectorialCoordsWithCGS(Param1, Param2, PosX2, PosY2);
{$ifdef FPVECTORIALDEBUG_PATHS}
WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] moveto %f, %f CurrentGraphicState.Translate %f, %f Resulting Value %f, %f',
[PosX, PosY, CurrentGraphicState.TranslateX, CurrentGraphicState.TranslateY, PosX2, PosY2]));
@ -2539,10 +2548,9 @@ begin
begin
Param1 := TPSToken(Stack.Pop);
Param2 := TPSToken(Stack.Pop);
PostScriptCoordsToFPVectorialCoords(Param1, Param2, PosX, PosY);
PosX2 := PosX + CurrentGraphicState.TranslateX;
PosY2 := PosY + CurrentGraphicState.TranslateY;
PostScriptCoordsToFPVectorialCoordsWithCGS(Param1, Param2, PosX2, PosY2);
{$ifdef FPVECTORIALDEBUG_PATHS}
PostScriptCoordsToFPVectorialCoords(Param1, Param2, PosX, PosY);
WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] lineto %f, %f Resulting value %f, %f', [PosX, PosY, PosX2, PosY2]));
{$endif}
AData.AddLineToPath(PosX2, PosY2);
@ -2574,9 +2582,9 @@ begin
Param4 := TPSToken(Stack.Pop); // x2
Param5 := TPSToken(Stack.Pop); // y1
Param6 := TPSToken(Stack.Pop); // x1
PostScriptCoordsToFPVectorialCoords(Param5, Param6, PosX, PosY);
PostScriptCoordsToFPVectorialCoords(Param3, Param4, PosX2, PosY2);
PostScriptCoordsToFPVectorialCoords(Param1, Param2, PosX3, PosY3);
PostScriptCoordsToFPVectorialCoordsWithCGS(Param5, Param6, PosX, PosY);
PostScriptCoordsToFPVectorialCoordsWithCGS(Param3, Param4, PosX2, PosY2);
PostScriptCoordsToFPVectorialCoordsWithCGS(Param1, Param2, PosX3, PosY3);
AData.AddBezierToPath(PosX, PosY, PosX2, PosY2, PosX3, PosY3);
Exit(True);
end;
@ -3314,6 +3322,14 @@ begin
APosY := AParam1.FloatValue;
end;
procedure TvEPSVectorialReader.PostScriptCoordsToFPVectorialCoordsWithCGS(
AParam1, AParam2: TPSToken; var APosX, APosY: Double);
begin
PostScriptCoordsToFPVectorialCoords(AParam1, AParam2, APosX, APosY);
APosX := APosX * CurrentGraphicState.ScaleX + CurrentGraphicState.TranslateX;
APosY := APosY * CurrentGraphicState.ScaleY + CurrentGraphicState.TranslateY;
end;
// Returns true if a dictionary substitution was executed
function TvEPSVectorialReader.DictionarySubstituteOperator(
ADictionary: TStringList; var ACurToken: TPSToken): Boolean;

20
components/fpvectorial/fpvectorial.pas
View File

@ -555,12 +555,13 @@ type
TvRasterImage = class(TvNamedEntity)
public
RasterImage: TFPCustomImage;
Top, Left, Width, Height: Double;
Width, Height: Double;
destructor Destroy; override;
procedure CreateRGB888Image(AWidth, AHeight: Cardinal);
procedure InitializeWithConvertionOf3DPointsToHeightMap(APage: TvVectorialPage; AWidth, AHeight: Integer);
procedure Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override;
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
end;
{ TvPoint }
@ -3221,6 +3222,23 @@ begin
//ADest.Draw(lFinalX, lFinalY, RasterImage); doesnt work
end;
function TvRasterImage.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
APageItem: Pointer): Pointer;
var
lStr: string;
begin
Result := inherited GenerateDebugTree(ADestRoutine, APageItem);
// Add the debug info in a sub-item
if RasterImage <> nil then
begin
lStr := Format('[TvRasterImage] Width=%f Height=%f RasterImage.Width=%d RasterImage.Height=%d',
[Width, Height,
RasterImage.Width, RasterImage.Height
]);
ADestRoutine(lStr, Result);
end;
end;
{ TvArrow }
procedure TvArrow.CalculateBoundingBox(ADest: TFPCustomCanvas; var ALeft, ATop,