diff --git a/applications/fpvviewer/fpvectorialsrc/avisocncgcodereader.pas b/applications/fpvviewer/fpvectorialsrc/avisocncgcodereader.pas deleted file mode 100644 index 4ae5c53c5..000000000 --- a/applications/fpvviewer/fpvectorialsrc/avisocncgcodereader.pas +++ /dev/null @@ -1,236 +0,0 @@ -{ -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: TvVectorialPage); - 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: TvVectorialPage); -var - AParams: T10Strings; - DestX, DestY, DestZ: Double; - i: Integer; -begin - {$ifdef FPVECTORIALDEBUG} - WriteLn('TvAvisoCNCGCodeReader.ReadString ', AStr); - {$endif} - 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; - FirstPage: TvVectorialPage; -begin - {$ifdef FPVECTORIALDEBUG} - WriteLn('TvAvisoCNCGCodeReader.ReadFromStrings AStrings = ', PtrInt(AStrings), ' AData = ', PtrInt(AData)); - {$endif} - - FirstPage := AData.AddPage(); - FirstPage.StartPath(0, 0); - - for i := 0 to AStrings.Count - 1 do - ReadString(AStrings.Strings[i], FirstPage); - - {$ifdef FPVECTORIALDEBUG} - WriteLn('AData.EndPath'); - {$endif} - FirstPage.EndPath(); -end; - -initialization - - RegisterVectorialReader(TvAvisoCNCGCodeReader, vfGCodeAvisoCNCPrototipoV5); - -end. - diff --git a/applications/fpvviewer/fpvectorialsrc/avisocncgcodewriter.pas b/applications/fpvviewer/fpvectorialsrc/avisocncgcodewriter.pas deleted file mode 100644 index 6c8d62cf0..000000000 --- a/applications/fpvviewer/fpvectorialsrc/avisocncgcodewriter.pas +++ /dev/null @@ -1,119 +0,0 @@ -{ -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) - private - procedure WritePageToStrings(AStrings: TStrings; AData: TvVectorialPage); - public - { General reading methods } - procedure WriteToStrings(AStrings: TStrings; AData: TvVectorialDocument); override; - end; - -implementation - -{ TvGCodeVectorialWriter } - -procedure TvAvisoCNCGCodeWriter.WritePageToStrings(AStrings: TStrings; - AData: TvVectorialPage); -var - i, j: Integer; - Str: string; - APath: TPath; - CurSegment: T2DSegment; - Cur3DSegment: T3DSegment; - Cur2DBezierSegment: T2DBezierSegment; - Cur3DBezierSegment: T3DBezierSegment; - lEntity: TvEntity; -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.GetEntitiesCount - 1 do - begin - lEntity := AData.GetEntity(i); - if not (lEntity is TPath) then Continue; - APath := lEntity as TPath; - - // levanta a broca - AStrings.Add('P01 // Sobe a cabeça de gravação'); - // vai para o ponto inicial - CurSegment := T2DSegment(APath.Points); - AStrings.Add(Format('G01 X%f Y%f', - [CurSegment.X, CurSegment.Y])); - AStrings.Add('P02 // Abaixa a cabeça de gravação'); - - for j := 1 to APath.Len - 1 do - begin - CurSegment := T2DSegment(CurSegment.Next); - case CurSegment.SegmentType of - st2DLine: AStrings.Add(Format('G01 X%f Y%f', - [CurSegment.X, CurSegment.Y])); - st3DLine: - begin - Cur3DSegment := T3DSegment(CurSegment); - AStrings.Add(Format('G01 X%f Y%f Z%f', - [Cur3DSegment.X, Cur3DSegment.Y, Cur3DSegment.Z])); - end; - st2DBezier: - begin - Cur2DBezierSegment := T2DBezierSegment(CurSegment); - AStrings.Add(Format('B02 X%f Y%f X%f Y%f X%f Y%f', - [Cur2DBezierSegment.X2, Cur2DBezierSegment.Y2, - Cur2DBezierSegment.X3, Cur2DBezierSegment.Y3, - Cur2DBezierSegment.X, Cur2DBezierSegment.Y])); - end; - st3DBezier: - begin - Cur3DBezierSegment := T3DBezierSegment(CurSegment); - AStrings.Add(Format('B03 X%f Y%f Z%f X%f Y%f Z%f X%f Y%f Z%f', - [Cur3DBezierSegment.X2, Cur3DBezierSegment.Y2, Cur3DBezierSegment.Z2, - Cur3DBezierSegment.X3, Cur3DBezierSegment.Y3, Cur3DBezierSegment.Z3, - Cur3DBezierSegment.X, Cur3DBezierSegment.Y, Cur3DBezierSegment.Z])); - end; - 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; - -procedure TvAvisoCNCGCodeWriter.WriteToStrings(AStrings: TStrings; - AData: TvVectorialDocument); -var - lPage: TvVectorialPage; -begin - lPage := AData.GetPage(0); - WritePageToStrings(AStrings, lPage); -end; - -initialization - - RegisterVectorialWriter(TvAvisoCNCGCodeWriter, vfGCodeAvisoCNCPrototipoV5); - -end. - diff --git a/applications/fpvviewer/fpvectorialsrc/avisozlib.pas b/applications/fpvviewer/fpvectorialsrc/avisozlib.pas deleted file mode 100644 index 4bef95bbf..000000000 --- a/applications/fpvviewer/fpvectorialsrc/avisozlib.pas +++ /dev/null @@ -1,74 +0,0 @@ -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. - diff --git a/applications/fpvviewer/fpvectorialsrc/cdrvectorialreader.pas b/applications/fpvviewer/fpvectorialsrc/cdrvectorialreader.pas deleted file mode 100644 index 8c9f9b02b..000000000 --- a/applications/fpvviewer/fpvectorialsrc/cdrvectorialreader.pas +++ /dev/null @@ -1,180 +0,0 @@ -{ -cdrvectorialreader.pas - -Reads a Corel Draw vectorial file - -CDR file format specification obtained from: - -ADOBE SYSTEMS INCORPORATED. PDF Reference: Adobe® -Portable Document Format. San Jose, 2006. (Sixth edition). - -AUTHORS: Felipe Monteiro de Carvalho - -License: The same modified LGPL as the Free Pascal RTL - See the file COPYING.modifiedLGPL for more details -} -unit cdrvectorialreader; - -{$ifdef fpc} - {$mode delphi} -{$endif} - -interface - -uses - Classes, SysUtils, - //avisozlib, - fpvectorial; - -type - - TCDRChunk = class - Name: array[0..3] of Char; - Size: Cardinal; - ChildChunks: TFPList; - end; - - TCDRChunkClass = class of TCDRChunk; - - TvCDRInternalData = TCDRChunk; - - TCDRChunkVRSN = class(TCDRChunk) - VersionStr: string; - VersionNum: Integer; - end; - - { TvCDRVectorialReader } - - TvCDRVectorialReader = class(TvCustomVectorialReader) - private - procedure ReadVersionChunk(AStream: TStream; var AData: TCDRChunk); - function AddNewChunk(var AData: TCDRChunk; AClass: TCDRChunkClass): TCDRChunk; - public - { General reading methods } - procedure ReadFromStream(AStream: TStream; AData: TvVectorialDocument); override; - { File format exploring methods } - procedure ExploreFromFile(AFilename: string; out AData: TvCDRInternalData); - procedure ExploreFromStream(AStream: TStream; out AData: TvCDRInternalData); - end; - -implementation - -{ TvPDFVectorialReader } - -procedure TvCDRVectorialReader.ReadVersionChunk(AStream: TStream; - var AData: TCDRChunk); -var - lDWord: DWord; - lChunk: TCDRChunkVRSN absolute AData; - lVerBytes: array[0..1] of Byte; -begin - // Read the Chunk name - lDWord := AStream.ReadDWord(); - - // Read the Chunk size - lDWord := AStream.ReadDWord(); - - // Read the version - AStream.Read(lVerBytes, 2); - - if (lVerBytes[0] = $BC) and (lVerBytes[1] = $02) then - begin - lChunk.VersionNum := 7; - lChunk.VersionStr := 'CorelDraw 7'; - end - else if (lVerBytes[0] = $20) and (lVerBytes[1] = $03) then - begin - lChunk.VersionNum := 8; - lChunk.VersionStr := 'CorelDraw 8'; - end - else if (lVerBytes[0] = $21) and (lVerBytes[1] = $03) then - begin - lChunk.VersionNum := 8; - lChunk.VersionStr := 'CorelDraw 8bidi'; - end - else if (lVerBytes[0] = $84) and (lVerBytes[1] = $03) then - begin - lChunk.VersionNum := 9; - lChunk.VersionStr := 'CorelDraw 9'; - end - else if (lVerBytes[0] = $E8) and (lVerBytes[1] = $03) then - begin - lChunk.VersionNum := 10; - lChunk.VersionStr := 'CorelDraw 10'; - end - else if (lVerBytes[0] = $4C) and (lVerBytes[1] = $04) then - begin - lChunk.VersionNum := 11; - lChunk.VersionStr := 'CorelDraw 11'; - end - else if (lVerBytes[0] = $B0) and (lVerBytes[1] = $04) then - begin - lChunk.VersionNum := 12; - lChunk.VersionStr := 'CorelDraw 12'; - end - else if (lVerBytes[0] = $14) and (lVerBytes[1] = $05) then - begin - lChunk.VersionNum := 13; - lChunk.VersionStr := 'CorelDraw X3'; - end; -end; - -function TvCDRVectorialReader.AddNewChunk(var AData: TCDRChunk; AClass: TCDRChunkClass): TCDRChunk; -begin - if AData.ChildChunks = nil then AData.ChildChunks := TFPList.Create; - - Result := AClass.Create; - - AData.ChildChunks.Add(Result); -end; - -procedure TvCDRVectorialReader.ReadFromStream(AStream: TStream; - AData: TvVectorialDocument); -begin -end; - -procedure TvCDRVectorialReader.ExploreFromFile(AFilename: string; - out AData: TvCDRInternalData); -var - FileStream: TFileStream; -begin - FileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone); - try - ExploreFromStream(FileStream, AData); - finally - FileStream.Free; - end; -end; - -procedure TvCDRVectorialReader.ExploreFromStream(AStream: TStream; - out AData: TvCDRInternalData); -var - lRIFF: array[0..3] of Char; - lDocSize, lDWord: Cardinal; - lChild: TCDRChunk; -begin - // Create the data object - AData := TCDRChunk.Create; - - // All CorelDraw files starts with "RIFF" - AStream.Read(lRIFF, 4); - if lRIFF <> 'RIFF' then - raise Exception.Create('[TvCDRVectorialReader.ExploreFromStream] The Corel Draw RIFF file marker wasn''t found.'); - - // And then 4 bytes for the document size - lDocSize := AStream.ReadDWord(); - - // And mroe 4 bytes of other stuff - lDWord := AStream.ReadDWord(); - - // Now comes the version - lChild := AddNewChunk(AData, TCDRChunkVRSN); - ReadVersionChunk(AStream, lChild); -end; - -initialization - - RegisterVectorialReader(TvCDRVectorialReader, vfCorelDrawCDR); - -end. - diff --git a/applications/fpvviewer/fpvectorialsrc/dxfvectorialreader.pas b/applications/fpvviewer/fpvectorialsrc/dxfvectorialreader.pas deleted file mode 100644 index df5d3aed8..000000000 --- a/applications/fpvviewer/fpvectorialsrc/dxfvectorialreader.pas +++ /dev/null @@ -1,1255 +0,0 @@ -{ -Reads DXF files - -License: The same modified LGPL as the Free Pascal RTL - See the file COPYING.modifiedLGPL for more details - -AUTHORS: Felipe Monteiro de Carvalho - -DXF is composed by records written in ASCII with the following structure: - -0 -SECTION -section_number -SECTION_NAME - -0 -ENDSEC -0 - -after all sections there is: - -EOF - -} -unit dxfvectorialreader; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, Math, - fpvectorial, fpimage, fpvutils; - -type - TDXFToken = class; - - TDXFTokens = TFPList;// TDXFToken; - - TDXFToken = class - GroupCode: Integer; - StrValue: string; - FloatValue: double; - IntValue: Integer; - Childs: TDXFTokens; - constructor Create; - Destructor Destroy; override; - end; - - TPolylineElement = record - X, Y: Double; - Color: TFPColor; - end; - - TSPLineElement = record - X, Y: Double; - KnotValue: Integer; - end; - - TLWPOLYLINEElement = record - X, Y: Double; - end; - - { TDXFTokenizer } - - TDXFTokenizer = class - public - Tokens: TDXFTokens; - constructor Create; - Destructor Destroy; override; - procedure ReadFromStrings(AStrings: TStrings); - function IsENTITIES_Subsection(AStr: string): Boolean; - end; - - { TvDXFVectorialReader } - - TvDXFVectorialReader = class(TvCustomVectorialReader) - private - FPointSeparator: TFormatSettings; - // HEADER data - ANGBASE: Double; - ANGDIR: Integer; - INSBASE, EXTMIN, EXTMAX, LIMMIN, LIMMAX: T3DPoint; - // Calculated HEADER data - DOC_OFFSET: T3DPoint; // The DOC_OFFSET compensates for documents with huge coordinates - // For building the POLYLINE objects which is composed of multiple records - IsReadingPolyline: Boolean; - Polyline: array of TPolylineElement; - // - procedure ReadHEADER(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument); - procedure ReadENTITIES(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument); - procedure ReadENTITIES_LINE(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument); - procedure ReadENTITIES_ARC(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument); - procedure ReadENTITIES_CIRCLE(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument); - procedure ReadENTITIES_DIMENSION(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument); - procedure ReadENTITIES_ELLIPSE(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument); - procedure ReadENTITIES_TEXT(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument); - procedure ReadENTITIES_LWPOLYLINE(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument); - procedure ReadENTITIES_SPLINE(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument); - procedure ReadENTITIES_POLYLINE(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument); - procedure ReadENTITIES_VERTEX(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument); - procedure ReadENTITIES_SEQEND(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument); - procedure ReadENTITIES_MTEXT(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument); - procedure ReadENTITIES_POINT(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument); - function GetCoordinateValue(AStr: shortstring): Double; - // - function DXFColorIndexToFPColor(AColorIndex: Integer): TFPColor; - public - { General reading methods } - Tokenizer: TDXFTokenizer; - constructor Create; override; - Destructor Destroy; override; - procedure ReadFromStrings(AStrings: TStrings; AData: TvVectorialDocument); override; - end; - -implementation - -{$ifndef Windows} -{$define FPVECTORIALDEBUG} -{$endif} - -const - // Items in the HEADER section - - // $ACADVER - DXF_AUTOCAD_2010 = 'AC1024'; // AutoCAD 2011 and 2012 too - DXF_AUTOCAD_2007 = 'AC1021'; // AutoCAD 2008 and 2009 too - DXF_AUTOCAD_2004 = 'AC1018'; // AutoCAD 2005 and 2006 too - DXF_AUTOCAD_2000 = 'AC1015'; // 1999 In some docs it is proposed as AC1500, but in practice I found AC1015 - // http://www.autodesk.com/techpubs/autocad/acad2000/dxf/ - // AutoCAD 2000i and 2002 too - DXF_AUTOCAD_R14 = 'AC1014'; // 1997 http://www.autodesk.com/techpubs/autocad/acadr14/dxf/index.htm - DXF_AUTOCAD_R13 = 'AC1012'; // 1994 - DXF_AUTOCAD_R11_and_R12 = 'AC1009'; // 1990 - DXF_AUTOCAD_R10 = 'AC1006'; // 1988 - DXF_AUTOCAD_R9 = 'AC1004'; - - // Group Codes for ENTITIES - DXF_ENTITIES_TYPE = 0; - DXF_ENTITIES_HANDLE = 5; - DXF_ENTITIES_LINETYPE_NAME = 6; - DXF_ENTITIES_APPLICATION_GROUP = 102; - DXF_ENTITIES_AcDbEntity = 100; - DXF_ENTITIES_MODEL_OR_PAPER_SPACE = 67; // default=0=model, 1=paper - DXF_ENTITIES_VISIBILITY = 60; // default=0 = Visible, 1 = Invisible - - // Obtained from http://www.generalcadd.com/pdf/LivingWithAutoCAD_v4.pdf - // Valid for DXF up to AutoCad 2004, after that RGB is available - AUTOCAD_COLOR_PALETTE: array[0..15] of TFPColor = - ( - (Red: $0000; Green: $0000; Blue: $0000; Alpha: alphaOpaque), // 0 - Black - (Red: $0000; Green: $0000; Blue: $8080; Alpha: alphaOpaque), // 1 - Dark blue - (Red: $0000; Green: $8080; Blue: $0000; Alpha: alphaOpaque), // 2 - Dark green - (Red: $0000; Green: $8080; Blue: $8080; Alpha: alphaOpaque), // 3 - Dark cyan - (Red: $8080; Green: $0000; Blue: $0000; Alpha: alphaOpaque), // 4 - Dark red - (Red: $8080; Green: $0000; Blue: $8080; Alpha: alphaOpaque), // 5 - Dark Magenta - (Red: $8080; Green: $8080; Blue: $0000; Alpha: alphaOpaque), // 6 - Dark - (Red: $c0c0; Green: $c0c0; Blue: $c0c0; Alpha: alphaOpaque), // 7 - Light Gray - (Red: $8080; Green: $8080; Blue: $8080; Alpha: alphaOpaque), // 8 - Medium Gray - (Red: $0000; Green: $0000; Blue: $ffff; Alpha: alphaOpaque), // 9 - Light blue - (Red: $0000; Green: $ffff; Blue: $0000; Alpha: alphaOpaque), // 10 - Light green - (Red: $0000; Green: $ffff; Blue: $ffff; Alpha: alphaOpaque), // 11 - Light cyan - (Red: $ffff; Green: $0000; Blue: $0000; Alpha: alphaOpaque), // 12 - Light red - (Red: $ffff; Green: $0000; Blue: $ffff; Alpha: alphaOpaque), // 13 - Light Magenta - (Red: $ffff; Green: $ffff; Blue: $0000; Alpha: alphaOpaque), // 14 - Light Yellow - (Red: $ffff; Green: $ffff; Blue: $ffff; Alpha: alphaOpaque) // 15 - White - ); - -{ TDXFToken } - -constructor TDXFToken.Create; -begin - inherited Create; - - Childs := TDXFTokens.Create; -end; - -destructor TDXFToken.Destroy; -begin - Childs.Free; - - inherited Destroy; -end; - -{ TDXFTokenizer } - -constructor TDXFTokenizer.Create; -begin - inherited Create; - - Tokens := TDXFTokens.Create; -end; - -destructor TDXFTokenizer.Destroy; -begin - Tokens.Free; - - inherited Destroy; -end; - -procedure TDXFTokenizer.ReadFromStrings(AStrings: TStrings); -var - i: Integer; - StrSectionGroupCode, StrSectionName: string; - IntSectionGroupCode: Integer; - CurTokenBase, NextTokenBase, SectionTokenBase: TDXFTokens; - NewToken: TDXFToken; - ParserState: Integer; -begin - // Tokens.ForEachCall(); deletecallback - Tokens.Clear; - - CurTokenBase := Tokens; - NextTokenBase := Tokens; - i := 0; - ParserState := 0; - - while i < AStrings.Count - 1 do - begin - CurTokenBase := NextTokenBase; - - // Now read and process the section name - StrSectionGroupCode := AStrings.Strings[i]; - IntSectionGroupCode := StrToInt(Trim(StrSectionGroupCode)); - StrSectionName := AStrings.Strings[i+1]; - - NewToken := TDXFToken.Create; - NewToken.GroupCode := IntSectionGroupCode; - NewToken.StrValue := StrSectionName; - - // Waiting for a section - if ParserState = 0 then - begin - if (StrSectionName = 'SECTION') then - begin - ParserState := 1; - NextTokenBase := NewToken.Childs; - end - else if (StrSectionName = 'EOF') then - begin - Exit; - end - else - begin - raise Exception.Create(Format( - 'TDXFTokenizer.ReadFromStrings: Expected SECTION, but got: %s', [StrSectionname])); - end; - end - // Processing the section name - else if ParserState = 1 then - begin - if (StrSectionName = 'HEADER') or - (StrSectionName = 'CLASSES') or - (StrSectionName = 'TABLES') or - (StrSectionName = 'BLOCKS') or - (StrSectionName = 'OBJECTS') or - (StrSectionName = 'THUMBNAILIMAGE') then - begin - ParserState := 2; - SectionTokenBase := CurTokenBase; - end - else if (StrSectionName = 'ENTITIES') then - begin - ParserState := 3; - SectionTokenBase := CurTokenBase; - end - else - begin - raise Exception.Create(Format( - 'TDXFTokenizer.ReadFromStrings: Invalid section name: %s', [StrSectionname])); - end; - end - // Reading a generic section - else if ParserState = 2 then - begin - if StrSectionName = 'ENDSEC' then - begin - ParserState := 0; - CurTokenBase := SectionTokenBase; - NextTokenBase := Tokens; - end; - end - // Reading the ENTITIES section - else if ParserState = 3 then - begin - if IsENTITIES_Subsection(StrSectionName) then - begin - CurTokenBase := SectionTokenBase; - NextTokenBase := NewToken.Childs; - end - else if StrSectionName = 'ENDSEC' then - begin - ParserState := 0; - CurTokenBase := SectionTokenBase; - NextTokenBase := Tokens; - end; - end; - - CurTokenBase.Add(NewToken); - - Inc(i, 2); - end; -end; - -function TDXFTokenizer.IsENTITIES_Subsection(AStr: string): Boolean; -begin - Result := - (AStr = '3DFACE') or - (AStr = '3DSOLID') or - (AStr = 'ACAD_PROXY_ENTITY') or - (AStr = 'ARC') or - (AStr = 'ATTDEF') or - (AStr = 'ATTRIB') or - (AStr = 'BODY') or - (AStr = 'CIRCLE') or - (AStr = 'DIMENSION') or - (AStr = 'ELLIPSE') or - (AStr = 'HATCH') or - (AStr = 'IMAGE') or - (AStr = 'INSERT') or - (AStr = 'LEADER') or - (AStr = 'LINE') or - (AStr = 'LWPOLYLINE') or - (AStr = 'MLINE') or - (AStr = 'MTEXT') or - (AStr = 'OLEFRAME') or - (AStr = 'OLE2FRAME') or - (AStr = 'POINT') or - (AStr = 'POLYLINE') or - (AStr = 'RAY') or - (AStr = 'REGION') or - (AStr = 'SEQEND') or - (AStr = 'SHAPE') or - (AStr = 'SOLID') or - (AStr = 'SPLINE') or - (AStr = 'TEXT') or - (AStr = 'TOLERANCE') or - (AStr = 'TRACE') or - (AStr = 'VERTEX') or - (AStr = 'VIEWPORT') or - (AStr = 'XLINE'); -end; - -{ TvDXFVectorialReader } - -procedure TvDXFVectorialReader.ReadHEADER(ATokens: TDXFTokens; - AData: TvVectorialPage; ADoc: TvVectorialDocument); -var - i, j: Integer; - CurToken: TDXFToken; - CurField: P3DPoint; -begin - i := 0; - while i < ATokens.Count do - begin - CurToken := TDXFToken(ATokens.Items[i]); - if CurToken.StrValue = '$ANGBASE' then - begin - CurToken := TDXFToken(ATokens.Items[i+1]); - ANGBASE := StrToFloat(CurToken.StrValue, FPointSeparator); - Inc(i); - end - else if CurToken.StrValue = '$ANGDIR' then - begin - CurToken := TDXFToken(ATokens.Items[i+1]); - ANGDIR := StrToInt(CurToken.StrValue); - Inc(i); - end - // This indicates the size of the document - else if (CurToken.StrValue = '$INSBASE') or - (CurToken.StrValue = '$EXTMIN') or (CurToken.StrValue = '$EXTMAX') or - (CurToken.StrValue = '$LIMMIN') or (CurToken.StrValue = '$LIMMAX') then - begin - if (CurToken.StrValue = '$INSBASE') then CurField := @INSBASE - else if (CurToken.StrValue = '$EXTMIN') then CurField := @EXTMIN - else if (CurToken.StrValue = '$EXTMAX') then CurField := @EXTMAX - else if (CurToken.StrValue = '$LIMMIN') then CurField := @LIMMIN - else if (CurToken.StrValue = '$LIMMAX') then CurField := @LIMMAX; - - // Check the next 2 items and verify if they are the values of the size of the document - for j := 0 to 1 do - begin - CurToken := TDXFToken(ATokens.Items[i+1]); - case CurToken.GroupCode of - 10: - begin; - CurField^.X := StrToFloat(CurToken.StrValue, FPointSeparator); - Inc(i); - end; - 20: - begin - CurField^.Y := StrToFloat(CurToken.StrValue, FPointSeparator); - Inc(i); - end; - end; - end; - end; - - Inc(i); - end; - - // After getting all the data, we can try to make some sense out of it - - // Sometimes EXTMIN comes as 10^20 and EXTMAX as -10^20, which makes no sence - // In these cases we need to ignore them. - if (EXTMIN.X > 10000000000) or (EXTMIN.X < -10000000000) - or (EXTMAX.X > 10000000000) or (EXTMAX.X < -10000000000) then - begin - DOC_OFFSET.X := 0; - DOC_OFFSET.Y := 0; - - AData.Width := LIMMAX.X; - AData.Height := LIMMAX.Y; - end - else - begin - // The size of the document seams to be given by: - // DOC_SIZE = min(EXTMAX, LIMMAX) - DOC_OFFSET; - // if EXTMIN is <> -infinite then DOC_OFFSET = EXTMIN else DOC_OFFSET = (0, 0) - // We will shift the whole document so that it has only positive coordinates and - // DOC_OFFSET will be utilized for that - - if EXTMIN.X > -100 then - begin - DOC_OFFSET.X := EXTMIN.X; - DOC_OFFSET.Y := EXTMIN.Y; - end - else FillChar(DOC_OFFSET, sizeof(T3DPoint), #0); - - AData.Width := min(EXTMAX.X, LIMMAX.X) - DOC_OFFSET.X; - AData.Height := min(EXTMAX.Y, LIMMAX.Y) - DOC_OFFSET.Y; - end; -end; - -procedure TvDXFVectorialReader.ReadENTITIES(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument); -var - i: Integer; - CurToken: TDXFToken; -begin - IsReadingPolyline := False; - - for i := 0 to ATokens.Count - 1 do - begin - CurToken := TDXFToken(ATokens.Items[i]); - if CurToken.StrValue = 'ARC' then ReadENTITIES_ARC(CurToken.Childs, AData, ADoc) - else if CurToken.StrValue = 'CIRCLE' then ReadENTITIES_CIRCLE(CurToken.Childs, AData, ADoc) - else if CurToken.StrValue = 'DIMENSION' then ReadENTITIES_DIMENSION(CurToken.Childs, AData, ADoc) - else if CurToken.StrValue = 'ELLIPSE' then ReadENTITIES_ELLIPSE(CurToken.Childs, AData, ADoc) - else if CurToken.StrValue = 'LINE' then ReadENTITIES_LINE(CurToken.Childs, AData, ADoc) - else if CurToken.StrValue = 'TEXT' then ReadENTITIES_TEXT(CurToken.Childs, AData, ADoc) - else if CurToken.StrValue = 'LWPOLYLINE' then ReadENTITIES_LWPOLYLINE(CurToken.Childs, AData, ADoc) - else if CurToken.StrValue = 'SPLINE' then ReadENTITIES_SPLINE(CurToken.Childs, AData, ADoc) - else if CurToken.StrValue = 'POINT' then ReadENTITIES_POINT(CurToken.Childs, AData, ADoc) - else if CurToken.StrValue = 'MTEXT' then ReadENTITIES_MTEXT(CurToken.Childs, AData, ADoc) - // A Polyline can have multiple child objects - else if CurToken.StrValue = 'POLYLINE' then - begin - IsReadingPolyline := True; - ReadENTITIES_POLYLINE(CurToken.Childs, AData, ADoc); - end - else if CurToken.StrValue = 'VERTEX' then ReadENTITIES_VERTEX(CurToken.Childs, AData, ADoc) - else if CurToken.StrValue = 'SEQEND' then - begin - ReadENTITIES_SEQEND(CurToken.Childs, AData, ADoc); - IsReadingPolyline := False; - end - else - begin - // ... - end; - end; -end; - -procedure TvDXFVectorialReader.ReadENTITIES_LINE(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument); -var - CurToken: TDXFToken; - i: Integer; - // LINE - LineStartX, LineStartY, LineStartZ: Double; - LineEndX, LineEndY, LineEndZ: Double; - LLineColor: TFPColor; -begin - // Initial values - LineStartX := 0; - LineStartY := 0; - LineStartZ := 0; - LineEndX := 0; - LineEndY := 0; - LineEndZ := 0; - LLineColor := colBlack; - - for i := 0 to ATokens.Count - 1 do - begin - // Now read and process the item name - CurToken := TDXFToken(ATokens.Items[i]); - - // Avoid an exception by previously checking if the conversion can be made - if CurToken.GroupCode in [10, 20, 30, 11, 21, 31, 62] then - begin - CurToken.FloatValue := StrToFloat(Trim(CurToken.StrValue), FPointSeparator); - end; - - case CurToken.GroupCode of - 10: LineStartX := CurToken.FloatValue; - 20: LineStartY := CurToken.FloatValue; - 30: LineStartZ := CurToken.FloatValue; - 11: LineEndX := CurToken.FloatValue; - 21: LineEndY := CurToken.FloatValue; - 31: LineEndZ := CurToken.FloatValue; - 62: LLineColor := DXFColorIndexToFPColor(Trunc(CurToken.FloatValue)); - end; - end; - - // Position fixing for documents with negative coordinates - LineStartX := LineStartX - DOC_OFFSET.X; - LineStartY := LineStartY - DOC_OFFSET.Y; - LineEndX := LineEndX - DOC_OFFSET.X; - LineEndY := LineEndY - DOC_OFFSET.Y; - - // And now write it - {$ifdef FPVECTORIALDEBUG} - // WriteLn(Format('Adding Line from %f,%f to %f,%f', [LineStartX, LineStartY, LineEndX, LineEndY])); - {$endif} - AData.StartPath(LineStartX, LineStartY); - AData.AddLineToPath(LineEndX, LineEndY, LLineColor); - AData.EndPath(); -end; - -{ -Arcs are always counter-clockwise in DXF - -100 Subclass marker (AcDbCircle) -39 Thickness (optional; default = 0) -10 Center point (in OCS) DXF: X value; APP: 3D point -20, 30 DXF: Y and Z values of center point (in OCS) -40 Radius -100 Subclass marker (AcDbArc) -50 Start angle (degrees) -51 End angle (degrees) -210 Extrusion direction. (optional; default = 0, 0, 1) DXF: X value; APP: 3D vector -220, 230 DXF: Y and Z values of extrusion direction (optional) -} -procedure TvDXFVectorialReader.ReadENTITIES_ARC(ATokens: TDXFTokens; - AData: TvVectorialPage; ADoc: TvVectorialDocument); -var - CurToken: TDXFToken; - i: Integer; - CenterX, CenterY, CenterZ, Radius, StartAngle, EndAngle: Double; - LColor: TFPColor; -begin - CenterX := 0.0; - CenterY := 0.0; - CenterZ := 0.0; - Radius := 0.0; - StartAngle := 0.0; - EndAngle := 0.0; - LColor := colBlack; - - for i := 0 to ATokens.Count - 1 do - begin - // Now read and process the item name - CurToken := TDXFToken(ATokens.Items[i]); - - // Avoid an exception by previously checking if the conversion can be made - if CurToken.GroupCode in [10, 20, 30, 40, 50, 51, 62] then - begin - CurToken.FloatValue := StrToFloat(Trim(CurToken.StrValue), FPointSeparator); - end; - - case CurToken.GroupCode of - 10: CenterX := CurToken.FloatValue; - 20: CenterY := CurToken.FloatValue; - 30: CenterZ := CurToken.FloatValue; - 40: Radius := CurToken.FloatValue; - 50: StartAngle := CurToken.FloatValue; - 51: EndAngle := CurToken.FloatValue; - 62: LColor := DXFColorIndexToFPColor(Trunc(CurToken.FloatValue)); - end; - end; - - // In DXF the EndAngle is always greater then the StartAngle. - // If it isn't then sum 360 to it to make sure we don't get wrong results - if EndAngle < StartAngle then EndAngle := EndAngle + 360; - - // Position fixing for documents with negative coordinates - CenterX := CenterX - DOC_OFFSET.X; - CenterY := CenterY - DOC_OFFSET.Y; - - {$ifdef FPVECTORIALDEBUG} - WriteLn(Format('Adding Arc Center=%f,%f Radius=%f StartAngle=%f EndAngle=%f', - [CenterX, CenterY, Radius, StartAngle, EndAngle])); - {$endif} - AData.AddCircularArc(CenterX, CenterY, Radius, StartAngle, EndAngle, LColor); -end; - -{ -Group codes Description -100 Subclass marker (AcDbCircle) -39 Thickness (optional; default = 0) -10 Center point (in OCS) DXF: X value; APP: 3D point -20, 30 DXF: Y and Z values of center point (in OCS) -40 Radius -210 Extrusion direction (optional; default = 0, 0, 1) DXF: X value; APP: 3D vector -220, 230 DXF: Y and Z values of extrusion direction (optional) -} -procedure TvDXFVectorialReader.ReadENTITIES_CIRCLE(ATokens: TDXFTokens; - AData: TvVectorialPage; ADoc: TvVectorialDocument); -var - CurToken: TDXFToken; - i: Integer; - CircleCenterX, CircleCenterY, CircleCenterZ, CircleRadius: Double; -begin - CircleCenterX := 0.0; - CircleCenterY := 0.0; - CircleCenterZ := 0.0; - CircleRadius := 0.0; - - for i := 0 to ATokens.Count - 1 do - begin - // Now read and process the item name - CurToken := TDXFToken(ATokens.Items[i]); - - // Avoid an exception by previously checking if the conversion can be made - if CurToken.GroupCode in [10, 20, 30, 40] then - begin - CurToken.FloatValue := StrToFloat(Trim(CurToken.StrValue), FPointSeparator); - end; - - case CurToken.GroupCode of - 10: CircleCenterX := CurToken.FloatValue; - 20: CircleCenterY := CurToken.FloatValue; - 30: CircleCenterZ := CurToken.FloatValue; - 40: CircleRadius := CurToken.FloatValue; - end; - end; - - // Position fixing for documents with negative coordinates - CircleCenterX := CircleCenterX - DOC_OFFSET.X; - CircleCenterY := CircleCenterY - DOC_OFFSET.Y; - - AData.AddCircle(CircleCenterX, CircleCenterY, CircleRadius); -end; - -{ -Group codes Description -100 Subclass marker (AcDbDimension) -2 Name of the block that contains the entities that make up the dimension picture -10 Definition point (in WCS) DXF: X value; APP: 3D point -20, 30 DXF: Y and Z values of definition point (in WCS) -11 Middle point of dimension text (in OCS) DXF: X value; APP: 3D point -21, 31 DXF: Y and Z values of middle point of dimension text (in OCS) -70 Dimension type. - Values 0-6 are integer values that represent the dimension type. - Values 32, 64, and 128 are bit values, which are added to the integer values - (value 32 is always set in R13 and later releases). - 0 = Rotated, horizontal, or vertical; 1 = Aligned; - 2 = Angular; 3 = Diameter; 4 = Radius; - 5 = Angular 3 point; 6 = Ordinate; - 32 = Indicates that the block reference (group code 2) is referenced by this dimension only. - 64 = Ordinate type. This is a bit value (bit 7) used only with integer value 6. - If set, ordinate is X-type; if not set, ordinate is Y-type. - 128 = This is a bit value (bit 8) added to the other group 70 values - if the dimension text has been positioned at a user-defined location - rather than at the default location. -71 Attachment point: - 1 = Top left; 2 = Top center; 3 = Top right; - 4 = Middle left; 5 = Middle center; 6 = Middle right; - 7 = Bottom left; 8 = Bottom center; 9 = Bottom right -72 Dimension text line spacing style (optional): - 1(or missing) = At least (taller characters will override) - 2 = Exact (taller characters will not override) -41 Dimension text line spacing factor (optional): - Percentage of default (3-on-5) line spacing to be applied. Valid values range from 0.25 to 4.00. -42 Actual measurement (optional; read-only value) -1 Dimension text explicitly entered by the user. Optional; default is the measurement. - If null or "<>", the dimension measurement is drawn as the text, - if " " (one blank space), the text is suppressed. Anything else is drawn as the text. -53 The optional group code 53 is the rotation angle of the dimension - text away from its default orientation (the direction of the dimension line) (optional). -51 All dimension types have an optional 51 group code, which indicates the - horizontal direction for the dimension entity. The dimension entity determines - the orientation of dimension text and lines for horizontal, vertical, and - rotated linear dimensions. - This group value is the negative of the angle between the OCS X axis - and the UCS X axis. It is always in the XY plane of the OCS. -210 Extrusion direction (optional; default = 0, 0, 1) DXF: X value; APP: 3D vector -220, 230 DXF: Y and Z values of extrusion direction (optional) -3 Dimension style name - -Aligned Dimension Group Codes - -100 Subclass marker (AcDbAlignedDimension) -12 Insertion point for clones of a dimension-Baseline and Continue (in OCS) DXF: X value; APP: 3D point -22, 32 DXF: Y and Z values of insertion point for clones of a dimension-Baseline and Continue (in OCS) -13 Definition point for linear and angular dimensions (in WCS) DXF: X value; APP: 3D point -23, 33 DXF: Y and Z values of definition point for linear and angular dimensions (in WCS) -14 Definition point for linear and angular dimensions (in WCS) DXF: X value; APP: 3D point -24, 34 DXF: Y and Z values of definition point for linear and angular dimensions (in WCS) - - |--text--|->10,20 - | | - | | - X->14,24 X->13,23 -} -procedure TvDXFVectorialReader.ReadENTITIES_DIMENSION(ATokens: TDXFTokens; - AData: TvVectorialPage; ADoc: TvVectorialDocument); -var - CurToken: TDXFToken; - i: Integer; - // DIMENSION - BaseLeft, BaseRight, DimensionRight, DimensionLeft, TmpPoint: T3DPoint; - IsAlignedDimension: Boolean = False; -begin - // Initial values - BaseLeft.X := 0; - BaseLeft.Y := 0; - BaseRight.X := 0; - BaseRight.X := 0; - DimensionRight.X := 0; - DimensionRight.Y := 0; - DimensionLeft.X := 0; - DimensionLeft.Y := 0; - - for i := 0 to ATokens.Count - 1 do - begin - // Now read and process the item name - CurToken := TDXFToken(ATokens.Items[i]); - - // Avoid an exception by previously checking if the conversion can be made - if CurToken.GroupCode in [10, 20, 30, 11, 21, 31, 13, 23, 33, 14, 24, 34] then - begin - CurToken.FloatValue := StrToFloat(Trim(CurToken.StrValue), FPointSeparator); - end; - - case CurToken.GroupCode of - 10: DimensionRight.X := CurToken.FloatValue; - 20: DimensionRight.Y := CurToken.FloatValue; - 30: DimensionRight.Z := CurToken.FloatValue; - 13: BaseRight.X := CurToken.FloatValue; - 23: BaseRight.Y := CurToken.FloatValue; - 33: BaseRight.Z := CurToken.FloatValue; - 14: BaseLeft.X := CurToken.FloatValue; - 24: BaseLeft.Y := CurToken.FloatValue; - 34: BaseLeft.Z := CurToken.FloatValue; - 100: - begin - if CurToken.StrValue = 'AcDbAlignedDimension' then IsAlignedDimension := True; - end; - end; - end; - - // And now write it - {$ifdef FPVECTORIALDEBUG} -// WriteLn(Format('Adding Line from %f,%f to %f,%f', [LineStartX, LineStartY, LineEndX, LineEndY])); - {$endif} - if IsAlignedDimension then - begin - // Now make sure that we actually that BaseLeft is to the left of BaseRight - if BaseRight.X < BaseLeft.X then - begin - TmpPoint := BaseRight; - BaseRight := BaseLeft; - BaseLeft := TmpPoint; - end; - - // Now check if we are a horizontal or vertical dimension - - // horizontal - // - //DL____ DR - // | | - // | | - // BL BR - if DimensionRight.X = BaseRight.X then - begin - DimensionLeft.X := BaseLeft.X; - DimensionLeft.Y := DimensionRight.Y; - end - // vertical - // - // BL ----|DR - // BR --|DL - // - // In this case we invert then DR and DL - else if DimensionRight.Y = BaseLeft.Y then - begin - DimensionLeft := DimensionRight; - DimensionRight.Y := BaseRight.Y; - end - // vertical - // - // BL ----|DL - // BR --|DR - // - else if DimensionRight.Y = BaseRight.Y then - begin - DimensionLeft.X := DimensionRight.X; - DimensionLeft.Y := BaseLeft.Y; - end; - - AData.AddAlignedDimension(BaseLeft, BaseRight, DimensionLeft, DimensionRight); - end; -end; - -{ -100 Subclass marker (AcDbEllipse) -10 Center point (in WCS) DXF: X value; APP: 3D point -20, 30 DXF: Y and Z values of center point (in WCS) -11 Endpoint of major axis, relative to the center (in WCS) DXF: X value; APP: 3D point -21, 31 DXF: Y and Z values of endpoint of major axis, relative to the center (in WCS) -210 Extrusion direction (optional; default = 0, 0, 1) DXF: X value; APP: 3D vector -220, 230 DXF: Y and Z values of extrusion direction (optional) -40 Ratio of minor axis to major axis -41 Start parameter (this value is 0.0 for a full ellipse) -42 End parameter (this value is 2pi for a full ellipse) -} -procedure TvDXFVectorialReader.ReadENTITIES_ELLIPSE(ATokens: TDXFTokens; - AData: TvVectorialPage; ADoc: TvVectorialDocument); -var - CurToken: TDXFToken; - i: Integer; - CenterX, CenterY, CenterZ, MajorHalfAxis, MinorHalfAxis, Angle: Double; -begin - for i := 0 to ATokens.Count - 1 do - begin - // Now read and process the item name - CurToken := TDXFToken(ATokens.Items[i]); - - // Avoid an exception by previously checking if the conversion can be made - if CurToken.GroupCode in [10, 20, 30] then - begin - CurToken.FloatValue := StrToFloat(Trim(CurToken.StrValue), FPointSeparator); - end; - - case CurToken.GroupCode of - 10: CenterX := CurToken.FloatValue; - 20: CenterY := CurToken.FloatValue; - 30: CenterZ := CurToken.FloatValue; - end; - end; - - // Position fixing for documents with negative coordinates - CenterX := CenterX - DOC_OFFSET.X; - CenterY := CenterY - DOC_OFFSET.Y; - - // - AData.AddEllipse(CenterX, CenterY, MajorHalfAxis, MinorHalfAxis, Angle); -end; - -{ -100 Subclass marker (AcDbText) -39 Thickness (optional; default = 0) -10 First alignment point (in OCS) DXF: X value; APP: 3D point -20, 30 DXF: Y and Z values of first alignment point (in OCS) -40 Text height -1 Default value (the string itself) -50 Text rotation (optional; default = 0) -41 Relative X scale factor-width (optional; default = 1) - This value is also adjusted when fit-type text is used. -51 Oblique angle (optional; default = 0) -7 Text style name (optional, default = STANDARD) -71 Text generation flags (optional, default = 0): - 2 = Text is backward (mirrored in X). - 4 = Text is upside down (mirrored in Y). -72 Horizontal text justification type (optional, default = 0) integer codes (not bit-coded) - 0 = Left; 1= Center; 2 = Right - 3 = Aligned (if vertical alignment = 0) - 4 = Middle (if vertical alignment = 0) - 5 = Fit (if vertical alignment = 0) - See the Group 72 and 73 integer codes table for clarification. -11 Second alignment point (in OCS) (optional) - DXF: X value; APP: 3D point - This value is meaningful only if the value of a 72 or 73 group is nonzero (if the justification is anything other than baseline/left). -21, 31 DXF: Y and Z values of second alignment point (in OCS) (optional) -210 Extrusion direction (optional; default = 0, 0, 1) - DXF: X value; APP: 3D vector -220, 230 DXF: Y and Z values of extrusion direction (optional) -73 Vertical text justification type (optional, default = 0): integer codes (not bit- coded): - 0 = Baseline; 1 = Bottom; 2 = Middle; 3 = Top - See the Group 72 and 73 integer codes table for clarification. -} -procedure TvDXFVectorialReader.ReadENTITIES_TEXT(ATokens: TDXFTokens; - AData: TvVectorialPage; ADoc: TvVectorialDocument); -var - CurToken: TDXFToken; - i: Integer; - PosX: Double = 0.0; - PosY: Double = 0.0; - PosZ: Double = 0.0; - FontSize: Double = 10.0; - Str: string = ''; -begin - for i := 0 to ATokens.Count - 1 do - begin - // Now read and process the item name - CurToken := TDXFToken(ATokens.Items[i]); - - // Avoid an exception by previously checking if the conversion can be made - if CurToken.GroupCode in [10, 20, 30, 40] then - begin - CurToken.FloatValue := StrToFloat(Trim(CurToken.StrValue), FPointSeparator); - end; - - case CurToken.GroupCode of - 1: Str := CurToken.StrValue; - 10: PosX := CurToken.FloatValue; - 20: PosY := CurToken.FloatValue; - 30: PosZ := CurToken.FloatValue; - 40: FontSize := CurToken.FloatValue; - end; - end; - - // Position fixing for documents with negative coordinates - PosX := PosX - DOC_OFFSET.X; - PosY := PosY - DOC_OFFSET.Y; - - // - AData.AddText(PosX, PosY, '', Round(FontSize), Str); -end; - -{.$define FPVECTORIALDEBUG_LWPOLYLINE} -procedure TvDXFVectorialReader.ReadENTITIES_LWPOLYLINE(ATokens: TDXFTokens; - AData: TvVectorialPage; ADoc: TvVectorialDocument); -var - CurToken: TDXFToken; - i, curPoint: Integer; - // LINE - LWPolyline: array of TLWPOLYLINEElement; -begin - curPoint := -1; - - for i := 0 to ATokens.Count - 1 do - begin - // Now read and process the item name - CurToken := TDXFToken(ATokens.Items[i]); - - // Avoid an exception by previously checking if the conversion can be made - if CurToken.GroupCode in [10, 20, 30, 11, 21, 31] then - begin - CurToken.FloatValue := StrToFloat(Trim(CurToken.StrValue), FPointSeparator); - end; - - // Loads the coordinates - // With Position fixing for documents with negative coordinates - case CurToken.GroupCode of - 10: - begin - // Starting a new point - Inc(curPoint); - SetLength(LWPolyline, curPoint+1); - - LWPolyline[curPoint].X := CurToken.FloatValue - DOC_OFFSET.X; - end; - 20: LWPolyline[curPoint].Y := CurToken.FloatValue - DOC_OFFSET.Y; - end; - end; - - // And now write it - if curPoint >= 0 then // otherwise the polyline is empty of points - begin - AData.StartPath(LWPolyline[0].X, LWPolyline[0].Y); - {$ifdef FPVECTORIALDEBUG_LWPOLYLINE} - Write(Format('LWPOLYLINE ID=%d %f,%f', [AData.PathCount-1, LWPolyline[0].X, LWPolyline[0].Y])); - {$endif} - for i := 1 to curPoint do - begin - AData.AddLineToPath(LWPolyline[i].X, LWPolyline[i].Y); - {$ifdef FPVECTORIALDEBUG_LWPOLYLINE} - Write(Format(' %f,%f', [LWPolyline[i].X, LWPolyline[i].Y])); - {$endif} - end; - {$ifdef FPVECTORIALDEBUG_LWPOLYLINE} - WriteLn(''); - {$endif} - AData.EndPath(); - end; -end; - -{.$define FPVECTORIALDEBUG_SPLINE} -procedure TvDXFVectorialReader.ReadENTITIES_SPLINE(ATokens: TDXFTokens; - AData: TvVectorialPage; ADoc: TvVectorialDocument); -var - CurToken: TDXFToken; - i, curPoint: Integer; - // LINE - SPLine: array of TSPLineElement; -begin - curPoint := -1; - - for i := 0 to ATokens.Count - 1 do - begin - // Now read and process the item name - CurToken := TDXFToken(ATokens.Items[i]); - - // Avoid an exception by previously checking if the conversion can be made - if CurToken.GroupCode in [10, 20, 30, 11, 21, 31] then - begin - CurToken.FloatValue := StrToFloat(Trim(CurToken.StrValue), FPointSeparator); - end; - - // Loads the coordinates - // With Position fixing for documents with negative coordinates - case CurToken.GroupCode of - 10: - begin - // Starting a new point - Inc(curPoint); - SetLength(SPLine, curPoint+1); - - SPLine[curPoint].X := CurToken.FloatValue - DOC_OFFSET.X; - end; - 20: SPLine[curPoint].Y := CurToken.FloatValue - DOC_OFFSET.Y; - end; - end; - - // And now write it - if curPoint >= 0 then // otherwise the polyline is empty of points - begin - AData.StartPath(SPLine[0].X, SPLine[0].Y); - {$ifdef FPVECTORIALDEBUG_SPLINE} - Write(Format('SPLINE ID=%d %f,%f', [AData.PathCount-1, SPLine[0].X, SPLine[0].Y])); - {$endif} - for i := 1 to curPoint do - begin - AData.AddLineToPath(SPLine[i].X, SPLine[i].Y); - {$ifdef FPVECTORIALDEBUG_SPLINE} - Write(Format(' %f,%f', [SPLine[i].X, SPLine[i].Y])); - {$endif} - end; - {$ifdef FPVECTORIALDEBUG_SPLINE} - WriteLn(''); - {$endif} - AData.EndPath(); - end; -end; - -procedure TvDXFVectorialReader.ReadENTITIES_POLYLINE(ATokens: TDXFTokens; - AData: TvVectorialPage; ADoc: TvVectorialDocument); -begin - SetLength(Polyline, 0); -end; - -procedure TvDXFVectorialReader.ReadENTITIES_VERTEX(ATokens: TDXFTokens; - AData: TvVectorialPage; ADoc: TvVectorialDocument); -var - CurToken: TDXFToken; - i, curPoint: Integer; -begin - if not IsReadingPolyline then raise Exception.Create('[TvDXFVectorialReader.ReadENTITIES_VERTEX] Unexpected record: VERTEX before a POLYLINE'); - - curPoint := Length(Polyline); - SetLength(Polyline, curPoint+1); - Polyline[curPoint].X := 0; - Polyline[curPoint].Y := 0; - Polyline[curPoint].Color := colBlack; - - for i := 0 to ATokens.Count - 1 do - begin - // Now read and process the item name - CurToken := TDXFToken(ATokens.Items[i]); - - // Avoid an exception by previously checking if the conversion can be made - if CurToken.GroupCode in [10, 20, 30, 62] then - begin - CurToken.FloatValue := StrToFloat(Trim(CurToken.StrValue), FPointSeparator); - end; - - // Loads the coordinates - // With Position fixing for documents with negative coordinates - case CurToken.GroupCode of - 10: Polyline[curPoint].X := CurToken.FloatValue - DOC_OFFSET.X; - 20: Polyline[curPoint].Y := CurToken.FloatValue - DOC_OFFSET.Y; - 62: Polyline[curPoint].Color := DXFColorIndexToFPColor(Trunc(CurToken.FloatValue)); - end; - end; -end; - -{$define FPVECTORIALDEBUG_POLYLINE} -procedure TvDXFVectorialReader.ReadENTITIES_SEQEND(ATokens: TDXFTokens; - AData: TvVectorialPage; ADoc: TvVectorialDocument); -var - i: Integer; -begin - if not IsReadingPolyline then raise Exception.Create('[TvDXFVectorialReader.ReadENTITIES_SEQEND] Unexpected record: SEQEND before a POLYLINE'); - - // Write the Polyline to the document - if Length(Polyline) >= 0 then // otherwise the polyline is empty of points - begin - AData.StartPath(Polyline[0].X, Polyline[0].Y); - {$ifdef FPVECTORIALDEBUG_POLYLINE} - Write(Format('POLYLINE %f,%f', [Polyline[0].X, Polyline[0].Y])); - {$endif} - for i := 1 to Length(Polyline)-1 do - begin - AData.AddLineToPath(Polyline[i].X, Polyline[i].Y, Polyline[i].Color); - {$ifdef FPVECTORIALDEBUG_POLYLINE} - Write(Format(' %f,%f', [Polyline[i].X, Polyline[i].Y])); - {$endif} - end; - {$ifdef FPVECTORIALDEBUG_POLYLINE} - WriteLn(''); - {$endif} - AData.EndPath(); - end; -end; - -procedure TvDXFVectorialReader.ReadENTITIES_MTEXT(ATokens: TDXFTokens; - AData: TvVectorialPage; ADoc: TvVectorialDocument); -var - CurToken: TDXFToken; - i: Integer; - PosX: Double = 0.0; - PosY: Double = 0.0; - PosZ: Double = 0.0; - FontSize: Double = 10.0; - Str: string = ''; -begin - for i := 0 to ATokens.Count - 1 do - begin - // Now read and process the item name - CurToken := TDXFToken(ATokens.Items[i]); - - // Avoid an exception by previously checking if the conversion can be made - if CurToken.GroupCode in [10, 20, 30, 40] then - begin - CurToken.FloatValue := StrToFloat(Trim(CurToken.StrValue), FPointSeparator); - end; - - case CurToken.GroupCode of - 1: Str := CurToken.StrValue; - 10: PosX := CurToken.FloatValue; - 20: PosY := CurToken.FloatValue; - 30: PosZ := CurToken.FloatValue; - 40: FontSize := CurToken.FloatValue; - end; - end; - - // Position fixing for documents with negative coordinates - PosX := PosX - DOC_OFFSET.X; - PosY := PosY - DOC_OFFSET.Y; - - // - AData.AddText(PosX, PosY, '', Round(FontSize), Str); -end; - -procedure TvDXFVectorialReader.ReadENTITIES_POINT(ATokens: TDXFTokens; - AData: TvVectorialPage; ADoc: TvVectorialDocument); -var - CurToken: TDXFToken; - i: Integer; - CircleCenterX, CircleCenterY, CircleCenterZ, CircleRadius: Double; -begin - CircleCenterX := 0.0; - CircleCenterY := 0.0; - CircleCenterZ := 0.0; - CircleRadius := 1.0; - - for i := 0 to ATokens.Count - 1 do - begin - // Now read and process the item name - CurToken := TDXFToken(ATokens.Items[i]); - - // Avoid an exception by previously checking if the conversion can be made - if CurToken.GroupCode in [10, 20, 30, 40] then - begin - CurToken.FloatValue := StrToFloat(Trim(CurToken.StrValue), FPointSeparator); - end; - - case CurToken.GroupCode of - 10: CircleCenterX := CurToken.FloatValue; - 20: CircleCenterY := CurToken.FloatValue; - 30: CircleCenterZ := CurToken.FloatValue; -// 40: CircleRadius := CurToken.FloatValue; - end; - end; - - // Position fixing for documents with negative coordinates - CircleCenterX := CircleCenterX - DOC_OFFSET.X; - CircleCenterY := CircleCenterY - DOC_OFFSET.Y; - - AData.AddCircle(CircleCenterX, CircleCenterY, CircleRadius); -end; - -function TvDXFVectorialReader.GetCoordinateValue(AStr: shortstring): Double; -begin - Result := 0.0; - -{ if Length(AStr) <= 1 then Exit; - - Result := StrToFloat(Copy(AStr, 2, Length(AStr) - 1));} -end; - -function TvDXFVectorialReader.DXFColorIndexToFPColor(AColorIndex: Integer): TFPColor; -begin - if (AColorIndex >= 0) and (AColorIndex <= 15) then - Result := AUTOCAD_COLOR_PALETTE[AColorIndex] - else - raise Exception.Create(Format('[TvDXFVectorialReader.DXFColorIndexToFPVColor] Invalid DXF Color Index: %d', [AColorIndex])); -end; - -constructor TvDXFVectorialReader.Create; -begin - inherited Create; - - FPointSeparator := DefaultFormatSettings; - FPointSeparator.DecimalSeparator := '.'; - FPointSeparator.ThousandSeparator := '#';// disable the thousand separator - - // Default HEADER data - ANGBASE := 0.0; // Starts pointing to the right / east - ANGDIR := 0; // counter-clock wise - - Tokenizer := TDXFTokenizer.Create; -end; - -destructor TvDXFVectorialReader.Destroy; -begin - Tokenizer.Free; - - inherited Destroy; -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 TvDXFVectorialReader.ReadFromStrings(AStrings: TStrings; - AData: TvVectorialDocument); -var - i: Integer; - CurToken, CurTokenFirstChild: TDXFToken; - lPage: TvVectorialPage; -begin - Tokenizer.ReadFromStrings(AStrings); - - lPage := AData.AddPage(); - - for i := 0 to Tokenizer.Tokens.Count - 1 do - begin - CurToken := TDXFToken(Tokenizer.Tokens.Items[i]); - CurTokenFirstChild := TDXFToken(CurToken.Childs.Items[0]); - - if CurTokenFirstChild.StrValue = 'HEADER' then - ReadHEADER(CurToken.Childs, lPage, AData) - else if CurTokenFirstChild.StrValue = 'ENTITIES' then - ReadENTITIES(CurToken.Childs, lPage, AData); - end; -end; - -initialization - - RegisterVectorialReader(TvDXFVectorialReader, vfDXF); - -end. - diff --git a/applications/fpvviewer/fpvectorialsrc/epsvectorialreader.pas b/applications/fpvviewer/fpvectorialsrc/epsvectorialreader.pas deleted file mode 100644 index 21b775d64..000000000 --- a/applications/fpvviewer/fpvectorialsrc/epsvectorialreader.pas +++ /dev/null @@ -1,2301 +0,0 @@ -{ -Reads EPS files - -License: The same modified LGPL as the Free Pascal RTL - See the file COPYING.modifiedLGPL for more details - -AUTHORS: Felipe Monteiro de Carvalho - -Documentation: http://www.tailrecursive.org/postscript/postscript.html - -Good reference: http://atrey.karlin.mff.cuni.cz/~milanek/PostScript/Reference/PSL2e.html -} -unit epsvectorialreader; - -{$mode objfpc}{$H+} - -{.$define FPVECTORIALDEBUG_PATHS} -{.$define FPVECTORIALDEBUG_COLORS} -{.$define FPVECTORIALDEBUG_ROLL} -{.$define FPVECTORIALDEBUG_CODEFLOW} -{.$define FPVECTORIALDEBUG_INDEX} -{.$define FPVECTORIALDEBUG_DICTIONARY} -{.$define FPVECTORIALDEBUG_CONTROL} -{.$define FPVECTORIALDEBUG_ARITHMETIC} -{.$define FPVECTORIALDEBUG_CLIP_REGION} - -interface - -uses - Classes, SysUtils, Math, contnrs, - fpimage, fpcanvas, - fpvectorial, fpvutils; - -type - TPSTokenType = (ttComment, ttFloat); - - TPSTokens = TFPList;// TPSToken; - - TPSToken = class - StrValue: string; - FloatValue: double; - IntValue: Integer; - BoolValue: Boolean; - Line: Integer; // To help debugging - function Duplicate: TPSToken; virtual; - end; - - TCommentToken = class(TPSToken) - end; - - { TProcedureToken } - - TProcedureToken = class(TPSToken) - Levels: Integer; // Used to count groups inside groups and find the end of a top-level group - Childs: TPSTokens; - Parsed: Boolean; - constructor Create; - destructor Destroy; override; - end; - - TETType = (ettNamedElement, ettOperand, ettOperator, ettDictionary); - - { TExpressionToken } - - TExpressionToken = class(TPSToken) - public - ETType: TETType; - function IsExpressionOperand: Boolean; - procedure PrepareFloatValue; - function Duplicate: TPSToken; override; - end; - - TPostScriptScannerState = (ssSearchingToken, ssInComment, ssInDefinition, ssInGroup, ssInExpressionElement); - - { TGraphicState } - - TGraphicState = class - public - Color: TFPColor; - TranslateX, TranslateY: Double; - ScaleX, ScaleY: Double; // not used currently - ClipPath: TPath; - ClipMode: TvClipMode; - OverPrint: Boolean; // not used currently - // - PenWidth: Integer; - // - function Duplicate: TGraphicState; - end; - - { TPSTokenizer } - - TPSTokenizer = class - public - Tokens: TPSTokens; - FCurLine: Integer; - constructor Create(ACurLine: Integer = -1); - destructor Destroy; override; - procedure ReadFromStream(AStream: TStream); - procedure DebugOut(); - function IsValidPostScriptChar(AChar: Byte): Boolean; - function IsPostScriptSpace(AChar: Byte): Boolean; - function IsEndOfLine(ACurChar: Byte; AStream: TStream): Boolean; - end; - - { TvEPSVectorialReader } - - TvEPSVectorialReader = class(TvCustomVectorialReader) - private - Stack: TObjectStack; - GraphicStateStack: TObjectStack; // TGraphicState - Dictionary: TStringList; - ExitCalled: Boolean; - CurrentGraphicState: TGraphicState; - // - procedure DebugStack(); - // - procedure RunPostScript(ATokens: TPsTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument); - // - procedure ExecuteProcedureToken(AToken: TProcedureToken; AData: TvVectorialPage; ADoc: TvVectorialDocument); - procedure ExecuteOperatorToken(AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument); - function ExecuteArithmeticAndMathOperator(AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean; - function ExecutePathConstructionOperator(AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean; - function ExecuteGraphicStateOperatorsDI(AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean; - function ExecuteGraphicStateOperatorsDD(AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean; - function ExecuteDictionaryOperators(AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean; - function ExecuteMiscellaneousOperators(AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean; - function ExecuteStackManipulationOperator(AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean; - function ExecuteControlOperator(AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean; - function ExecutePaintingOperator(AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean; - function ExecuteDeviceSetupAndOutputOperator(AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean; - function ExecuteArrayOperator(AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean; - function ExecuteStringOperator(AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean; - // - procedure PostScriptCoordsToFPVectorialCoords(AParam1, AParam2: TPSToken; var APosX, APosY: Double); - function DictionarySubstituteOperator(ADictionary: TStringList; var ACurToken: TPSToken): Boolean; - public - { General reading methods } - Tokenizer: TPSTokenizer; - constructor Create; override; - Destructor Destroy; override; - procedure ReadFromStream(AStream: TStream; AData: TvVectorialDocument); override; - end; - -implementation - -type - TStackAccess = class(TObjectStack) - end; - -var - FPointSeparator: TFormatSettings; - -{ TGraphicState } - -function TGraphicState.Duplicate: TGraphicState; -begin - Result := TGraphicState(Self.ClassType.Create); - Result.Color := Color; - Result.TranslateX := TranslateX; - Result.TranslateY := TranslateY; - Result.ScaleX := ScaleX; - Result.ScaleY := ScaleY; - Result.ClipPath := ClipPath; - Result.ClipMode := ClipMode; - Result.OverPrint := OverPrint; - Result.PenWidth := PenWidth; -end; - -{ TPSToken } - -function TPSToken.Duplicate: TPSToken; -begin - Result := TPSToken(Self.ClassType.Create); - Result.StrValue := StrValue; - Result.FloatValue := FloatValue; - Result.IntValue := IntValue; - Result.Line := Line; -end; - -{ TProcedureToken } - -constructor TProcedureToken.Create; -begin - inherited Create; - - Childs := TPSTokens.Create; -end; - -destructor TProcedureToken.Destroy; -begin - Childs.Free; - - inherited Destroy; -end; - -{ TExpressionToken } - -function TExpressionToken.IsExpressionOperand: Boolean; -begin - if StrValue = '' then Exit(False); - Result := StrValue[1] in ['0'..'9','-']; -end; - -procedure TExpressionToken.PrepareFloatValue; -begin - //if not IsExpressionOperand() then Exit; - if ETType <> ettOperand then Exit; // faster, because this field should already be filled - - FloatValue := StrToFloat(StrValue, FPointSeparator); -end; - -function TExpressionToken.Duplicate: TPSToken; -begin - Result:=inherited Duplicate; - TExpressionToken(Result).ETType := ETType; -end; - -{$DEFINE FPVECTORIALDEBUG} - -{ TPSTokenizer } - -// ACurLine < 0 indicates that we should use the line of this list of strings -// else we use ACurLine -constructor TPSTokenizer.Create(ACurLine: Integer); -begin - inherited Create; - Tokens := TPSTokens.Create; - FCurLine := ACurLine; -end; - -destructor TPSTokenizer.Destroy; -begin - Tokens.Free; - inherited Destroy; -end; - -{@@ Rules for parsing PostScript files: - -* Coments go from the first occurence of % outside a line to the next new line -* The only accepted characters are printable ASCII ones, plus spacing ASCII chars - See IsValidPostScriptChar about that -} -procedure TPSTokenizer.ReadFromStream(AStream: TStream); -var - i: Integer; - CurChar: Char; - CurLine: Integer = 1; - State: TPostScriptScannerState = ssSearchingToken; - CommentToken: TCommentToken; - ProcedureToken: TProcedureToken; - ExpressionToken: TExpressionToken; - Len: Integer; - lIsEndOfLine: Boolean; -begin - while AStream.Position < AStream.Size do - begin - CurChar := Char(AStream.ReadByte()); -// {$ifdef FPVECTORIALDEBUG} -// WriteLn(Format('Obtained token %s', [CurChar])); -// {$endif} - if not IsValidPostScriptChar(Byte(CurChar)) then - raise Exception.Create('[TPSTokenizer.ReadFromStream] Invalid char: ' + IntToHex(Byte(CurChar), 2)); - - lIsEndOfLine := IsEndOfLine(Byte(CurChar), AStream); - if lIsEndOfLine then Inc(CurLine); - if FCurLine >= 0 then CurLine := FCurLine; - - case State of - { Searching for a token } - ssSearchingToken: - begin - if CurChar = '%' then - begin - CommentToken := TCommentToken.Create; - CommentToken.Line := CurLine; - State := ssInComment; -// {$ifdef FPVECTORIALDEBUG} -// WriteLn(Format('Starting Comment at Line %d', [CurLine])); -// {$endif} - end - else if CurChar = '{' then - begin - ProcedureToken := TProcedureToken.Create; - ProcedureToken.Levels := 1; - ProcedureToken.Line := CurLine; - State := ssInGroup; - end - else if CurChar in ['a'..'z','A'..'Z','0'..'9','-','/'] then - begin - ExpressionToken := TExpressionToken.Create; - ExpressionToken.Line := CurLine; - ExpressionToken.StrValue := ''; - if CurChar = '/' then - ExpressionToken.ETType := ettNamedElement - else - begin - ExpressionToken.StrValue := CurChar; - if ExpressionToken.IsExpressionOperand() then - ExpressionToken.ETType := ettOperand - else - ExpressionToken.ETType := ettOperator; - end; - State := ssInExpressionElement; - end - else if lIsEndOfLine then Continue - else if IsPostScriptSpace(Byte(CurChar)) then Continue - else - raise Exception.Create(Format('[TPSTokenizer.ReadFromStream] Unexpected char while searching for token: $%s in Line %d', - [IntToHex(Byte(CurChar), 2), CurLine])); - end; - - { Passing by comments } - ssInComment: - begin - CommentToken.StrValue := CommentToken.StrValue + CurChar; - if lIsEndOfLine then - begin - Tokens.Add(CommentToken); - State := ssSearchingToken; -// {$ifdef FPVECTORIALDEBUG} -// WriteLn(Format('Adding Comment "%s" at Line %d', [CommentToken.StrValue, CurLine])); -// {$endif} - end; - end; // ssInComment - - // Starts at { and ends in }, passing over nested groups - ssInGroup: - begin - if (CurChar = '{') then ProcedureToken.Levels := ProcedureToken.Levels + 1; - if (CurChar = '}') then ProcedureToken.Levels := ProcedureToken.Levels - 1; - - if ProcedureToken.Levels = 0 then - begin - Tokens.Add(ProcedureToken); - State := ssSearchingToken; - end - else - begin - // Don't add line ends, because they cause problems when outputing the debug info - // but in this case we need to add spaces to compensate, or else items separates only - // by line end might get glued together - if CurChar in [#10, #13] then - ProcedureToken.StrValue := ProcedureToken.StrValue + ' ' - else - ProcedureToken.StrValue := ProcedureToken.StrValue + CurChar; - end; - end; - - // Goes until a space comes, or { - ssInExpressionElement: - begin - if IsPostScriptSpace(Byte(CurChar)) or (CurChar = '{') then - begin - ExpressionToken.PrepareFloatValue(); - Tokens.Add(ExpressionToken); - State := ssSearchingToken; - if (CurChar = '{') then AStream.Seek(-1, soFromCurrent); - end - else - ExpressionToken.StrValue := ExpressionToken.StrValue + CurChar; - end; - - end; // case - end; // while - - // If the stream finished, there might be a token still being built - // so lets finish it - if State = ssInExpressionElement then - begin - Tokens.Add(ExpressionToken); - end; -end; - -procedure TPSTokenizer.DebugOut(); -var - i: Integer; - Token: TPSToken; -begin - for i := 0 to Tokens.Count - 1 do - begin - Token := TPSToken(Tokens.Items[i]); - - if Token is TCommentToken then - begin - WriteLn(Format('TCommentToken StrValue=%s', [Token.StrValue])); - end - else if Token is TProcedureToken then - begin - WriteLn(Format('TProcedureToken StrValue=%s', [Token.StrValue])); - end - else if Token is TExpressionToken then - begin - WriteLn(Format('TExpressionToken StrValue=%s', [Token.StrValue])); - end; - end; -end; - -{@@ Valid PostScript Chars: - -All printable ASCII: a..zA..Z0..9 plus punctuation - -Plus the following white spaces -000 00 0 Null (nul) -011 09 9 Tab (tab) -012 0A 10 Line feed (LF) -014 0C 12 Form feed (FF) -015 0D 13 Carriage return (CR) -040 20 32 Space (SP) -} -function TPSTokenizer.IsValidPostScriptChar(AChar: Byte): Boolean; -begin - Result := ((AChar > 32) and (AChar < 127)) or (AChar in [0, 9, 10, 12, 13, 32]); -end; - -function TPSTokenizer.IsPostScriptSpace(AChar: Byte): Boolean; -begin - Result := AChar in [0, 9, 10, 12, 13, 32]; -end; - -function TPSTokenizer.IsEndOfLine(ACurChar: Byte; AStream: TStream): Boolean; -var - HasNextChar: Boolean = False; - NextChar: Byte; -begin - Result := False; - - if ACurChar = 13 then - begin - if AStream.Position < AStream.Size then - begin - HasNextChar := True; - NextChar := AStream.ReadByte(); - if NextChar <> 10 then AStream.Seek(-1, soFromCurrent); // Go back if it wasnt a #13#10 - Exit(True); - end; - end; - - if ACurChar = 10 then Result := True; -end; - -{$ifndef Windows} -{$define FPVECTORIALDEBUG} -{$endif} - -{ TvEPSVectorialReader } - -procedure TvEPSVectorialReader.DebugStack(); -var - i: Integer; - lToken: TPSToken; -begin - WriteLn('===================='); - WriteLn('Stack dump'); - WriteLn('===================='); - for i := 0 to TStackAccess(Stack).List.Count - 1 do - begin - lToken := TPSToken(TStackAccess(Stack).List.Items[i]); - WriteLn(Format('Stack #%d : %s', [i, lToken.StrValue])); - end; -end; - -procedure TvEPSVectorialReader.RunPostScript(ATokens: TPsTokens; - AData: TvVectorialPage; ADoc: TvVectorialDocument); -var - i: Integer; - lSubstituted: Boolean; - CurToken: TPSToken; -begin - {$ifdef FPVECTORIALDEBUG_CODEFLOW} - WriteLn('[TvEPSVectorialReader.RunPostScript] START'); - {$endif} - if ExitCalled then - begin - {$ifdef FPVECTORIALDEBUG_CODEFLOW} - WriteLn('[TvEPSVectorialReader.RunPostScript] ExitCalled'); - {$endif} - Exit; - end; - for i := 0 to ATokens.Count - 1 do - begin - CurToken := TPSToken(ATokens.Items[i]); - -{ if CurToken.StrValue = 'setrgbcolor' then - begin - WriteLn('==================='); - WriteLn('CMYK__'); - WriteLn('==================='); - DebugStack(); - end;} - - if CurToken is TCommentToken then - begin - {$ifdef FPVECTORIALDEBUG_CODEFLOW} - WriteLn(Format('[TvEPSVectorialReader.RunPostScript] Type: TCommentToken Token: %s', [CurToken.StrValue])); - {$endif} -// ProcessCommentToken(CurToken as TCommentToken, AData); - Continue; - end; - - if CurToken is TProcedureToken then - begin - {$ifdef FPVECTORIALDEBUG_CODEFLOW} - WriteLn(Format('[TvEPSVectorialReader.RunPostScript] Type: TProcedureToken Token: %s', [CurToken.StrValue])); - {$endif} - Stack.Push(CurToken); - Continue; - end; - - if CurToken is TExpressionToken then - begin - {$ifdef FPVECTORIALDEBUG_CODEFLOW} - WriteLn(Format('[TvEPSVectorialReader.RunPostScript] Type: TExpressionToken Token: %s', [CurToken.StrValue])); - {$endif} - - if TExpressionToken(CurToken).ETType = ettOperand then - begin - Stack.Push(CurToken); - Continue; - end; - - // Now we need to verify if the operator should be substituted in the dictionary - lSubstituted := DictionarySubstituteOperator(Dictionary, CurToken); - - // Check if this is the first time that a named element appears, if yes, don't try to execute it - // just put it into the stack - if (not lSubstituted) and (TExpressionToken(CurToken).ETType = ettNamedElement) then - begin - Stack.Push(CurToken); - Continue; - end; - - if CurToken is TProcedureToken then ExecuteProcedureToken(TProcedureToken(CurToken), AData, ADoc) - else ExecuteOperatorToken(TExpressionToken(CurToken), AData, ADoc); - - if ExitCalled then Break; - end; - end; - {$ifdef FPVECTORIALDEBUG_CODEFLOW} - WriteLn('[TvEPSVectorialReader.RunPostScript] END'); - {$endif} -end; - -procedure TvEPSVectorialReader.ExecuteProcedureToken(AToken: TProcedureToken; - AData: TvVectorialPage; ADoc: TvVectorialDocument); -var - ProcTokenizer: TPSTokenizer; - lStream: TMemoryStream; - lOldTokens: TPSTokens; - i: Integer; -begin - {$ifdef FPVECTORIALDEBUG_CODEFLOW} - WriteLn('[TvEPSVectorialReader.ExecuteProcedureToken] START'); - {$endif} - if ExitCalled then - begin - {$ifdef FPVECTORIALDEBUG_CODEFLOW} - WriteLn('[TvEPSVectorialReader.ExecuteProcedureToken] ExitCalled'); - {$endif} - Exit; - end; - - if not AToken.Parsed then - begin - ProcTokenizer := TPSTokenizer.Create(AToken.Line); - lStream := TMemoryStream.Create; - try - // Copy the string to a Stream - for i := 1 to Length(AToken.StrValue) do - lStream.WriteByte(Byte(AToken.StrValue[i])); - - // Change the Tokens so that it writes directly to AToken.Childs - lOldTokens := ProcTokenizer.Tokens; - ProcTokenizer.Tokens := AToken.Childs; - - // Now parse the procedure code - lStream.Position := 0; - ProcTokenizer.ReadFromStream(lStream); - - // Recover the old tokens for usage in .Free - ProcTokenizer.Tokens := lOldTokens; - finally - lStream.Free; - ProcTokenizer.Free; - end; - - AToken.Parsed := True; - end; - - // Now run the procedure - RunPostScript(AToken.Childs, AData, ADoc); - {$ifdef FPVECTORIALDEBUG_CODEFLOW} - WriteLn('[TvEPSVectorialReader.ExecuteProcedureToken] END'); - {$endif} -end; - -procedure TvEPSVectorialReader.ExecuteOperatorToken(AToken: TExpressionToken; - AData: TvVectorialPage; ADoc: TvVectorialDocument); -var - Param1, Param2: TPSToken; -begin - if AToken.StrValue = '' then raise Exception.Create('[TvEPSVectorialReader.ProcessExpressionToken] Empty operator'); - - if ExecuteDictionaryOperators(AToken, AData, ADoc) then Exit; - - if ExecuteArithmeticAndMathOperator(AToken, AData, ADoc) then Exit; - - if ExecutePathConstructionOperator(AToken, AData, ADoc) then Exit; - - if ExecuteGraphicStateOperatorsDI(AToken, AData, ADoc) then Exit; - - if ExecuteGraphicStateOperatorsDD(AToken, AData, ADoc) then Exit; - - if ExecuteControlOperator(AToken, AData, ADoc) then Exit; - - if ExecuteStackManipulationOperator(AToken, AData, ADoc) then Exit; - - if ExecuteMiscellaneousOperators(AToken, AData, ADoc) then Exit; - - if ExecutePaintingOperator(AToken, AData, ADoc) then Exit; - - if ExecuteDeviceSetupAndOutputOperator(AToken, AData, ADoc) then Exit; - - if ExecuteArrayOperator(AToken, AData, ADoc) then Exit; - - if ExecuteStringOperator(AToken, AData, ADoc) then Exit; - - // If we got here, there the command not yet implemented - raise Exception.Create(Format('[TvEPSVectorialReader.ProcessExpressionToken] Unknown PostScript Command "%s" in Line %d', - [AToken.StrValue, AToken.Line])); - -{ File Operators - - filename access file file Open named file with specified access - datasrc|datatgt dict - param1 … paramn filtername filter file Establish filtered file - file closefile – Close file - file read int true Read one character from file - or false - file int write – Write one character to file - file string readhexstring substring bool Read hexadecimal numbers from file into - string - file string writehexstring – Write string to file as hexadecimal - file string readstring substring bool Read string from file - file string writestring – Write string to file - file string readline substring bool Read line from file into string - file token any true Read token from file - or false - file bytesavailable int Return number of bytes available to read - – flush – Send buffered data to standard output file - file flushfile – Send buffered data or read to EOF - file resetfile – Discard buffered characters - file status bool Return status of file (true = valid) - filename status pages bytes referenced created true - or false Return information about named file - filename run – Execute contents of named file - – currentfile file Return file currently being executed - filename deletefile – Delete named file - filename1 filename2 renamefile – Rename file filename1 to filename2 - template proc scratch filenameforall – Execute proc for each file name matching - template - file position setfileposition – Set file to specified position - file fileposition position Return current position in file - string print – Write string to standard output file - any = – Write text representation of any to standard - output file - any == – Write syntactic representation of any to - standard output file - any1 … anyn stack any1 … anyn Print stack nondestructively using = - any1 … anyn pstack any1 … anyn Print stack nondestructively using == - obj tag printobject – Write binary object to standard output file, - using tag - file obj tag writeobject – Write binary object to file, using tag - int setobjectformat – Set binary object format (0 = disable, - 1 = IEEE high, 2 = IEEE low, 3 = native - high, 4 = native low) - – currentobjectformat int Return binary object format -} -{ Resource Operators - - key instance category defineresource instance Register named resource instance in category - key category undefineresource – Remove resource registration - key category findresource instance Return resource instance identified by key in - category - renderingintent findcolorrendering name bool Select CIE-based color rendering dictionary - by rendering intent - key category resourcestatus status size true Return status of resource instance - or false - template proc scratch category resourceforall – Enumerate resource instances in category -} -{ Virtual Memory Operators - - – save save Create VM snapshot - save restore – Restore VM snapshot - bool setglobal – Set VM allocation mode (false = local, - true = global) - – currentglobal bool Return current VM allocation mode - any gcheck bool Return true if any is simple or in global VM, - false if in local VM - bool1 password startjob bool2 Start new job that will alter initial VM if - bool1 is true - index any defineuserobject – Define user object associated with index - index execuserobject – Execute user object associated with index - index undefineuserobject – Remove user object associated with index - – UserObjects array Return current UserObjects array defined in - userdict -} -{ Errors - - configurationerror setpagedevice or setdevparams request - cannot be satisfied - dictfull No more room in dictionary - dictstackoverflow Too many begin operators - dictstackunderflow Too many end operators - execstackoverflow Executive stack nesting too deep - handleerror Called to report error information - interrupt External interrupt request (for example, - Control-C) - invalidaccess Attempt to violate access attribute - invalidexit exit not in loop - invalidfileaccess Unacceptable access string - invalidfont Invalid Font resource name or font or - CIDFont dictionary - invalidrestore Improper restore - ioerror Input/output error - limitcheck Implementation limit exceeded - nocurrentpoint Current point undefined - rangecheck Operand out of bounds - stackoverflow Operand stack overflow - stackunderflow Operand stack underflow - syntaxerror PostScript language syntax error - timeout Time limit exceeded - typecheck Operand of wrong type - undefined Name not known - undefinedfilename File not found - undefinedresource Resource instance not found - undefinedresult Overflow, underflow, or meaningless result - unmatchedmark Expected mark not on stack - unregistered Internal error - VMerror Virtual memory exhausted -} -end; - -{ Operand Stack Manipulation Operators - - any pop – Discard top element - any1 any2 exch ==> any2 any1 Exchange top two elements - any dup ==> any any Duplicate top element - any1 … anyn n copy any1 … anyn any1 … anyn - Duplicate top n elements - anyn … any0 n index anyn … any0 anyn - Duplicate arbitrary element - anyn-1 … any0 n j roll any(j-1) mod n … any0 anyn-1 … anyj mod n - Roll n elements up j times - any1 … anyn clear Discard all elements - any1 … anyn count any1 … anyn n - Count elements on stack - – mark mark Push mark on stack - mark obj1 … objn cleartomark – - Discard elements down through mark - mark obj1 … objn counttomark mark obj1 … objn n - Count elements down to mark -} -function TvEPSVectorialReader.ExecuteStackManipulationOperator( - AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean; -var - Param1, Param2, NewToken: TPSToken; - lIndexN, lIndexJ: Integer; - lTokens: array of TPSToken; - i: Integer; -begin - Result := False; - - // Discard top element - if AToken.StrValue = 'pop' then - begin - Param1 := TPSToken(Stack.Pop); - Exit(True); - end; - // Exchange top two elements - if AToken.StrValue = 'exch' then - begin - Param1 := TPSToken(Stack.Pop); - Param2 := TPSToken(Stack.Pop); - Stack.Push(Param1); - Stack.Push(Param2); - Exit(True); - end; - // Duplicate top element - if AToken.StrValue = 'dup' then - begin - Param1 := TPSToken(Stack.Pop); - NewToken := Param1.Duplicate(); - Stack.Push(Param1); - Stack.Push(NewToken); - Exit(True); - end; - // anyn … any0 n index anyn … any0 anyn - // Duplicate arbitrary element - if AToken.StrValue = 'index' then - begin - {$ifdef FPVECTORIALDEBUG_INDEX} - WriteLn('[TvEPSVectorialReader.ExecuteStackManipulationOperator] index'); -// DebugStack(); - {$endif} - - Param1 := TPSToken(Stack.Pop); - lIndexN := Round(Param1.FloatValue); - SetLength(lTokens, lIndexN+1); - - if lIndexN < 0 then raise Exception.Create('[TvEPSVectorialReader.ExecuteStackManipulationOperator] index operator: n must be positive or zero'); - - // Unroll all elements necessary - - for i := 0 to lIndexN do - begin - lTokens[i] := TPSToken(Stack.Pop); - Param2 := lTokens[i]; - if Param2 = nil then - begin - raise Exception.Create(Format('[TvEPSVectorialReader.ExecuteStackManipulationOperator] Stack underflow in operation "index". Error at line %d', [AToken.Line])); - end; - end; - - // Duplicate the disired token - - NewToken := lTokens[lIndexN].Duplicate(); - - // Roll them back - - for i := lIndexN downto 0 do - begin - Stack.Push(lTokens[i]); - end; - - // Roll the duplicated element too - - Stack.Push(NewToken); - - Exit(True); - end; - // anyn-1 … any0 n j roll any(j-1) mod n … any0 anyn-1 … anyj mod n - // - // performs a circular shift of the objects anyn-1 through any0 on the operand stack - // by the amount j. Positive j indicates upward motion on the stack, whereas negative - // j indicates downward motion. - // n must be a nonnegative integer and j must be an integer. roll first removes these - // operands from the stack; there must be at least n additional elements. It then performs - // a circular shift of these n elements by j positions. - // If j is positive, each shift consists of removing an element from the top of the stack - // and inserting it between element n - 1 and element n of the stack, moving all in8.2 - // tervening elements one level higher on the stack. If j is negative, each shift consists - // of removing element n - 1 of the stack and pushing it on the top of the stack, - // moving all intervening elements one level lower on the stack. - // - // Examples N J - // (a) (b) (c) 3 -1 roll => (b) (c) (a) - // (a) (b) (c) 3 1 roll => (c) (a) (b) - // (a) (b) (c) 3 0 roll => (a) (b) (c) - if AToken.StrValue = 'roll' then - begin - Param1 := TPSToken(Stack.Pop); - Param2 := TPSToken(Stack.Pop); - lIndexJ := Round(Param1.FloatValue); - lIndexN := Round(Param2.FloatValue); - - {$ifdef FPVECTORIALDEBUG_ROLL} - WriteLn(Format('[TvEPSVectorialReader] roll: N=%d J=%d', [lIndexN, lIndexJ])); - {$endif} - - if lIndexN < 0 then raise Exception.Create('[TvEPSVectorialReader.ExecuteStackManipulationOperator] rool operator: n must be positive or zero'); - - if lIndexJ = 0 then Exit; - - SetLength(lTokens, lIndexN); - - // Unroll all elements necessary - - for i := 0 to lIndexN-1 do - begin - lTokens[i] := TPSToken(Stack.Pop()); - Param2 := lTokens[i]; - if Param2 = nil then - begin - raise Exception.Create('[TvEPSVectorialReader.ExecuteStackManipulationOperator] nil element poped in operator index'); - //Exit(True); - end; - end; - - // Roll them back - - if lIndexJ > 0 then - begin - for i := lIndexJ-1 downto 0 do - begin - Stack.Push(lTokens[i]); - end; - for i := lIndexN-1 downto lIndexJ do - begin - Stack.Push(lTokens[i]); - end; - end - else - begin - lIndexJ := -lIndexJ; - - for i := lIndexN-lIndexJ-1 downto 0 do - begin - Stack.Push(lTokens[i]); - end; - for i := lIndexN-1 downto lIndexN-lIndexJ do - begin - Stack.Push(lTokens[i]); - end; - end; - - Exit(True); - end; -end; - -{ Control Operators - - any exec – Execute arbitrary object - bool proc if – Execute proc if bool is true - bool proc1 proc2 ifelse – - Execute proc1 if bool is true, proc2 if false - initial increment limit proc for – - Execute proc with values from initial by steps - of increment to limit - int proc repeat – Execute proc int times - proc loop – Execute proc an indefinite number of times - – exit – Exit innermost active loop - – stop – Terminate stopped context - any stopped bool Establish context for catching stop - – countexecstack int Count elements on execution stack - array execstack subarray Copy execution stack into array - – quit – Terminate interpreter - – start – Executed at interpreter startup - Type, Attribute, and Conversion Operators - any type name Return type of any - any cvlit any Make object literal - any cvx any Make object executable - any xcheck bool Test executable attribute - array|packedarray|file|string executeonly array|packedarray|file|string - Reduce access to execute-only - array|packedarray|dict|file|string noaccess array|packedarray|dict|file|string - Disallow any access - array|packedarray|dict|file|string readonly array|packedarray|dict|file|string - Reduce access to read-only - array|packedarray|dict|file|string rcheck bool Test read access - array|packedarray|dict|file|string wcheck bool Test write access - num|string cvi int Convert to integer - string cvn name Convert to name - num|string cvr real Convert to real - num radix string cvrs substring Convert with radix to string - any string cvs substring Convert to string -} -function TvEPSVectorialReader.ExecuteControlOperator(AToken: TExpressionToken; - AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean; -var - Param1, Param2, Param3, Param4, CounterToken: TPSToken; - NewToken: TExpressionToken; - FloatCounter: Double; -begin - Result := False; - - // Execute proc if bool is true - if AToken.StrValue = 'if' then - begin - Param1 := TPSToken(Stack.Pop); // proc - Param2 := TPSToken(Stack.Pop); // bool - - if not (Param1 is TProcedureToken) then - raise Exception.Create(Format('[TvEPSVectorialReader.ExecuteControlOperator] The operator if requires a procedure. Error at line %d', [AToken.Line])); - - if Param2.BoolValue then ExecuteProcedureToken(TProcedureToken(Param1), AData, ADoc); - - Exit(True); - end; - // Execute proc1 if bool is true, proc2 if false - if AToken.StrValue = 'ifelse' then - begin - Param1 := TPSToken(Stack.Pop); // proc2 - Param2 := TPSToken(Stack.Pop); // proc1 - Param3 := TPSToken(Stack.Pop); // bool - - if not (Param1 is TProcedureToken) then - raise Exception.Create(Format('[TvEPSVectorialReader.ExecuteControlOperator] The operator ifelse requires a procedure. Error at line %d', [AToken.Line])); - if not (Param2 is TProcedureToken) then - raise Exception.Create(Format('[TvEPSVectorialReader.ExecuteControlOperator] The operator ifelse requires a procedure. Error at line %d', [AToken.Line])); - - if Param3.BoolValue then ExecuteProcedureToken(TProcedureToken(Param2), AData, ADoc) - else ExecuteProcedureToken(TProcedureToken(Param1), AData, ADoc); - - Exit(True); - end; - // Exit innermost active loop - if AToken.StrValue = 'exit' then - begin - ExitCalled := True; - - Exit(True); - end; - { - Establish context for catching stop - - executes any, which is typically, but not necessarily, a procedure, executable file, - or executable string object. If any runs to completion normally, stopped returns false on the operand stack. - - If any terminates prematurely as a result of executing stop, stopped returns - true on the operand stack. Regardless of the outcome, the interpreter resumes execution at the next object in normal sequence after stopped. - This mechanism provides an effective way for a PostScript language program - to "catch" errors or other premature terminations, retain control, and perhaps perform its own error recovery. - - EXAMPLE: - { ... } stopped {handleerror} if - - If execution of the procedure {...} causes an error, - the default error-reporting procedure is invoked (by handleerror). - In any event, normal execution continues at the token following the if. - - ERRORS: stackunderflow - } - if AToken.StrValue = 'stopped' then - begin - {$ifdef FPVECTORIALDEBUG_CONTROL} - WriteLn('[TvEPSVectorialReader.ExecuteControlOperator] stopped'); -// DebugStack(); - {$endif} - - Param1 := TPSToken(Stack.Pop); - - if not (Param1 is TProcedureToken) then - raise Exception.Create(Format('[TvEPSVectorialReader.ExecuteControlOperator] The operator stopped requires a procedure. Error at line %d', [AToken.Line])); - - ExecuteProcedureToken(TProcedureToken(Param1), AData, ADoc); - - NewToken := TExpressionToken.Create; - NewToken.ETType := ettOperand; - NewToken.BoolValue := False; - NewToken.StrValue := 'false'; - Stack.Push(NewToken); - - Exit(True); - end; - // Execute proc an indefinite number of times - if AToken.StrValue = 'loop' then - begin - Param1 := TPSToken(Stack.Pop); - - if not (Param1 is TProcedureToken) then - raise Exception.Create(Format('[TvEPSVectorialReader.ExecuteControlOperator] The operator loop requires a procedure. Error at line %d', [AToken.Line])); - - while True do - begin - ExecuteProcedureToken(TProcedureToken(Param1), AData, ADoc); - - if ExitCalled then - begin - ExitCalled := False; - Break; - end; - end; - - Exit(True); - end; - { initial increment limit proc for - - - executes proc repeatedly, passing it a sequence of values from initial - by steps of increment to limit. The for operator expects initial, increment, - and limit to be numbers. It maintains a temporary internal variable, known as - the control variable, which it first sets to initial. Then, before each - repetition, it compares the control variable with the termination value limit. - If limit has not been exceeded, it pushes the control variable on the operand - stack, executes proc, and adds increment to the control variable. - - The termination condition depends on whether increment is positive or negative. - If increment is positive, for terminates when the control variable becomes - greater than limit. If increment is negative, for terminates when the control - variable becomes less than limit. If initial meets the termination condition, - for does not execute proc at all. If proc executes the exit operator, - for terminates prematurely. - - Usually, proc will use the value on the operand stack for some purpose. - However, if proc does not remove the value, it will remain there. - Successive executions of proc will cause successive values of the control - variable to accumulate on the operand stack. - - EXAMPLE: - 0 1 1 4 {add} for -> 10 - 1 2 6 { } for -> 1 3 5 - 3 -.5 1 {-> } for -> 3.0 2.5 2.0 1.5 1.0 - - In the first example, the value of the control variable is added to whatever - is on the stack, so 1, 2, 3, and 4 are added in turn to a running sum whose - initial value is 0. The second example has an empty procedure, so the - successive values of the control variable are left on the stack. The - last example counts backward from 3 to 1 by halves, leaving the successive - values on the stack. - - Beware of using reals instead of integers for any of the first three operands. - Most real numbers are not represented exactly. This can cause an error to - accumulate in the value of the control variable, with possibly surprising results. - In particular, if the difference between initial and limit is a multiple of - increment, as in the third line of the example, the control variable may not - achieve the limit value. - - ERRORS: stackoverflow stackunderflow, typecheck - - SEE ALSO: repeat, loop, forall, exit - } - if AToken.StrValue = 'for' then - begin - Param1 := TPSToken(Stack.Pop); - Param2 := TPSToken(Stack.Pop); - Param3 := TPSToken(Stack.Pop); - Param4 := TPSToken(Stack.Pop); - - if not (Param1 is TProcedureToken) then - raise Exception.Create(Format('[TvEPSVectorialReader.ExecuteControlOperator] The operator for requires a procedure. Error at line %d', [AToken.Line])); - - FloatCounter := Param4.FloatValue; - while FloatCounter < Param2.FloatValue do - begin - CounterToken := Param4.Duplicate(); - CounterToken.FloatValue := FloatCounter; - Stack.Push(CounterToken); - - ExecuteProcedureToken(TProcedureToken(Param1), AData, ADoc); - - FloatCounter := FloatCounter + Param3.FloatValue; - - if ExitCalled then - begin - ExitCalled := False; - Break; - end; - end; - - Exit(True); - end; - // tests whether the operand has the executable or the literal attribute, returning true - // if it is executable or false if it is literal - if AToken.StrValue = 'xcheck' then - begin -// {$ifdef FPVECTORIALDEBUG_CONTROL} -// WriteLn('[TvEPSVectorialReader.ExecuteControlOperator] xcheck'); -// DebugStack(); -// {$endif} - - Param1 := TPSToken(Stack.Pop); - - NewToken := TExpressionToken.Create; - NewToken.ETType := ettOperand; - NewToken.BoolValue := (Param1 is TProcedureToken) or - ((Param1 is TExpressionToken) and (TExpressionToken(Param1).ETType = ettOperator)); - if NewToken.BoolValue then NewToken.StrValue := 'true' - else NewToken.StrValue := 'false'; - Stack.Push(NewToken); - - Exit(True); - end; -end; - -{ Painting Operators - - – erasepage – Paint current page white - – stroke – Draw line along current path - – fill – Fill current path with current color - – eofill – Fill using even-odd rule - x y width height rectstroke – Define rectangular path and stroke - x y width height matrix rectstroke – Define rectangular path, concatenate matrix, - and stroke - numarray|numstring rectstroke – Define rectangular paths and stroke - numarray|numstring matrix rectstroke – Define rectangular paths, concatenate - matrix, and stroke - x y width height rectfill – Fill rectangular path - numarray|numstring rectfill – Fill rectangular paths - userpath ustroke – Interpret and stroke userpath - userpath matrix ustroke – Interpret userpath, concatenate matrix, and - stroke - userpath ufill – Interpret and fill userpath - userpath ueofill – Fill userpath using even-odd rule - dict shfill – Fill area defined by shading pattern - dict image – Paint any sampled image - width height bits/sample matrix datasrc image – Paint monochrome sampled image - width height bits/comp matrix - datasrc0 … datasrcncomp-1 multi ncomp colorimage – Paint color sampled image - dict imagemask – Paint current color through mask - width height polarity matrix datasrc imagemask – Paint current color through mask - Insideness-Testing Operators - x y infill bool Test whether (x, y) would be painted by fill - userpath infill bool Test whether pixels in userpath would be - painted by fill - x y ineofill bool Test whether (x, y) would be painted by eofill - userpath ineofill bool Test whether pixels in userpath would be - painted by eofill - x y userpath inufill bool Test whether (x, y) would be painted by ufill - of userpath - userpath1 userpath2 inufill bool Test whether pixels in userpath1 would be - painted by ufill of userpath2 - x y userpath inueofill bool Test whether (x, y) would be painted by - ueofill of userpath - userpath1 userpath2 inueofill bool Test whether pixels in userpath1 would be - painted by ueofill of userpath2 - x y instroke bool Test whether (x, y) would be painted by - stroke - x y userpath inustroke bool Test whether (x, y) would be painted by - ustroke of userpath - x y userpath matrix inustroke bool Test whether (x, y) would be painted by - ustroke of userpath - userpath1 userpath2 inustroke bool Test whether pixels in userpath1 would be - painted by ustroke of userpath2 - userpath1 userpath2 matrix inustroke bool Test whether pixels in userpath1 would be - painted by ustroke of userpath2 - Form and Pattern Operators - pattern matrix makepattern pattern’ Create pattern instance from prototype - pattern setpattern – Install pattern as current color - comp1 … compn pattern setpattern – Install pattern as current color - form execform – Paint form -} -function TvEPSVectorialReader.ExecutePaintingOperator(AToken: TExpressionToken; - AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean; -var - Param1, Param2: TPSToken; -begin - Result := False; - - if AToken.StrValue = 'stroke' then - begin - {$ifdef FPVECTORIALDEBUG_PATHS} - WriteLn('[TvEPSVectorialReader.ExecutePaintingOperator] stroke'); - {$endif} - AData.SetPenStyle(psSolid); - AData.SetBrushStyle(bsClear); - AData.SetPenColor(CurrentGraphicState.Color); - AData.SetClipPath(CurrentGraphicState.ClipPath, CurrentGraphicState.ClipMode); - AData.SetPenWidth(CurrentGraphicState.PenWidth); - AData.EndPath(); - Exit(True); - end; - - if AToken.StrValue = 'eofill' then - begin - {$ifdef FPVECTORIALDEBUG_PATHS} - WriteLn('[TvEPSVectorialReader.ExecutePaintingOperator] eofill'); - {$endif} - AData.SetBrushStyle(bsSolid); - AData.SetPenStyle(psSolid); - AData.SetClipPath(CurrentGraphicState.ClipPath, CurrentGraphicState.ClipMode); - AData.SetPenWidth(CurrentGraphicState.PenWidth); - AData.EndPath(); - - Exit(True); - end; -end; - -{ Device Setup and Output Operators - - – showpage – Transmit and reset current page - – copypage – Transmit current page - dict setpagedevice – Install page-oriented output device - – currentpagedevice dict Return current page device parameters - – nulldevice – Install no-output device - Glyph and Font Operators - key font|cidfont definefont font|cidfont Register font|cidfont in Font resource - category - key name|string|dict array composefont font Register composite font dictionary created - from CMap and array of CIDFonts or fonts - key undefinefont – Remove Font resource registration - key findfont font|cidfont Return Font resource instance identified by - key - font|cidfont scale scalefont font¢|cidfont¢ Scale font|cidfont by scale to produce - font¢|cidfont¢ - font|cidfont matrix makefont font¢|cidfont¢ Transform font|cidfont by matrix to produce - font¢|cidfont¢ - font|cidfont setfont – Set font or CIDFont in graphics state - – rootfont font|cidfont Return last set font or CIDFont - – currentfont font|cidfont Return current font or CIDFont, possibly a - descendant of rootfont - key scale|matrix selectfont – Set font or CIDFont given name and - transform - string show – Paint glyphs for string in current font - ax ay string ashow – Add (ax , ay) to width of each glyph while - showing string - cx cy char string widthshow – Add (cx , cy) to width of glyph for char while - showing string - cx cy char ax ay string awidthshow – Combine effects of ashow and widthshow - string numarray|numstring xshow – Paint glyphs for string using x widths in - numarray|numstring - string numarray|numstring xyshow – Paint glyphs for string using x and y widths - in numarray|numstring - string numarray|numstring yshow – Paint glyphs for string using y widths in - numarray|numstring - name|cid glyphshow – Paint glyph for character identified by - name|cid - string stringwidth wx wy Return width of glyphs for string in current - font - proc string cshow – Invoke character mapping algorithm and - call proc - proc string kshow – Execute proc between characters shown from - string - – FontDirectory dict Return dictionary of Font resource instances - – GlobalFontDirectory dict Return dictionary of Font resource instances - in global VM - – StandardEncoding array Return Adobe standard font encoding vector - – ISOLatin1Encoding array Return ISO Latin-1 font encoding vector - key findencoding array Find encoding vector - wx wy llx lly urx ury setcachedevice – Declare cached glyph metrics - w0x w0y llx lly urx ury - w1x w1y vx vy setcachedevice2 – Declare cached glyph metrics - wx wy setcharwidth – Declare uncached glyph metrics - Interpreter Parameter Operators - dict setsystemparams – Set systemwide interpreter parameters - – currentsystemparams dict Return systemwide interpreter parameters - dict setuserparams – Set per-context interpreter parameters - – currentuserparams dict Return per-context interpreter parameters - string dict setdevparams – Set parameters for input/output device - string currentdevparams dict Return device parameters - int vmreclaim – Control garbage collector - int setvmthreshold – Control garbage collector - – vmstatus level used maximum - Report VM status - – cachestatus bsize bmax msize mmax csize cmax blimit - Return font cache status and parameters - int setcachelimit – Set maximum bytes in cached glyph - mark size lower upper setcacheparams – Set font cache parameters - – currentcacheparams mark size lower upper - Return current font cache parameters - mark blimit setucacheparams – Set user path cache parameters - – ucachestatus mark bsize bmax rsize rmax blimit - Return user path cache status and - parameters -} -function TvEPSVectorialReader.ExecuteDeviceSetupAndOutputOperator( - AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean; -var - Param1, Param2: TPSToken; -begin - Result := False; - - if AToken.StrValue = 'showpage' then - begin - Exit(True); - end; -end; - -{ Array Operators - - int array array Create array of length int - – [ mark Start array construction - mark obj0 … objn-1 ] array End array construction - array length int Return number of elements in array - array index get any Return array element indexed by index - array index any put – Put any into array at index - array index count getinterval subarray Return subarray of array starting at index for - count elements - array1 index array2|packedarray2 putinterval – Replace subarray of array1 starting at index - by array2|packedarray2 - any0 … anyn-1 array astore array Pop elements from stack into array - array aload any0 … anyn-1 array Push all elements of array on stack - array1 array2 copy subarray2 Copy elements of array1 to initial subarray of - array2 - array proc forall – Execute proc for each element of array - Packed Array Operators - any0 … anyn-1 n packedarray packedarray Create packed array consisting of n elements - from stack - bool setpacking – Set array packing mode for { … } syntax - (true = packed array) - – currentpacking bool Return array packing mode - packedarray length int Return number of elements in packedarray - packedarray index get any Return packedarray element indexed by index - packedarray index count getinterval subarray Return subarray of packedarray starting at - index for count elements - packedarray aload any0 … anyn-1 packedarray - Push all elements of packedarray on stack - packedarray1 array2 copy subarray2 Copy elements of packedarray1 to initial - subarray of array2 - packedarray proc forall – Execute proc for each element of packedarray -} -function TvEPSVectorialReader.ExecuteArrayOperator(AToken: TExpressionToken; - AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean; -begin - Result := False; - -end; - -{ String Operators - - int string string Create string of length int - string length int Return number of elements in string - string index get int Return string element indexed by index - string index int put – Put int into string at index - string index count getinterval substring Return substring of string starting at index - for count elements - string1 index string2 putinterval – Replace substring of string1 starting at index - by string2 - string1 string2 copy substring2 Copy elements of string1 to initial substring - of string2 - string proc forall – Execute proc for each element of string - string seek anchorsearch post match true Search for seek at start of string - or string false - string seek search post match pre true Search for seek in string - or string false - string token post any true Read token from start of string - or false - Relational, Boolean, and Bitwise Operators - any1 any2 eq bool Test equal - any1 any2 ne bool Test not equal - num1|str1 num2|str2 ge bool Test greater than or equal - num1|str1 num2|str2 gt bool Test greater than - num1|str1 num2|str2 le bool Test less than or equal - num1|str1 num2|str2 lt bool Test less than - bool1|int1 bool2|int2 and bool3|int3 Perform logical|bitwise and - bool1|int1 not bool2|int2 Perform logical|bitwise not - bool1|int1 bool2|int2 or bool3|int3 Perform logical|bitwise inclusive or - bool1|int1 bool2|int2 xor bool3|int3 Perform logical|bitwise exclusive or - – true true Return boolean value true - – false false Return boolean value false - int1 shift bitshift int2 Perform bitwise shift of int1 (positive is left) -} -function TvEPSVectorialReader.ExecuteStringOperator(AToken: TExpressionToken; - AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean; -var - Param1, Param2: TPSToken; - NewToken: TExpressionToken; -begin - Result := False; - - // any1 any2 ne bool Test not equal - if AToken.StrValue = 'ne' then - begin - Param1 := TPSToken(Stack.Pop); - Param2 := TPSToken(Stack.Pop); - - NewToken := TExpressionToken.Create; - NewToken.ETType := ettOperand; - NewToken.BoolValue := Param1.StrValue = Param2.StrValue; - if NewToken.BoolValue then NewToken.StrValue := 'true' - else NewToken.StrValue := 'false'; - Stack.Push(NewToken); - - Exit(True); - end; - // num1 num2 lt bool - // string1 string2 lt bool - // pops two objects from the operand stack and pushes true if the first operand is less - // than the second, or false otherwise. If both operands are numbers, lt compares - // their mathematical values. If both operands are strings, lt compares them element - // by element, treating the elements as integers in the range 0 to 255, to determine - // whether the first string is lexically less than the second. If the operands are of - // other types or one is a string and the other is a number, a typecheck error occurs. - if AToken.StrValue = 'lt' then - begin - Param1 := TPSToken(Stack.Pop); - Param2 := TPSToken(Stack.Pop); - - NewToken := TExpressionToken.Create; - NewToken.ETType := ettOperand; - NewToken.BoolValue := Param1.FloatValue > Param2.FloatValue; - if NewToken.BoolValue then NewToken.StrValue := 'true' - else NewToken.StrValue := 'false'; - Stack.Push(NewToken); - - Exit(True); - end; -end; - -{ Arithmetic and Math Operators - - num1 num2 add sum Return num1 plus num2 - num1 num2 div quotient Return num1 divided by num2 - int1 int2 idiv quotient Return int1 divided by int2 - int1 int2 mod remainder Return remainder after dividing int1 by int2 - num1 num2 mul product Return num1 times num2 - num1 num2 sub difference Return num1 minus num2 - num1 abs num2 Return absolute value of num1 - num1 neg num2 Return negative of num1 - num1 ceiling num2 Return ceiling of num1 - num1 floor num2 Return floor of num1 - num1 round num2 Round num1 to nearest integer - num1 truncate num2 Remove fractional part of num1 - num sqrt real Return square root of num - num den atan angle Return arctangent of num/den in degrees - angle cos real Return cosine of angle degrees - angle sin real Return sine of angle degrees - base exponent exp real Raise base to exponent power - num ln real Return natural logarithm (base e) - num log real Return common logarithm (base 10) - – rand int Generate pseudo-random integer - int srand – Set random number seed - – rrand int Return random number seed -} -function TvEPSVectorialReader.ExecuteArithmeticAndMathOperator( - AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean; -var - Param1, Param2: TPSToken; - NewToken: TExpressionToken; -begin - Result := False; - - // Division - // Param2 Param1 div ==> (Param2 div Param1) - if AToken.StrValue = 'div' then - begin - Param1 := TPSToken(Stack.Pop); - Param2 := TPSToken(Stack.Pop); - NewToken := TExpressionToken.Create; - NewToken.ETType := ettOperand; - NewToken.FloatValue := Param2.FloatValue / Param1.FloatValue; - NewToken.StrValue := FloatToStr(NewToken.FloatValue); - Stack.Push(NewToken); - {$ifdef FPVECTORIALDEBUG_ARITHMETIC} - WriteLn(Format('[TvEPSVectorialReader.ExecuteArithmeticAndMathOperator] %f %f div %f', [Param2.FloatValue, Param1.FloatValue, NewToken.FloatValue])); - {$endif} - Exit(True); - end; - - // Param2 Param1 mul ==> (Param2 mul Param1) - if AToken.StrValue = 'mul' then - begin - Param1 := TPSToken(Stack.Pop); - Param2 := TPSToken(Stack.Pop); - NewToken := TExpressionToken.Create; - NewToken.ETType := ettOperand; - NewToken.FloatValue := Param2.FloatValue * Param1.FloatValue; - NewToken.StrValue := FloatToStr(NewToken.FloatValue); - Stack.Push(NewToken); - Exit(True); - end; - // num1 num2 sub difference Return num1 minus num2 - if AToken.StrValue = 'sub' then - begin - NewToken := TExpressionToken.Create; - NewToken.ETType := ettOperand; - Param1 := TPSToken(Stack.Pop); // num2 - Param2 := TPSToken(Stack.Pop); // num1 - NewToken.FloatValue := Param2.FloatValue - Param1.FloatValue; - NewToken.StrValue := FloatToStr(NewToken.FloatValue); - Stack.Push(NewToken); - Exit(True); - end; -end; - -{ Path Construction Operators - - – newpath – Initialize current path to be empty - – currentpoint x y Return current point coordinates - x y moveto – Set current point to (x, y) - dx dy rmoveto – Perform relative moveto - x y lineto – Append straight line to (x, y) - dx dy rlineto – Perform relative lineto - x y r angle1 angle2 arc – Append counterclockwise arc - x y r angle1 angle2 arcn – Append clockwise arc - x1 y1 x2 y2 r arct – Append tangent arc - x1 y1 x2 y2 r arcto xt1 yt1 xt2 yt2 Append tangent arc - x1 y1 x2 y2 x3 y3 curveto – Append Bézier cubic section - dx1 dy1 dx2 dy2 dx3 dy3 rcurveto – Perform relative curveto - – closepath – Connect subpath back to its starting point - – flattenpath – Convert curves to sequences of straight lines - – reversepath – Reverse direction of current path - – strokepath – Compute outline of stroked path - userpath ustrokepath – Compute outline of stroked userpath - userpath matrix ustrokepath – Compute outline of stroked userpath - string bool charpath – Append glyph outline to current path - userpath uappend – Interpret userpath and append to current - path - – clippath – Set current path to clipping path - llx lly urx ury setbbox – Set bounding box for current path - – pathbbox llx lly urx ury Return bounding box of current path - move line curve close pathforall – Enumerate current path - bool upath userpath Create userpath for current path; include - ucache if bool is true - – initclip – Set clipping path to device default - – clip – Clip using nonzero winding number rule - – eoclip – Clip using even-odd rule - x y width height rectclip – Clip with rectangular path - numarray|numstring rectclip – Clip with rectangular paths - – ucache – Declare that user path is to be cached -} -function TvEPSVectorialReader.ExecutePathConstructionOperator( - AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean; -var - Param1, Param2, Param3, Param4, Param5, Param6: TPSToken; - PosX, PosY, PosX2, PosY2, PosX3, PosY3, BaseX, BaseY: Double; - // For Arc - P1, P2, P3, P4: T3DPoint; - startAngle, endAngle: Double; -begin - Result := False; - - // – newpath – Initialize current path to be empty - if AToken.StrValue = 'newpath' then - begin - {$ifdef FPVECTORIALDEBUG_PATHS} - WriteLn('[TvEPSVectorialReader.ExecutePathConstructionOperator] newpath'); - {$endif} -// AData.SetClipPath(CurrentGraphicState.ClipPath, CurrentGraphicState.ClipMode); -// AData.SetPenWidth(CurrentGraphicState.PenWidth); -// AData.SetClipPath(CurrentGraphicState.ClipPath, CurrentGraphicState.ClipMode); - AData.SetBrushStyle(bsClear); - AData.SetPenStyle(psClear); - AData.EndPath(); - AData.StartPath(); - - AData.SetPenColor(CurrentGraphicState.Color); - AData.SetBrushColor(CurrentGraphicState.Color); - AData.SetPenStyle(psClear); - - Exit(True); - end; - // Param2 Param1 moveto - ===> moveto(X=Param2, Y=Param1); - if AToken.StrValue = 'moveto' then - begin - Param1 := TPSToken(Stack.Pop); - Param2 := TPSToken(Stack.Pop); - PostScriptCoordsToFPVectorialCoords(Param1, Param2, PosX, PosY); - PosX2 := PosX + CurrentGraphicState.TranslateX; - PosY2 := PosY + CurrentGraphicState.TranslateY; - {$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])); - {$endif} - AData.AddMoveToPath(PosX2, PosY2); - Exit(True); - end; - // Absolute LineTo - // x y lineto – Append straight line to (x, y) - if AToken.StrValue = 'lineto' then - begin - Param1 := TPSToken(Stack.Pop); - Param2 := TPSToken(Stack.Pop); - PostScriptCoordsToFPVectorialCoords(Param1, Param2, PosX, PosY); - PosX2 := PosX + CurrentGraphicState.TranslateX; - PosY2 := PosY + CurrentGraphicState.TranslateY; - {$ifdef FPVECTORIALDEBUG_PATHS} - WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] lineto %f, %f Resulting value %f, %f', [PosX, PosY, PosX2, PosY2])); - {$endif} - AData.AddLineToPath(PosX2, PosY2); - Exit(True); - end; - // Relative LineTo - // dx dy rlineto – Perform relative lineto - if AToken.StrValue = 'rlineto' then - begin - Param1 := TPSToken(Stack.Pop); - Param2 := TPSToken(Stack.Pop); - PostScriptCoordsToFPVectorialCoords(Param1, Param2, PosX, PosY); - AData.GetCurrentPathPenPos(BaseX, BaseY); - PosX2 := PosX + BaseX; - PosY2 := PosY + BaseY; - {$ifdef FPVECTORIALDEBUG_PATHS} - WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] rlineto %f, %f Base %f, %f Resulting %f, %f', - [PosX, PosY, BaseX, BaseY, PosX2, PosY2])); - {$endif} - AData.AddLineToPath(PosX2, PosY2); - Exit(True); - end; - // dx1 dy1 dx2 dy2 dx3 dy3 rcurveto – - // (relative curveto) appends a section of a cubic Bézier curve to the current path in - // the same manner as curveto. However, the operands are interpreted as relative - // displacements from the current point rather than as absolute coordinates. That is, - // rcurveto constructs a curve between the current point (x0, y0) and the endpoint - // (x0 + dx3, y0 + dy3), using (x0 + dx1, y0 + dy1) and (x0 + dx2, y0 + dy2) as the Bézier - // control points. In all other respects, the behavior of rcurveto is identical to that of - // curveto. - if AToken.StrValue = 'rcurveto' then - begin - Param1 := TPSToken(Stack.Pop); // dy3 - Param2 := TPSToken(Stack.Pop); // dx3 - Param3 := TPSToken(Stack.Pop); // dy2 - Param4 := TPSToken(Stack.Pop); // dx2 - Param5 := TPSToken(Stack.Pop); // dy1 - Param6 := TPSToken(Stack.Pop); // dx1 - PostScriptCoordsToFPVectorialCoords(Param5, Param6, PosX, PosY); - PostScriptCoordsToFPVectorialCoords(Param3, Param4, PosX2, PosY2); - PostScriptCoordsToFPVectorialCoords(Param1, Param2, PosX3, PosY3); - AData.GetCurrentPathPenPos(BaseX, BaseY); - // First move to the start of the arc -// BaseX := BaseX + CurrentGraphicState.TranslateX; -// BaseY := BaseY + CurrentGraphicState.TranslateY; - {$ifdef FPVECTORIALDEBUG_PATHS} - WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] rcurveto translate %f, %f', - [CurrentGraphicState.TranslateX, CurrentGraphicState.TranslateY])); - WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] rcurveto from %f, %f via %f, %f %f, %f to %f, %f', - [BaseX, BaseY, BaseX + PosX, BaseY + PosY, BaseX + PosX2, BaseY + PosY2, BaseX + PosX3, BaseY + PosY3])); - {$endif} - AData.AddBezierToPath(BaseX + PosX, BaseY + PosY, BaseX + PosX2, BaseY + PosY2, BaseX + PosX3, BaseY + PosY3); - Exit(True); - end; - // – closepath – - // - // Don't do anything, because a stroke or fill might come after closepath - // and newpath will be called after stroke and fill anyway - // - if AToken.StrValue = 'closepath' then - begin - {$ifdef FPVECTORIALDEBUG_PATHS} - WriteLn('[TvEPSVectorialReader.ExecutePathConstructionOperator] closepath'); - {$endif} - - Exit(True); - end; - { - x y r angle1 angle2 arc – Append counterclockwise arc - - Arcs in PostScript are described by a center (x, y), a radius r and - two angles, angle1 for the start and angle2 for the end. These two - angles are relative to the X axis growing to the right (positive direction). - - } - if AToken.StrValue = 'arc' then - begin - Param1 := TPSToken(Stack.Pop); // angle2 - Param2 := TPSToken(Stack.Pop); // angle1 - Param3 := TPSToken(Stack.Pop); // r - Param4 := TPSToken(Stack.Pop); // y - Param5 := TPSToken(Stack.Pop); // x - PostScriptCoordsToFPVectorialCoords(Param4, Param5, PosX, PosY); - PosX := PosX + CurrentGraphicState.TranslateX; - PosY := PosY + CurrentGraphicState.TranslateY; - startAngle := Param2.FloatValue * Pi / 180; - endAngle := Param1.FloatValue * Pi / 180; - - // If the angle is too big we need to use two beziers - if endAngle - startAngle > Pi then - begin - CircularArcToBezier(PosX, PosY, Param3.FloatValue, startAngle, endAngle - Pi, P1, P2, P3, P4); - AData.AddMoveToPath(P1.X, P1.Y); - AData.AddBezierToPath(P2.X, P2.Y, P3.X, P3.Y, P4.X, P4.Y); - - CircularArcToBezier(PosX, PosY, Param3.FloatValue, startAngle + Pi, endAngle, P1, P2, P3, P4); - AData.AddMoveToPath(P1.X, P1.Y); - AData.AddBezierToPath(P2.X, P2.Y, P3.X, P3.Y, P4.X, P4.Y); - end - else - begin - CircularArcToBezier(PosX, PosY, Param3.FloatValue, startAngle, endAngle, P1, P2, P3, P4); - AData.AddMoveToPath(P1.X, P1.Y); - AData.AddBezierToPath(P2.X, P2.Y, P3.X, P3.Y, P4.X, P4.Y); - end; - {$ifdef FPVECTORIALDEBUG_PATHS} - WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] arc X,Y=%f, %f Resulting X,Y=%f, %f R=%f Angles Start,End=%f,%f', - [Param5.FloatValue, Param4.FloatValue, PosX, PosY, Param3.FloatValue, Param2.FloatValue, Param1.FloatValue])); - {$endif} - Exit(True); - end; - // – eoclip – Clip using even-odd rule - // - // intersects the inside of the current clipping path with the inside - // of the current path to produce a new, smaller current clipping path. - // The inside of the current path is determined by the even-odd rule, - // while the inside of the current clipping path is determined by whatever - // rule was used at the time that path was created. - // - // Except for the choice of insideness rule, the behavior of eoclip is identical to that of clip. - // - // ERRORS: limitcheck - // - if AToken.StrValue = 'eoclip' then - begin - {$ifdef FPVECTORIALDEBUG_PATHS} - WriteLn('[TvEPSVectorialReader.ExecutePathConstructionOperator] eoclip'); - {$endif} - {$ifndef FPVECTORIALDEBUG_CLIP_REGION} - AData.SetPenStyle(psClear); - {$endif} - AData.SetBrushStyle(bsClear); - AData.EndPath(); - CurrentGraphicState.ClipPath := AData.GetEntity(AData.GetEntitiesCount()-1) as TPath; - CurrentGraphicState.ClipMode := vcmEvenOddRule; - Exit(True); - end -end; - -{ Graphics State Operators (Device-Independent) - - – gsave – Push graphics state - – grestore – Pop graphics state - – clipsave – Push clipping path - – cliprestore – Pop clipping path - – grestoreall – Pop to bottommost graphics state - – initgraphics – Reset graphics state parameters - – gstate gstate Create graphics state object - gstate setgstate – Set graphics state from gstate - gstate currentgstate gstate Copy current graphics state into gstate - num setlinewidth – Set line width - – currentlinewidth num Return current line width - int setlinecap – Set shape of line ends for stroke (0 = butt, - 1 = round, 2 = square) - – currentlinecap int Return current line cap - int setlinejoin – Set shape of corners for stroke (0 = miter, - 1 = round, 2 = bevel) - – currentlinejoin int Return current line join - num setmiterlimit – Set miter length limit - – currentmiterlimit num Return current miter limit - bool setstrokeadjust – Set stroke adjustment (false = disable, - true = enable) - – currentstrokeadjust bool Return current stroke adjustment - array offset setdash – Set dash pattern for stroking - – currentdash array offset Return current dash pattern - array|name setcolorspace – Set color space - – currentcolorspace array Return current color space - comp1 … compn setcolor – Set color components - pattern setcolor – Set colored tiling pattern as current color - comp1 … compn pattern setcolor – Set uncolored tiling pattern as current color - – currentcolor comp1 … compn Return current color components - num setgray – Set color space to DeviceGray and color to - specified gray value (0 = black, 1 = white) - – currentgray num Return current color as gray value - hue saturation brightness sethsbcolor – Set color space to DeviceRGB and color to - specified hue, saturation, brightness - – currenthsbcolor hue saturation brightness - Return current color as hue, saturation, - brightness - red green blue setrgbcolor – Set color space to DeviceRGB and color to - specified red, green, blue - – currentrgbcolor red green blue Return current color as red, green, blue - cyan magenta yellow black setcmykcolor – Set color space to DeviceCMYK and color to - specified cyan, magenta, yellow, black - – currentcmykcolor cyan magenta yellow black - Return current color as cyan, magenta, - yellow, black -} -function TvEPSVectorialReader.ExecuteGraphicStateOperatorsDI( - AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean; -var - Param1, Param2, Param3: TPSToken; - lRed, lGreen, lBlue: Double; - lGraphicState: TGraphicState; -begin - Result := False; - - // – gsave – Push graphics state - if AToken.StrValue = 'gsave' then - begin - GraphicStateStack.Push(CurrentGraphicState.Duplicate()); - {$ifdef FPVECTORIALDEBUG_PATHS} - WriteLn('[TvEPSVectorialReader.ExecuteGraphicStateOperatorsDI] gsave'); - {$endif} - Exit(True); - end; - // – grestore - Pop graphics state - if AToken.StrValue = 'grestore' then - begin - lGraphicState := TGraphicState(GraphicStateStack.Pop()); - if lGraphicState = nil then raise Exception.Create('[TvEPSVectorialReader.ExecuteGraphicStateOperatorsDI] grestore: call to grestore without corresponding gsave'); - CurrentGraphicState.Free; - CurrentGraphicState := lGraphicState; - {$ifdef FPVECTORIALDEBUG_PATHS} - WriteLn('[TvEPSVectorialReader.ExecuteGraphicStateOperatorsDI] grestore'); - {$endif} - Exit(True); - end; - // num setlinewidth – Set line width - if AToken.StrValue = 'setlinewidth' then - begin - Param1 := TPSToken(Stack.Pop); - CurrentGraphicState.PenWidth := Round(Param1.FloatValue); - Exit(True); - end; - // int setlinecap – Set shape of line ends for stroke (0 = butt, - // 1 = round, 2 = square) - if AToken.StrValue = 'setlinecap' then - begin - Param1 := TPSToken(Stack.Pop); - Exit(True); - end; - // int setlinejoin – Set shape of corners for stroke (0 = miter, - // 1 = round, 2 = bevel) - if AToken.StrValue = 'setlinejoin' then - begin - Param1 := TPSToken(Stack.Pop); - Exit(True); - end; - // red green blue setrgbcolor – - // sets the current color space in the graphics state to DeviceRGB and the current color - // to the component values specified by red, green, and blue. Each component - // must be a number in the range 0.0 to 1.0. If any of the operands is outside this - // range, the nearest valid value is substituted without error indication. - if AToken.StrValue = 'setrgbcolor' then - begin - Param1 := TPSToken(Stack.Pop); - Param2 := TPSToken(Stack.Pop); - Param3 := TPSToken(Stack.Pop); - - lRed := EnsureRange(Param3.FloatValue, 0, 1); - lGreen := EnsureRange(Param2.FloatValue, 0, 1); - lBlue := EnsureRange(Param1.FloatValue, 0, 1); - - CurrentGraphicState.Color.Red := Round(lRed * $FFFF); - CurrentGraphicState.Color.Green := Round(lGreen * $FFFF); - CurrentGraphicState.Color.Blue := Round(lBlue * $FFFF); - CurrentGraphicState.Color.alpha := alphaOpaque; - - AData.SetPenColor(CurrentGraphicState.Color); - - {$ifdef FPVECTORIALDEBUG_COLORS} - WriteLn(Format('[TvEPSVectorialReader.ExecuteGraphicStateOperatorsDI] setrgbcolor r=%f g=%f b=%f', - [Param3.FloatValue, Param2.FloatValue, Param1.FloatValue])); - {$endif} - - Exit(True); - end; -end; - -{ Graphics State Operators (Device-Dependent) - - halftone sethalftone – Set halftone dictionary - – currenthalftone halftone - Return current halftone dictionary - frequency angle proc setscreen – Set gray halftone screen by frequency, angle, - and spot function - frequency angle halftone setscreen – Set gray halftone screen from halftone - dictionary - – currentscreen frequency angle proc|halftone - Return current gray halftone screen - redfreq redang redproc|redhalftone - greenfreq greenang greenproc|greenhalftone - bluefreq blueang blueproc|bluehalftone - grayfreq grayang grayproc|grayhalftone setcolorscreen – Set all four halftone screens - – currentcolorscreen redfreq redang redproc|redhalftone - greenfreq greenang greenproc|greenhalftone - bluefreq blueang blueproc|bluehalftone - grayfreq grayang grayproc|grayhalftone - Return all four halftone screens - proc settransfer – Set gray transfer function - – currenttransfer proc - Return current gray transfer function - redproc greenproc blueproc grayproc setcolortransfer – Set all four transfer functions - – currentcolortransfer redproc greenproc blueproc grayproc - Return current transfer functions - proc setblackgeneration – Set black-generation function - – currentblackgeneration proc - Return current black-generation function - proc setundercolorremoval – Set undercolor-removal function - – currentundercolorremoval proc - Return current undercolor-removal - function - dict setcolorrendering – Set CIE-based color rendering dictionary - – currentcolorrendering dict - Return current CIE-based color rendering - dictionary - num setflat – Set flatness tolerance - – currentflat num Return current flatness - bool setoverprint – Set overprint parameter - – currentoverprint bool Return current overprint parameter - num setsmoothness – Set smoothness parameter - – currentsmoothness num Return current smoothness parameter - Coordinate System and Matrix Operators - – matrix matrix Create identity matrix - – initmatrix – Set CTM to device default - matrix identmatrix matrix Fill matrix with identity transform - matrix defaultmatrix matrix Fill matrix with device default matrix - matrix currentmatrix matrix Fill matrix with CTM - matrix setmatrix – Replace CTM by matrix - tx ty translate – Translate user space by (tx , ty) - tx ty matrix translate matrix Define translation by (tx , ty) - sx sy scale – Scale user space by sx and sy - sx sy matrix scale matrix Define scaling by sx and sy - angle rotate – Rotate user space by angle degrees - angle matrix rotate matrix Define rotation by angle degrees - matrix concat – Replace CTM by matrix ´ CTM - matrix1 matrix2 matrix3 concatmatrix matrix3 Fill matrix3 with matrix1 ´ matrix2 - x y transform x¢ y¢ Transform (x, y) by CTM - x y matrix transform x¢ y¢ Transform (x, y) by matrix - dx dy dtransform dx¢ dy¢ Transform distance (dx, dy) by CTM - dx dy matrix dtransform dx¢ dy¢ Transform distance (dx, dy) by matrix - x¢ y¢ itransform x y Perform inverse transform of (x¢, y¢) by - CTM - x¢ y¢ matrix itransform x y Perform inverse transform of (x¢, y¢) by - matrix - dx¢ dy¢ idtransform dx dy Perform inverse transform of distance - (dx¢, dy¢) by CTM - dx¢ dy¢ matrix idtransform dx dy Perform inverse transform of distance - (dx¢, dy¢) by matrix - matrix1 matrix2 invertmatrix matrix2 Fill matrix2 with inverse of matrix1 -} -function TvEPSVectorialReader.ExecuteGraphicStateOperatorsDD( - AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean; -var - Param1, Param2: TPSToken; -begin - Result := False; - - // bool setoverprint – Set overprint parameter - if AToken.StrValue = 'setoverprint' then - begin - Param1 := TPSToken(Stack.Pop); - - CurrentGraphicState.OverPrint := Param1.BoolValue; - - Exit(True); - end; - // sx sy scale – Scale user space by sx and sy - if AToken.StrValue = 'scale' then - begin - Param1 := TPSToken(Stack.Pop); - Param2 := TPSToken(Stack.Pop); - - if Param2 = nil then - begin - Exit(True); - end; - - CurrentGraphicState.ScaleX := Param2.FloatValue; - CurrentGraphicState.ScaleY := Param1.FloatValue; - {$ifdef FPVECTORIALDEBUG_PATHS} - WriteLn(Format('[TvEPSVectorialReader.ExecuteGraphicStateOperatorsDI] scale %f %f', - [CurrentGraphicState.ScaleX, CurrentGraphicState.ScaleY])); - {$endif} - - Exit(True); - end; - { - translate tx ty translate - - tx ty matrix translate matrix - - With no matrix operand, translate builds a temporary matrix and concatenates - this matrix with the current transformation matrix (CTM). Precisely, translate - replaces the CTM by T x CTM. The effect of this is to move the origin of the - user coordinate system by tx units in the x direction and ty units in the y - direction relative to the former user coordinate system. The sizes of the x - and y units and the orientation of the axes are unchanged. - - If the matrix operand is supplied, translate replaces the value of matrix by - T and pushes the modified matrix back on the operand stack. - In this case, translate does not affect the CTM. - } - if AToken.StrValue = 'translate' then - begin - Param1 := TPSToken(Stack.Pop); // ty - Param2 := TPSToken(Stack.Pop); // tx - - if Param2 = nil then - begin - raise Exception.Create('[TvEPSVectorialReader.ExecuteGraphicStateOperatorsDI] Stack underflow in operator "translate"'); - end; - - {$ifdef FPVECTORIALDEBUG_PATHS} - WriteLn(Format('[TvEPSVectorialReader.ExecuteGraphicStateOperatorsDI] translate %f, %f CurrentGraphicState.Translate %f %f', - [Param2.FloatValue, Param1.FloatValue, CurrentGraphicState.TranslateX, CurrentGraphicState.TranslateY])); - {$endif} - - CurrentGraphicState.TranslateX := CurrentGraphicState.TranslateX + Param2.FloatValue; - CurrentGraphicState.TranslateY := CurrentGraphicState.TranslateY + Param1.FloatValue; - - Exit(True); - end; - // angle rotate – Rotate user space by angle degrees - if AToken.StrValue = 'rotate' then - begin - Param1 := TPSToken(Stack.Pop); - - {$ifdef FPVECTORIALDEBUG_PATHS} - WriteLn(Format('[TvEPSVectorialReader.ExecuteGraphicStateOperatorsDI] rotate angle=%f', [Param1.FloatValue])); - DebugStack(); - {$endif} - - Exit(True); - end; -end; - -{ Dictionary Operators - - int dict dict Create dictionary with capacity for int - elements - – << mark Start dictionary construction - mark key1 value1 … keyn valuen >> dict - End dictionary construction - dict length int Return number of entries in dict - dict maxlength int Return current capacity of dict - dict begin – Push dict on dictionary stack - – end – Pop current dictionary off dictionary stack - key value def – Associate key and value in current dictionary - key load value Search dictionary stack for key and return - associated value - key value store – Replace topmost definition of key - dict key get any Return value associated with key in dict - dict key value put – Associate key with value in dict - dict key undef – Remove key and its value from dict - dict key known bool Test whether key is in dict - key where dict true Find dictionary in which key is defined - or false - dict1 dict2 copy dict2 Copy contents of dict1 to dict2 - dict proc forall – Execute proc for each entry in dict - – currentdict dict Return current dictionary - – errordict dict Return error handler dictionary - – $error dict Return error control and status dictionary - – systemdict dict Return system dictionary - – userdict dict Return writeable dictionary in local VM - – globaldict dict Return writeable dictionary in global VM - – statusdict dict Return product-dependent dictionary - – countdictstack int Count elements on dictionary stack - array dictstack subarray Copy dictionary stack into array - – cleardictstack – Pop all nonpermanent dictionaries off - dictionary stack -} -function TvEPSVectorialReader.ExecuteDictionaryOperators( - AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean; -var - Param1, Param2: TPSToken; - NewToken: TExpressionToken; -begin - Result := False; - - // Adds a dictionary definition - // key value def – Associate key and value in current dictionary - if AToken.StrValue = 'def' then - begin - Param1 := TPSToken(Stack.Pop); - Param2 := TPSToken(Stack.Pop); - Dictionary.AddObject(Param2.StrValue, Param1); - Exit(True); - end; - - // Can be ignored, because in the files found it only loads - // standard routines, like /moveto ... - // - // key load value Search dictionary stack for key and return - // associated value - if AToken.StrValue = 'load' then - begin -// {$ifdef FPVECTORIALDEBUG_DICTIONARY} -// WriteLn('[TvEPSVectorialReader.ExecuteDictionaryOperators] load'); -// DebugStack(); -// {$endif} - - Exit(True); - end; - - // Find dictionary in which key is defined - //key where dict true Find dictionary in which key is defined - // or false - if AToken.StrValue = 'where' then - begin - {$ifdef FPVECTORIALDEBUG_DICTIONARY} - WriteLn('[TvEPSVectorialReader.ExecuteDictionaryOperators] where'); - DebugStack(); - {$endif} - - Param1 := TPSToken(Stack.Pop); - - if Dictionary.IndexOf(Param1.StrValue) >= 0 then - begin - // We use only 1 dictionary, so this is just a representation of our single dictionary - NewToken := TExpressionToken.Create; - NewToken.ETType := ettDictionary; - Stack.Push(NewToken); - - NewToken := TExpressionToken.Create; - NewToken.ETType := ettOperand; - NewToken.BoolValue := True; - Stack.Push(NewToken); - - {$ifdef FPVECTORIALDEBUG_DICTIONARY} - WriteLn('[TvEPSVectorialReader.ExecuteDictionaryOperators] where True'); - {$endif} - end - else - begin - NewToken := TExpressionToken.Create; - NewToken.ETType := ettOperand; - NewToken.BoolValue := False; - Stack.Push(NewToken); - - {$ifdef FPVECTORIALDEBUG_DICTIONARY} - WriteLn('[TvEPSVectorialReader.ExecuteDictionaryOperators] where False'); - {$endif} - end; - - Exit(True); - end; -end; - -{ Miscellaneous Operators - - proc bind proc Replace operator names in proc with - operators; perform idiom recognition - – null null Push null on stack - – version string Return interpreter version - – realtime int Return real time in milliseconds - – usertime int Return execution time in milliseconds - – languagelevel int Return LanguageLevel - – product string Return product name - – revision int Return product revision level - – serialnumber int Return machine serial number - – executive – Invoke interactive executive - bool echo – Turn echoing on or off - – prompt – Executed when ready for interactive input -} -function TvEPSVectorialReader.ExecuteMiscellaneousOperators( - AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean; -begin - Result := False; - - // Just a hint for more efficient parsing, we can ignore - // - // proc bind proc Replace operator names in proc with - // operators; perform idiom recognition - if AToken.StrValue = 'bind' then - begin - {$ifdef FPVECTORIALDEBUG_CONTROL} - WriteLn('[TvEPSVectorialReader.ExecuteControlOperator] bind'); - DebugStack(); - {$endif} - - Exit(True); - end; -end; - -procedure TvEPSVectorialReader.PostScriptCoordsToFPVectorialCoords(AParam1, - AParam2: TPSToken; var APosX, APosY: Double); -begin - APosX := AParam2.FloatValue; - APosY := AParam1.FloatValue; -end; - -// Returns true if a dictionary substitution was executed -function TvEPSVectorialReader.DictionarySubstituteOperator( - ADictionary: TStringList; var ACurToken: TPSToken): Boolean; -var - lIndex: Integer; - SubstituteToken, NewToken: TPSToken; -begin - Result := False; - lIndex := ADictionary.IndexOf(ACurToken.StrValue); - if lIndex >= 0 then - begin - Result := True; - - SubstituteToken := TPSToken(ADictionary.Objects[lIndex]); - - if SubstituteToken is TExpressionToken then - begin - ACurToken.StrValue := SubstituteToken.StrValue; - ACurToken.FloatValue := SubstituteToken.FloatValue; - end - else if SubstituteToken is TProcedureToken then - begin - ACurToken := SubstituteToken; - end; - if ACurToken.StrValue = '' then raise Exception.Create('[TvEPSVectorialReader.DictionarySubstituteOperator] The Dictionary substitution resulted in an empty value'); - end; -end; - -constructor TvEPSVectorialReader.Create; -begin - inherited Create; - - FPointSeparator := SysUtils.DefaultFormatSettings; - FPointSeparator.DecimalSeparator := '.'; - FPointSeparator.ThousandSeparator := ','; - - Tokenizer := TPSTokenizer.Create(-1); - Stack := TObjectStack.Create; - GraphicStateStack := TObjectStack.Create; - Dictionary := TStringList.Create; - Dictionary.CaseSensitive := True; - CurrentGraphicState := TGraphicState.Create; -end; - -destructor TvEPSVectorialReader.Destroy; -begin - Tokenizer.Free; - Stack.Free; - GraphicStateStack.Free; - Dictionary.Free; - CurrentGraphicState.Free; - - inherited Destroy; -end; - -procedure TvEPSVectorialReader.ReadFromStream(AStream: TStream; - AData: TvVectorialDocument); -var - lPage: TvVectorialPage; -begin - Tokenizer.ReadFromStream(AStream); -// Tokenizer.DebugOut(); - - // Make sure we have at least one path - lPage := AData.AddPage(); - lPage.StartPath(); - - RunPostScript(Tokenizer.Tokens, lPage, AData); - - // Make sure we have at least one path - lPage.EndPath(); - - // PostScript has no document size information, so lets calculate it ourselves - AData.GuessDocumentSize(); - AData.GuessGoodZoomLevel() -end; - -initialization - - RegisterVectorialReader(TvEPSVectorialReader, vfEncapsulatedPostScript); - -end. - diff --git a/applications/fpvviewer/fpvectorialsrc/fpvectbuildunit.pas b/applications/fpvviewer/fpvectorialsrc/fpvectbuildunit.pas deleted file mode 100644 index e5e68e8a7..000000000 --- a/applications/fpvviewer/fpvectorialsrc/fpvectbuildunit.pas +++ /dev/null @@ -1,10 +0,0 @@ -unit fpvectbuildunit; - -interface -Uses - avisocncgcodereader,avisocncgcodewriter,avisozlib,fpvectorial, - fpvtocanvas, - svgvectorialwriter,cdrvectorialreader,epsvectorialreader; - -implementation -end. diff --git a/applications/fpvviewer/fpvectorialsrc/fpvectorial.pas b/applications/fpvviewer/fpvectorialsrc/fpvectorial.pas deleted file mode 100644 index 4f7902982..000000000 --- a/applications/fpvviewer/fpvectorialsrc/fpvectorial.pas +++ /dev/null @@ -1,1473 +0,0 @@ -{ -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, Math, - fpcanvas, fpimage; - -type - TvVectorialFormat = ( - { Multi-purpose document formats } - vfPDF, vfSVG, vfCorelDrawCDR, vfWindowsMetafileWMF, - { CAD formats } - vfDXF, - { Printing formats } - vfPostScript, vfEncapsulatedPostScript, - { GCode formats } - vfGCodeAvisoCNCPrototipoV5, vfGCodeAvisoCNCPrototipoV6); - -const - { Default extensions } - { Multi-purpose document formats } - STR_PDF_EXTENSION = '.pdf'; - STR_POSTSCRIPT_EXTENSION = '.ps'; - STR_SVG_EXTENSION = '.svg'; - STR_CORELDRAW_EXTENSION = '.cdr'; - STR_WINMETAFILE_EXTENSION = '.wmf'; - STR_AUTOCAD_EXCHANGE_EXTENSION = '.dxf'; - STR_ENCAPSULATEDPOSTSCRIPT_EXTENSION = '.eps'; - -type - { Pen, Brush and Font } - - TvPen = record - Color: TFPColor; - Style: TFPPenStyle; - Width: Integer; - end; - - TvBrush = record - Color: TFPColor; - Style: TFPBrushStyle; - end; - - TvFont = record - Color: TFPColor; - Size: integer; - Name: utf8string; - {@@ - Font orientation is measured in degrees and uses the - same direction as the LCL TFont.orientation, which is counter-clockwise. - Zero is the normal, horizontal, orientation, directed to the right. - } - Orientation: Double; - end; - - { Coordinates and polyline segments } - - T3DPoint = record - X, Y, Z: Double; - end; - - P3DPoint = ^T3DPoint; - - TSegmentType = ( - st2DLine, st2DLineWithPen, st2DBezier, - st3DLine, st3DBezier, stMoveTo); - - {@@ - The coordinates in fpvectorial are given in millimiters and - the starting point is in the bottom-left corner of the document. - The X grows to the right and the Y grows to the top. - } - { TPathSegment } - - TPathSegment = class - public - SegmentType: TSegmentType; - // Fields for linking the list - Previous: TPathSegment; - Next: TPathSegment; - end; - - {@@ - In a 2D segment, the X and Y coordinates represent usually the - final point of the segment, being that it starts where the previous - segment ends. The exception is for the first segment of all, which simply - holds the starting point for the drawing and should always be of the type - stMoveTo. - } - T2DSegment = class(TPathSegment) - public - X, Y: Double; - end; - - T2DSegmentWithPen = class(T2DSegment) - public - Pen: TvPen; - end; - - {@@ - In Bezier segments, we remain using the X and Y coordinates for the ending point. - The starting point is where the previous segment ended, so that the intermediary - bezier control points are [X2, Y2] and [X3, Y3]. - } - T2DBezierSegment = class(T2DSegment) - public - X2, Y2: Double; - X3, Y3: Double; - end; - - T3DSegment = class(TPathSegment) - public - {@@ - Coordinates of the end of the segment. - For the first segment, this is the starting point. - } - X, Y, Z: Double; - end; - - T3DBezierSegment = class(T3DSegment) - public - X2, Y2, Z2: Double; - X3, Y3, Z3: Double; - end; - - TvFindEntityResult = (vfrNotFound, vfrFound, vfrSubpartFound); - - { Now all elements } - - {@@ - All elements should derive from TvEntity, regardless of whatever properties - they might contain. - } - - { TvEntity } - - TvEntity = class - public - X, Y: Double; - {@@ The global Pen for the entire entity. In the case of paths, individual - elements might be able to override this setting. } - Pen: TvPen; - {@@ The global Brush for the entire entity. In the case of paths, individual - elements might be able to override this setting. } - Brush: TvBrush; - constructor Create; virtual; - procedure CalculateBoundingBox(var ALeft, ATop, ARight, ABottom: Double); virtual; - procedure ExpandBoundingBox(var ALeft, ATop, ARight, ABottom: Double); - function TryToSelect(APos: TPoint): TvFindEntityResult; virtual; - procedure Translate(ADeltaX, ADeltaY: Integer); virtual; - end; - - TvClipMode = (vcmNonzeroWindingRule, vcmEvenOddRule); - - TPath = class(TvEntity) - Len: Integer; - Points: TPathSegment; // Beginning 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; - procedure CalculateBoundingBox(var ALeft, ATop, ARight, ABottom: Double); override; - procedure AppendSegment(ASegment: TPathSegment); - end; - - {@@ - TvText represents a text entity. - } - - { TvText } - - TvText = class(TvEntity) - public - Value: TStringList; - Font: TvFont; - constructor Create; override; - destructor Destroy; override; - function TryToSelect(APos: TPoint): TvFindEntityResult; override; - end; - - {@@ - } - TvCircle = class(TvEntity) - public - Radius: Double; - end; - - {@@ - } - TvCircularArc = class(TvEntity) - public - Radius: Double; - {@@ The Angle is measured in degrees in relation to the positive X axis } - StartAngle, EndAngle: Double; - end; - - {@@ - } - TvEllipse = class(TvEntity) - public - // Mandatory fields - MajorHalfAxis, MinorHalfAxis: Double; - {@@ The Angle is measured in degrees in relation to the positive X axis } - Angle: Double; - // Calculated fields - BoundingRect: TRect; - procedure CalculateBoundingRectangle; - end; - - {@@ - The brush has no effect in this class - - DimensionLeft ---text--- DimensionRight - | | - | | BaseRight - | - | BaseLeft - } - - { TvAlignedDimension } - - TvAlignedDimension = class(TvEntity) - public - // Mandatory fields - BaseLeft, BaseRight, DimensionLeft, DimensionRight: T3DPoint; - end; - - {@@ - Vectorial images can contain raster images inside them and this entity - represents this. - - If the Width and Height differ from the same data in the image, then - the raster image will be stretched. - - Note that TFPCustomImage does not implement a storage, so the property - RasterImage should be filled with either a FPImage.TFPMemoryImage or with - a TLazIntfImage. The property RasterImage might be nil. - } - TvRasterImage = class(TvEntity) - public - RasterImage: TFPCustomImage; - Top, Left, Width, Height: Double; - end; - -type - - TvCustomVectorialWriter = class; - TvCustomVectorialReader = class; - TvVectorialPage = class; - - { TvVectorialDocument } - - TvVectorialDocument = class - private - FPages: TFPList; - FCurrentPageIndex: Integer; - function CreateVectorialWriter(AFormat: TvVectorialFormat): TvCustomVectorialWriter; - function CreateVectorialReader(AFormat: TvVectorialFormat): TvCustomVectorialReader; - public - Width, Height: Double; // in millimeters - Name: string; - // User-Interface information - ZoomLevel: Double; // 1 = 100% - { Selection fields } - SelectedvElement: TvEntity; - { Base methods } - constructor Create; virtual; - destructor Destroy; override; - procedure Assign(ASource: TvVectorialDocument); - procedure AssignTo(ADest: TvVectorialDocument); - procedure WriteToFile(AFileName: string; AFormat: TvVectorialFormat); overload; - procedure WriteToFile(AFileName: string); overload; - procedure WriteToStream(AStream: TStream; AFormat: TvVectorialFormat); - procedure WriteToStrings(AStrings: TStrings; AFormat: TvVectorialFormat); - procedure ReadFromFile(AFileName: string; AFormat: TvVectorialFormat); overload; - procedure ReadFromFile(AFileName: string); overload; - procedure ReadFromStream(AStream: TStream; AFormat: TvVectorialFormat); - procedure ReadFromStrings(AStrings: TStrings; AFormat: TvVectorialFormat); - class function GetFormatFromExtension(AFileName: string): TvVectorialFormat; - function GetDetailedFileFormat(): string; - procedure GuessDocumentSize(); - procedure GuessGoodZoomLevel(AScreenSize: Integer = 500); - { Page methods } - function GetPage(AIndex: Integer): TvVectorialPage; - function GetPageCount: Integer; - function GetCurrentPage: TvVectorialPage; - procedure SetCurrentPage(AIndex: Integer); - function AddPage(): TvVectorialPage; - { Data removing methods } - procedure Clear; virtual; - end; - - { TvVectorialPage } - - TvVectorialPage = class - private - FEntities: TFPList; - FTmpPath: TPath; - FTmpText: TvText; - //procedure RemoveCallback(data, arg: pointer); - procedure ClearTmpPath(); - procedure AppendSegmentToTmpPath(ASegment: TPathSegment); - public - Width, Height: Double; // in millimeters - Owner: TvVectorialDocument; - { Base methods } - constructor Create(AOwner: TvVectorialDocument); virtual; - destructor Destroy; override; - procedure Assign(ASource: TvVectorialPage); - { Data reading methods } - function GetEntity(ANum: Cardinal): TvEntity; - function GetEntitiesCount: Integer; - function FindAndSelectEntity(Pos: TPoint): TvFindEntityResult; - { Data removing methods } - procedure Clear; virtual; - { Data writing methods } - function AddEntity(AEntity: TvEntity): Integer; - procedure AddPathCopyMem(APath: TPath); - procedure StartPath(AX, AY: Double); overload; - procedure StartPath(); overload; - procedure AddMoveToPath(AX, AY: Double); - procedure AddLineToPath(AX, AY: Double); overload; - procedure AddLineToPath(AX, AY: Double; AColor: TFPColor); overload; - procedure AddLineToPath(AX, AY, AZ: Double); overload; - procedure GetCurrentPathPenPos(var AX, AY: Double); - procedure AddBezierToPath(AX1, AY1, AX2, AY2, AX3, AY3: Double); overload; - procedure AddBezierToPath(AX1, AY1, AZ1, AX2, AY2, AZ2, AX3, AY3, AZ3: Double); overload; - procedure SetBrushColor(AColor: TFPColor); - procedure SetBrushStyle(AStyle: TFPBrushStyle); - procedure SetPenColor(AColor: TFPColor); - procedure SetPenStyle(AStyle: TFPPenStyle); - procedure SetPenWidth(AWidth: Integer); - procedure SetClipPath(AClipPath: TPath; AClipMode: TvClipMode); - procedure EndPath(); - procedure AddText(AX, AY: Double; FontName: string; FontSize: integer; AText: utf8string); overload; - procedure AddText(AX, AY: Double; AStr: utf8string); overload; - procedure AddCircle(ACenterX, ACenterY, ARadius: Double); - procedure AddCircularArc(ACenterX, ACenterY, ARadius, AStartAngle, AEndAngle: Double; AColor: TFPColor); - procedure AddEllipse(CenterX, CenterY, MajorHalfAxis, MinorHalfAxis, Angle: Double); - // Dimensions - procedure AddAlignedDimension(BaseLeft, BaseRight, DimLeft, DimRight: T3DPoint); - end; - - {@@ TvVectorialReader class reference type } - - TvVectorialReaderClass = class of TvCustomVectorialReader; - - { TvCustomVectorialReader } - - TvCustomVectorialReader = class - public - { General reading methods } - constructor Create; virtual; - 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 } - constructor Create; virtual; - 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); -function Make2DPoint(AX, AY: Double): T3DPoint; - -implementation - -const - Str_Error_Nil_Path = ' The program attempted to add a segment before creating a path'; - -{@@ - 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; - -function Make2DPoint(AX, AY: Double): T3DPoint; -begin - Result.X := AX; - Result.Y := AY; - Result.Z := 0; -end; - -{ TvVectorialPage } - -procedure TvVectorialPage.ClearTmpPath; -var - segment, oldsegment: TPathSegment; -begin - FTmpPath.Points := nil; - FTmpPath.PointsEnd := nil; - FTmpPath.Len := 0; - FTmpPath.Brush.Color := colBlue; - FTmpPath.Brush.Style := bsClear; - FTmpPath.Pen.Color := colBlack; - FTmpPath.Pen.Style := psSolid; - FTmpPath.Pen.Width := 1; -end; - -procedure TvVectorialPage.AppendSegmentToTmpPath(ASegment: TPathSegment); -begin - FTmpPath.AppendSegment(ASegment); -end; - -constructor TvVectorialPage.Create(AOwner: TvVectorialDocument); -begin - inherited Create; - - FEntities := TFPList.Create; - FTmpPath := TPath.Create; - Owner := AOwner; -end; - -destructor TvVectorialPage.Destroy; -begin - Clear; - - FEntities.Free; - - inherited Destroy; -end; - -procedure TvVectorialPage.Assign(ASource: TvVectorialPage); -var - i: Integer; -begin - Clear; - - for i := 0 to ASource.GetEntitiesCount - 1 do - Self.AddEntity(ASource.GetEntity(i)); -end; - -function TvVectorialPage.GetEntity(ANum: Cardinal): TvEntity; -begin - if ANum >= FEntities.Count then raise Exception.Create('TvVectorialDocument.GetEntity: Entity number out of bounds'); - - if FEntities.Items[ANum] = nil then raise Exception.Create('TvVectorialDocument.GetEntity: Invalid Entity number'); - - Result := TvEntity(FEntities.Items[ANum]); -end; - -function TvVectorialPage.GetEntitiesCount: Integer; -begin - Result := FEntities.Count; -end; - -function TvVectorialPage.FindAndSelectEntity(Pos: TPoint): TvFindEntityResult; -var - lEntity: TvEntity; - i: Integer; -begin - Result := vfrNotFound; - - for i := 0 to GetEntitiesCount() - 1 do - begin - lEntity := GetEntity(i); - - Result := lEntity.TryToSelect(Pos); - - if Result <> vfrNotFound then - begin - Owner.SelectedvElement := lEntity; - Exit; - end; - end; -end; - -procedure TvVectorialPage.Clear; -begin - FEntities.Clear(); -end; - -{@@ - Adds an entity to the document and returns it's current index -} -function TvVectorialPage.AddEntity(AEntity: TvEntity): Integer; -begin - Result := FEntities.Count; - FEntities.Add(Pointer(AEntity)); -end; - -procedure TvVectorialPage.AddPathCopyMem(APath: TPath); -var - lPath: TPath; - Len: Integer; -begin - lPath := TPath.Create; - lPath.Assign(APath); - AddEntity(lPath); - //WriteLn(':>TvVectorialDocument.AddPath 1 Len = ', Len); -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 EndPath, AddPointToPath -} -procedure TvVectorialPage.StartPath(AX, AY: Double); -var - segment: T2DSegment; -begin - ClearTmpPath(); - - FTmpPath.Len := 1; - segment := T2DSegment.Create; - segment.SegmentType := stMoveTo; - segment.X := AX; - segment.Y := AY; - - FTmpPath.Points := segment; - FTmpPath.PointsEnd := segment; -end; - -procedure TvVectorialPage.StartPath; -begin - ClearTmpPath(); -end; - -procedure TvVectorialPage.AddMoveToPath(AX, AY: Double); -var - segment: T2DSegment; -begin - segment := T2DSegment.Create; - segment.SegmentType := stMoveTo; - segment.X := AX; - segment.Y := AY; - - AppendSegmentToTmpPath(segment); -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 TvVectorialPage.AddLineToPath(AX, AY: Double); -var - segment: T2DSegment; -begin - segment := T2DSegment.Create; - segment.SegmentType := st2DLine; - segment.X := AX; - segment.Y := AY; - - AppendSegmentToTmpPath(segment); -end; - -procedure TvVectorialPage.AddLineToPath(AX, AY: Double; AColor: TFPColor); -var - segment: T2DSegmentWithPen; -begin - segment := T2DSegmentWithPen.Create; - segment.SegmentType := st2DLineWithPen; - segment.X := AX; - segment.Y := AY; - segment.Pen.Color := AColor; - - AppendSegmentToTmpPath(segment); -end; - -procedure TvVectorialPage.AddLineToPath(AX, AY, AZ: Double); -var - segment: T3DSegment; -begin - segment := T3DSegment.Create; - segment.SegmentType := st3DLine; - segment.X := AX; - segment.Y := AY; - segment.Z := AZ; - - AppendSegmentToTmpPath(segment); -end; - -{@@ - Gets the current Pen Pos in the temporary path -} -procedure TvVectorialPage.GetCurrentPathPenPos(var AX, AY: Double); -begin - // Check if we are the first segment in the tmp path - if FTmpPath.PointsEnd = nil then raise Exception.Create('[TvVectorialDocument.GetCurrentPathPenPos] One cannot obtain the Pen Pos if there are no segments in the temporary path'); - - AX := T2DSegment(FTmpPath.PointsEnd).X; - AY := T2DSegment(FTmpPath.PointsEnd).Y; -end; - -{@@ - Adds a bezier element to the path. It starts where the previous element ended - and it goes throw the control points [AX1, AY1] and [AX2, AY2] and ends - in [AX3, AY3]. -} -procedure TvVectorialPage.AddBezierToPath(AX1, AY1, AX2, AY2, AX3, AY3: Double); -var - segment: T2DBezierSegment; -begin - segment := T2DBezierSegment.Create; - segment.SegmentType := st2DBezier; - segment.X := AX3; - segment.Y := AY3; - segment.X2 := AX1; - segment.Y2 := AY1; - segment.X3 := AX2; - segment.Y3 := AY2; - - AppendSegmentToTmpPath(segment); -end; - -procedure TvVectorialPage.AddBezierToPath(AX1, AY1, AZ1, AX2, AY2, AZ2, AX3, AY3, AZ3: Double); -var - segment: T3DBezierSegment; -begin - segment := T3DBezierSegment.Create; - segment.SegmentType := st3DBezier; - segment.X := AX3; - segment.Y := AY3; - segment.Z := AZ3; - segment.X2 := AX1; - segment.Y2 := AY1; - segment.Z2 := AZ1; - segment.X3 := AX2; - segment.Y3 := AY2; - segment.Z3 := AZ2; - - AppendSegmentToTmpPath(segment); -end; - -procedure TvVectorialPage.SetBrushColor(AColor: TFPColor); -begin - FTmPPath.Brush.Color := AColor; -end; - -procedure TvVectorialPage.SetBrushStyle(AStyle: TFPBrushStyle); -begin - FTmPPath.Brush.Style := AStyle; -end; - -procedure TvVectorialPage.SetPenColor(AColor: TFPColor); -begin - FTmPPath.Pen.Color := AColor; -end; - -procedure TvVectorialPage.SetPenStyle(AStyle: TFPPenStyle); -begin - FTmPPath.Pen.Style := AStyle; -end; - -procedure TvVectorialPage.SetPenWidth(AWidth: Integer); -begin - FTmPPath.Pen.Width := AWidth; -end; - -procedure TvVectorialPage.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, - to the document. - - Does nothing if there wasn't a previous correspondent call to - StartPath. - - @see StartPath, AddPointToPath -} -procedure TvVectorialPage.EndPath; -begin - if FTmPPath.Len = 0 then Exit; - AddPathCopyMem(FTmPPath); - ClearTmpPath(); -end; - -procedure TvVectorialPage.AddText(AX, AY: Double; FontName: string; - FontSize: integer; AText: utf8string); -var - lText: TvText; -begin - lText := TvText.Create; - lText.Value.Text := AText; - lText.X := AX; - lText.Y := AY; - lText.Font.Name := FontName; - lText.Font.Size := FontSize; - AddEntity(lText); -end; - -procedure TvVectorialPage.AddText(AX, AY: Double; AStr: utf8string); -begin - AddText(AX, AY, '', 10, AStr); -end; - -procedure TvVectorialPage.AddCircle(ACenterX, ACenterY, ARadius: Double); -var - lCircle: TvCircle; -begin - lCircle := TvCircle.Create; - lCircle.X := ACenterX; - lCircle.Y := ACenterY; - lCircle.Radius := ARadius; - AddEntity(lCircle); -end; - -procedure TvVectorialPage.AddCircularArc(ACenterX, ACenterY, ARadius, - AStartAngle, AEndAngle: Double; AColor: TFPColor); -var - lCircularArc: TvCircularArc; -begin - lCircularArc := TvCircularArc.Create; - lCircularArc.X := ACenterX; - lCircularArc.Y := ACenterY; - lCircularArc.Radius := ARadius; - lCircularArc.StartAngle := AStartAngle; - lCircularArc.EndAngle := AEndAngle; - lCircularArc.Pen.Color := AColor; - AddEntity(lCircularArc); -end; - -procedure TvVectorialPage.AddEllipse(CenterX, CenterY, MajorHalfAxis, - MinorHalfAxis, Angle: Double); -var - lEllipse: TvEllipse; -begin - lEllipse := TvEllipse.Create; - lEllipse.X := CenterX; - lEllipse.Y := CenterY; - lEllipse.MajorHalfAxis := MajorHalfAxis; - lEllipse.MinorHalfAxis := MinorHalfAxis; - lEllipse.Angle := Angle; - AddEntity(lEllipse); -end; - - -procedure TvVectorialPage.AddAlignedDimension(BaseLeft, BaseRight, DimLeft, - DimRight: T3DPoint); -var - lDim: TvAlignedDimension; -begin - lDim := TvAlignedDimension.Create; - lDim.BaseLeft := BaseLeft; - lDim.BaseRight := BaseRight; - lDim.DimensionLeft := DimLeft; - lDim.DimensionRight := DimRight; - AddEntity(lDim); -end; - -{ TvText } - -constructor TvText.Create; -begin - inherited Create; - Value := TStringList.Create; -end; - -destructor TvText.Destroy; -begin - Value.Free; - inherited Destroy; -end; - -function TvText.TryToSelect(APos: TPoint): TvFindEntityResult; -var - lProximityFactor: Integer; -begin - lProximityFactor := 5; - if (APos.X > X - lProximityFactor) and (APos.X < X + lProximityFactor) - and (APos.Y > Y - lProximityFactor) and (APos.Y < Y + lProximityFactor) then - Result := vfrFound - else Result := vfrNotFound; -end; - -{ TvEntity } - -constructor TvEntity.Create; -begin - Pen.Style := psSolid; - Pen.Color := colBlack; - Brush.Style := bsClear; - Brush.Color := colBlue; -end; - -procedure TvEntity.CalculateBoundingBox(var ALeft, ATop, ARight, ABottom: Double); -begin - ALeft := 0; - ATop := 0; - ARight := 0; - ABottom := 0; -end; - -procedure TvEntity.ExpandBoundingBox(var ALeft, ATop, ARight, ABottom: Double); -var - lLeft, lTop, lRight, lBottom: Double; -begin - CalculateBoundingBox(lLeft, lTop, lRight, lBottom); - if lLeft < ALeft then ALeft := lLeft; - if lTop < ATop then ATop := lTop; - if lRight > ARight then ARight := lRight; - if lBottom > ABottom then ABottom := lBottom; -end; - -function TvEntity.TryToSelect(APos: TPoint): TvFindEntityResult; -begin - Result := vfrNotFound; -end; - -procedure TvEntity.Translate(ADeltaX, ADeltaY: Integer); -begin - X := X + ADeltaX; - Y := Y + ADeltaY; -end; - -{ TvEllipse } - -procedure TvEllipse.CalculateBoundingRectangle; -var - t, tmp: Double; -begin - { - To calculate the bounding rectangle we can do this: - - Ellipse equations:You could try using the parametrized equations for an ellipse rotated at an arbitrary angle: - - x = CenterX + MajorHalfAxis*cos(t)*cos(Angle) - MinorHalfAxis*sin(t)*sin(Angle) - y = CenterY + MinorHalfAxis*sin(t)*cos(Angle) + MajorHalfAxis*cos(t)*sin(Angle) - - You can then differentiate and solve for gradient = 0: - 0 = dx/dt = -MajorHalfAxis*sin(t)*cos(Angle) - MinorHalfAxis*cos(t)*sin(Angle) - => - tan(t) = -MinorHalfAxis*tan(Angle)/MajorHalfAxis - => - t = cotang(-MinorHalfAxis*tan(Angle)/MajorHalfAxis) - - On the other axis: - - 0 = dy/dt = b*cos(t)*cos(phi) - a*sin(t)*sin(phi) - => - tan(t) = b*cot(phi)/a - } - t := cotan(-MinorHalfAxis*tan(Angle)/MajorHalfAxis); - tmp := X + MajorHalfAxis*cos(t)*cos(Angle) - MinorHalfAxis*sin(t)*sin(Angle); - BoundingRect.Right := Round(tmp); -end; - -{ TsWorksheet } - -{@@ - Constructor. -} -constructor TvVectorialDocument.Create; -begin - inherited Create; - - FPages := TFPList.Create; -end; - -{@@ - Destructor. -} -destructor TvVectorialDocument.Destroy; -begin - Clear; - - FPages.Free; - - inherited Destroy; -end; - -procedure TvVectorialDocument.Assign(ASource: TvVectorialDocument); -//var -// i: Integer; -begin -// Clear; -// -// for i := 0 to ASource.GetEntitiesCount - 1 do -// Self.AddEntity(ASource.GetEntity(i)); -end; - -procedure TvVectorialDocument.AssignTo(ADest: TvVectorialDocument); -begin - ADest.Assign(Self); -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 - if GvVectorialFormats[i].WriterClass <> nil then - Result := GvVectorialFormats[i].WriterClass.Create; - - Break; - end; - - if Result = nil then raise Exception.Create('Unsupported 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 - if GvVectorialFormats[i].ReaderClass <> nil then - Result := GvVectorialFormats[i].ReaderClass.Create; - - Break; - end; - - if Result = nil then raise Exception.Create('Unsupported 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; - -procedure TvVectorialDocument.WriteToFile(AFileName: string); -var - lFormat: TvVectorialFormat; -begin - lFormat := GetFormatFromExtension(ExtractFileExt(AFileName)); - WriteToFile(AFileName, lFormat); -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 in this object 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 file. A variant that auto-detects the format from the extension and other factors. -} -procedure TvVectorialDocument.ReadFromFile(AFileName: string); -var - lFormat: TvVectorialFormat; -begin - lFormat := GetFormatFromExtension(ExtractFileExt(AFileName)); - ReadFromFile(AFileName, lFormat); -end; - -{@@ - Reads the document from a stream. - - Any current contents in this object 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; - -class function TvVectorialDocument.GetFormatFromExtension(AFileName: string - ): TvVectorialFormat; -var - lExt: string; -begin - lExt := ExtractFileExt(AFileName); - if AnsiCompareText(lExt, STR_PDF_EXTENSION) = 0 then Result := vfPDF - else if AnsiCompareText(lExt, STR_POSTSCRIPT_EXTENSION) = 0 then Result := vfPostScript - else if AnsiCompareText(lExt, STR_SVG_EXTENSION) = 0 then Result := vfSVG - else if AnsiCompareText(lExt, STR_CORELDRAW_EXTENSION) = 0 then Result := vfCorelDrawCDR - else if AnsiCompareText(lExt, STR_WINMETAFILE_EXTENSION) = 0 then Result := vfWindowsMetafileWMF - else if AnsiCompareText(lExt, STR_AUTOCAD_EXCHANGE_EXTENSION) = 0 then Result := vfDXF - else if AnsiCompareText(lExt, STR_ENCAPSULATEDPOSTSCRIPT_EXTENSION) = 0 then Result := vfEncapsulatedPostScript - else - raise Exception.Create('TvVectorialDocument.GetFormatFromExtension: The extension (' + lExt + ') doesn''t match any supported formats.'); -end; - -function TvVectorialDocument.GetDetailedFileFormat(): string; -begin - -end; - -procedure TvVectorialDocument.GuessDocumentSize(); -var - i, j: Integer; - lEntity: TvEntity; - lLeft, lTop, lRight, lBottom: Double; - CurPage: TvVectorialPage; -begin - lLeft := 0; - lTop := 0; - lRight := 0; - lBottom := 0; - - for j := 0 to GetPageCount()-1 do - begin - CurPage := GetPage(j); - for i := 0 to CurPage.GetEntitiesCount() - 1 do - begin - lEntity := CurPage.GetEntity(I); - lEntity.ExpandBoundingBox(lLeft, lTop, lRight, lBottom); - end; - end; - - Width := lRight - lLeft; - Height := lBottom - lTop; -end; - -procedure TvVectorialDocument.GuessGoodZoomLevel(AScreenSize: Integer); -begin - ZoomLevel := AScreenSize / Height; -end; - -function TvVectorialDocument.GetPage(AIndex: Integer): TvVectorialPage; -begin - Result := TvVectorialPage(FPages.Items[AIndex]); -end; - -function TvVectorialDocument.GetPageCount: Integer; -begin - Result := FPages.Count; -end; - -function TvVectorialDocument.GetCurrentPage: TvVectorialPage; -begin - if FCurrentPageIndex >= 0 then - Result := GetPage(FCurrentPageIndex) - else - Result := nil; -end; - -procedure TvVectorialDocument.SetCurrentPage(AIndex: Integer); -begin - FCurrentPageIndex := AIndex; -end; - -function TvVectorialDocument.AddPage: TvVectorialPage; -begin - Result := TvVectorialPage.Create(Self); - FPages.Add(Result); - if FCurrentPageIndex < 0 then FCurrentPageIndex := FPages.Count-1; -end; - -{@@ - Clears all data in the document -} -procedure TvVectorialDocument.Clear; -begin -end; - -{ TvCustomVectorialReader } - -constructor TvCustomVectorialReader.Create; -begin - inherited Create; -end; - -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 } - -constructor TvCustomVectorialWriter.Create; -begin - inherited Create; -end; - -{@@ - 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; - -{@@ - The default stream writer just uses WriteToStrings -} -procedure TvCustomVectorialWriter.WriteToStream(AStream: TStream; - AData: TvVectorialDocument); -var - lStringList: TStringList; -begin - lStringList := TStringList.Create; - try - WriteToStrings(lStringList, AData); - lStringList.SaveToStream(AStream); - finally - lStringList.Free; - end; -end; - -procedure TvCustomVectorialWriter.WriteToStrings(AStrings: TStrings; - AData: TvVectorialDocument); -begin - -end; - -{ TPath } - -procedure TPath.Assign(ASource: TPath); -begin - Len := ASource.Len; - Points := ASource.Points; - PointsEnd := ASource.PointsEnd; - CurPoint := ASource.CurPoint; - Pen := ASource.Pen; - Brush := ASource.Brush; - ClipPath := ASource.ClipPath; - ClipMode := ASource.ClipMode; -end; - -procedure TPath.PrepareForSequentialReading; -begin - CurPoint := nil; -end; - -function TPath.Next(): TPathSegment; -begin - if CurPoint = nil then Result := Points - else Result := CurPoint.Next; - - CurPoint := Result; -end; - -procedure TPath.CalculateBoundingBox(var ALeft, ATop, ARight, ABottom: Double); -var - lSegment: TPathSegment; - l2DSegment: T2DSegment; - lFirstValue: Boolean = True; -begin - inherited CalculateBoundingBox(ALeft, ATop, ARight, ABottom); - - PrepareForSequentialReading(); - lSegment := Next(); - while lSegment <> nil do - begin - if lSegment is T2DSegment then - begin - l2DSegment := T2DSegment(lSegment); - if lFirstValue then - begin - ALeft := l2DSegment.X; - ATop := l2DSegment.Y; - ARight := l2DSegment.X; - ABottom := l2DSegment.Y; - lFirstValue := False; - end - else - begin - if l2DSegment.X < ALeft then ALeft := l2DSegment.X; - if l2DSegment.Y < ATop then ATop := l2DSegment.Y; - if l2DSegment.X > ARight then ARight := l2DSegment.X; - if l2DSegment.Y > ABottom then ABottom := l2DSegment.Y; - end; - end; - - lSegment := Next(); - end; -end; - -procedure TPath.AppendSegment(ASegment: TPathSegment); -var - L: Integer; -begin - // Check if we are the first segment in the tmp path - if PointsEnd = nil then - begin - if Len <> 0 then - Exception.Create('[TPath.AppendSegment] Assertion failed Len <> 0 with PointsEnd = nil'); - - Points := ASegment; - PointsEnd := ASegment; - Len := 1; - Exit; - end; - - L := Len; - Inc(Len); - - // Adds the element to the end of the list - PointsEnd.Next := ASegment; - ASegment.Previous := PointsEnd; - PointsEnd := ASegment; -end; - -finalization - - SetLength(GvVectorialFormats, 0); - -end. - diff --git a/applications/fpvviewer/fpvectorialsrc/fpvectorialpkg.lpk b/applications/fpvviewer/fpvectorialsrc/fpvectorialpkg.lpk deleted file mode 100644 index 9eb8097ce..000000000 --- a/applications/fpvviewer/fpvectorialsrc/fpvectorialpkg.lpk +++ /dev/null @@ -1,82 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/applications/fpvviewer/fpvectorialsrc/fpvectorialpkg.pas b/applications/fpvviewer/fpvectorialsrc/fpvectorialpkg.pas deleted file mode 100644 index bf0888c21..000000000 --- a/applications/fpvviewer/fpvectorialsrc/fpvectorialpkg.pas +++ /dev/null @@ -1,23 +0,0 @@ -{ This file was automatically created by Lazarus. Do not edit! - This source is only used to compile and install the package. - } - -unit fpvectorialpkg; - -interface - -uses - svgvectorialwriter, fpvtocanvas, fpvectorial, fpvectbuildunit, - dxfvectorialreader, cdrvectorialreader, avisozlib, avisocncgcodewriter, - avisocncgcodereader, svgvectorialreader, epsvectorialreader, fpvutils, - LazarusPackageIntf; - -implementation - -procedure Register; -begin -end; - -initialization - RegisterPackage('fpvectorialpkg', @Register); -end. diff --git a/applications/fpvviewer/fpvectorialsrc/fpvtocanvas.pas b/applications/fpvviewer/fpvectorialsrc/fpvtocanvas.pas deleted file mode 100644 index 58a0ff886..000000000 --- a/applications/fpvviewer/fpvectorialsrc/fpvtocanvas.pas +++ /dev/null @@ -1,591 +0,0 @@ -unit fpvtocanvas; - -{$mode objfpc}{$H+} - -interface - -{$define USE_LCL_CANVAS} -{$ifdef USE_LCL_CANVAS} - {$define USE_CANVAS_CLIP_REGION} - {.$define DEBUG_CANVAS_CLIP_REGION} -{$endif} -{$ifndef Windows} -{.$define FPVECTORIAL_TOCANVAS_DEBUG} -{$endif} - -uses - Classes, SysUtils, Math, - {$ifdef USE_LCL_CANVAS} - Graphics, LCLIntf, LCLType, - {$endif} - fpcanvas, - fpimage, - fpvectorial, fpvutils; - -procedure DrawFPVectorialToCanvas(ASource: TvVectorialPage; - ADest: TFPCustomCanvas; - ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); -procedure DrawFPVPathToCanvas(ASource: TvVectorialPage; CurPath: TPath; - ADest: TFPCustomCanvas; - ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); -procedure DrawFPVEntityToCanvas(ASource: TvVectorialPage; CurEntity: TvEntity; - ADest: TFPCustomCanvas; - ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); -procedure DrawFPVTextToCanvas(ASource: TvVectorialPage; CurText: TvText; - ADest: TFPCustomCanvas; - ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); - -implementation - -function Rotate2DPoint(P,Fix :TPoint; alpha:double): TPoint; -var - sinus, cosinus : Extended; -begin - SinCos(alpha, sinus, cosinus); - P.x := P.x - Fix.x; - P.y := P.y - Fix.y; - result.x := Round(p.x*cosinus + p.y*sinus) + fix.x ; - result.y := Round(-p.x*sinus + p.y*cosinus) + Fix.y; -end; - -procedure DrawRotatedEllipse( - ADest: TFPCustomCanvas; - CurEllipse: TvEllipse; - ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); -var - PointList: array[0..6] of TPoint; - f: TPoint; - dk, x1, x2, y1, y2: Integer; - {$ifdef USE_LCL_CANVAS} - ALCLDest: TCanvas absolute ADest; - {$endif} -begin - {$ifdef USE_LCL_CANVAS} - CurEllipse.CalculateBoundingRectangle(); - x1 := CurEllipse.BoundingRect.Left; - x2 := CurEllipse.BoundingRect.Right; - y1 := CurEllipse.BoundingRect.Top; - y2 := CurEllipse.BoundingRect.Bottom; - - dk := Round(0.654 * Abs(y2-y1)); - f.x := Round(CurEllipse.X); - f.y := Round(CurEllipse.Y - 1); - PointList[0] := Rotate2DPoint(Point(x1, f.y), f, CurEllipse.Angle) ; // Startpoint - PointList[1] := Rotate2DPoint(Point(x1, f.y - dk), f, CurEllipse.Angle); - //Controlpoint of Startpoint first part - PointList[2] := Rotate2DPoint(Point(x2- 1, f.y - dk), f, CurEllipse.Angle); - //Controlpoint of secondpoint first part - PointList[3] := Rotate2DPoint(Point(x2 -1 , f.y), f, CurEllipse.Angle); - // Firstpoint of secondpart - PointList[4] := Rotate2DPoint(Point(x2-1 , f.y + dk), f, CurEllipse.Angle); - // Controllpoint of secondpart firstpoint - PointList[5] := Rotate2DPoint(Point(x1, f.y + dk), f, CurEllipse.Angle); - // Conrollpoint of secondpart endpoint - PointList[6] := PointList[0]; // Endpoint of - // Back to the startpoint - ALCLDest.PolyBezier(Pointlist[0]); - {$endif} -end; - -{@@ - This function draws a FPVectorial vectorial image to a TFPCustomCanvas - descendent, such as TCanvas from the LCL. - - Be careful that by default this routine does not execute coordinate transformations, - and that FPVectorial works with a start point in the bottom-left corner, with - the X growing to the right and the Y growing to the top. This will result in - an image in TFPCustomCanvas mirrored in the Y axis in relation with the document - as seen in a PDF viewer, for example. This can be easily changed with the - provided parameters. To have the standard view of an image viewer one could - use this function like this: - - DrawFPVectorialToCanvas(ASource, ADest, 0, ASource.Height, 1.0, -1.0); -} -procedure DrawFPVectorialToCanvas(ASource: TvVectorialPage; - ADest: TFPCustomCanvas; - ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); -var - i: Integer; - CurEntity: TvEntity; -begin - {$ifdef FPVECTORIAL_TOCANVAS_DEBUG} - WriteLn(':>DrawFPVectorialToCanvas'); - {$endif} - - for i := 0 to ASource.GetEntitiesCount - 1 do - begin - {$ifdef FPVECTORIAL_TOCANVAS_DEBUG} - Write(Format('[Path] ID=%d', [i])); - {$endif} - - CurEntity := ASource.GetEntity(i); - - if CurEntity is TPath then DrawFPVPathToCanvas(ASource, TPath(CurEntity), ADest, ADestX, ADestY, AMulX, AMulY) - else if CurEntity is TvText then DrawFPVTextToCanvas(ASource, TvText(CurEntity), ADest, ADestX, ADestY, AMulX, AMulY) - else DrawFPVEntityToCanvas(ASource, CurEntity, ADest, ADestX, ADestY, AMulX, AMulY); - end; - - {$ifdef FPVECTORIAL_TOCANVAS_DEBUG} - WriteLn(': nil then - begin - OldClipRegion := LCLIntf.CreateEmptyRegion(); - GetClipRgn(ACanvas.Handle, OldClipRegion); - ClipRegion := ConvertPathToRegion(CurPath.ClipPath, ADestX, ADestY, AMulX, AMulY); - SelectClipRgn(ACanvas.Handle, ClipRegion); - DeleteObject(ClipRegion); - // debug info - {$ifdef DEBUG_CANVAS_CLIP_REGION} - ConvertPathToPoints(CurPath.ClipPath, ADestX, ADestY, AMulX, AMulY, Points); - ACanvas.Polygon(Points); - {$endif} - end; - {$endif} - - // - // For solid paths, draw a polygon for the main internal area - // - if CurPath.Brush.Style <> bsClear then - begin - CurPath.PrepareForSequentialReading; - - {$ifdef FPVECTORIAL_TOCANVAS_DEBUG} - Write(' Solid Path Internal Area'); - {$endif} - ADest.Brush.Style := CurPath.Brush.Style; - - SetLength(Points, CurPath.Len); - - for j := 0 to CurPath.Len - 1 do - begin - //WriteLn('j = ', j); - CurSegment := TPathSegment(CurPath.Next()); - - CoordX := CoordToCanvasX(Cur2DSegment.X); - CoordY := CoordToCanvasY(Cur2DSegment.Y); - - Points[j].X := CoordX; - Points[j].Y := CoordY; - - {$ifdef FPVECTORIAL_TOCANVAS_DEBUG} - Write(Format(' P%d,%d', [CoordY, CoordY])); - {$endif} - end; - - ADest.Polygon(Points); - - {$ifdef FPVECTORIAL_TOCANVAS_DEBUG} - Write(' Now the details '); - {$endif} - end; - - // - // For other paths, draw more carefully - // - CurPath.PrepareForSequentialReading; - - for j := 0 to CurPath.Len - 1 do - begin - //WriteLn('j = ', j); - CurSegment := TPathSegment(CurPath.Next()); - - case CurSegment.SegmentType of - stMoveTo: - begin - CoordX := CoordToCanvasX(Cur2DSegment.X); - CoordY := CoordToCanvasY(Cur2DSegment.Y); - ADest.MoveTo(CoordX, CoordY); - PosX := Cur2DSegment.X; - PosY := Cur2DSegment.Y; - {$ifdef FPVECTORIAL_TOCANVAS_DEBUG} - Write(Format(' M%d,%d', [CoordY, CoordY])); - {$endif} - end; - // This element can override temporarely the Pen - st2DLineWithPen: - begin - ADest.Pen.FPColor := T2DSegmentWithPen(Cur2DSegment).Pen.Color; - - CoordX := CoordToCanvasX(PosX); - CoordY := CoordToCanvasY(PosY); - CoordX2 := CoordToCanvasX(Cur2DSegment.X); - CoordY2 := CoordToCanvasY(Cur2DSegment.Y); - ADest.Line(CoordX, CoordY, CoordX2, CoordY2); - - PosX := Cur2DSegment.X; - PosY := Cur2DSegment.Y; - - ADest.Pen.FPColor := CurPath.Pen.Color; - - {$ifdef FPVECTORIAL_TOCANVAS_DEBUG} - Write(Format(' L%d,%d', [CoordToCanvasX(Cur2DSegment.X), CoordToCanvasY(Cur2DSegment.Y)])); - {$endif} - end; - st2DLine, st3DLine: - begin - CoordX := CoordToCanvasX(PosX); - CoordY := CoordToCanvasY(PosY); - CoordX2 := CoordToCanvasX(Cur2DSegment.X); - CoordY2 := CoordToCanvasY(Cur2DSegment.Y); - ADest.Line(CoordX, CoordY, CoordX2, CoordY2); - PosX := Cur2DSegment.X; - PosY := Cur2DSegment.Y; - {$ifdef FPVECTORIAL_TOCANVAS_DEBUG} - Write(Format(' L%d,%d', [CoordX, CoordY])); - {$endif} - end; - { To draw a bezier we need to divide the interval in parts and make - lines between this parts } - st2DBezier, st3DBezier: - begin - CoordX := CoordToCanvasX(PosX); - CoordY := CoordToCanvasY(PosY); - CoordX2 := CoordToCanvasX(Cur2DBSegment.X2); - CoordY2 := CoordToCanvasY(Cur2DBSegment.Y2); - CoordX3 := CoordToCanvasX(Cur2DBSegment.X3); - CoordY3 := CoordToCanvasY(Cur2DBSegment.Y3); - CoordX4 := CoordToCanvasX(Cur2DBSegment.X); - CoordY4 := CoordToCanvasY(Cur2DBSegment.Y); - SetLength(Points, 0); - AddBezierToPoints( - Make2DPoint(CoordX, CoordY), - Make2DPoint(CoordX2, CoordY2), - Make2DPoint(CoordX3, CoordY3), - Make2DPoint(CoordX4, CoordY4), - Points - ); - - ADest.Brush.Style := CurPath.Brush.Style; - if Length(Points) >= 3 then - ADest.Polygon(Points); - - PosX := Cur2DSegment.X; - 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; - {$ifdef FPVECTORIAL_TOCANVAS_DEBUG} - WriteLn(''); - {$endif} - - // Restores the previous Clip Region - {$ifdef USE_CANVAS_CLIP_REGION} - if CurPath.ClipPath <> nil then - begin - SelectClipRgn(ACanvas.Handle, OldClipRegion); //Using OldClipRegion crashes in Qt - end; - {$endif} -end; - -procedure DrawFPVEntityToCanvas(ASource: TvVectorialPage; CurEntity: TvEntity; - ADest: TFPCustomCanvas; - ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); - - function CoordToCanvasX(ACoord: Double): Integer; - begin - Result := Round(ADestX + AmulX * ACoord); - end; - - function CoordToCanvasY(ACoord: Double): Integer; - begin - Result := Round(ADestY + AmulY * ACoord); - end; - -var - i: Integer; - {$ifdef USE_LCL_CANVAS} - ALCLDest: TCanvas; - {$endif} - // For entities - CurCircle: TvCircle; - CurEllipse: TvEllipse; - // - CurArc: TvCircularArc; - FinalStartAngle, FinalEndAngle: double; - BoundsLeft, BoundsTop, BoundsRight, BoundsBottom, - IntStartAngle, IntAngleLength, IntTmp: Integer; - // - CurDim: TvAlignedDimension; - Points: array of TPoint; - UpperDim, LowerDim: T3DPoint; -begin - {$ifdef USE_LCL_CANVAS} - ALCLDest := TCanvas(ADest); - {$endif} - - ADest.Brush.Style := CurEntity.Brush.Style; - ADest.Pen.Style := CurEntity.Pen.Style; - ADest.Pen.FPColor := CurEntity.Pen.Color; - ADest.Brush.FPColor := CurEntity.Brush.Color; - - if CurEntity is TvCircle then - begin - CurCircle := CurEntity as TvCircle; - ADest.Ellipse( - CoordToCanvasX(CurCircle.X - CurCircle.Radius), - CoordToCanvasY(CurCircle.Y - CurCircle.Radius), - CoordToCanvasX(CurCircle.X + CurCircle.Radius), - CoordToCanvasY(CurCircle.Y + CurCircle.Radius) - ); - end - else if CurEntity is TvEllipse then - begin - CurEllipse := CurEntity as TvEllipse; - DrawRotatedEllipse(ADest, CurEllipse); - end - else if CurEntity is TvCircularArc then - begin - CurArc := CurEntity as TvCircularArc; - {$ifdef USE_LCL_CANVAS} - // ToDo: Consider a X axis inversion - // If the Y axis is inverted, then we need to mirror our angles as well - BoundsLeft := CoordToCanvasX(CurArc.X - CurArc.Radius); - BoundsTop := CoordToCanvasY(CurArc.Y - CurArc.Radius); - BoundsRight := CoordToCanvasX(CurArc.X + CurArc.Radius); - BoundsBottom := CoordToCanvasY(CurArc.Y + CurArc.Radius); - {if AMulY > 0 then - begin} - FinalStartAngle := CurArc.StartAngle; - FinalEndAngle := CurArc.EndAngle; - {end - else // AMulY is negative - begin - // Inverting the angles generates the correct result for Y axis inversion - if CurArc.EndAngle = 0 then FinalStartAngle := 0 - else FinalStartAngle := 360 - 1* CurArc.EndAngle; - if CurArc.StartAngle = 0 then FinalEndAngle := 0 - else FinalEndAngle := 360 - 1* CurArc.StartAngle; - end;} - IntStartAngle := Round(16*FinalStartAngle); - IntAngleLength := Round(16*(FinalEndAngle - FinalStartAngle)); - // On Gtk2 and Carbon, the Left really needs to be to the Left of the Right position - // The same for the Top and Bottom - // On Windows it works fine either way - // On Gtk2 if the positions are inverted then the arcs are screwed up - // In Carbon if the positions are inverted, then the arc is inverted - if BoundsLeft > BoundsRight then - begin - IntTmp := BoundsLeft; - BoundsLeft := BoundsRight; - BoundsRight := IntTmp; - end; - if BoundsTop > BoundsBottom then - begin - IntTmp := BoundsTop; - BoundsTop := BoundsBottom; - BoundsBottom := IntTmp; - end; - // Arc(ALeft, ATop, ARight, ABottom, Angle16Deg, Angle16DegLength: Integer); - {$ifdef FPVECTORIAL_TOCANVAS_DEBUG} -// WriteLn(Format('Drawing Arc Center=%f,%f Radius=%f StartAngle=%f AngleLength=%f', -// [CurArc.CenterX, CurArc.CenterY, CurArc.Radius, IntStartAngle/16, IntAngleLength/16])); - {$endif} - ADest.Pen.FPColor := CurArc.Pen.Color; - ALCLDest.Arc( - BoundsLeft, BoundsTop, BoundsRight, BoundsBottom, - IntStartAngle, IntAngleLength - ); - ADest.Pen.FPColor := colBlack; - // Debug info -// {$define FPVECTORIALDEBUG} -// {$ifdef FPVECTORIALDEBUG} -// WriteLn(Format('Drawing Arc x1y1=%d,%d x2y2=%d,%d start=%d end=%d', -// [BoundsLeft, BoundsTop, BoundsRight, BoundsBottom, IntStartAngle, IntAngleLength])); -// {$endif} -{ ADest.TextOut(CoordToCanvasX(CurArc.CenterX), CoordToCanvasY(CurArc.CenterY), - Format('R=%d S=%d L=%d', [Round(CurArc.Radius*AMulX), Round(FinalStartAngle), - Abs(Round((FinalEndAngle - FinalStartAngle)))])); - ADest.Pen.Color := TColor($DDDDDD); - ADest.Rectangle( - BoundsLeft, BoundsTop, BoundsRight, BoundsBottom); - ADest.Pen.Color := clBlack;} - {$endif} - end - else if CurEntity is TvAlignedDimension then - begin - CurDim := CurEntity as TvAlignedDimension; - // - // Draws this shape: - // vertical horizontal - // ___ - // | | or ---| X cm - // | --| - // Which marks the dimension - ADest.MoveTo(CoordToCanvasX(CurDim.BaseRight.X), CoordToCanvasY(CurDim.BaseRight.Y)); - ADest.LineTo(CoordToCanvasX(CurDim.DimensionRight.X), CoordToCanvasY(CurDim.DimensionRight.Y)); - ADest.LineTo(CoordToCanvasX(CurDim.DimensionLeft.X), CoordToCanvasY(CurDim.DimensionLeft.Y)); - ADest.LineTo(CoordToCanvasX(CurDim.BaseLeft.X), CoordToCanvasY(CurDim.BaseLeft.Y)); - // Now the arrows - // horizontal - SetLength(Points, 3); - if CurDim.DimensionRight.Y = CurDim.DimensionLeft.Y then - begin - ADest.Brush.FPColor := colBlack; - ADest.Brush.Style := bsSolid; - // Left arrow - Points[0] := Point(CoordToCanvasX(CurDim.DimensionLeft.X), CoordToCanvasY(CurDim.DimensionLeft.Y)); - Points[1] := Point(Points[0].X + 7, Points[0].Y - 3); - Points[2] := Point(Points[0].X + 7, Points[0].Y + 3); - ADest.Polygon(Points); - // Right arrow - Points[0] := Point(CoordToCanvasX(CurDim.DimensionRight.X), CoordToCanvasY(CurDim.DimensionRight.Y)); - Points[1] := Point(Points[0].X - 7, Points[0].Y - 3); - Points[2] := Point(Points[0].X - 7, Points[0].Y + 3); - ADest.Polygon(Points); - ADest.Brush.Style := bsClear; - // Dimension text - Points[0].X := CoordToCanvasX((CurDim.DimensionLeft.X+CurDim.DimensionRight.X)/2); - Points[0].Y := CoordToCanvasY(CurDim.DimensionLeft.Y); - LowerDim.X := CurDim.DimensionRight.X-CurDim.DimensionLeft.X; - ADest.Font.Size := 10; - ADest.TextOut(Points[0].X, Points[0].Y, Format('%.1f', [LowerDim.X])); - end - else - begin - ADest.Brush.FPColor := colBlack; - ADest.Brush.Style := bsSolid; - // There is no upper/lower preference for DimensionLeft/Right, so we need to check - if CurDim.DimensionLeft.Y > CurDim.DimensionRight.Y then - begin - UpperDim := CurDim.DimensionLeft; - LowerDim := CurDim.DimensionRight; - end - else - begin - UpperDim := CurDim.DimensionRight; - LowerDim := CurDim.DimensionLeft; - end; - // Upper arrow - Points[0] := Point(CoordToCanvasX(UpperDim.X), CoordToCanvasY(UpperDim.Y)); - Points[1] := Point(Points[0].X + Round(AMulX), Points[0].Y - Round(AMulY*3)); - Points[2] := Point(Points[0].X - Round(AMulX), Points[0].Y - Round(AMulY*3)); - ADest.Polygon(Points); - // Lower arrow - Points[0] := Point(CoordToCanvasX(LowerDim.X), CoordToCanvasY(LowerDim.Y)); - Points[1] := Point(Points[0].X + Round(AMulX), Points[0].Y + Round(AMulY*3)); - Points[2] := Point(Points[0].X - Round(AMulX), Points[0].Y + Round(AMulY*3)); - ADest.Polygon(Points); - ADest.Brush.Style := bsClear; - // Dimension text - Points[0].X := CoordToCanvasX(CurDim.DimensionLeft.X); - Points[0].Y := CoordToCanvasY((CurDim.DimensionLeft.Y+CurDim.DimensionRight.Y)/2); - LowerDim.Y := CurDim.DimensionRight.Y-CurDim.DimensionLeft.Y; - if LowerDim.Y < 0 then LowerDim.Y := -1 * LowerDim.Y; - ADest.Font.Size := 10; - ADest.TextOut(Points[0].X, Points[0].Y, Format('%.1f', [LowerDim.Y])); - end; - SetLength(Points, 0); -{ // Debug info - ADest.TextOut(CoordToCanvasX(CurDim.BaseRight.X), CoordToCanvasY(CurDim.BaseRight.Y), 'BR'); - ADest.TextOut(CoordToCanvasX(CurDim.DimensionRight.X), CoordToCanvasY(CurDim.DimensionRight.Y), 'DR'); - ADest.TextOut(CoordToCanvasX(CurDim.DimensionLeft.X), CoordToCanvasY(CurDim.DimensionLeft.Y), 'DL'); - ADest.TextOut(CoordToCanvasX(CurDim.BaseLeft.X), CoordToCanvasY(CurDim.BaseLeft.Y), 'BL');} - end; -end; - -procedure DrawFPVTextToCanvas(ASource: TvVectorialPage; CurText: TvText; - ADest: TFPCustomCanvas; - ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); - - function CoordToCanvasX(ACoord: Double): Integer; - begin - Result := Round(ADestX + AmulX * ACoord); - end; - - function CoordToCanvasY(ACoord: Double): Integer; - begin - Result := Round(ADestY + AmulY * ACoord); - end; - -var - i: Integer; - {$ifdef USE_LCL_CANVAS} - ALCLDest: TCanvas; - {$endif} - // - LowerDim: T3DPoint; -begin - {$ifdef USE_LCL_CANVAS} - ALCLDest := TCanvas(ADest); - {$endif} - - ADest.Font.Size := Round(AmulX * CurText.Font.Size); - ADest.Pen.Style := psSolid; - ADest.Pen.FPColor := colBlack; - ADest.Brush.Style := bsClear; - {$ifdef USE_LCL_CANVAS} - ALCLDest.Font.Orientation := Round(CurText.Font.Orientation * 16); - {$endif} - - // TvText supports multiple lines - for i := 0 to CurText.Value.Count - 1 do - begin - if CurText.Font.Size = 0 then LowerDim.Y := CurText.Y - 12 * (i + 1) - else LowerDim.Y := CurText.Y - CurText.Font.Size * (i + 1); - - ADest.TextOut(CoordToCanvasX(CurText.X), CoordToCanvasY(LowerDim.Y), CurText.Value.Strings[i]); - end; -end; - -end. - diff --git a/applications/fpvviewer/fpvectorialsrc/fpvutils.pas b/applications/fpvviewer/fpvectorialsrc/fpvutils.pas deleted file mode 100644 index 71fbd0561..000000000 --- a/applications/fpvviewer/fpvectorialsrc/fpvutils.pas +++ /dev/null @@ -1,295 +0,0 @@ -{ -fpvutils.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 fpvutils; - -{$define USE_LCL_CANVAS} -{.$define FPVECTORIAL_BEZIERTOPOINTS_DEBUG} - -{$ifdef fpc} - {$mode delphi} -{$endif} - -interface - -uses - Classes, SysUtils, Math, - {$ifdef USE_LCL_CANVAS} - Graphics, LCLIntf, LCLType, - {$endif} - fpvectorial, fpimage; - -type - T10Strings = array[0..9] of shortstring; - TPointsArray = array of TPoint; - -// Color Conversion routines -function FPColorToRGBHexString(AColor: TFPColor): string; -function RGBToFPColor(AR, AG, AB: byte): TFPColor; inline; -// 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); -procedure AddBezierToPoints(P1, P2, P3, P4: T3DPoint; var Points: TPointsArray); -procedure ConvertPathToPoints(APath: TPath; ADestX, ADestY: Integer; AMulX, AMulY: Double; var Points: TPointsArray); -// LCL-related routines -{$ifdef USE_LCL_CANVAS} -function ConvertPathToRegion(APath: TPath; ADestX, ADestY: Integer; AMulX, AMulY: Double): HRGN; -{$endif} - -implementation - -{@@ This function is utilized by the SVG writer and some other places, so - it shouldn't be changed. -} -function FPColorToRGBHexString(AColor: TFPColor): string; -begin - Result := Format('%.2x%.2x%.2x', [AColor.Red shr 8, AColor.Green shr 8, AColor.Blue shr 8]); -end; - -function RGBToFPColor(AR, AG, AB: byte): TFPColor; inline; -begin - Result.Red := (AR shl 8) + AR; - Result.Green := (AG shl 8) + AG; - Result.Blue := (AB shl 8) + AB; - Result.Alpha := $FFFF; -end; - -{@@ Converts the coordinate system from a TCanvas to FPVectorial - The basic difference is that the Y axis is positioned differently and - points upwards in FPVectorial and downwards in TCanvas. - The X axis doesn't change. The fix is trivial and requires only the Height of - the Canvas as extra info. - - @param AHeight Should receive TCanvas.Height -} -function CanvasCoordsToFPVectorial(AY: Integer; AHeight: Integer): Integer; inline; -begin - Result := AHeight - AY; -end; - -{@@ - LCL Text is positioned based on the top-left corner of the text. - Besides that, one also needs to take the general coordinate change into account too. - - @param ACanvasHeight Should receive TCanvas.Height - @param ATextHeight Should receive TFont.Size -} -function CanvasTextPosToFPVectorial(AY: Integer; ACanvasHeight, ATextHeight: Integer): Integer; -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. - - Limits: - - Number of substrings: 10 (indexed 0 to 9) - Length of each substring: 255 (they are shortstrings) -} -function 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; - -{ Considering a counter-clockwise arc, elliptical and alligned to the axises - - An elliptical Arc can be converted to - the following Cubic Bezier control points: - - P1 = E(startAngle) <- start point - P2 = P1+alfa * dE(startAngle) <- control point - P3 = P4−alfa * dE(endAngle) <- control point - P4 = E(endAngle) <- end point - - source: http://www.spaceroots.org/documents/ellipse/elliptical-arc.pdf - - The equation of an elliptical arc is: - - X(t) = Xc + Rx * cos(t) - Y(t) = Yc + Ry * sin(t) - - dX(t)/dt = - Rx * sin(t) - dY(t)/dt = + Ry * cos(t) -} -procedure EllipticalArcToBezier(Xc, Yc, Rx, Ry, startAngle, endAngle: Double; - var P1, P2, P3, P4: T3DPoint); -var - halfLength, arcLength, alfa: Double; -begin - arcLength := endAngle - startAngle; - halfLength := (endAngle - startAngle) / 2; - alfa := sin(arcLength) * (Sqrt(4 + 3*sqr(tan(halfLength))) - 1) / 3; - - // Start point - P1.X := Xc + Rx * cos(startAngle); - P1.Y := Yc + Ry * sin(startAngle); - - // End point - P4.X := Xc + Rx * cos(endAngle); - P4.Y := Yc + Ry * sin(endAngle); - - // Control points - P2.X := P1.X + alfa * -1 * Rx * sin(startAngle); - P2.Y := P1.Y + alfa * Ry * cos(startAngle); - - P3.X := P4.X - alfa * -1 * Rx * sin(endAngle); - P3.Y := P4.Y - alfa * Ry * cos(endAngle); -end; - -procedure CircularArcToBezier(Xc, Yc, R, startAngle, endAngle: Double; var P1, - P2, P3, P4: T3DPoint); -begin - EllipticalArcToBezier(Xc, Yc, R, R, startAngle, endAngle, P1, P2, P3, P4); -end; - -{ This routine converts a Bezier to a Polygon and adds the points of this poligon - to the end of the provided Points output variables } -procedure AddBezierToPoints(P1, P2, P3, P4: T3DPoint; var Points: TPointsArray); -var - CurveLength, k, CurX, CurY, LastPoint: Integer; - t: Double; -begin - {$ifdef FPVECTORIAL_BEZIERTOPOINTS_DEBUG} - Write(Format('[AddBezierToPoints] P1=%f,%f P2=%f,%f P3=%f,%f P4=%f,%f =>', [P1.X, P1.Y, P2.X, P2.Y, P3.X, P3.Y, P4.X, P4.Y])); - {$endif} - - CurveLength := - Round(sqrt(sqr(P2.X - P1.X) + sqr(P2.Y - P1.Y))) + - Round(sqrt(sqr(P3.X - P2.X) + sqr(P3.Y - P2.Y))) + - Round(sqrt(sqr(P4.X - P4.X) + sqr(P4.Y - P3.Y))); - - LastPoint := Length(Points)-1; - SetLength(Points, Length(Points)+CurveLength); - for k := 1 to CurveLength do - begin - t := k / CurveLength; - CurX := Round(sqr(1 - t) * (1 - t) * P1.X + 3 * t * sqr(1 - t) * P2.X + 3 * t * t * (1 - t) * P3.X + t * t * t * P4.X); - CurY := Round(sqr(1 - t) * (1 - t) * P1.Y + 3 * t * sqr(1 - t) * P2.Y + 3 * t * t * (1 - t) * P3.Y + t * t * t * P4.Y); - Points[LastPoint+k].X := CurX; - Points[LastPoint+k].Y := CurY; - {$ifdef FPVECTORIAL_BEZIERTOPOINTS_DEBUG} - Write(Format(' P=%d,%d', [CurX, CurY])); - {$endif} - end; - {$ifdef FPVECTORIAL_BEZIERTOPOINTS_DEBUG} - WriteLn(Format(' CurveLength=%d', [CurveLength])); - {$endif} -end; - -procedure ConvertPathToPoints(APath: TPath; ADestX, ADestY: Integer; AMulX, AMulY: Double; var Points: TPointsArray); -var - i, LastPoint: Integer; - CoordX, CoordY: Integer; - CoordX2, CoordY2, CoordX3, CoordY3, CoordX4, CoordY4: Integer; - // Segments - CurSegment: TPathSegment; - Cur2DSegment: T2DSegment absolute CurSegment; - Cur2DBSegment: T2DBezierSegment absolute CurSegment; -begin - APath.PrepareForSequentialReading; - - SetLength(Points, 0); - - 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); - - case CurSegment.SegmentType of - st2DBezier, st3DBezier: - begin - LastPoint := Length(Points)-1; - CoordX4 := CoordX; - CoordY4 := CoordY; - CoordX := Points[LastPoint].X; - CoordY := Points[LastPoint].Y; - CoordX2 := CoordToCanvasX(Cur2DBSegment.X2, ADestX, AMulX); - CoordY2 := CoordToCanvasY(Cur2DBSegment.Y2, ADestY, AMulY); - CoordX3 := CoordToCanvasX(Cur2DBSegment.X3, ADestX, AMulX); - CoordY3 := CoordToCanvasY(Cur2DBSegment.Y3, ADestY, AMulY); - AddBezierToPoints( - Make2DPoint(CoordX, CoordY), - Make2DPoint(CoordX2, CoordY2), - Make2DPoint(CoordX3, CoordY3), - Make2DPoint(CoordX4, CoordY4), - Points); - end; - else - LastPoint := Length(Points); - SetLength(Points, Length(Points)+1); - Points[LastPoint].X := CoordX; - Points[LastPoint].Y := CoordY; - end; - end; -end; - -{$ifdef USE_LCL_CANVAS} -function ConvertPathToRegion(APath: TPath; ADestX, ADestY: Integer; AMulX, AMulY: Double): HRGN; -var - WindingMode: Integer; - Points: array of TPoint; -begin - APath.PrepareForSequentialReading; - - SetLength(Points, 0); - ConvertPathToPoints(APath, ADestX, ADestY, AMulX, AMulY, Points); - - if APath.ClipMode = vcmEvenOddRule then WindingMode := LCLType.ALTERNATE - else WindingMode := LCLType.WINDING; - - Result := LCLIntf.CreatePolygonRgn(@Points[0], Length(Points), WindingMode); -end; -{$endif} - -end. - diff --git a/applications/fpvviewer/fpvectorialsrc/pdfvectorialreader.pas b/applications/fpvviewer/fpvectorialsrc/pdfvectorialreader.pas deleted file mode 100644 index 8f184cfcf..000000000 --- a/applications/fpvviewer/fpvectorialsrc/pdfvectorialreader.pas +++ /dev/null @@ -1,265 +0,0 @@ -{ -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 - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> TvPDFVectorialReader.getFirstPage'); - {$endif} - 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; - - {$ifdef FPVECTORIALDEBUG} - WriteLn(':< TvPDFVectorialReader.getFirstPage'); - {$endif} - -// AInput2.Free; -end; - -procedure TvPDFVectorialReader.unzipPage(AInput: TStream; AOutput: TStream); -var - compr, uncompr: Pbyte; - comprLen, uncomprLen: LongInt; - myDecode: decode; - BufStr: string; -begin - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> TvPDFVectorialReader.unzipPage'); - {$endif} - - 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); - - {$ifdef FPVECTORIALDEBUG} - WriteLn(':< TvPDFVectorialReader.unzipPage'); - {$endif} -end; - -procedure TvPDFVectorialReader.translatePage(AInput: TStream; - AData: TvVectorialDocument; APageHeader: PageHeader); -var - myAnLexico: AnLexico; - myAnSintaticoCommand: AnSintaticoCommand; - myAnSemantico: AnSemantico; - mytoken: Token; - c: Command; -begin - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> TvPDFVectorialReader.translatePage'); - {$endif} - - // 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 - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> TvPDFVectorialReader.ReadFromStream'); - {$endif} - - 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!'); - {$ifdef FPVECTORIALDEBUG} - WriteLn(':< TvPDFVectorialReader.ReadFromStream'); - WriteLn('Sucesso!'); - {$endif} -end; - -{******************************************************************* -* Initialization section -* -* Registers this reader / writer on fpVectorial -* -*******************************************************************} -initialization - - RegisterVectorialReader(TvPDFVectorialReader, vfPDF); - -end. - diff --git a/applications/fpvviewer/fpvectorialsrc/pdfvrlexico.pas b/applications/fpvviewer/fpvectorialsrc/pdfvrlexico.pas deleted file mode 100644 index e8542e956..000000000 --- a/applications/fpvviewer/fpvectorialsrc/pdfvrlexico.pas +++ /dev/null @@ -1,113 +0,0 @@ -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 - Doc: TStream; - bytesRemaining: Int64; - constructor Create(); - function getToken(): Token; - function getPageToken(): Token; - 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. - diff --git a/applications/fpvviewer/fpvectorialsrc/pdfvrsemantico.pas b/applications/fpvviewer/fpvectorialsrc/pdfvrsemantico.pas deleted file mode 100644 index bf2c80edf..000000000 --- a/applications/fpvviewer/fpvectorialsrc/pdfvrsemantico.pas +++ /dev/null @@ -1,244 +0,0 @@ -unit pdfvrsemantico; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, pdfvrlexico, fpvectorial; - -type - - { AnSemantico } - - AnSemantico = class - public - FPointSeparator, FCommaSeparator: TFormatSettings; - 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 StringToFloat(AStr: string): Double; - 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 - -{ PDF doesn't seam very consistent when it comes to using commas or - points as decimal separator, so we just try both } -function AnSemantico.StringToFloat(AStr: string): Double; -begin - if Pos('.', AStr) > 0 then Result := StrToFloat(AStr, FPointSeparator) - else Result := StrToFloat(AStr, FCommaSeparator); -end; - -function AnSemantico.generate(c: Command; AData: TvVectorialDocument): String; -var - enter_line : String; -begin - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSemantico.generate'); - {$endif} - - 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 - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSemantico.generate Estado 1 EndPath StartPath'); - {$endif} - // 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(StringToFloat(c.cord_x), StringToFloat(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 - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSemantico.generate Estado 2 AddPointToPath'); - {$endif} - // Result:='G01' + ' ' + 'X' + c.cord_x + ' ' + 'Y' + c.cord_y; - - AData.AddLineToPath(StringToFloat(c.cord_x), StringToFloat(c.cord_y)); - end; - cc_h_CLOSE_PATH: // command h - begin - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSemantico.generate Estado 3 AddPointToPath'); - {$endif} - //Result:='G01' + ' ' + 'X' + c.cord_x + ' ' + 'Y' + c.cord_y; - - AData.AddLineToPath(StringToFloat(c.cord_x), StringToFloat(c.cord_y)); - end; - cc_S_END_PATH: // command S - begin - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSemantico.generate Estado 4 EndPath'); - {$endif} - // Result:='G01 Z0 // Sobe a cabeça de gravação' + enter_line; - AData.EndPath(); - end; - cc_hS_CLOSE_AND_END_PATH: // command s - begin - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSemantico.generate Estado 5 AddPoint EndPath'); - {$endif} - //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(StringToFloat(c.cord_x), StringToFloat(c.cord_y)); - AData.EndPath(); - end; - cc_c_BEZIER_TO_X_Y_USING_X2_Y2_AND_X3_Y3: // command c - begin - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSemantico.generate Estado 6 Bezier'); - {$endif} - //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( - StringToFloat(c.cord_x3), StringToFloat(c.cord_y3), - StringToFloat(c.cord_x2), StringToFloat(c.cord_y2), - StringToFloat(c.cord_x), StringToFloat(c.cord_y) - ); - end; - cc_CONCATENATE_MATRIX: // command cm - begin - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSemantico.cc_CONCATENATE_MATRIX'); - {$endif} - - cm_a := StringToFloat(c.cord_x3); - cm_b := StringToFloat(c.cord_y3); - cm_c := StringToFloat(c.cord_x2); - cm_d := StringToFloat(c.cord_y2); - cm_e := StringToFloat(c.cord_x); - cm_f := StringToFloat(c.cord_y); - end; - cc_RESTORE_MATRIX: // command Q - begin - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSemantico.cc_RESTORE_MATRIX'); - {$endif} - - cm_a:=1; - cm_b:=0; - cm_c:=0; - cm_d:=1; - cm_e:=0; - cm_f:=0; - end; - else - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSemantico.generate Estado ELSE'); - {$endif} - Result:=c.my_operator; - end; -end; - -function AnSemantico.convert(x: String; y: String; Axis: Char): String; -begin - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSemantico.convert'); - {$endif} - // 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*StringToFloat(x)+cm_d*StringToFloat(y)+cm_f)*(25.40/72)); - end - else - // Axis = 'x' - begin - // x' = a * x + c * y + e - Result:=FloatToStr((cm_a*StringToFloat(x)+cm_c*StringToFloat(y)+cm_e)*(25.40/72)); - end; -end; - -function AnSemantico.startMachine(): String; -var - enter_line : String; -begin - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSemantico.startMachine'); - {$endif} - 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 - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSemantico.endMachine'); - {$endif} - 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; - - // Format seetings to convert a string to a float - FPointSeparator := DefaultFormatSettings; - FPointSeparator.DecimalSeparator := '.'; - FPointSeparator.ThousandSeparator := '#';// disable the thousand separator - FCommaSeparator := DefaultFormatSettings; - FCommaSeparator.DecimalSeparator := ','; - FCommaSeparator.ThousandSeparator := '#';// disable the thousand separator -end; - -end. - diff --git a/applications/fpvviewer/fpvectorialsrc/pdfvrsintatico.pas b/applications/fpvviewer/fpvectorialsrc/pdfvrsintatico.pas deleted file mode 100644 index 2bcb7e905..000000000 --- a/applications/fpvviewer/fpvectorialsrc/pdfvrsintatico.pas +++ /dev/null @@ -1,628 +0,0 @@ -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 - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSintaticoPage.automata Estado 1'); - {$endif} - if(t.token_string = 'Type') then - begin - Estado := 2; - end - else - begin - Estado := 1; - end; - end; - 2: - begin - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSintaticoPage.automata Estado 2'); - {$endif} - if(t.token_string = 'Page') then - begin - Estado := 3; - end - else - begin - Estado := 1; - end; - end; - 3: - begin - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSintaticoPage.automata Estado 3'); - {$endif} - if(t.token_string = 'Contents') then - begin - Estado := 4; - end - else - begin - Estado := 3; - end; - end; - 4: - begin - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSintaticoPage.automata Estado 4'); - {$endif} - 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 - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSintaticoPage.automata Estado 5'); - {$endif} - 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 - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSintaticoPage.automata Estado ELSE'); - {$endif} - Estado := 1; - end; -end; - -procedure AnSintaticoPageContents.automata(t: Token; Input: TStream); -var - myAnLexicoLength: AnLexico; - myAnSintaticoLength: AnSintaticoLength; - mytokenLength: Token; -begin - case Estado of - 1: - begin - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSintaticoPageContents.automata Estado 1'); - {$endif} - if(t.token_string = obj1) then - begin - Estado := 2; - end - else - begin - Estado := 1; - end; - end; - 2: - begin - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSintaticoPageContents.automata Estado 2'); - {$endif} - if(t.token_string = obj2) then - begin - Estado := 3; - end - else - begin - Estado := 1; - end; - end; - 3: - begin - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSintaticoPageContents.automata Estado 3'); - {$endif} - if(t.token_string = 'obj') then - begin - Estado := 4; - end - else - begin - Estado := 1; - end; - end; - 4: - begin - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSintaticoPageContents.automata Estado 4'); - {$endif} - 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 - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSintaticoPageContents.automata Estado 5'); - {$endif} - 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 - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSintaticoPageContents.automata Estado 6'); - {$endif} - 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 - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSintaticoPageContents.automata Estado 7'); - {$endif} - 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 - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSintaticoPageContents.automata Estado 8'); - {$endif} - 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 - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSintaticoPageContents.automata Estado ELSE'); - {$endif} - Estado := 1; - end; -end; - -procedure AnSintaticoLength.automata(t: Token); -begin - case Estado of - 1: - begin - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSintaticoLength.automata Estado 1'); - {$endif} - if(t.token_string = len_obj1) then - begin - Estado := 2; - end - else - begin - Estado := 1; - end; - end; - 2: - begin - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSintaticoLength.automata Estado 2'); - {$endif} - if(t.token_string = len_obj2) then - begin - Estado := 3; - end - else - begin - Estado := 1; - end; - end; - 3: - begin - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSintaticoLength.automata Estado 3'); - {$endif} - if(t.token_string = 'obj') then - begin - Estado := 4; - end - else - begin - Estado := 1; - end; - end; - 4: - begin - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSintaticoLength.automata Estado 4 Length: ', StrToInt(t.token_string)); - {$endif} - 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 - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSintaticoLength.automata Estado ELSE'); - {$endif} - 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 - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSintaticoCommand.automata Estado 1'); - {$endif} - 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 - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSintaticoCommand.automata Estado 2'); - {$endif} - if(t.tipo = 1) then // numbers 2 - begin - Estado := 3; - end - else - begin - Estado := 1; - end; - end; - 3: - begin - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSintaticoCommand.automata Estado 3'); - {$endif} - 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 - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSintaticoCommand.automata Estado 5'); - {$endif} - if(t.tipo = 1) then // numbers 4 - begin - Estado := 6; - end - else - begin - Estado := 1; - end; - end; - 6: - begin - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSintaticoCommand.automata Estado 6'); - {$endif} - 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 - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSintaticoCommand.automata Estado 7'); - {$endif} - if(t.tipo = 1) then // numbers 6 - begin - Estado := 8; - end - else - begin - Estado := 1; - end; - end; - 8: - begin - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSintaticoCommand.automata Estado 8'); - {$endif} - 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 - {$ifdef FPVECTORIALDEBUG} - WriteLn(':> AnSintaticoCommand.automata Estado ELSE'); - {$endif} - 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. - diff --git a/applications/fpvviewer/fpvectorialsrc/svgvectorialreader.pas b/applications/fpvviewer/fpvectorialsrc/svgvectorialreader.pas deleted file mode 100644 index a36f956ef..000000000 --- a/applications/fpvviewer/fpvectorialsrc/svgvectorialreader.pas +++ /dev/null @@ -1,369 +0,0 @@ -{ -Reads an SVG Document - -License: The same modified LGPL as the Free Pascal RTL - See the file COPYING.modifiedLGPL for more details - -AUTHORS: Felipe Monteiro de Carvalho -} -unit svgvectorialreader; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, math, - xmlread, dom, fgl, - fpvectorial, fpvutils; - -type - TSVGTokenType = (sttMoveTo, sttLineTo, sttBezierTo, sttFloatValue); - - TSVGToken = class - TokenType: TSVGTokenType; - Value: Float; - end; - - TSVGTokenList = specialize TFPGList; - - { TSVGPathTokenizer } - - TSVGPathTokenizer = class - public - FPointSeparator, FCommaSeparator: TFormatSettings; - Tokens: TSVGTokenList; - constructor Create; - Destructor Destroy; override; - procedure AddToken(AStr: string); - procedure TokenizePathString(AStr: string); - end; - - { TvSVGVectorialReader } - - TvSVGVectorialReader = class(TvCustomVectorialReader) - private - FPointSeparator, FCommaSeparator: TFormatSettings; - FSVGPathTokenizer: TSVGPathTokenizer; - procedure ReadPathFromNode(APath: TDOMNode; AData: TvVectorialPage; ADoc: TvVectorialDocument); - procedure ReadPathFromString(AStr: string; AData: TvVectorialPage; ADoc: TvVectorialDocument); - function StringWithUnitToFloat(AStr: string): Single; - procedure ConvertSVGCoordinatesToFPVCoordinates( - const AData: TvVectorialPage; - const ASrcX, ASrcY: Float; var ADestX, ADestY: Float); - procedure ConvertSVGDeltaToFPVDelta( - const AData: TvVectorialPage; - const ASrcX, ASrcY: Float; var ADestX, ADestY: Float); - public - { General reading methods } - constructor Create; override; - Destructor Destroy; override; - procedure ReadFromStream(AStream: TStream; AData: TvVectorialDocument); override; - end; - -implementation - -const - // SVG requires hardcoding a DPI value - - // The Opera Browser and Inkscape use 90 DPI, so we follow that - - // 1 Inch = 25.4 milimiters - // 90 inches per pixel = (1 / 90) * 25.4 = 0.2822 - // FLOAT_MILIMETERS_PER_PIXEL = 0.3528; // DPI 72 = 1 / 72 inches per pixel - - FLOAT_MILIMETERS_PER_PIXEL = 0.2822; // DPI 90 = 1 / 90 inches per pixel - FLOAT_PIXELS_PER_MILIMETER = 3.5433; // DPI 90 = 1 / 90 inches per pixel - -{ TSVGPathTokenizer } - -constructor TSVGPathTokenizer.Create; -begin - inherited Create; - - FPointSeparator := DefaultFormatSettings; - FPointSeparator.DecimalSeparator := '.'; - FPointSeparator.ThousandSeparator := '#';// disable the thousand separator - - Tokens := TSVGTokenList.Create; -end; - -destructor TSVGPathTokenizer.Destroy; -begin - Tokens.Free; - - inherited Destroy; -end; - -procedure TSVGPathTokenizer.AddToken(AStr: string); -var - lToken: TSVGToken; -begin - lToken := TSVGToken.Create; - - if AStr = 'm' then lToken.TokenType := sttMoveTo - else if AStr = 'l' then lToken.TokenType := sttLineTo - else if AStr = 'c' then lToken.TokenType := sttBezierTo - else - begin - lToken.TokenType := sttFloatValue; - lToken.Value := StrToFloat(AStr, FPointSeparator); - end; - - Tokens.Add(lToken); -end; - -procedure TSVGPathTokenizer.TokenizePathString(AStr: string); -const - Str_Space: Char = ' '; - Str_Comma: Char = ','; -var - i: Integer; - lTmpStr: string; - lState: Integer; - lCurChar: Char; -begin - lState := 0; - - i := 1; - while i <= Length(AStr) do - begin - case lState of - 0: // Adding to the tmp string - begin - lCurChar := AStr[i]; - if lCurChar = Str_Space then - begin - lState := 1; - AddToken(lTmpStr); - lTmpStr := ''; - end - else if lCurChar = Str_Comma then - begin - AddToken(lTmpStr); - lTmpStr := ''; - end - else - lTmpStr := lTmpStr + lCurChar; - - Inc(i); - end; - 1: // Removing spaces - begin - if AStr[i] <> Str_Space then lState := 0 - else Inc(i); - end; - end; - end; -end; - -{ Example of a supported SVG image: - - - - - - - - - - - -} - -{ TvSVGVectorialReader } - -procedure TvSVGVectorialReader.ReadPathFromNode(APath: TDOMNode; - AData: TvVectorialPage; ADoc: TvVectorialDocument); -var - lNodeName, lStyleStr, lDStr: WideString; - i: Integer; -begin - for i := 0 to APath.Attributes.Length - 1 do - begin - lNodeName := APath.Attributes.Item[i].NodeName; - if lNodeName = 'style' then - lStyleStr := APath.Attributes.Item[i].NodeValue - else if lNodeName = 'd' then - lDStr := APath.Attributes.Item[i].NodeValue - end; - - AData.StartPath(); - ReadPathFromString(UTF8Encode(lDStr), AData, ADoc); - AData.EndPath(); -end; - -procedure TvSVGVectorialReader.ReadPathFromString(AStr: string; - AData: TvVectorialPage; ADoc: TvVectorialDocument); -var - i: Integer; - X, Y, X2, Y2, X3, Y3: Float; - CurX, CurY: Float; -begin - FSVGPathTokenizer.Tokens.Clear; - FSVGPathTokenizer.TokenizePathString(AStr); - CurX := 0; - CurY := 0; - - i := 0; - while i < FSVGPathTokenizer.Tokens.Count do - begin - if FSVGPathTokenizer.Tokens.Items[i].TokenType = sttMoveTo then - begin - CurX := FSVGPathTokenizer.Tokens.Items[i+1].Value; - CurY := FSVGPathTokenizer.Tokens.Items[i+2].Value; - ConvertSVGCoordinatesToFPVCoordinates(AData, CurX, CurY, CurX, CurY); - - AData.AddMoveToPath(CurX, CurY); - - Inc(i, 3); - end - else if FSVGPathTokenizer.Tokens.Items[i].TokenType = sttLineTo then - begin - X := FSVGPathTokenizer.Tokens.Items[i+1].Value; - Y := FSVGPathTokenizer.Tokens.Items[i+2].Value; - ConvertSVGDeltaToFPVDelta(AData, X, Y, X, Y); - - // LineTo uses relative coordenates in SVG - CurX := CurX + X; - CurY := CurY + Y; - - AData.AddLineToPath(CurX, CurY); - - Inc(i, 3); - end - else if FSVGPathTokenizer.Tokens.Items[i].TokenType = sttBezierTo then - begin - X2 := FSVGPathTokenizer.Tokens.Items[i+1].Value; - Y2 := FSVGPathTokenizer.Tokens.Items[i+2].Value; - X3 := FSVGPathTokenizer.Tokens.Items[i+3].Value; - Y3 := FSVGPathTokenizer.Tokens.Items[i+4].Value; - X := FSVGPathTokenizer.Tokens.Items[i+5].Value; - Y := FSVGPathTokenizer.Tokens.Items[i+6].Value; - - ConvertSVGDeltaToFPVDelta(AData, X2, Y2, X2, Y2); - ConvertSVGDeltaToFPVDelta(AData, X3, Y3, X3, Y3); - ConvertSVGDeltaToFPVDelta(AData, X, Y, X, Y); - - AData.AddBezierToPath(X2 + CurX, Y2 + CurY, X3 + CurX, Y3 + CurY, X + CurX, Y + CurY); - - // BezierTo uses relative coordenates in SVG - CurX := CurX + X; - CurY := CurY + Y; - - Inc(i, 7); - end - else - begin - Inc(i); - end; - end; -end; - -function TvSVGVectorialReader.StringWithUnitToFloat(AStr: string): Single; -var - UnitStr, ValueStr: string; - Len: Integer; -begin - // Check the unit - Len := Length(AStr); - UnitStr := Copy(AStr, Len-1, 2); - if UnitStr = 'mm' then - begin - ValueStr := Copy(AStr, 1, Len-2); - Result := StrToInt(ValueStr); - end; -end; - -procedure TvSVGVectorialReader.ConvertSVGCoordinatesToFPVCoordinates( - const AData: TvVectorialPage; const ASrcX, ASrcY: Float; - var ADestX,ADestY: Float); -begin - ADestX := ASrcX * FLOAT_MILIMETERS_PER_PIXEL; - ADestY := AData.Height - ASrcY * FLOAT_MILIMETERS_PER_PIXEL; -end; - -procedure TvSVGVectorialReader.ConvertSVGDeltaToFPVDelta( - const AData: TvVectorialPage; const ASrcX, ASrcY: Float; var ADestX, - ADestY: Float); -begin - ADestX := ASrcX * FLOAT_MILIMETERS_PER_PIXEL; - ADestY := - ASrcY * FLOAT_MILIMETERS_PER_PIXEL; -end; - -constructor TvSVGVectorialReader.Create; -begin - inherited Create; - - FPointSeparator := DefaultFormatSettings; - FPointSeparator.DecimalSeparator := '.'; - FPointSeparator.ThousandSeparator := '#';// disable the thousand separator - - FSVGPathTokenizer := TSVGPathTokenizer.Create; -end; - -destructor TvSVGVectorialReader.Destroy; -begin - FSVGPathTokenizer.Free; - - inherited Destroy; -end; - -procedure TvSVGVectorialReader.ReadFromStream(AStream: TStream; - AData: TvVectorialDocument); -var - Doc: TXMLDocument; - lFirstLayer, lCurNode: TDOMNode; - lPage: TvVectorialPage; -begin - try - // Read in xml file from the stream - ReadXMLFile(Doc, AStream); - - // Read the properties of the tag - AData.Width := StringWithUnitToFloat(Doc.DocumentElement.GetAttribute('width')); - AData.Height := StringWithUnitToFloat(Doc.DocumentElement.GetAttribute('height')); - - // Now process the elements inside the first layer - lFirstLayer := Doc.DocumentElement.FirstChild; - lCurNode := lFirstLayer.FirstChild; - lPage := AData.AddPage(); - lPage.Width := AData.Width; - lPage.Height := AData.Height; - while Assigned(lCurNode) do - begin - ReadPathFromNode(lCurNode, lPage, AData); - lCurNode := lCurNode.NextSibling; - end; - finally - // finally, free the document - Doc.Free; - end; -end; - -initialization - - RegisterVectorialReader(TvSVGVectorialReader, vfSVG); - -end. - diff --git a/applications/fpvviewer/fpvectorialsrc/svgvectorialwriter.pas b/applications/fpvviewer/fpvectorialsrc/svgvectorialwriter.pas deleted file mode 100644 index 811a4914b..000000000 --- a/applications/fpvviewer/fpvectorialsrc/svgvectorialwriter.pas +++ /dev/null @@ -1,275 +0,0 @@ -{ -Writes an SVG Document - -License: The same modified LGPL as the Free Pascal RTL - See the file COPYING.modifiedLGPL for more details - -AUTHORS: Felipe Monteiro de Carvalho -} -unit svgvectorialwriter; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, math, fpvectorial, fpvutils, fpcanvas; - -type - { TvSVGVectorialWriter } - - TvSVGVectorialWriter = class(TvCustomVectorialWriter) - private - FPointSeparator, FCommaSeparator: TFormatSettings; - procedure WriteDocumentSize(AStrings: TStrings; AData: TvVectorialDocument); - procedure WriteDocumentName(AStrings: TStrings; AData: TvVectorialDocument); - procedure WritePath(AIndex: Integer; APath: TPath; AStrings: TStrings; AData: TvVectorialPage; ADoc: TvVectorialDocument); - procedure WriteText(AStrings: TStrings; lText: TvText; AData: TvVectorialPage; ADoc: TvVectorialDocument); - procedure WriteEntities(AStrings: TStrings; AData: TvVectorialPage; ADoc: TvVectorialDocument); - procedure ConvertFPVCoordinatesToSVGCoordinates( - const AData: TvVectorialPage; - const ASrcX, ASrcY: Double; var ADestX, ADestY: double); - public - { General reading methods } - procedure WriteToStrings(AStrings: TStrings; AData: TvVectorialDocument); override; - end; - -implementation - -const - // SVG requires hardcoding a DPI value - - // The Opera Browser and Inkscape use 90 DPI, so we follow that - - // 1 Inch = 25.4 milimiters - // 90 inches per pixel = (1 / 90) * 25.4 = 0.2822 - // FLOAT_MILIMETERS_PER_PIXEL = 0.3528; // DPI 72 = 1 / 72 inches per pixel - - FLOAT_MILIMETERS_PER_PIXEL = 0.2822; // DPI 90 = 1 / 90 inches per pixel - FLOAT_PIXELS_PER_MILIMETER = 3.5433; // DPI 90 = 1 / 90 inches per pixel - -{ TvSVGVectorialWriter } - -procedure TvSVGVectorialWriter.WriteDocumentSize(AStrings: TStrings; AData: TvVectorialDocument); -begin - AStrings.Add(' width="' + FloatToStr(AData.Width, FPointSeparator) + 'mm"'); - AStrings.Add(' height="' + FloatToStr(AData.Height, FPointSeparator) + 'mm"'); -end; - -procedure TvSVGVectorialWriter.WriteDocumentName(AStrings: TStrings; AData: TvVectorialDocument); -begin - AStrings.Add(' sodipodi:docname="New document 1">'); -end; - -{@@ - SVG Coordinate system measures things only in pixels, so that we have to - hardcode a DPI value for the screen, which is usually 72. - FPVectorial uses only milimeters (mm). - - The initial point in FPVectorial is in the bottom-left corner of the document - and it grows to the top and to the right. In SVG, on the other hand, the - initial point is in the top-left corner, growing to the bottom and right. - Besides that, coordinates in SVG are also lengths in comparison to the - previous point and not absolute coordinates. - - SVG uses commas "," to separate the X,Y coordinates, so it always uses points - "." as decimal separators and uses no thousand separators -} -procedure TvSVGVectorialWriter.WritePath(AIndex: Integer; APath: TPath; AStrings: TStrings; - AData: TvVectorialPage; ADoc: TvVectorialDocument); -var - j: Integer; - PathStr: string; - PtX, PtY, OldPtX, OldPtY: double; - BezierCP1X, BezierCP1Y, BezierCP2X, BezierCP2Y: double; - segment: TPathSegment; - l2DSegment: T2DSegment absolute segment; - l2DBSegment: T2DBezierSegment absolute segment; - // Pen properties - lPenWidth: Integer; - lPenColor: string; - // Brush properties - lFillColor: string; -begin - OldPtX := 0; - OldPtY := 0; - PathStr := ''; - - APath.PrepareForSequentialReading(); - - for j := 0 to APath.Len - 1 do - begin - segment := TPathSegment(APath.Next()); - - if (segment.SegmentType <> st2DLine) - and (segment.SegmentType <> stMoveTo) - and (segment.SegmentType <> st2DBezier) - then Break; // unsupported line type - - // Coordinate conversion from fpvectorial to SVG - ConvertFPVCoordinatesToSVGCoordinates( - AData, l2DSegment.X, l2DSegment.Y, PtX, PtY); - PtX := PtX - OldPtX; - PtY := PtY - OldPtY; - - if (segment.SegmentType = stMoveTo) then - begin - PathStr := PathStr + 'm ' - + FloatToStr(PtX, FPointSeparator) + ',' - + FloatToStr(PtY, FPointSeparator) + ' '; - end - else if (segment.SegmentType = st2DLine) then - begin - PathStr := PathStr + 'l ' - + FloatToStr(PtX, FPointSeparator) + ',' - + FloatToStr(PtY, FPointSeparator) + ' '; - end - else if (segment.SegmentType = st2DBezier) then - begin - // Converts all coordinates to absolute values - ConvertFPVCoordinatesToSVGCoordinates( - AData, l2DBSegment.X2, l2DBSegment.Y2, BezierCP1X, BezierCP1Y); - ConvertFPVCoordinatesToSVGCoordinates( - AData, l2DBSegment.X3, l2DBSegment.Y3, BezierCP2X, BezierCP2Y); - - // Transforms them into values relative to the initial point - BezierCP1X := BezierCP1X - OldPtX; - BezierCP1Y := BezierCP1Y - OldPtY; - BezierCP2X := BezierCP2X - OldPtX; - BezierCP2Y := BezierCP2Y - OldPtY; - - // PtX and PtY already contains the destination point - - // Now render our 2D cubic bezier - PathStr := PathStr + 'c ' - + FloatToStr(BezierCP1X, FPointSeparator) + ',' - + FloatToStr(BezierCP1Y, FPointSeparator) + ' ' - + FloatToStr(BezierCP2X, FPointSeparator) + ',' - + FloatToStr(BezierCP2Y, FPointSeparator) + ' ' - + FloatToStr(PtX, FPointSeparator) + ',' - + FloatToStr(PtY, FPointSeparator) + ' ' - ; - end; - - // Store the current position for future points - OldPtX := OldPtX + PtX; - OldPtY := OldPtY + PtY; - end; - - // Get the Pen Width - if APath.Pen.Width >= 1 then lPenWidth := APath.Pen.Width - else lPenWidth := 1; - - // Get the Pen Color and Style - if APath.Pen.Style = psClear then lPenColor := 'none' - else lPenColor := '#' + FPColorToRGBHexString(APath.Pen.Color); - - // Get the Brush color and style - if APath.Brush.Style = bsClear then lFillColor := 'none' - else lFillColor := '#' + FPColorToRGBHexString(APath.Brush.Color); - - // Now effectively write the path - AStrings.Add(' '); -end; - -procedure TvSVGVectorialWriter.ConvertFPVCoordinatesToSVGCoordinates( - const AData: TvVectorialPage; const ASrcX, ASrcY: Double; var ADestX, - ADestY: double); -begin - ADestX := ASrcX / FLOAT_MILIMETERS_PER_PIXEL; - ADestY := (AData.Height - ASrcY) / FLOAT_MILIMETERS_PER_PIXEL; -end; - -procedure TvSVGVectorialWriter.WriteToStrings(AStrings: TStrings; - AData: TvVectorialDocument); -var - lPage: TvVectorialPage; -begin - // Format seetings to convert a string to a float - FPointSeparator := DefaultFormatSettings; - FPointSeparator.DecimalSeparator := '.'; - FPointSeparator.ThousandSeparator := '#';// disable the thousand separator - FCommaSeparator := DefaultFormatSettings; - FCommaSeparator.DecimalSeparator := ','; - FCommaSeparator.ThousandSeparator := '#';// disable the thousand separator - - // Headers - AStrings.Add(''); - AStrings.Add(''); - AStrings.Add(''); - AStrings.Add(''); - lPage := AData.GetPage(0); - WriteEntities(AStrings, lPage, AData); - AStrings.Add(' '); - - // finalization - AStrings.Add(''); -end; - -procedure TvSVGVectorialWriter.WriteText(AStrings: TStrings; lText: TvText; - AData: TvVectorialPage; ADoc: TvVectorialDocument); -var - i, j, FontSize: Integer; - TextStr, FontName, SVGFontFamily: string; - PtX, PtY: double; -begin - TextStr := ''; - - ConvertFPVCoordinatesToSVGCoordinates( - AData, lText.X, lText.Y, PtX, PtY); - - TextStr := lText.Value.Text; - FontSize:= ceil(lText.Font.Size / FLOAT_MILIMETERS_PER_PIXEL); - SVGFontFamily := 'Arial, sans-serif';//lText.FontName; - - AStrings.Add(' '); - AStrings.Add(' '); - AStrings.Add(TextStr + ''); -end; - -procedure TvSVGVectorialWriter.WriteEntities(AStrings: TStrings; - AData: TvVectorialPage; ADoc: TvVectorialDocument); -var - lEntity: TvEntity; - i, j: Integer; -begin - for i := 0 to AData.GetEntitiesCount() - 1 do - begin - lEntity := AData.GetEntity(i); - - if lEntity is TPath then WritePath(i, TPath(lEntity), AStrings, AData, ADoc) - else if lEntity is TvText then WriteText(AStrings, TvText(lEntity), AData, ADoc); - end; -end; - -initialization - - RegisterVectorialWriter(TvSVGVectorialWriter, vfSVG); - -end. -