fpvectorial: Implements support for clipping regions, specially for PostScript

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1768 8e941d3f-bd1b-0410-a28a-d453659cc2b4

applications/fpvviewer/fpvectorialsrc/epsvectorialreader.pas

@@ -71,6 +71,8 @@ type
   public
     Color: TFPColor;
     TranslateX, TranslateY: Double;
+    ClipPath: TPath;
+    ClipMode: TvClipMode;
     function Duplicate: TGraphicState;
   end;
 
@@ -144,6 +146,7 @@ begin
   Result.Color := Color;
   Result.TranslateX := TranslateX;
   Result.TranslateY := TranslateY;
+  Result.ClipPath := ClipPath;
 end;
 
 { TPSToken }
@@ -1467,6 +1470,7 @@ begin
     {$ifdef FPVECTORIALDEBUG_PATHS}
     WriteLn('[TvEPSVectorialReader.ExecutePathConstructionOperator] newpath');
     {$endif}
+    AData.SetClipPath(CurrentGraphicState.ClipPath, CurrentGraphicState.ClipMode);
     AData.EndPath();
     AData.StartPath();
 
@@ -1611,6 +1615,10 @@ begin
   // – eoclip – Clip using even-odd rule
   if AToken.StrValue = 'eoclip' then
   begin
+    AData.SetPenStyle(psClear);
+    AData.EndPath();
+    CurrentGraphicState.ClipPath := AData.GetPath(AData.GetPathCount()-1);
+    CurrentGraphicState.ClipMode := vcmEvenOddRule;
     Exit(True);
   end
 end;

applications/fpvviewer/fpvectorialsrc/fpvectorial.pas

@@ -157,11 +157,15 @@ type
     constructor Create; virtual;
   end;
 
+  TvClipMode = (vcmNonzeroWindingRule, vcmEvenOddRule);
+
   TPath = class(TvEntity)
     Len: Integer;
-    Points: TPathSegment; // Beginning of the double-linked list
+    Points: TPathSegment;   // Beginning of the double-linked list
-    PointsEnd: TPathSegment; // End of the double-linked list
+    PointsEnd: TPathSegment;// End of the double-linked list
     CurPoint: TPathSegment; // Used in PrepareForSequentialReading and Next
+    ClipPath: TPath;
+    ClipMode: TvClipMode;
     procedure Assign(ASource: TPath);
     procedure PrepareForSequentialReading;
     function Next(): TPathSegment;
@@ -303,6 +307,7 @@ type
     procedure SetPenColor(AColor: TFPColor);
     procedure SetPenStyle(AStyle: TFPPenStyle);
     procedure SetPenWidth(AWidth: Integer);
+    procedure SetClipPath(AClipPath: TPath; AClipMode: TvClipMode);
     procedure EndPath();
     procedure AddText(AX, AY, AZ: Double; FontName: string; FontSize: integer; AText: utf8string); overload;
     procedure AddText(AX, AY, AZ: Double; AStr: utf8string); overload;
@@ -737,6 +742,13 @@ begin
   FTmPPath.Pen.Width := AWidth;
 end;
 
