View Issue Details

IDProjectCategoryView StatusLast Update
0036871FPCPackagespublic2020-04-10 07:46
ReporterAnton Kavalenka Assigned ToMichael Van Canneyt  
PrioritynormalSeverityminorReproducibilityhave not tried
Status closedResolutionfixed 
Product Version3.3.1 
Fixed in Version3.3.1 
Summary0036871: fcl-pdf: Implement clip path management, publish graphic state management
DescriptionPatch implements:
* clipping to path
* minor optimizations in font searching
* published graphics stack state management
* resetting cached line width and color on restoring graphics stack state

Rectangular clipping is done as follows

    fPage.PushGraphicsStack;
    inc(fSaveCount);
    fPage.DrawRect(x,y,w,h,Pen.Width*72/1200,false,false);
    fPage.ClipPath;
TagsNo tags attached.
Fixed in Revision44667
FPCOldBugId
FPCTarget4.0.0
Attached Files

Activities

Anton Kavalenka

2020-04-04 20:21

reporter  

fppdf.diff (4,493 bytes)   
Index: fppdf.pp
===================================================================
--- fppdf.pp	(revision 44567)
+++ fppdf.pp	(working copy)
@@ -199,7 +199,16 @@
     class function Command: string;
   end;
 
+  { TPDFClipPath }
 
+  TPDFClipPath = class(TPDFDocumentObject)
+  protected
+    procedure   Write(const AStream: TStream); override;
+  public
+    class function Command: string;
+  end;
+
+
   TPDFPushGraphicsStack = class(TPDFDocumentObject)
   protected
     procedure   Write(const AStream: TStream); override;
@@ -668,6 +677,9 @@
 
   { When the WriteXXX() and DrawXXX() methods specify coordinates, they do it as
     per the PDF specification, from the bottom-left. }
+
+  { TPDFPage }
+
   TPDFPage = Class(TPDFDocumentObject)
   private
     FObjects : TObjectList;
@@ -731,6 +743,7 @@
     procedure DrawPolyLine(const APoints: array of TPDFCoord; const ALineWidth: TPDFFloat);
     { start a new subpath }
     procedure ResetPath;
+    procedure ClipPath;
     { Close the current subpath by appending a straight line segment from the current point to the starting point of the subpath. }
     procedure ClosePath;
     procedure ClosePathStroke;
@@ -740,6 +753,9 @@
     procedure FillStrokePath;
     { Fill using the Even-Odd rule. }
     procedure FillEvenOddStrokePath;
+    { Graphic stack management }
+    procedure PushGraphicsStack;
+    procedure PopGraphicsStack;
     { Move the current drawing position to (x, y) }
     procedure MoveTo(x, y: TPDFFloat); overload;
     procedure MoveTo(APos: TPDFCoord); overload;
@@ -849,10 +865,13 @@
   end;
 
 
+  { TPDFFontDefs }
+
   TPDFFontDefs = Class(TCollection)
   private
     function GetF(AIndex : Integer): TPDFFont;
   Public
+    Function FindFont(const AName:string):integer;
     Function AddFontDef : TPDFFont;
     Property FontDefs[AIndex : Integer] : TPDFFont Read GetF; Default;
   end;
@@ -1457,7 +1476,6 @@
   SetLength(result, iPos - 1);
 end;
 
-
 { TPDFMemoryStream }
 
 procedure TPDFMemoryStream.Write(const AStream: TStream);
@@ -1814,6 +1832,19 @@
   Result := 'S' + CRLF;
 end;
 
+{ TPDFClipPath }
+
+procedure TPDFClipPath.Write(const AStream: TStream);
+begin
+  WriteString(Command, AStream);
+end;
+
+class function TPDFClipPath.Command: string;
+begin
+  Result := 'W n' + CRLF;
+end;
+
+
 { TPDFPushGraphicsStack }
 
 procedure TPDFPushGraphicsStack.Write(const AStream: TStream);
