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

Initial commit for the FPVectorial library

Browse Source 
git-svn-id: trunk@13403 -
This commit is contained in:
sekelsenmat 2009-07-17 14:27:35 +00:00
parent 5d8835861c
commit f6e203cf3b
13 changed files with 2373 additions and 0 deletions

12
.gitattributes vendored
View File

@ -1726,6 +1726,18 @@ packages/fpmkunit/Makefile.fpc svneol=native#text/plain
packages/fpmkunit/examples/ppu2fpmake.sh svneol=native#text/plain
packages/fpmkunit/fpmake.pp svneol=native#text/plain
packages/fpmkunit/src/fpmkunit.pp svneol=native#text/plain
packages/fpvectorial/Makefile.fpc svneol=native#text/plain
packages/fpvectorial/src/avisocncgcodereader.pas svneol=native#text/plain
packages/fpvectorial/src/avisocncgcodewriter.pas svneol=native#text/plain
packages/fpvectorial/src/avisozlib.pas svneol=native#text/plain
packages/fpvectorial/src/fpvectorial.pas svneol=native#text/plain
packages/fpvectorial/src/fpvectorial_pkg.lpk svneol=native#text/plain
packages/fpvectorial/src/fpvectorial_pkg.pas svneol=native#text/plain
packages/fpvectorial/src/fpvtocanvas.pas svneol=native#text/plain
packages/fpvectorial/src/pdfvectorialreader.pas svneol=native#text/plain
packages/fpvectorial/src/pdfvrlexico.pas svneol=native#text/plain
packages/fpvectorial/src/pdfvrsemantico.pas svneol=native#text/plain
packages/fpvectorial/src/pdfvrsintatico.pas svneol=native#text/plain
packages/fv/Makefile svneol=native#text/plain
packages/fv/Makefile.fpc svneol=native#text/plain
packages/fv/examples/Makefile svneol=native#text/plain

32
packages/fpvectorial/Makefile.fpc Normal file
View File

@ -0,0 +1,32 @@
#
# Makefile.fpc for FPVectorial Library
#
[package]
name=fpvectorial
version=2.2.2
[require]
libc=n
[target]
units=fpvectorial
exampledirs=
implicitunits=
[compiler]
includedir=src
sourcedir=src
[install]
buildunit=
fpcpackage=y
[shared]
build=n
[default]
fpcdir=../..
[rules]
.NOTPARALLEL:

228
packages/fpvectorial/src/avisocncgcodereader.pas Normal file
View File