+procedure TvVectorialDocument.SetClipPath(AClipPath: TPath;
+  AClipMode: TvClipMode);
+begin
+  FTmPPath.ClipPath := AClipPath;
+  FTmPPath.ClipMode := AClipMode;
+end;
+
 {@@
   Finishes writing a Path, which was created in multiple
   steps using StartPath and AddPointToPath,
@@ -885,15 +897,6 @@ procedure TvVectorialDocument.ClearTmpPath();
 var
   segment, oldsegment: TPathSegment;
 begin
-//  segment := FTmpPath.Points;
-// Don't free segments, because they are used when the path is added
-//  while segment <> nil do
-//  begin
-//    oldsegment := segment;
-//    segment := segment^.Next;
-//    oldsegment^.Free;
-//  end;
-
   FTmpPath.Points := nil;
   FTmpPath.PointsEnd := nil;
   FTmpPath.Len := 0;
@@ -1240,6 +1243,8 @@ begin
   CurPoint := ASource.CurPoint;
   Pen := ASource.Pen;
   Brush := ASource.Brush;
+  ClipPath := ASource.ClipPath;
+  ClipMode := ASource.ClipMode;
 end;
 
 procedure TPath.PrepareForSequentialReading;

applications/fpvviewer/fpvectorialsrc/fpvtocanvas.pas

@@ -4,16 +4,16 @@ unit fpvtocanvas;
 
 interface
 
-{.$define USE_LCL_CANVAS}
+{$define USE_LCL_CANVAS}
 
 uses
   Classes, SysUtils, Math,
   {$ifdef USE_LCL_CANVAS}
-  Graphics, LCLIntf,
+  Graphics, LCLIntf, LCLType,
   {$endif}
   fpcanvas,
   fpimage,
-  fpvectorial;
+  fpvectorial, fpvutils;
 
 procedure DrawFPVectorialToCanvas(ASource: TvVectorialDocument;
   ADest: TFPCustomCanvas;
@@ -155,6 +155,11 @@ var
   t: Double;
   // For polygons
   Points: array of TPoint;
+  // Clipping Region
+  {$ifdef USE_LCL_CANVAS}
+  ClipRegion, OldClipRegion: HRGN;
+  ACanvas: TCanvas absolute ADest;
+  {$endif}
 begin
   PosX := 0;
   PosY := 0;
@@ -162,17 +167,29 @@ begin
 
   ADest.MoveTo(ADestX, ADestY);
 
-  CurPath.PrepareForSequentialReading;
-
   // Set the path Pen and Brush options
   ADest.Pen.Style := CurPath.Pen.Style;
   ADest.Pen.Width := CurPath.Pen.Width;
   ADest.Pen.FPColor := CurPath.Pen.Color;
   ADest.Brush.FPColor := CurPath.Brush.Color;
 
+  // Prepare the Clipping Region, if any
+  {$ifdef USE_LCL_CANVAS}
+  if CurPath.ClipPath <> nil then
+  begin
+    OldClipRegion := LCLIntf.CreateEmptyRegion();
+    GetClipRgn(ACanvas.Handle, OldClipRegion);
+    ClipRegion := ConvertPathToRegion(CurPath.ClipPath, ADestX, ADestY, AMulX, AMulY);
+    SelectClipRgn(ACanvas.Handle, ClipRegion);
+    DeleteObject(ClipRegion);
+  end;
+  {$endif}
+
   //
   // For solid paths, draw a polygon instead
   //
+  CurPath.PrepareForSequentialReading;
+
   if CurPath.Brush.Style = bsSolid then
   begin
     ADest.Brush.Style := CurPath.Brush.Style;
@@ -281,6 +298,14 @@ begin
   {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
   WriteLn('');
   {$endif}
+
+  // Restores the previous Clip Region
+  {$ifdef USE_LCL_CANVAS}
+  if CurPath.ClipPath <> nil then
+  begin
+    SelectClipRgn(ACanvas.Handle, OldClipRegion); //Using OldClipRegion crashes in Qt
+  end;
+  {$endif}
 end;
 
 procedure DrawFPVEntityToCanvas(ASource: TvVectorialDocument; CurEntity: TvEntity;

applications/fpvviewer/fpvectorialsrc/fpvutils.pas

@@ -11,6 +11,8 @@ AUTHORS: Felipe Monteiro de Carvalho
 }
 unit fpvutils;
 
+{$define USE_LCL_CANVAS}
+
 {$ifdef fpc}
   {$mode delphi}
 {$endif}
@@ -19,6 +21,9 @@ interface
 
 uses
   Classes, SysUtils, Math,
+  {$ifdef USE_LCL_CANVAS}
+  Graphics, LCLIntf, LCLType,
+  {$endif}
   fpvectorial, fpimage;
 
 type
@@ -27,13 +32,20 @@ type
 // Color Conversion routines
 function FPColorToRGBHexString(AColor: TFPColor): string;
 function RGBToFPColor(AR, AG, AB: byte): TFPColor; inline;
-// Other routine
+// Coordinate Conversion routines
 function CanvasCoordsToFPVectorial(AY: Integer; AHeight: Integer): Integer; inline;
 function CanvasTextPosToFPVectorial(AY: Integer; ACanvasHeight, ATextHeight: Integer): Integer;
+function CoordToCanvasX(ACoord: Double; ADestX: Integer; AMulX: Double): Integer; inline;
+function CoordToCanvasY(ACoord: Double; ADestY: Integer; AMulY: Double): Integer; inline;
+// Other routines
 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);
+// LCL-related routines
+{$ifdef USE_LCL_CANVAS}
+function ConvertPathToRegion(APath: TPath; ADestX, ADestY: Integer; AMulX, AMulY: Double): HRGN;
+{$endif}
 
 implementation
 
@@ -78,6 +90,16 @@ begin
   Result := CanvasCoordsToFPVectorial(AY, ACanvasHeight) - ATextHeight;
 end;
 
+function CoordToCanvasX(ACoord: Double; ADestX: Integer; AMulX: Double): Integer;
+begin
+  Result := Round(ADestX + AmulX * ACoord);
+end;
+
+function CoordToCanvasY(ACoord: Double; ADestY: Integer; AMulY: Double): Integer;
+begin
+  Result := Round(ADestY + AmulY * ACoord);
+end;
+
 {@@
   Reads a string and separates it in substring
   using ASeparator to delimite them.
@@ -164,5 +186,38 @@ 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;
+var
+  i: Integer;
+  WindingMode: Integer;
+  Points: array of TPoint;
+  CoordX, CoordY: Integer;
+  // Segments
+  CurSegment: TPathSegment;
+  Cur2DSegment: T2DSegment absolute CurSegment;
+begin
+  APath.PrepareForSequentialReading;
+
+  SetLength(Points, APath.Len);
+
+  for i := 0 to APath.Len - 1 do
+  begin
+    CurSegment := TPathSegment(APath.Next());
+
+    CoordX := CoordToCanvasX(Cur2DSegment.X, ADestX, AMulX);
+    CoordY := CoordToCanvasY(Cur2DSegment.Y, ADestY, AMulY);
+
+    Points[i].X := CoordX;
+    Points[i].Y := CoordY;
+  end;
+
+  if APath.ClipMode = vcmEvenOddRule then WindingMode := LCLType.ALTERNATE
+  else WindingMode := LCLType.WINDING;
+
+  Result := LCLIntf.CreatePolygonRgn(@Points[0], APath.Len, WindingMode);
+end;
+{$endif}
+
 end.