@@ -1831,6 +1862,9 @@
 procedure TPDFPopGraphicsStack.Write(const AStream: TStream);
 begin
   WriteString(Command, AStream);
+  // disable cache
+  Self.Document.CurrentWidth:='';
+  Self.Document.CurrentColor:='';
 end;
 
 class function TPDFPopGraphicsStack.Command: string;
@@ -2616,6 +2650,12 @@
   AddObject(TPDFResetPath.Create(Document));
 end;
 
+procedure TPDFPage.ClipPath;
+begin
+  AddObject(TPDFClipPath.Create(Document));
+end;
+
+
 procedure TPDFPage.ClosePath;
 begin
   AddObject(TPDFClosePath.Create(Document));
@@ -2641,6 +2681,16 @@
   AddObject(TPDFFreeFormString.Create(Document, 'B*'+CRLF));
 end;
 
+procedure TPDFPage.PushGraphicsStack;
+begin
+  AddObject(TPDFPushGraphicsStack.Create(Document));
+end;
+
+procedure TPDFPage.PopGraphicsStack;
+begin
+  AddObject(TPDFPopGraphicsStack.Create(Document));
+end;
+
 procedure TPDFPage.MoveTo(x, y: TPDFFloat);
 var
   p1: TPDFCoord;
@@ -2764,6 +2814,21 @@
   Result:=Items[AIndex] as TPDFFont;
 end;
 
+function TPDFFontDefs.FindFont(const AName: string): integer;
+var
+  i:integer;
+begin
+  Result:=-1;
+  for i := 0 to Count-1 do
+  begin
+    if GetF(i).Name = AName then
+    begin
+      Result := i;
+      Exit;
+    end;
+  end;
+end;
+
 function TPDFFontDefs.AddFontDef: TPDFFont;
 begin
   Result:=Add as TPDFFont;
@@ -6046,14 +6111,8 @@
   i: integer;
 begin
   { reuse existing font definition if it exists }
-  for i := 0 to Fonts.Count-1 do
-  begin
-    if Fonts[i].Name = AName then
-    begin
-      Result := i;
-      Exit;
-    end;
-  end;
+  Result:=Fonts.FindFont(AName);
+  if Result>=0 then exit;
   F := Fonts.AddFontDef;
   F.Name := AName;
   F.IsStdFont := True;
@@ -6067,14 +6126,8 @@
   lFName: string;
 begin
   { reuse existing font definition if it exists }
-  for i := 0 to Fonts.Count-1 do
-  begin
-    if Fonts[i].Name = AName then
-    begin
-      Result := i;
-      Exit;
-    end;
-  end;
+  Result:=Fonts.FindFont(AName);
+  if Result>=0 then exit;
   F := Fonts.AddFontDef;
   if ExtractFilePath(AFontFile) <> '' then
     // assume AFontFile is the full path to the TTF file
fppdf.diff (4,493 bytes)   

Michael Van Canneyt

2020-04-09 23:37

administrator   ~0122054

Many thanks for the useful additions !

Issue History

Date Modified Username Field Change
2020-04-04 20:21 Anton Kavalenka New Issue
2020-04-04 20:21 Anton Kavalenka File Added: fppdf.diff
2020-04-09 23:37 Michael Van Canneyt Assigned To => Michael Van Canneyt
2020-04-09 23:37 Michael Van Canneyt Status new => resolved
2020-04-09 23:37 Michael Van Canneyt Resolution open => fixed
2020-04-09 23:37 Michael Van Canneyt Fixed in Version => 3.3.1
2020-04-09 23:37 Michael Van Canneyt Fixed in Revision => 44667
2020-04-09 23:37 Michael Van Canneyt FPCTarget => 4.0.0
2020-04-09 23:37 Michael Van Canneyt Note Added: 0122054
2020-04-10 07:46 Anton Kavalenka Status resolved => closed