@ -0,0 +1,228 @@
{
Reads AvisoCNC G-Code
License: The same modified LGPL as the Free Pascal RTL
See the file COPYING.modifiedLGPL for more details
AUTHORS: Felipe Monteiro de Carvalho
Pedro Sol Pegorini L de Lima
}
unit avisocncgcodereader;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
fpvectorial;
type
{ Used by tcutils.SeparateString }
T10Strings = array[0..9] of shortstring;
{ TvAvisoCNCGCodeReader }
TvAvisoCNCGCodeReader = class(TvCustomVectorialReader)
private
LastX, LastY, LastZ: Double;
function SeparateString(AString: string; ASeparator: Char): T10Strings;
procedure ReadString(AStr: string; AData: TvVectorialDocument);
function GetCoordinate(AStr: shortstring): Integer;
function GetCoordinateValue(AStr: shortstring): Double;
public
{ General reading methods }
procedure ReadFromStrings(AStrings: TStrings; AData: TvVectorialDocument); override;
end;
implementation
const
{ Coordinate constants }
INT_COORDINATE_NONE = 0;
INT_COORDINATE_X = 1;
INT_COORDINATE_Y = 2;
INT_COORDINATE_Z = 3;
{ GCode constants }
STR_GCODE_LINEAR_MOVE = 'G01';
STR_GCODE_STEPPER_MOVE = 'S01';
STR_GCODE_2DBEZIER_MOVE = 'B02';
STR_GCODE_3DBEZIER_MOVE = 'B03';
STR_GCODE_DRILL_UP = 'P01';
STR_GCODE_DRILL_DOWN = 'P02';
{ TvAvisoCNCGCodeReader }
{@@
Reads a string and separates it in substring
using ASeparator to delimite them.
Limits:
Number of substrings: 10 (indexed 0 to 9)
Length of each substring: 255 (they are shortstrings)
}
function TvAvisoCNCGCodeReader.SeparateString(AString: string; ASeparator: Char): T10Strings;
var
i, CurrentPart: Integer;
begin
CurrentPart := 0;
{ Clears the result }
for i := 0 to 9 do Result[i] := '';
{ Iterates througth the string, filling strings }
for i := 1 to Length(AString) do
begin
if Copy(AString, i, 1) = ASeparator then
begin
Inc(CurrentPart);
{ Verifies if the string capacity wasn't exceeded }
if CurrentPart > 9 then Exit;
end
else
Result[CurrentPart] := Result[CurrentPart] + Copy(AString, i, 1);
end;
end;
procedure TvAvisoCNCGCodeReader.ReadString(AStr: string;
AData: TvVectorialDocument);
var
AParams: T10Strings;
DestX, DestY, DestZ: Double;
i: Integer;
begin
WriteLn('TvAvisoCNCGCodeReader.ReadString ', AStr);
AParams := SeparateString(AStr, ' ');
{
Format may be:
G01 X3
G01 X3 Y4
G01 X3 Y4 Z2
}
if AParams[0] = STR_GCODE_DRILL_UP then
begin
AData.AddLineToPath(LastX, LastY, 0);
LastZ := 0;
end
else if AParams[0] = STR_GCODE_DRILL_DOWN then
begin
AData.AddLineToPath(LastX, LastY, 50);
LastZ := 50;
end
else if AParams[0] = STR_GCODE_LINEAR_MOVE then
begin
DestX := LastX;
DestY := LastY;
DestZ := LastZ;
for i := 1 to 3 do
begin
case GetCoordinate(AParams[i]) of
INT_COORDINATE_X: DestX := GetCoordinateValue(AParams[i]);
INT_COORDINATE_Y: DestY := GetCoordinateValue(AParams[i]);
INT_COORDINATE_Z: DestZ := GetCoordinateValue(AParams[i]);
else
// error
end;
end;
AData.AddLineToPath(DestX, DestY, DestZ);
LastX := DestX;
LastY := DestY;
LastZ := DestZ;
end
else if AParams[0] = STR_GCODE_2DBEZIER_MOVE then
begin
AData.AddBezierToPath(
GetCoordinateValue(AParams[1]),
GetCoordinateValue(AParams[2]),
GetCoordinateValue(AParams[3]),
GetCoordinateValue(AParams[4]),
GetCoordinateValue(AParams[5]),
GetCoordinateValue(AParams[6])
);
LastX := GetCoordinateValue(AParams[5]);
LastY := GetCoordinateValue(AParams[6]);
end
else if AParams[0] = STR_GCODE_3DBEZIER_MOVE then
begin
AData.AddBezierToPath(
GetCoordinateValue(AParams[1]),
GetCoordinateValue(AParams[2]),
GetCoordinateValue(AParams[3]),
GetCoordinateValue(AParams[4]),
GetCoordinateValue(AParams[5]),
GetCoordinateValue(AParams[6]),
GetCoordinateValue(AParams[7]),
GetCoordinateValue(AParams[8]),
GetCoordinateValue(AParams[9])
);
LastX := GetCoordinateValue(AParams[7]);
LastY := GetCoordinateValue(AParams[8]);
LastZ := GetCoordinateValue(AParams[9]);
end;
{else
begin
Ignore any of these codes:
STR_GCODE_STEPPER_MOVE
and anything else
end;}
end;
function TvAvisoCNCGCodeReader.GetCoordinate(AStr: shortstring): Integer;
begin
Result := INT_COORDINATE_NONE;
if AStr = '' then Exit
else if AStr[1] = 'X' then Result := INT_COORDINATE_X
else if AStr[1] = 'Y' then Result := INT_COORDINATE_Y
else if AStr[1] = 'Z' then Result := INT_COORDINATE_Z;
end;
function TvAvisoCNCGCodeReader.GetCoordinateValue(AStr: shortstring): Double;
begin
Result := 0.0;
if Length(AStr) <= 1 then Exit;
Result := StrToFloat(Copy(AStr, 2, Length(AStr) - 1));
end;
{@@
The information of each separate path is lost in G-Code files
Only one path uniting all of them is created when reading G-Code
}
procedure TvAvisoCNCGCodeReader.ReadFromStrings(AStrings: TStrings;
AData: TvVectorialDocument);
var
i: Integer;
begin
WriteLn('TvAvisoCNCGCodeReader.ReadFromStrings AStrings = ', PtrInt(AStrings), ' AData = ', PtrInt(AData));
AData.StartPath(0, 0);
for i := 0 to AStrings.Count - 1 do
ReadString(AStrings.Strings[i], AData);
WriteLn('AData.EndPath');
AData.EndPath();
end;
initialization
RegisterVectorialReader(TvAvisoCNCGCodeReader, vfGCodeAvisoCNCPrototipoV5);
end.

87
packages/fpvectorial/src/avisocncgcodewriter.pas Normal file
View File

@ -0,0 +1,87 @@
{
Writes AvisoCNC G-Code
License: The same modified LGPL as the Free Pascal RTL
See the file COPYING.modifiedLGPL for more details
AUTHORS: Felipe Monteiro de Carvalho
Pedro Sol Pegorini L de Lima
}
unit avisocncgcodewriter;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
fpvectorial;
type
{ TvAvisoCNCGCodeWriter }
TvAvisoCNCGCodeWriter = class(TvCustomVectorialWriter)
public
{ General reading methods }
procedure WriteToStrings(AStrings: TStrings; AData: TvVectorialDocument); override;
end;
implementation
{ TvGCodeVectorialWriter }
procedure TvAvisoCNCGCodeWriter.WriteToStrings(AStrings: TStrings;
AData: TvVectorialDocument);
var
i, j: Integer;
Str: string;
APath: TPath;
begin
AStrings.Clear;
AStrings.Add('M216 // Ligar monitor de carga');
AStrings.Add('G28 // Ir rapidamente para posição inicial');
AStrings.Add('G00');
// itera por todos os itens
for i := 0 to AData.GetPathCount - 1 do
begin
APath := AData.GetPath(i);
// levanta a broca
AStrings.Add('P01 // Sobe a cabeça de gravação');
// vai para o ponto inicial
AStrings.Add(Format('G01 X%f Y%f',
[APath.Points[0].X, APath.Points[0].Y]));
AStrings.Add('P02 // Abaixa a cabeça de gravação');
for j := 1 to APath.Len - 1 do
begin
case APath.Points[j].SegmentType of
st2DLine: AStrings.Add(Format('G01 X%f Y%f',
[APath.Points[j].X, APath.Points[j].Y]));
st3DLine: AStrings.Add(Format('G01 X%f Y%f Z%f',
[APath.Points[j].X, APath.Points[j].Y, APath.Points[j].Z]));
st2DBezier: AStrings.Add(Format('B02 X%f Y%f X%f Y%f X%f Y%f',
[APath.Points[j].X2, APath.Points[j].Y2,
APath.Points[j].X3, APath.Points[j].Y3,
APath.Points[j].X, APath.Points[j].Y]));
st3DBezier: AStrings.Add(Format('B03 X%f Y%f Z%f X%f Y%f Z%f X%f Y%f Z%f',
[APath.Points[j].X2, APath.Points[j].Y2, APath.Points[j].Z2,
APath.Points[j].X3, APath.Points[j].Y3, APath.Points[j].Z3,
APath.Points[j].X, APath.Points[j].Y, APath.Points[j].Z]));
end;
end;
end;
AStrings.Add('P01 // Sobe a cabeça de gravação');
AStrings.Add('M30 // Parar o programa e retornar para posição inicial');
AStrings.Add('M215 // Desligar monitor de carga');
end;
initialization
RegisterVectorialWriter(TvAvisoCNCGCodeWriter, vfGCodeAvisoCNCPrototipoV5);
end.

74
packages/fpvectorial/src/avisozlib.pas Normal file
View File

@ -0,0 +1,74 @@
unit avisozlib;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, paszlib;
type
Decode = class
public
procedure CHECK_ERR(err: Integer; msg: String);
procedure EXIT_ERR(const msg: String);
function test_inflate(compr: Pointer; comprLen : LongInt;
uncompr: Pointer; uncomprLen : LongInt): PChar;
constructor Create();
end;
implementation
procedure Decode.CHECK_ERR(err: Integer; msg: String);
begin
if err <> Z_OK then
begin
raise Exception.Create('ERROR: ' + msg);
Halt(1);
end;
end;
procedure Decode.EXIT_ERR(const msg: String);
begin
raise Exception.Create('ERROR: ' + msg);
Halt(1);
end;
function Decode.test_inflate(compr: Pointer; comprLen : LongInt;
uncompr: Pointer; uncomprLen : LongInt): PChar;
var err: Integer;
d_stream: TZStream; // decompression stream
begin
StrCopy(PChar(uncompr), 'garbage');
d_stream.next_in := compr;
d_stream.avail_in := 0;
d_stream.next_out := uncompr;
err := inflateInit(d_stream);
CHECK_ERR(err, 'inflateInit');
while (d_stream.total_out < uncomprLen) and
(d_stream.total_in < comprLen) do
begin
d_stream.avail_out := 1; // force small buffers
d_stream.avail_in := 1;
err := inflate(d_stream, Z_NO_FLUSH);
if err = Z_STREAM_END then
break;
CHECK_ERR(err, 'inflate');
end;
err := inflateEnd(d_stream);
CHECK_ERR(err, 'inflateEnd');
Result:=PChar(uncompr);
end;
constructor Decode.Create();
begin
inherited Create;
end;
end.

637
packages/fpvectorial/src/fpvectorial.pas Normal file
View File

@ -0,0 +1,637 @@
{
fpvectorial.pas
Vector graphics document
License: The same modified LGPL as the Free Pascal RTL
See the file COPYING.modifiedLGPL for more details
AUTHORS: Felipe Monteiro de Carvalho
Pedro Sol Pegorini L de Lima
}
unit fpvectorial;
{$ifdef fpc}
{$mode delphi}
{$endif}
interface
uses
Classes, SysUtils;
type
TvVectorialFormat = (
{ Multi-purpose document formats }
vfPDF, vfPostScript, vfSVG, vfCorelDrawCDR, vfWindowsMetafileWMF,
{ CAD formats }
vfDXF,
{ GCode formats }
vfGCodeAvisoCNCPrototipoV5, vfGCodeAvisoCNCPrototipoV6);
const
{ Default extensions }
STR_PDF_EXTENSION = '.pdf';
type
TSegmentType = (
st2DLine, st2DBezier,
st3DLine, st3DBezier);
TPathSegment = record
SegmentType: TSegmentType;
X, Y, Z: Double; // Z is ignored in 2D segments
X2, Y2, Z2: Double; // Z is ignored in 2D segments
X3, Y3, Z3: Double; // Z is ignored in 2D segments
end;
TPath = record
Len: Integer;
// ToDo: make the array dynamic
Points: array[0..255] of TPathSegment;
end;
PPath = ^TPath;
type
TvCustomVectorialWriter = class;
TvCustomVectorialReader = class;
{ TvVectorialDocument }
TvVectorialDocument = class
private
FPaths: TFPList;
FTmpPath: TPath;
procedure RemoveCallback(data, arg: pointer);
function CreateVectorialWriter(AFormat: TvVectorialFormat): TvCustomVectorialWriter;
function CreateVectorialReader(AFormat: TvVectorialFormat): TvCustomVectorialReader;
public
Name: string;
Width, Height: Double; // in millimeters
{ Base methods }
constructor Create;
destructor Destroy; override;
procedure WriteToFile(AFileName: string; AFormat: TvVectorialFormat);
procedure WriteToStream(AStream: TStream; AFormat: TvVectorialFormat);
procedure WriteToStrings(AStrings: TStrings; AFormat: TvVectorialFormat);
procedure ReadFromFile(AFileName: string; AFormat: TvVectorialFormat);
procedure ReadFromStream(AStream: TStream; AFormat: TvVectorialFormat);
procedure ReadFromStrings(AStrings: TStrings; AFormat: TvVectorialFormat);
{ Data reading methods }
function GetPath(ANum: Cardinal): TPath;
function GetPathCount: Integer;
{ Data removing methods }
procedure Clear;
procedure RemoveAllPaths;
{ Data writing methods }
procedure AddPath(APath: TPath);
procedure StartPath(AX, AY: Double);
procedure AddLineToPath(AX, AY: Double); overload;
procedure AddLineToPath(AX, AY, AZ: Double); overload;
procedure AddBezierToPath(AX1, AY1, AX2, AY2, AX3, AY3: Double); overload;
procedure AddBezierToPath(AX1, AY1, AZ1, AX2, AY2, AZ2, AX3, AY3, AZ3: Double); overload;
procedure EndPath();
{ properties }
property PathCount: Integer read GetPathCount;
property Paths[Index: Cardinal]: TPath read GetPath;
end;
{@@ TvVectorialReader class reference type }
TvVectorialReaderClass = class of TvCustomVectorialReader;
{ TvCustomVectorialReader }
TvCustomVectorialReader = class
public
{ General reading methods }
procedure ReadFromFile(AFileName: string; AData: TvVectorialDocument); virtual;
procedure ReadFromStream(AStream: TStream; AData: TvVectorialDocument); virtual;
procedure ReadFromStrings(AStrings: TStrings; AData: TvVectorialDocument); virtual;
end;
{@@ TvVectorialWriter class reference type }
TvVectorialWriterClass = class of TvCustomVectorialWriter;
{@@ TvCustomVectorialWriter }
{ TvCustomVectorialWriter }
TvCustomVectorialWriter = class
public
{ General writing methods }
procedure WriteToFile(AFileName: string; AData: TvVectorialDocument); virtual;
procedure WriteToStream(AStream: TStream; AData: TvVectorialDocument); virtual;
procedure WriteToStrings(AStrings: TStrings; AData: TvVectorialDocument); virtual;
end;
{@@ List of registered formats }
TvVectorialFormatData = record
ReaderClass: TvVectorialReaderClass;
WriterClass: TvVectorialWriterClass;
ReaderRegistered: Boolean;
WriterRegistered: Boolean;
Format: TvVectorialFormat;
end;
var
GvVectorialFormats: array of TvVectorialFormatData;
procedure RegisterVectorialReader(
AReaderClass: TvVectorialReaderClass;
AFormat: TvVectorialFormat);
procedure RegisterVectorialWriter(
AWriterClass: TvVectorialWriterClass;
AFormat: TvVectorialFormat);
implementation
{@@
Registers a new reader for a format
}
procedure RegisterVectorialReader(
AReaderClass: TvVectorialReaderClass;
AFormat: TvVectorialFormat);
var
i, len: Integer;
FormatInTheList: Boolean;
begin
len := Length(GvVectorialFormats);
FormatInTheList := False;
{ First search for the format in the list }
for i := 0 to len - 1 do
begin
if GvVectorialFormats[i].Format = AFormat then
begin
if GvVectorialFormats[i].ReaderRegistered then
raise Exception.Create('RegisterVectorialReader: Reader class for format ' {+ AFormat} + ' already registered.');
GvVectorialFormats[i].ReaderRegistered := True;
GvVectorialFormats[i].ReaderClass := AReaderClass;
FormatInTheList := True;
Break;
end;
end;
{ If not already in the list, then add it }
if not FormatInTheList then
begin
SetLength(GvVectorialFormats, len + 1);
GvVectorialFormats[len].ReaderClass := AReaderClass;
GvVectorialFormats[len].WriterClass := nil;
GvVectorialFormats[len].ReaderRegistered := True;
GvVectorialFormats[len].WriterRegistered := False;
GvVectorialFormats[len].Format := AFormat;
end;
end;
{@@
Registers a new writer for a format
}
procedure RegisterVectorialWriter(
AWriterClass: TvVectorialWriterClass;
AFormat: TvVectorialFormat);
var
i, len: Integer;
FormatInTheList: Boolean;
begin
len := Length(GvVectorialFormats);
FormatInTheList := False;
{ First search for the format in the list }
for i := 0 to len - 1 do
begin
if GvVectorialFormats[i].Format = AFormat then
begin
if GvVectorialFormats[i].WriterRegistered then
raise Exception.Create('RegisterVectorialWriter: Writer class for format ' + {AFormat +} ' already registered.');
GvVectorialFormats[i].WriterRegistered := True;
GvVectorialFormats[i].WriterClass := AWriterClass;
FormatInTheList := True;
Break;
end;
end;
{ If not already in the list, then add it }
if not FormatInTheList then
begin
SetLength(GvVectorialFormats, len + 1);
GvVectorialFormats[len].ReaderClass := nil;
GvVectorialFormats[len].WriterClass := AWriterClass;
GvVectorialFormats[len].ReaderRegistered := False;
GvVectorialFormats[len].WriterRegistered := True;
GvVectorialFormats[len].Format := AFormat;
end;
end;
{ TsWorksheet }
{@@
Helper method for clearing the records in a spreadsheet.
}
procedure TvVectorialDocument.RemoveCallback(data, arg: pointer);
begin
if data <> nil then FreeMem(data);
end;
{@@
Constructor.
}
constructor TvVectorialDocument.Create;
begin
inherited Create;
FPaths := TFPList.Create;
end;
{@@
Destructor.
}
destructor TvVectorialDocument.Destroy;
begin
Clear;
FPaths.Free;
inherited Destroy;
end;
{@@
Clears the list of Vectors and releases their memory.
}
procedure TvVectorialDocument.RemoveAllPaths;
begin
FPaths.ForEachCall(RemoveCallback, nil);
FPaths.Clear;
end;
procedure TvVectorialDocument.AddPath(APath: TPath);
var
Path: PPath;
Len: Integer;
begin
Len := SizeOf(TPath);
WriteLn(':>TvVectorialDocument.AddPath 1 Len = ', Len);
Path := GetMem(Len);
WriteLn(':>TvVectorialDocument.AddPath 2');
Move(APath, Path^, Len);
WriteLn(':>TvVectorialDocument.AddPath 3');
FPaths.Add(Path);
WriteLn(':>TvVectorialDocument.AddPath 4');
end;
{@@
Starts writing a Path in multiple steps.
Should be followed by zero or more calls to AddPointToPath
and by a call to EndPath to effectively add the data.
@see StartPath, AddPointToPath
}
procedure TvVectorialDocument.StartPath(AX, AY: Double);
begin
FTmpPath.Len := 1;
FTmpPath.Points[0].SegmentType := st2DLine;
FTmpPath.Points[0].X := AX;
FTmpPath.Points[0].Y := AY;
end;
{@@
Adds one more point to the end of a Path being
writing in multiple steps.
Does nothing if not called between StartPath and EndPath.
Can be called multiple times to add multiple points.
@see StartPath, EndPath
}
procedure TvVectorialDocument.AddLineToPath(AX, AY: Double);
var
L: Integer;
begin
L := FTmpPath.Len;
Inc(FTmpPath.Len);
FTmpPath.Points[L].SegmentType := st2DLine;
FTmpPath.Points[L].X := AX;
FTmpPath.Points[L].Y := AY;
end;
procedure TvVectorialDocument.AddLineToPath(AX, AY, AZ: Double);
var
L: Integer;
begin
L := FTmPPath.Len;
Inc(FTmPPath.Len);
FTmPPath.Points[L].SegmentType := st3DLine;
FTmPPath.Points[L].X := AX;
FTmPPath.Points[L].Y := AY;
FTmPPath.Points[L].Z := AZ;
end;
procedure TvVectorialDocument.AddBezierToPath(AX1, AY1, AX2, AY2, AX3,
AY3: Double);
var
L: Integer;
begin
L := FTmPPath.Len;
Inc(FTmPPath.Len);
FTmPPath.Points[L].SegmentType := st2DBezier;
FTmPPath.Points[L].X := AX3;
FTmPPath.Points[L].Y := AY3;
FTmPPath.Points[L].X2 := AX1;
FTmPPath.Points[L].Y2 := AY1;
FTmPPath.Points[L].X3 := AX2;
FTmPPath.Points[L].Y3 := AY2;
end;
procedure TvVectorialDocument.AddBezierToPath(AX1, AY1, AZ1, AX2, AY2, AZ2,
AX3, AY3, AZ3: Double);
begin
end;
{@@
Finishes writing a Path, which was created in multiple
steps using StartPath and AddPointToPath,
to the document.
Does nothing if there wasn't a previous correspondent call to
StartPath.
@see StartPath, AddPointToPath
}
procedure TvVectorialDocument.EndPath();
begin
if FTmPPath.Len = 0 then Exit;
AddPath(FTmPPath);
FTmPPath.Len := 0;
end;
{@@
Convenience method which creates the correct
writer object for a given vector graphics document format.
}
function TvVectorialDocument.CreateVectorialWriter(AFormat: TvVectorialFormat): TvCustomVectorialWriter;
var
i: Integer;
begin
Result := nil;
for i := 0 to Length(GvVectorialFormats) - 1 do
if GvVectorialFormats[i].Format = AFormat then
begin
Result := GvVectorialFormats[i].WriterClass.Create;
Break;
end;
if Result = nil then raise Exception.Create('Unsuported vector graphics format.');
end;
{@@
Convenience method which creates the correct
reader object for a given vector graphics document format.
}
function TvVectorialDocument.CreateVectorialReader(AFormat: TvVectorialFormat): TvCustomVectorialReader;
var
i: Integer;
begin
Result := nil;
for i := 0 to Length(GvVectorialFormats) - 1 do
if GvVectorialFormats[i].Format = AFormat then
begin
Result := GvVectorialFormats[i].ReaderClass.Create;
Break;
end;
if Result = nil then raise Exception.Create('Unsuported vector graphics format.');
end;
{@@
Writes the document to a file.
If the file doesn't exist, it will be created.
}
procedure TvVectorialDocument.WriteToFile(AFileName: string; AFormat: TvVectorialFormat);
var
AWriter: TvCustomVectorialWriter;
begin
AWriter := CreateVectorialWriter(AFormat);
try
AWriter.WriteToFile(AFileName, Self);
finally
AWriter.Free;
end;
end;
{@@
Writes the document to a stream
}
procedure TvVectorialDocument.WriteToStream(AStream: TStream; AFormat: TvVectorialFormat);
var
AWriter: TvCustomVectorialWriter;
begin
AWriter := CreateVectorialWriter(AFormat);
try
AWriter.WriteToStream(AStream, Self);
finally
AWriter.Free;
end;
end;
procedure TvVectorialDocument.WriteToStrings(AStrings: TStrings;
AFormat: TvVectorialFormat);
var
AWriter: TvCustomVectorialWriter;
begin
AWriter := CreateVectorialWriter(AFormat);
try
AWriter.WriteToStrings(AStrings, Self);
finally
AWriter.Free;
end;
end;
{@@
Reads the document from a file.
Any current contents will be removed.
}
procedure TvVectorialDocument.ReadFromFile(AFileName: string;
AFormat: TvVectorialFormat);
var
AReader: TvCustomVectorialReader;
begin
Self.Clear;
AReader := CreateVectorialReader(AFormat);
try
AReader.ReadFromFile(AFileName, Self);
finally
AReader.Free;
end;
end;
{@@
Reads the document from a stream.
Any current contents will be removed.
}
procedure TvVectorialDocument.ReadFromStream(AStream: TStream;
AFormat: TvVectorialFormat);
var
AReader: TvCustomVectorialReader;
begin
Self.Clear;
AReader := CreateVectorialReader(AFormat);
try
AReader.ReadFromStream(AStream, Self);
finally
AReader.Free;
end;
end;
procedure TvVectorialDocument.ReadFromStrings(AStrings: TStrings;
AFormat: TvVectorialFormat);
var
AReader: TvCustomVectorialReader;
begin
Self.Clear;
AReader := CreateVectorialReader(AFormat);
try
AReader.ReadFromStrings(AStrings, Self);
finally
AReader.Free;
end;
end;
function TvVectorialDocument.GetPath(ANum: Cardinal): TPath;
begin
if ANum >= FPaths.Count then raise Exception.Create('TvVectorialDocument.GetPath: Path number out of bounds');
if FPaths.Items[ANum] = nil then raise Exception.Create('TvVectorialDocument.GetPath: Invalid Path number');
Result := PPath(FPaths.Items[ANum])^;
end;
function TvVectorialDocument.GetPathCount: Integer;
begin
Result := FPaths.Count;
end;
{@@
Clears all data in the document
}
procedure TvVectorialDocument.Clear;
begin
RemoveAllPaths();
end;
{ TvCustomVectorialReader }
procedure TvCustomVectorialReader.ReadFromFile(AFileName: string; AData: TvVectorialDocument);
var
FileStream: TFileStream;
begin
FileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
try
ReadFromStream(FileStream, AData);
finally
FileStream.Free;
end;
end;
procedure TvCustomVectorialReader.ReadFromStream(AStream: TStream;
AData: TvVectorialDocument);
var
AStringStream: TStringStream;
AStrings: TStringList;
begin
AStringStream := TStringStream.Create('');
AStrings := TStringList.Create;
try
AStringStream.CopyFrom(AStream, AStream.Size);
AStringStream.Seek(0, soFromBeginning);
AStrings.Text := AStringStream.DataString;
ReadFromStrings(AStrings, AData);
finally
AStringStream.Free;
AStrings.Free;
end;
end;
procedure TvCustomVectorialReader.ReadFromStrings(AStrings: TStrings;
AData: TvVectorialDocument);
var
AStringStream: TStringStream;
begin
AStringStream := TStringStream.Create('');
try
AStringStream.WriteString(AStrings.Text);
AStringStream.Seek(0, soFromBeginning);
ReadFromStream(AStringStream, AData);
finally
AStringStream.Free;
end;
end;
{ TsCustomSpreadWriter }
{@@
Default file writting method.
Opens the file and calls WriteToStream
@param AFileName The output file name.
If the file already exists it will be replaced.
@param AData The Workbook to be saved.
@see TsWorkbook
}
procedure TvCustomVectorialWriter.WriteToFile(AFileName: string; AData: TvVectorialDocument);
var
OutputFile: TFileStream;
begin
OutputFile := TFileStream.Create(AFileName, fmCreate or fmOpenWrite);
try
WriteToStream(OutputFile, AData);
finally
OutputFile.Free;
end;
end;
procedure TvCustomVectorialWriter.WriteToStream(AStream: TStream;
AData: TvVectorialDocument);
begin
end;
procedure TvCustomVectorialWriter.WriteToStrings(AStrings: TStrings;
AData: TvVectorialDocument);
begin
end;
finalization
SetLength(GvVectorialFormats, 0);
end.

69
packages/fpvectorial/src/fpvectorial_pkg.lpk Normal file
View File

@ -0,0 +1,69 @@
<?xml version="1.0"?>
<CONFIG>
<Package Version="3">
<PathDelim Value="\"/>
<Name Value="fpvectorial_pkg"/>
<CompilerOptions>
<Version Value="8"/>
<PathDelim Value="\"/>
<SearchPaths>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Files Count="9">
<Item1>
<Filename Value="fpvectorial.pas"/>
<UnitName Value="fpvectorial"/>
</Item1>
<Item2>
<Filename Value="pdfvectorialreader.pas"/>
<UnitName Value="pdfvectorialreader"/>
</Item2>
<Item3>
<Filename Value="pdfvrlexico.pas"/>
<UnitName Value="pdfvrlexico"/>
</Item3>
<Item4>
<Filename Value="pdfvrsemantico.pas"/>
<UnitName Value="pdfvrsemantico"/>
</Item4>
<Item5>
<Filename Value="pdfvrsintatico.pas"/>
<UnitName Value="pdfvrsintatico"/>
</Item5>
<Item6>
<Filename Value="avisozlib.pas"/>
<UnitName Value="avisozlib"/>
</Item6>
<Item7>
<Filename Value="avisocncgcodewriter.pas"/>
<UnitName Value="avisocncgcodewriter"/>
</Item7>
<Item8>
<Filename Value="avisocncgcodereader.pas"/>
<UnitName Value="avisocncgcodereader"/>
</Item8>
<Item9>
<Filename Value="fpvtocanvas.pas"/>
<UnitName Value="fpvtocanvas"/>
</Item9>
</Files>
<Type Value="RunAndDesignTime"/>
<RequiredPkgs Count="1">
<Item1>
<PackageName Value="FCL"/>
<MinVersion Major="1" Valid="True"/>
</Item1>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
</PublishOptions>
</Package>
</CONFIG>

22
packages/fpvectorial/src/fpvectorial_pkg.pas Normal file
View File

@ -0,0 +1,22 @@
{ This file was automatically created by Lazarus. do not edit!
This source is only used to compile and install the package.
}
unit fpvectorial_pkg;
interface
uses
fpvectorial, pdfvectorialreader, pdfvrlexico, pdfvrsemantico,
pdfvrsintatico, avisozlib, avisocncgcodewriter, avisocncgcodereader,
fpvtocanvas, LazarusPackageIntf;
implementation
procedure Register;
begin
end;
initialization
RegisterPackage('fpvectorial_pkg', @Register);
end.

81
packages/fpvectorial/src/fpvtocanvas.pas Normal file
View File

@ -0,0 +1,81 @@
unit fpvtocanvas;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
fpcanvas,
fpvectorial;
procedure DrawFPVectorialToCanvas(ASource: TvVectorialDocument; ADest: TFPCustomCanvas;
ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Integer = 1; AMulY: Integer = 1);
implementation
procedure DrawFPVectorialToCanvas(ASource: TvVectorialDocument; ADest: TFPCustomCanvas;
ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Integer = 1; AMulY: Integer = 1);
var
i, j, k: Integer;
PosX, PosY: Integer; // Not modified by ADestX, etc
CurSegment: TPathSegment;
// For bezier
CurX, CurY: Integer; // Not modified by ADestX, etc
CurveLength: Integer;
t: Double;
begin
WriteLn(':>DrawFPVectorialToCanvas');
PosX := 0;
PosY := 0;
ADest.MoveTo(ADestX, ADestY);
for i := 0 to ASource.PathCount - 1 do
begin
//WriteLn('i = ', i);
for j := 0 to Length(ASource.Paths[i].Points) - 1 do
begin
//WriteLn('j = ', j);
CurSegment := ASource.Paths[i].Points[j];
case CurSegment.SegmentType of
st2DLine, st3DLine:
begin
PosX := Round(CurSegment.X);
PosY := Round(CurSegment.Y);
ADest.LineTo(
ADestX + AMulX * PosX,
ADestY + AMulY * PosY
);
end;
{ To draw a bezier we need to divide the interval in parts and make
lines between this parts }
st2DBezier, st3DBezier:
begin
CurveLength :=
Round(sqrt(sqr(CurSegment.X3 - PosX) + sqr(CurSegment.Y3 - PosY))) +
Round(sqrt(sqr(CurSegment.X2 - CurSegment.X3) + sqr(CurSegment.Y2 - CurSegment.Y3))) +
Round(sqrt(sqr(CurSegment.X - CurSegment.X3) + sqr(CurSegment.Y - CurSegment.Y3)));
for k := 1 to CurveLength do
begin
t := k / CurveLength;
CurX := Round(sqr(1 - t) * (1 - t) * PosX + 3 * t * sqr(1 - t) * CurSegment.X2 + 3 * t * t * (1 - t) * CurSegment.X3 + t * t * t * CurSegment.X);
CurY := Round(sqr(1 - t) * (1 - t) * PosY + 3 * t * sqr(1 - t) * CurSegment.Y2 + 3 * t * t * (1 - t) * CurSegment.Y3 + t * t * t * CurSegment.Y);
ADest.LineTo(
ADestX + AMulX * CurX,
ADestY + AMulY * CurY);
end;
PosX := Round(CurSegment.X);
PosY := Round(CurSegment.Y);
end;
end;
end;
end;
WriteLn(':<DrawFPVectorialToCanvas');
end;
end.

251
packages/fpvectorial/src/pdfvectorialreader.pas Normal file
View File

@ -0,0 +1,251 @@
{
pdfvectorialreader.pas
Reads the vectorial information form a PDF file
PDF file format specification obtained from:
ADOBE SYSTEMS INCORPORATED. PDF Reference: Adobe®
Portable Document Format. San Jose, 2006. (Sixth edition).
AUTHORS: Felipe Monteiro de Carvalho
Pedro Sol Pegorini L de Lima
}
unit pdfvectorialreader;
{$ifdef fpc}
{$mode delphi}
{$endif}
interface
uses
Classes, SysUtils,
pdfvrlexico, pdfvrsintatico, pdfvrsemantico, avisozlib,
fpvectorial;
type
{ TvPDFVectorialReader }
TvPDFVectorialReader = class(TvCustomVectorialReader)
private
procedure WriteStringToStream(AStream: TStream; AString: string);
public
{ public to allow uncompressing PDFs independently }
function getFirstPage(AInput: TStream; AOutput: TStream):PageHeader;
procedure unzipPage(AInput: TStream; AOutput: TStream);
procedure translatePage(AInput: TStream; AData: TvVectorialDocument;
APageHeader: PageHeader);
{ General reading methods }
procedure ReadFromStream(AStream: TStream; AData: TvVectorialDocument); override;
end;
implementation
{ TvPDFVectorialReader }
procedure TvPDFVectorialReader.WriteStringToStream(AStream: TStream;
AString: string);
begin
AStream.WriteBuffer(AString[1], Length(AString));
end;
function TvPDFVectorialReader.getFirstPage(AInput: TStream; AOutput: TStream): PageHeader;
var
mytoken: Token;
myAnLexicoPage: AnLexico;
myAnLexicoContents: AnLexico;
myAnSintaticoPage: AnSintaticoPage;
myAnSintaticoContents: AnSintaticoPageContents;
AInput2: TStream;
begin
WriteLn(':> TvPDFVectorialReader.getFirstPage');
AInput2 := TMemoryStream.Create;
AInput2.Size := AInput.Size;
AInput2.CopyFrom(AInput, AInput.Size);
AInput.Seek(0, soFromBeginning);
AInput2.Seek(0, soFromBeginning);
myAnLexicoPage := AnLexico.Create;
myAnLexicoPage.Doc := AInput;
myAnLexicoPage.bytesRemaining:= myAnLexicoPage.Doc.Size;
myAnSintaticoPage := AnSintaticoPage.Create;
// find first page
while ((myAnSintaticoPage.pageFound <> true) and
(myAnLexicoPage.bytesRemaining > 0)) do
begin
mytoken := myAnLexicoPage.getToken();
myAnSintaticoPage.automata(mytoken);
end;
if (myAnSintaticoPage.pageFound = false) then
begin
raise Exception.Create('ERROR: Arquivo corrompido.');
Halt(1);
end;
AInput.Seek(0, soFromBeginning);
myAnLexicoContents := AnLexico.Create;
myAnLexicoContents.Doc := AInput;
myAnLexicoContents.bytesRemaining:= myAnLexicoContents.Doc.Size;
myAnSintaticoContents := AnSintaticoPageContents.Create;
// gathering information of the first page
myAnSintaticoContents.obj1:=myAnSintaticoPage.obj1;
myAnSintaticoContents.obj2:=myAnSintaticoPage.obj2;
//find first page contents
while ((myAnSintaticoContents.contentsFound <> true) and
(myAnLexicoContents.bytesRemaining > 0)) do
begin
mytoken := myAnLexicoContents.getToken();
myAnSintaticoContents.automata(mytoken, AInput2);
end;
if (myAnSintaticoContents.contentsFound = false) then
begin
raise Exception.Create('ERROR: Arquivo corrompido.');
Halt(1);
end;
// gathering information of the first page
myAnLexicoContents.bytesRemaining:=myAnSintaticoContents.h.page_length;
// write file with content just from the first page
while (myAnLexicoContents.bytesRemaining > 0) do
begin
mytoken := myAnLexicoContents.getPageToken();
WriteStringToStream(AOutput, mytoken.token_string);
end;
Result:=myAnSintaticoContents.h;
WriteLn(':< TvPDFVectorialReader.getFirstPage');
// AInput2.Free;
end;
procedure TvPDFVectorialReader.unzipPage(AInput: TStream; AOutput: TStream);
var
compr, uncompr: Pbyte;
comprLen, uncomprLen: LongInt;
myDecode: decode;
BufStr: string;
begin
WriteLn(':> TvPDFVectorialReader.unzipPage');
myDecode := Decode.Create;
comprLen := 10000 * SizeOf(Integer); // don't overflow
uncomprLen := comprLen;
GetMem(compr, comprLen);
GetMem(uncompr, uncomprLen);
if (compr = NIL) or (uncompr = NIL) then
myDecode.EXIT_ERR('Out of memory');
(* compr and uncompr are cleared to avoid reading uninitialized
* data and to ensure that uncompr compresses well.
*)
FillChar(compr^, comprLen, 0);
FillChar(uncompr^, uncomprLen, 0);
AInput.Read(compr^, comprLen);
BufStr := string(myDecode.test_inflate(compr, comprLen, uncompr, uncomprLen));
WriteStringToStream(AOutput, BufStr);
FreeMem(compr, comprLen);
FreeMem(uncompr, uncomprLen);
WriteLn(':< TvPDFVectorialReader.unzipPage');
end;
procedure TvPDFVectorialReader.translatePage(AInput: TStream;
AData: TvVectorialDocument; APageHeader: PageHeader);
var
myAnLexico: AnLexico;
myAnSintaticoCommand: AnSintaticoCommand;
myAnSemantico: AnSemantico;
mytoken: Token;
c: Command;
begin
WriteLn(':> TvPDFVectorialReader.translatePage');
// initialize data main
myAnLexico := AnLexico.Create;
myAnLexico.Doc := AInput;
myAnLexico.bytesRemaining:= myAnLexico.Doc.Size;
myAnSintaticoCommand := AnSintaticoCommand.Create;
myAnSemantico := AnSemantico.Create;
// initialize machine
myAnSemantico.startMachine();
while (myAnLexico.bytesRemaining > 0) do
begin
mytoken := myAnLexico.getToken();
c:=myAnSintaticoCommand.automata(mytoken);
if (myAnSintaticoCommand.Codigo = true) then
myAnSemantico.generate(c, AData);
end;
// end machine
myAnSemantico.endMachine();
end;
procedure TvPDFVectorialReader.ReadFromStream(AStream: TStream;
AData: TvVectorialDocument);
var
APageHeader: PageHeader;
APageStream, AUnzipStream: TStream;
begin
WriteLn(':> TvPDFVectorialReader.ReadFromStream');
APageStream := TMemoryStream.Create;
AUnzipStream := TMemoryStream.Create;
// get first page
APageHeader := getFirstPage(AStream, APageStream);
// unzip page
if (APageHeader.flate_decode = true) then
begin
APageStream.Seek(0, soFromBeginning);
unzipPage(APageStream, AUnzipStream);
// translate page to doc data
AUnzipStream.Seek(0, soFromBeginning);
translatePage(AUnzipStream, AData, APageHeader);
end
else
begin
// translate page to doc data
APageStream.Seek(0, soFromBeginning);
translatePage(APageStream, AData, APageHeader);
end;
APageStream.Free;
AUnzipStream.Free;
//ShowMessage('Sucesso!');
WriteLn(':< TvPDFVectorialReader.ReadFromStream');
WriteLn('Sucesso!');
end;
{*******************************************************************
* Initialization section
*
* Registers this reader / writer on fpVectorial
*
*******************************************************************}
initialization
RegisterVectorialReader(TvPDFVectorialReader, vfPDF);
end.

113
packages/fpvectorial/src/pdfvrlexico.pas Normal file
View File

@ -0,0 +1,113 @@
unit pdfvrlexico;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
type
Token = record
tipo: Int64;
token_string: String;
end;
TPDFCommandCode = (cc_NONE, cc_m_START_PATH, cc_l_ADD_LINE_TO_PATH,
cc_H_CLOSE_PATH, cc_S_END_PATH, cc_hS_CLOSE_AND_END_PATH,
cc_c_BEZIER_TO_X_Y_USING_X2_Y2_AND_X3_Y3,
cc_v_BEZIER_TO_X_Y_USING_CURRENT_POS_AND_X2_Y2,
cc_y_BEZIER_TO_X_Y_USING_X_Y_AND_X2_Y2,
cc_CONCATENATE_MATRIX,cc_RESTORE_MATRIX);
Command = record
cord_x3: String;
cord_y3: String;
cord_x2: String;
cord_y2: String;
cord_x: String;
cord_y: String;
my_operator: String;
code: TPDFCommandCode;
end;
PageHeader = record
page_length: Int64;
flate_decode: Boolean;
end;
AnLexico = class
public
constructor Create();
function getToken(): Token;
function getPageToken(): Token;
Doc: TStream;
bytesRemaining: Int64;
end;
implementation
function AnLexico.getToken(): Token;
var
t: Byte;
mytoken: Token;
begin
mytoken.tipo := 0;
while( bytesRemaining > 0 ) do
begin
t := Doc.ReadByte();
bytesRemaining := bytesRemaining - 1;
// numbers or points or minus
if((((t >= 48) and (t <= 57)) or (t = 46 ) or (t = 45)) and
((mytoken.tipo = 1) or (mytoken.tipo = 0))) then
begin
mytoken.token_string := mytoken.token_string + char(t);
mytoken.tipo:=1;
end
else if(((t >= 65) and (t <= 90)) or ((t >= 97) and (t <= 122)) // letters
or (t = 42) // *
and ((mytoken.tipo = 2) or (mytoken.tipo = 0))) then
begin
mytoken.token_string := mytoken.token_string + char(t);
mytoken.tipo:=2;
end
else // everything else
begin
if (mytoken.tipo <> 0) then
begin
// solve CorelDraw problem after "stream"
if ((t=13) and (bytesRemaining>0)) then
begin
t := Doc.ReadByte();
bytesRemaining:=bytesRemaining-1;
end;
Result := mytoken;
Exit;
end;
end;
end;
Result := mytoken;
end;
function AnLexico.getPageToken(): Token;
var
t: Byte;
mytoken: Token;
begin
mytoken.tipo := 0;
if (bytesRemaining > 0) then
begin
t := Doc.ReadByte;
mytoken.token_string:=char(t);
bytesRemaining := bytesRemaining - 1;
end;
Result := mytoken;
end;
constructor AnLexico.Create();
begin
inherited Create;
end;
end.

195
packages/fpvectorial/src/pdfvrsemantico.pas Normal file
View File

@ -0,0 +1,195 @@
unit pdfvrsemantico;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, pdfvrlexico, fpvectorial;
type
AnSemantico = class
public
close_path_x: String;
close_path_y: String;
cm_a, cm_b, cm_c, cm_d, cm_e, cm_f: Real; // coordinate spaces constants
function generate(c: Command; AData: TvVectorialDocument): String;
function convert(x: String; y: String; Axis: Char): String;
function startMachine(): String;
function endMachine(): String;
constructor Create;
end;
implementation
function AnSemantico.generate(c: Command; AData: TvVectorialDocument): String;
var
enter_line : String;
begin
WriteLn(':> AnSemantico.generate');
enter_line:= LineEnding; //chr(13) + chr(10); // CR and LF
if ((c.code = cc_H_CLOSE_PATH) or (c.code = cc_hS_CLOSE_AND_END_PATH)) then // command h or s
begin
c.cord_x:=close_path_x;
c.cord_y:=close_path_y;
end;
if ((c.code <> cc_H_CLOSE_PATH) and (c.code <> cc_hS_CLOSE_AND_END_PATH)) then // close path already converted
begin
if ((c.code = cc_m_START_PATH) or (c.code = cc_l_ADD_LINE_TO_PATH)) then
begin
WriteLn(':: anSemantico.generate convert code ', Integer(c.code));
c.cord_x := convert(c.cord_x,c.cord_y,'x');
c.cord_y := convert(c.cord_x,c.cord_y,'y');
end;
if ((c.code = cc_c_BEZIER_TO_X_Y_USING_X2_Y2_AND_X3_Y3)) then
begin
WriteLn(':: anSemantico.generate convert code ', Integer(c.code));
c.cord_x := convert(c.cord_x,c.cord_y,'x');
c.cord_y := convert(c.cord_x,c.cord_y,'y');
c.cord_x2 := convert(c.cord_x2,c.cord_y2,'x');
c.cord_y2 := convert(c.cord_x2,c.cord_y2,'y');
c.cord_x3 := convert(c.cord_x3,c.cord_y3,'x');
c.cord_y3 := convert(c.cord_x3,c.cord_y3,'y');
end;
end;
case c.code of
cc_m_START_PATH: // command m
begin
WriteLn(':> AnSemantico.generate Estado 1 EndPath StartPath');
// Result:='G01' + ' ' + 'X' + c.cord_x + ' ' + 'Y' + c.cord_y + enter_line +
// 'G01 Z50 // Abaixa a cabeça de gravação';
// Correcao para programas de desenho que geram um novo inicio no
// fim do desenho, terminamos qualquer desenho inacabado
AData.EndPath();
AData.StartPath(StrToFloat(c.cord_x), StrToFloat(c.cord_y));
close_path_x:=c.cord_x;
close_path_y:=c.cord_y;
end;
cc_l_ADD_LINE_TO_PATH: // command l
begin
WriteLn(':> AnSemantico.generate Estado 2 AddPointToPath');
// Result:='G01' + ' ' + 'X' + c.cord_x + ' ' + 'Y' + c.cord_y;
AData.AddLineToPath(StrToFloat(c.cord_x), StrToFloat(c.cord_y));
end;
cc_h_CLOSE_PATH: // command h
begin
WriteLn(':> AnSemantico.generate Estado 3 AddPointToPath');
//Result:='G01' + ' ' + 'X' + c.cord_x + ' ' + 'Y' + c.cord_y;
AData.AddLineToPath(StrToFloat(c.cord_x), StrToFloat(c.cord_y));
end;
cc_S_END_PATH: // command S
begin
WriteLn(':> AnSemantico.generate Estado 4 EndPath');
// Result:='G01 Z0 // Sobe a cabeça de gravação' + enter_line;
AData.EndPath();
end;
cc_hS_CLOSE_AND_END_PATH: // command s
begin
WriteLn(':> AnSemantico.generate Estado 5 AddPoint EndPath');
//Result:='G01' + ' ' + 'X' + c.cord_x + ' ' + 'Y' + c.cord_y + enter_line
// +'G01 Z0 // Sobe a cabeça de gravação' + enter_line;
AData.AddLineToPath(StrToFloat(c.cord_x), StrToFloat(c.cord_y));
AData.EndPath();
end;
cc_c_BEZIER_TO_X_Y_USING_X2_Y2_AND_X3_Y3: // command c
begin
WriteLn(':> AnSemantico.generate Estado 6 Bezier');
//Result:='G01' + ' ' + 'X' + c.cord_x + ' ' + 'Y' + c.cord_y + enter_line
// +'G01 Z0 // Sobe a cabeça de gravação' + enter_line;
AData.AddBezierToPath(
StrToFloat(c.cord_x3), StrToFloat(c.cord_y3),
StrToFloat(c.cord_x2), StrToFloat(c.cord_y2),
StrToFloat(c.cord_x), StrToFloat(c.cord_y)
);
end;
cc_CONCATENATE_MATRIX: // command cm
begin
WriteLn(':> AnSemantico.cc_CONCATENATE_MATRIX');
cm_a := StrToFloat(c.cord_x3);
cm_b := StrToFloat(c.cord_y3);
cm_c := StrToFloat(c.cord_x2);
cm_d := StrToFloat(c.cord_y2);
cm_e := StrToFloat(c.cord_x);
cm_f := StrToFloat(c.cord_y);
end;
cc_RESTORE_MATRIX: // command Q
begin
WriteLn(':> AnSemantico.cc_RESTORE_MATRIX');
cm_a:=1;
cm_b:=0;
cm_c:=0;
cm_d:=1;
cm_e:=0;
cm_f:=0;
end;
else
WriteLn(':> AnSemantico.generate Estado ELSE');
Result:=c.my_operator;
end;
end;
function AnSemantico.convert(x: String; y: String; Axis: Char): String;
begin
WriteLn(':> AnSemantico.convert');
// convert from 1/72 inch to milimeters and change axis if necessary
if (Axis = 'y') then
begin
// y' = b * x + d * y + f
Result:=FloatToStr((cm_b*StrToFloat(x)+cm_d*StrToFloat(y)+cm_f)*(25.40/72));
end
else
// Axis = 'x'
begin
// x' = a * x + c * y + e
Result:=FloatToStr((cm_a*StrToFloat(x)+cm_c*StrToFloat(y)+cm_e)*(25.40/72));
end;
end;
function AnSemantico.startMachine(): String;
var
enter_line : String;
begin
WriteLn(':> AnSemantico.startMachine');
enter_line:=chr(13) + chr(10); // CR and LF
Result:='M216 // Ligar monitor de carga' + enter_line +
'G28 // Ir rapidamente para posição inicial' + enter_line +
'G00' + enter_line;
end;
function AnSemantico.endMachine(): String;
var
enter_line : String;
begin
WriteLn(':> AnSemantico.endMachine');
enter_line:=chr(13) + chr(10); // CR and LF
Result:='M30 // Parar o programa e retornar para posição inicial' + enter_line +
'M215 // Desligar monitor de carga' + enter_line;
end;
constructor AnSemantico.Create;
begin
inherited Create;
cm_a:=1;
cm_b:=0;
cm_c:=0;
cm_d:=1;
cm_e:=0;
cm_f:=0;
end;
end.

572
packages/fpvectorial/src/pdfvrsintatico.pas Normal file
View File

@ -0,0 +1,572 @@
unit pdfvrsintatico;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, pdfvrlexico;
type
AnSintaticoPage = class
public
Estado: Int64;
obj1,obj2 : String;
pageFound: Boolean;
constructor Create;
procedure automata(t: Token);
end;
AnSintaticoPageContents = class
public
Estado: Int64;
obj1,obj2 : String;
len_obj1,len_obj2: String;
contentsFound: Boolean;
h: PageHeader;
constructor Create;
procedure automata(t: Token; Input: TStream);
end;
AnSintaticoCommand = class
public
Estado: Int64;
Codigo: Boolean;
c: Command;
constructor Create;
function automata(t: Token):Command;
end;
AnSintaticoLength = class
public
Estado: Int64;
len_obj1,len_obj2: String;
page_length : Int64;
lenghtFound: Boolean;
constructor Create;
procedure automata(t: Token);
end;
implementation
procedure AnSintaticoPage.automata(t: Token);
begin
case Estado of
1:
begin
WriteLn(':> AnSintaticoPage.automata Estado 1');
if(t.token_string = 'Type') then
begin
Estado := 2;
end
else
begin
Estado := 1;
end;
end;
2:
begin
WriteLn(':> AnSintaticoPage.automata Estado 2');
if(t.token_string = 'Page') then
begin
Estado := 3;
end
else
begin
Estado := 1;
end;
end;
3:
begin
WriteLn(':> AnSintaticoPage.automata Estado 3');
if(t.token_string = 'Contents') then
begin
Estado := 4;
end
else
begin
Estado := 3;
end;
end;
4:
begin
WriteLn(':> AnSintaticoPage.automata Estado 4');
if(t.tipo = 1) then // numbers 1
begin
obj1:=t.token_string;
Estado := 5;
end
else
begin
raise Exception.Create('ERROR: Arquivo corrompido.');
Halt(1);
end;
end;
5:
begin
WriteLn(':> AnSintaticoPage.automata Estado 5');
if(t.tipo = 1) then // numbers 2
begin
obj2:=t.token_string;
Estado := 6; // symbolic state
pageFound := true;
end
else
begin
raise Exception.Create('ERROR: Arquivo corrompido.');
Halt(1);
end;
end;
else
WriteLn(':> AnSintaticoPage.automata Estado ELSE');
Estado := 1;
end;
end;
procedure AnSintaticoPageContents.automata(t: Token; Input: TStream);
var
myAnLexicoLength: AnLexico;
myAnSintaticoLength: AnSintaticoLength;
mytokenLength: Token;
begin
case Estado of
1:
begin
WriteLn(':> AnSintaticoPageContents.automata Estado 1');
if(t.token_string = obj1) then
begin
Estado := 2;
end
else
begin
Estado := 1;
end;
end;
2:
begin
WriteLn(':> AnSintaticoPageContents.automata Estado 2');
if(t.token_string = obj2) then
begin
Estado := 3;
end
else
begin
Estado := 1;
end;
end;
3:
begin
WriteLn(':> AnSintaticoPageContents.automata Estado 3');
if(t.token_string = 'obj') then
begin
Estado := 4;
end
else
begin
Estado := 1;
end;
end;
4:
begin
WriteLn(':> AnSintaticoPageContents.automata Estado 4');
if(t.token_string = 'Length') then
begin
Estado := 5;
end
else if (t.token_string = 'Filter') then
begin
Estado := 7;
end
else
begin
Estado := 4;
end;
end;
5:
begin
WriteLn(':> AnSintaticoPageContents.automata Estado 5');
if(t.tipo = 1) then
begin
h.page_length := StrToInt(t.token_string);
len_obj1:=t.token_string;
Estado := 6;
end
else
begin
raise Exception.Create('ERROR: Arquivo corrompido.');
Halt(1);
end;
end;
6:
begin
WriteLn(':> AnSintaticoPageContents.automata Estado 6');
if(t.token_string = 'Filter') then
begin
Estado := 7;
end
else if (t.token_string = 'stream') then
begin
contentsFound := true;
Estado := 9; // symbolic state
end
else if (t.tipo = 1) then
begin
len_obj2:=t.token_string;
myAnLexicoLength := AnLexico.Create;
myAnLexicoLength.Doc := Input;
myAnLexicoLength.bytesRemaining:= myAnLexicoLength.Doc.Size;
myAnSintaticoLength := AnSintaticoLength.Create;
myAnSintaticoLength.len_obj1:=len_obj1;
myAnSintaticoLength.len_obj2:=len_obj2;
while ((myAnSintaticoLength.lenghtFound <> true) and
(myAnLexicoLength.bytesRemaining > 0)) do
begin
mytokenLength := myAnLexicoLength.getToken();
myAnSintaticoLength.automata(mytokenLength);
end;
if (myAnSintaticoLength.lenghtFound = false) then
begin
raise Exception.Create('ERROR: Arquivo corrompido.');
Halt(1);
end;
h.page_length:=myAnSintaticoLength.page_length;
myAnLexicoLength.Doc.Destroy;
Estado := 6;
end
else
begin
Estado := 6;
end;
end;
7:
begin
WriteLn(':> AnSintaticoPageContents.automata Estado 7');
if(t.token_string = 'FlateDecode') then
begin
h.flate_decode := true;
Estado := 8;
end
else
begin
raise Exception.Create('ERROR: Encodificacao nao suportada.');
Halt(1);
end;
end;
8:
begin
WriteLn(':> AnSintaticoPageContents.automata Estado 8');
if(t.token_string = 'stream') then
begin
contentsFound := true;
Estado := 9; // symbolic state
end
else if (t.token_string = 'Length') then
begin
Estado := 5;
end
else
begin
Estado := 8;
end;
end;
else
WriteLn(':> AnSintaticoPageContents.automata Estado ELSE');
Estado := 1;
end;
end;
procedure AnSintaticoLength.automata(t: Token);
begin
case Estado of
1:
begin
WriteLn(':> AnSintaticoLength.automata Estado 1');
if(t.token_string = len_obj1) then
begin
Estado := 2;
end
else
begin
Estado := 1;
end;
end;
2:
begin
WriteLn(':> AnSintaticoLength.automata Estado 2');
if(t.token_string = len_obj2) then
begin
Estado := 3;
end
else
begin
Estado := 1;
end;
end;
3:
begin
WriteLn(':> AnSintaticoLength.automata Estado 3');
if(t.token_string = 'obj') then
begin
Estado := 4;
end
else
begin
Estado := 1;
end;
end;
4:
begin
WriteLn(':> AnSintaticoLength.automata Estado 4 Length: ', StrToInt(t.token_string));
if(t.tipo = 1) then
begin
page_length:=StrToInt(t.token_string);
lenghtFound:=true;
Estado := 5; // symbolic state
end
else
begin
raise Exception.Create('ERROR: Arquivo corrompido.');
Halt(1);
end;
end;
else
WriteLn(':> AnSintaticoLength.automata Estado ELSE');
Estado := 1;
end;
end;
function AnSintaticoCommand.automata(t: Token):Command;
begin
c.cord_x3 := c.cord_y3;
c.cord_y3 := c.cord_x2;
c.cord_x2 := c.cord_y2;
c.cord_y2 := c.cord_x;
c.cord_x := c.cord_y;
c.cord_y := c.my_operator;
c.my_operator := t.token_string;
c.code := cc_NONE;
Codigo := false;
case Estado of
1:
begin
WriteLn(':> AnSintaticoCommand.automata Estado 1');
if(t.tipo = 1) then // numbers 1
begin
Estado := 2;
end
else if( t.token_string = 'h' ) then // command h
begin
Estado := 9; // symbolic state
Estado := 1;
Codigo := true;
c.code:=cc_H_CLOSE_PATH;
Result:=c;
end
else if( t.token_string = 's' ) then // command s
begin
Estado := 10; // symbolic state
Estado := 1;
Codigo := true;
c.code:=cc_hS_CLOSE_AND_END_PATH;
Result:=c;
end
else if( t.token_string = 'S' ) then // command S
begin
Estado := 11; // symbolic state
Estado := 1;
Codigo := true;
c.code:=cc_S_END_PATH;
Result:=c;
end
else if( t.token_string = 'Q' ) then // command Q
begin
Estado := 21; // symbolic state
Estado := 1;
Codigo := true;
c.code:=cc_RESTORE_MATRIX;
Result:=c;
end
else if ((t.token_string = 'f') or (t.token_string = 'F')
or (t.token_string = 'f*') or (t.token_string = 'B')
or (t.token_string = 'B*') or (t.token_string = 'b')
or (t.token_string = 'b*') or (t.token_string = 'n')) then
begin
Estado := 12; // symbolic state
Estado := 1;
Codigo := true;
c.code:=cc_hS_CLOSE_AND_END_PATH; // ignore painting..
Result:=c;
//raise Exception.Create('ERROR: Prenchimento nao eh suportado.');
//Halt(1);
end
else if ((t.token_string = 'W') or (t.token_string = 'W*')) then
begin
Estado := 13; // symbolic state
raise Exception.Create('ERROR: Clipping nao eh suportado.');
Halt(1);
end
else
begin
Estado := 1;
end;
end;
2:
begin
WriteLn(':> AnSintaticoCommand.automata Estado 2');
if(t.tipo = 1) then // numbers 2
begin
Estado := 3;
end
else
begin
Estado := 1;
end;
end;
3:
begin
WriteLn(':> AnSintaticoCommand.automata Estado 3');
if(t.tipo = 1) then // numbers 3
begin
Estado := 5;
end
else if(t.token_string = 'l') then // command l
begin
Estado := 14; // symbolic state
Estado := 1;
c.code:=cc_l_ADD_LINE_TO_PATH;
Codigo := true;
Result:=c;
end
else if(t.token_string = 'm') then // command m
begin
Estado := 15; // symbolic state
Estado := 1;
c.code:=cc_m_START_PATH;
Codigo := true;
Result:=c;
end
else
begin
Estado := 1;
end;
end;
5:
begin
WriteLn(':> AnSintaticoCommand.automata Estado 5');
if(t.tipo = 1) then // numbers 4
begin
Estado := 6;
end
else
begin
Estado := 1;
end;
end;
6:
begin
WriteLn(':> AnSintaticoCommand.automata Estado 6');
if(t.tipo = 1) then // numbers 5
begin
Estado := 7;
end
else if( t.token_string = 'v' ) then // command v
begin
Estado := 16; // symbolic state
raise Exception.Create('ERROR: Curva de bezier nao eh suportada.');
Halt(1);
end
else if( t.token_string = 'y' ) then // command y
begin
Estado := 17; // symbolic state
raise Exception.Create('ERROR: Curva de bezier nao eh suportada.');
Halt(1);
end
else if( t.token_string = 're' ) then // command re
begin
Estado := 18; // symbolic state
raise Exception.Create('ERROR: Comando nao suportado.');
Halt(1);
end
else
begin
Estado := 1;
end;
end;
7:
begin
WriteLn(':> AnSintaticoCommand.automata Estado 7');
if(t.tipo = 1) then // numbers 6
begin
Estado := 8;
end
else
begin
Estado := 1;
end;
end;
8:
begin
WriteLn(':> AnSintaticoCommand.automata Estado 8');
if(t.token_string = 'c') then // commmand c
begin
Estado := 19; // symbolic state
Estado := 1;
c.code:=cc_c_BEZIER_TO_X_Y_USING_X2_Y2_AND_X3_Y3;
Codigo := true;
Result:=c;
end
else if( t.token_string = 'cm' ) then // command cm
begin
Estado := 20; // symbolic state
Estado := 1;
c.code:=cc_CONCATENATE_MATRIX;
Codigo := true;
Result:=c;
end
else
begin
Estado := 1;
end;
end;
else
WriteLn(':> AnSintaticoCommand.automata Estado ELSE');
Estado := 1;
end;
end;
constructor AnSintaticoCommand.Create;
begin
inherited Create;
Estado := 1;
end;
constructor AnSintaticoPage.Create;
begin
inherited Create;
Estado := 1;
pageFound := false;
end;
constructor AnSintaticoPageContents.Create;
begin
inherited Create;
Estado := 1;
contentsFound := false;
h.flate_decode := false;
end;
constructor AnSintaticoLength.Create;
begin
inherited Create;
Estado := 1;
lenghtFound := false;
end;
end.