pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpvectorial: Vast improvements to the PostScript interpreter, fixes running procedures

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1722 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat
2011-06-28 15:54:03 +00:00
parent df8f1e9ab7
commit 01ce49eb39
4 changed files with 673 additions and 126 deletions
Download Patch File Download Diff File Expand all files Collapse all files

724
applications/fpvviewer/fpvectorialsrc/epsvectorialreader.pas
View File

File diff suppressed because it is too large Load Diff

60
applications/fpvviewer/fpvectorialsrc/fpvtocanvas.pas
View File

@ -31,7 +31,7 @@ procedure DrawFPVTextToCanvas(ASource: TvVectorialDocument; CurText: TvText;
implementation implementation
{$ifndef Windows} {$ifndef Windows}
{$define FPVECTORIALDEBUG} {.$define FPVECTORIAL_TOCANVAS_DEBUG}
{$endif} {$endif}
function Rotate2DPoint(P,Fix :TPoint; alpha:double): TPoint; function Rotate2DPoint(P,Fix :TPoint; alpha:double): TPoint;
@ -112,6 +112,10 @@ begin
for i := 0 to ASource.GetEntitiesCount - 1 do for i := 0 to ASource.GetEntitiesCount - 1 do
begin begin
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
Write(Format('[Path] ID=%d', [i]));
{$endif}
CurEntity := ASource.GetEntity(i); CurEntity := ASource.GetEntity(i);
if CurEntity is TPath then DrawFPVPathToCanvas(ASource, TPath(CurEntity), ADest, ADestX, ADestY, AMulX, AMulY) if CurEntity is TPath then DrawFPVPathToCanvas(ASource, TPath(CurEntity), ADest, ADestX, ADestY, AMulX, AMulY)
@ -119,7 +123,7 @@ begin
else DrawFPVEntityToCanvas(ASource, CurEntity, ADest, ADestX, ADestY, AMulX, AMulY); else DrawFPVEntityToCanvas(ASource, CurEntity, ADest, ADestX, ADestY, AMulX, AMulY);
end; end;
{$ifdef FPVECTORIALDEBUG} {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
WriteLn(':<DrawFPVectorialToCanvas'); WriteLn(':<DrawFPVectorialToCanvas');
{$endif} {$endif}
end; end;
@ -140,7 +144,8 @@ procedure DrawFPVPathToCanvas(ASource: TvVectorialDocument; CurPath: TPath;
var var
j, k: Integer; j, k: Integer;
PosX, PosY: Integer; // Not modified by ADestX, etc PosX, PosY: Double; // Not modified by ADestX, etc
CoordX, CoordY: Integer;
CurSegment: TPathSegment; CurSegment: TPathSegment;
Cur2DSegment: T2DSegment absolute CurSegment; Cur2DSegment: T2DSegment absolute CurSegment;
Cur2DBSegment: T2DBezierSegment absolute CurSegment; Cur2DBSegment: T2DBezierSegment absolute CurSegment;
@ -164,10 +169,6 @@ begin
ADest.Pen.FPColor := CurPath.Pen.Color; ADest.Pen.FPColor := CurPath.Pen.Color;
ADest.Brush.FPColor := CurPath.Brush.Color; ADest.Brush.FPColor := CurPath.Brush.Color;
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
Write(Format('[Path] ID=%d', [i]));
{$endif}
for j := 0 to CurPath.Len - 1 do for j := 0 to CurPath.Len - 1 do
begin begin
//WriteLn('j = ', j); //WriteLn('j = ', j);
@ -176,9 +177,13 @@ begin
case CurSegment.SegmentType of case CurSegment.SegmentType of
stMoveTo: stMoveTo:
begin begin
ADest.MoveTo(CoordToCanvasX(Cur2DSegment.X), CoordToCanvasY(Cur2DSegment.Y)); CoordX := CoordToCanvasX(Cur2DSegment.X);
CoordY := CoordToCanvasY(Cur2DSegment.Y);
ADest.MoveTo(CoordX, CoordY);
PosX := Cur2DSegment.X;
PosY := Cur2DSegment.Y;
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG} {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
Write(Format(' M%d,%d', [CoordToCanvasX(Cur2DSegment.X), CoordToCanvasY(Cur2DSegment.Y)])); Write(Format(' M%d,%d', [CoordY, CoordY]));
{$endif} {$endif}
end; end;
// This element can override temporarely the Pen // This element can override temporarely the Pen
@ -186,7 +191,11 @@ begin
begin begin
ADest.Pen.FPColor := T2DSegmentWithPen(Cur2DSegment).Pen.Color; ADest.Pen.FPColor := T2DSegmentWithPen(Cur2DSegment).Pen.Color;
ADest.LineTo(CoordToCanvasX(Cur2DSegment.X), CoordToCanvasY(Cur2DSegment.Y)); CoordX := CoordToCanvasX(Cur2DSegment.X);
CoordY := CoordToCanvasY(Cur2DSegment.Y);
ADest.LineTo(CoordX, CoordY);
PosX := Cur2DSegment.X;
PosY := Cur2DSegment.Y;
ADest.Pen.FPColor := CurPath.Pen.Color; ADest.Pen.FPColor := CurPath.Pen.Color;
@ -196,9 +205,13 @@ begin
end; end;
st2DLine, st3DLine: st2DLine, st3DLine:
begin begin
ADest.LineTo(CoordToCanvasX(Cur2DSegment.X), CoordToCanvasY(Cur2DSegment.Y)); CoordX := CoordToCanvasX(Cur2DSegment.X);
CoordY := CoordToCanvasY(Cur2DSegment.Y);
ADest.LineTo(CoordX, CoordY);
PosX := Cur2DSegment.X;
PosY := Cur2DSegment.Y;
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG} {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
Write(Format(' L%d,%d', [CoordToCanvasX(Cur2DSegment.X), CoordToCanvasY(Cur2DSegment.Y)])); Write(Format(' L%d,%d', [CoordX, CoordY]));
{$endif} {$endif}
end; end;
{ To draw a bezier we need to divide the interval in parts and make { To draw a bezier we need to divide the interval in parts and make
@ -206,8 +219,8 @@ begin
st2DBezier, st3DBezier: st2DBezier, st3DBezier:
begin begin
CurveLength := CurveLength :=
Round(sqrt(sqr(Cur2DBSegment.X3 - PosX) + sqr(Cur2DBSegment.Y3 - PosY))) + Round(sqrt(sqr(Cur2DBSegment.X2 - PosX) + sqr(Cur2DBSegment.Y2 - PosY))) +
Round(sqrt(sqr(Cur2DBSegment.X2 - Cur2DBSegment.X3) + sqr(Cur2DBSegment.Y2 - Cur2DBSegment.Y3))) + Round(sqrt(sqr(Cur2DBSegment.X3 - Cur2DBSegment.X2) + sqr(Cur2DBSegment.Y3 - Cur2DBSegment.Y2))) +
Round(sqrt(sqr(Cur2DBSegment.X - Cur2DBSegment.X3) + sqr(Cur2DBSegment.Y - Cur2DBSegment.Y3))); Round(sqrt(sqr(Cur2DBSegment.X - Cur2DBSegment.X3) + sqr(Cur2DBSegment.Y - Cur2DBSegment.Y3)));
for k := 1 to CurveLength do for k := 1 to CurveLength do
@ -215,10 +228,23 @@ begin
t := k / CurveLength; 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); 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); 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);
ADest.LineTo(CoordToCanvasX(CurX), CoordToCanvasY(CurY)); CoordX := CoordToCanvasX(CurX);
CoordY := CoordToCanvasY(CurY);
ADest.LineTo(CoordX, CoordY);
// {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
// Write(Format(' CL%d,%d', [CoordX, CoordY]));
// {$endif}
end; end;
PosX := Round(Cur2DBSegment.X); PosX := Cur2DSegment.X;
PosY := Round(Cur2DBSegment.Y); PosY := Cur2DSegment.Y;
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
Write(Format(' ***C%d,%d %d,%d %d,%d %d,%d',
[CoordToCanvasX(PosX), CoordToCanvasY(PosY),
CoordToCanvasX(Cur2DBSegment.X2), CoordToCanvasY(Cur2DBSegment.Y2),
CoordToCanvasX(Cur2DBSegment.X3), CoordToCanvasY(Cur2DBSegment.Y3),
CoordToCanvasX(Cur2DBSegment.X), CoordToCanvasY(Cur2DBSegment.Y)]));
{$endif}
end; end;
end; end;
end; end;

7
applications/fpvviewer/fpvv_mainform.lfm
View File

@ -37,9 +37,10 @@ object frmFPVViewer: TfrmFPVViewer
Top = 72 Top = 72
Width = 168 Width = 168
DecimalPlaces = 6 DecimalPlaces = 6
Increment = 1 Increment = 0.1
MaxValue = 100 MaxValue = 100
MinValue = 0 MinValue = 0
OnChange = spinScaleChange
TabOrder = 2 TabOrder = 2
Value = 1 Value = 1
end end
@ -76,8 +77,8 @@ object frmFPVViewer: TfrmFPVViewer
object pageViewer: TPage object pageViewer: TPage
end end
object Page2: TPage object Page2: TPage
ClientWidth = 67584 ClientWidth = 135
ClientHeight = 79872 ClientHeight = 159
object DXFTreeView: TTreeView object DXFTreeView: TTreeView
Left = 8 Left = 8
Height = 313 Height = 313

8
applications/fpvviewer/fpvv_mainform.pas
View File

@ -31,6 +31,7 @@ type
procedure buttonRenderingTestClick(Sender: TObject); procedure buttonRenderingTestClick(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject); procedure FormDestroy(Sender: TObject);
procedure spinScaleChange(Sender: TObject);
private private
{ private declarations } { private declarations }
public public
@ -190,5 +191,12 @@ begin
Drawer.Free; Drawer.Free;
end; end;
procedure TfrmFPVViewer.spinScaleChange(Sender: TObject);
begin
if spinScale.Value <= 0.2 then spinScale.Increment := 0.01
else if spinScale.Value <= 2 then spinScale.Increment := 0.1
else spinScale.Increment := 1;
end;
end. end.