You've already forked lazarus-ccr
fpvectorial: Vast improvements to the PostScript interpreter, fixes running procedures
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1722 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat
@ -12,11 +12,16 @@ unit epsvectorialreader;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
{.$define FPVECTORIALDEBUG_PATHS}
|
||||
{.$define FPVECTORIALDEBUG_COLORS}
|
||||
{.$define FPVECTORIALDEBUG_ROLL}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Math, contnrs,
|
||||
fpvectorial, fpimage, fpvutils;
|
||||
fpimage, fpcanvas,
|
||||
fpvectorial, fpvutils;
|
||||
|
||||
type
|
||||
TPSTokenType = (ttComment, ttFloat);
|
||||
@ -27,6 +32,7 @@ type
|
||||
StrValue: string;
|
||||
FloatValue: double;
|
||||
IntValue: Integer;
|
||||
BoolValue: Boolean;
|
||||
Line: Integer; // To help debugging
|
||||
function Duplicate: TPSToken; virtual;
|
||||
end;
|
||||
@ -57,6 +63,15 @@ type
|
||||
|
||||
TPostScriptScannerState = (ssSearchingToken, ssInComment, ssInDefinition, ssInGroup, ssInExpressionElement);
|
||||
|
||||
{ TGraphicState }
|
||||
|
||||
TGraphicState = class
|
||||
public
|
||||
Color: TFPColor;
|
||||
TranslateX, TranslateY: Double;
|
||||
function Duplicate: TGraphicState;
|
||||
end;
|
||||
|
||||
{ TPSTokenizer }
|
||||
|
||||
TPSTokenizer = class
|
||||
@ -76,7 +91,10 @@ type
|
||||
TvEPSVectorialReader = class(TvCustomVectorialReader)
|
||||
private
|
||||
Stack: TObjectStack;
|
||||
GraphicStateStack: TObjectStack; // TGraphicState
|
||||
Dictionary: TStringList;
|
||||
ExitCalled: Boolean;
|
||||
CurrentGraphicState: TGraphicState;
|
||||
//
|
||||
procedure RunPostScript(ATokens: TPsTokens; AData: TvVectorialDocument);
|
||||
//
|
||||
@ -92,6 +110,8 @@ type
|
||||
function ExecuteControlOperator(AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
|
||||
function ExecutePaintingOperator(AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
|
||||
function ExecuteDeviceSetupAndOutputOperator(AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
|
||||
function ExecuteArrayOperator(AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
|
||||
function ExecuteStringOperator(AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
|
||||
//
|
||||
procedure PostScriptCoordsToFPVectorialCoords(AParam1, AParam2: TPSToken; var APosX, APosY: Double);
|
||||
procedure DictionarySubstituteOperator(ADictionary: TStringList; var ACurToken: TPSToken);
|
||||
@ -108,6 +128,16 @@ implementation
|
||||
var
|
||||
FPointSeparator: TFormatSettings;
|
||||
|
||||
{ TGraphicState }
|
||||
|
||||
function TGraphicState.Duplicate: TGraphicState;
|
||||
begin
|
||||
Result := TGraphicState(Self.ClassType.Create);
|
||||
Result.Color := Color;
|
||||
Result.TranslateX := TranslateX;
|
||||
Result.TranslateY := TranslateY;
|
||||
end;
|
||||
|
||||
{ TPSToken }
|
||||
|
||||
function TPSToken.Duplicate: TPSToken;
|
||||
@ -291,6 +321,13 @@ begin
|
||||
|
||||
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();
|
||||
@ -372,27 +409,44 @@ var
|
||||
i: Integer;
|
||||
CurToken: TPSToken;
|
||||
begin
|
||||
{$ifdef FPVECTORIALDEBUG}
|
||||
{$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 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 <> ettOperator then
|
||||
begin
|
||||
Stack.Push(CurToken);
|
||||
@ -404,9 +458,11 @@ begin
|
||||
|
||||
if CurToken is TProcedureToken then ExecuteProcedureToken(TProcedureToken(CurToken), AData)
|
||||
else ExecuteOperatorToken(TExpressionToken(CurToken), AData);
|
||||
|
||||
if ExitCalled then Break;
|
||||
end;
|
||||
end;
|
||||
{$ifdef FPVECTORIALDEBUG}
|
||||
{$ifdef FPVECTORIALDEBUG_CODEFLOW}
|
||||
WriteLn('[TvEPSVectorialReader.RunPostScript] END');
|
||||
{$endif}
|
||||
end;
|
||||
@ -419,9 +475,17 @@ var
|
||||
lOldTokens: TPSTokens;
|
||||
i: Integer;
|
||||
begin
|
||||
{$ifdef FPVECTORIALDEBUG}
|
||||
{$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;
|
||||
@ -432,14 +496,15 @@ begin
|
||||
lStream.WriteByte(Byte(AToken.StrValue[i]));
|
||||
|
||||
// Change the Tokens so that it writes directly to AToken.Childs
|
||||
lOldTokens := Tokenizer.Tokens;
|
||||
Tokenizer.Tokens := 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
|
||||
Tokenizer.Tokens := lOldTokens;
|
||||
ProcTokenizer.Tokens := lOldTokens;
|
||||
finally
|
||||
lStream.Free;
|
||||
ProcTokenizer.Free;
|
||||
@ -450,7 +515,7 @@ begin
|
||||
|
||||
// Now run the procedure
|
||||
RunPostScript(AToken.Childs, AData);
|
||||
{$ifdef FPVECTORIALDEBUG}
|
||||
{$ifdef FPVECTORIALDEBUG_CODEFLOW}
|
||||
WriteLn('[TvEPSVectorialReader.ExecuteProcedureToken] END');
|
||||
{$endif}
|
||||
end;
|
||||
@ -482,77 +547,14 @@ begin
|
||||
|
||||
if ExecuteDeviceSetupAndOutputOperator(AToken, AData) then Exit;
|
||||
|
||||
if ExecuteArrayOperator(AToken, AData) then Exit;
|
||||
|
||||
if ExecuteStringOperator(AToken, AData) 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]));
|
||||
|
||||
{ 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
|
||||
}
|
||||
{ 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)
|
||||
}
|
||||
{ File Operators
|
||||
|
||||
filename access file file Open named file with specified access
|
||||
@ -688,11 +690,29 @@ end;
|
||||
function TvEPSVectorialReader.ExecuteStackManipulationOperator(
|
||||
AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
|
||||
var
|
||||
Param1, NewToken: TPSToken;
|
||||
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(Param2);
|
||||
Stack.Push(Param1);
|
||||
Exit(True);
|
||||
end;
|
||||
// Duplicate top element
|
||||
if AToken.StrValue = 'dup' then
|
||||
begin
|
||||
Param1 := TPSToken(Stack.Pop);
|
||||
@ -701,14 +721,130 @@ begin
|
||||
Stack.Push(NewToken);
|
||||
Exit(True);
|
||||
end;
|
||||
// Duplicate arbitrary element
|
||||
if AToken.StrValue = 'index' then
|
||||
begin
|
||||
Param1 := TPSToken(Stack.Pop);
|
||||
lIndexN := Round(Param1.FloatValue);
|
||||
SetLength(lTokens, lIndexN+1);
|
||||
|
||||
// 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('[TvEPSVectorialReader.ExecuteStackManipulationOperator] nil element poped in operator index');
|
||||
Exit(True);
|
||||
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');
|
||||
|
||||
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
|
||||
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
|
||||
@ -742,10 +878,87 @@ function TvEPSVectorialReader.ExecuteControlOperator(AToken: TExpressionToken;
|
||||
AData: TvVectorialDocument): Boolean;
|
||||
var
|
||||
Param1, Param2, Param3, Param4: 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);
|
||||
|
||||
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)
|
||||
else ExecuteProcedureToken(TProcedureToken(Param1), AData);
|
||||
|
||||
Exit(True);
|
||||
end;
|
||||
// Exit innermost active loop
|
||||
if AToken.StrValue = 'exit' then
|
||||
begin
|
||||
ExitCalled := True;
|
||||
|
||||
Exit(True);
|
||||
end;
|
||||
// Establish context for catching stop
|
||||
if AToken.StrValue = 'stopped' then
|
||||
begin
|
||||
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);
|
||||
|
||||
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);
|
||||
|
||||
if ExitCalled then
|
||||
begin
|
||||
ExitCalled := False;
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
|
||||
Exit(True);
|
||||
end;
|
||||
// initial increment limit proc for
|
||||
if AToken.StrValue = 'for' then
|
||||
begin
|
||||
@ -765,6 +978,22 @@ begin
|
||||
FloatCounter := FloatCounter + Param3.FloatValue;
|
||||
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
|
||||
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;
|
||||
@ -837,6 +1066,13 @@ begin
|
||||
begin
|
||||
Exit(True);
|
||||
end;
|
||||
|
||||
if AToken.StrValue = 'eofill' then
|
||||
begin
|
||||
AData.SetBrushStyle(bsDiagCross);
|
||||
|
||||
Exit(True);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Device Setup and Output Operators
|
||||
@ -929,6 +1165,127 @@ begin
|
||||
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: 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: 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
|
||||
@ -983,6 +1340,16 @@ begin
|
||||
Stack.Push(Param1);
|
||||
Exit(True);
|
||||
end;
|
||||
// num1 num2 sub difference Return num1 minus num2
|
||||
if AToken.StrValue = 'sub' then
|
||||
begin
|
||||
Param1 := TPSToken(Stack.Pop); // num2
|
||||
Param2 := TPSToken(Stack.Pop); // num1
|
||||
Param1.FloatValue := Param2.FloatValue - Param1.FloatValue;
|
||||
Param1.StrValue := '00'; // Just to mark it as a number
|
||||
Stack.Push(Param1);
|
||||
Exit(True);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Path Construction Operators
|
||||
@ -1032,8 +1399,14 @@ begin
|
||||
//
|
||||
if AToken.StrValue = 'newpath' then
|
||||
begin
|
||||
{$ifdef FPVECTORIALDEBUG_PATHS}
|
||||
WriteLn('[TvEPSVectorialReader.ExecutePathConstructionOperator] newpath');
|
||||
{$endif}
|
||||
AData.EndPath();
|
||||
AData.StartPath();
|
||||
|
||||
AData.SetPenColor(CurrentGraphicState.Color);
|
||||
|
||||
Exit(True);
|
||||
end;
|
||||
// Param2 Param1 moveto ===> moveto(X=Param2, Y=Param1);
|
||||
@ -1042,6 +1415,11 @@ begin
|
||||
Param1 := TPSToken(Stack.Pop);
|
||||
Param2 := TPSToken(Stack.Pop);
|
||||
PostScriptCoordsToFPVectorialCoords(Param1, Param2, PosX, PosY);
|
||||
PosX := PosX + CurrentGraphicState.TranslateX;
|
||||
PosY := PosY + CurrentGraphicState.TranslateY;
|
||||
{$ifdef FPVECTORIALDEBUG_PATHS}
|
||||
WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] moveto %f, %f', [PosX, PosY]));
|
||||
{$endif}
|
||||
AData.AddMoveToPath(PosX, PosY);
|
||||
Exit(True);
|
||||
end;
|
||||
@ -1051,6 +1429,11 @@ begin
|
||||
Param1 := TPSToken(Stack.Pop);
|
||||
Param2 := TPSToken(Stack.Pop);
|
||||
PostScriptCoordsToFPVectorialCoords(Param1, Param2, PosX, PosY);
|
||||
PosX := PosX + CurrentGraphicState.TranslateX;
|
||||
PosY := PosY + CurrentGraphicState.TranslateY;
|
||||
{$ifdef FPVECTORIALDEBUG_PATHS}
|
||||
WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] lineto %f, %f', [PosX, PosY]));
|
||||
{$endif}
|
||||
AData.AddLineToPath(PosX, PosY);
|
||||
Exit(True);
|
||||
end;
|
||||
@ -1061,23 +1444,61 @@ begin
|
||||
Param2 := TPSToken(Stack.Pop);
|
||||
PostScriptCoordsToFPVectorialCoords(Param1, Param2, PosX, PosY);
|
||||
AData.GetCurrenPathPenPos(BaseX, BaseY);
|
||||
PosX := PosX + CurrentGraphicState.TranslateX;
|
||||
PosY := PosY + CurrentGraphicState.TranslateY;
|
||||
{$ifdef FPVECTORIALDEBUG_PATHS}
|
||||
WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] rlineto %f, %f', [BaseX + PosX, BaseY + PosY]));
|
||||
{$endif}
|
||||
AData.AddLineToPath(BaseX + PosX, BaseY + PosY);
|
||||
Exit(True);
|
||||
end;
|
||||
// dx1 dy1 dx2 dy2 dx3 dy3 rcurveto – Perform relative curveto
|
||||
// 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.GetCurrenPathPenPos(BaseX, BaseY);
|
||||
BaseX := BaseX + CurrentGraphicState.TranslateX;
|
||||
BaseY := BaseY + CurrentGraphicState.TranslateY;
|
||||
{$ifdef FPVECTORIALDEBUG_PATHS}
|
||||
WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] 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;
|
||||
// x y r angle1 angle2 arc – Append counterclockwise arc
|
||||
if AToken.StrValue = 'arc' then
|
||||
begin
|
||||
Param1 := TPSToken(Stack.Pop);
|
||||
Param2 := TPSToken(Stack.Pop);
|
||||
Param3 := TPSToken(Stack.Pop);
|
||||
Param4 := TPSToken(Stack.Pop);
|
||||
Param5 := TPSToken(Stack.Pop);
|
||||
Param6 := TPSToken(Stack.Pop);
|
||||
PostScriptCoordsToFPVectorialCoords(Param1, Param2, PosX, PosY);
|
||||
PostScriptCoordsToFPVectorialCoords(Param3, Param4, PosX2, PosY2);
|
||||
PostScriptCoordsToFPVectorialCoords(Param5, Param6, PosX3, PosY3);
|
||||
AData.GetCurrenPathPenPos(BaseX, BaseY);
|
||||
AData.AddBezierToPath(BaseX + PosX, BaseY + PosY, BaseX + PosX2, BaseY + PosY2, BaseX + PosX3, BaseY + PosY3);
|
||||
PostScriptCoordsToFPVectorialCoords(Param4, Param5, PosX, PosY);
|
||||
// {$ifdef FPVECTORIALDEBUG}
|
||||
// WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] rcurveto %f, %f', [BaseX + PosX, BaseY + PosY]));
|
||||
// {$endif}
|
||||
// AData.AddBezierToPath(BaseX + PosX, BaseY + PosY, BaseX + PosX2, BaseY + PosY2, BaseX + PosX3, BaseY + PosY3);
|
||||
{$ifdef FPVECTORIALDEBUG_PATHS}
|
||||
WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] arc %f, %f', [PosX, PosY]));
|
||||
{$endif}
|
||||
Exit(True);
|
||||
end;
|
||||
// – eoclip – Clip using even-odd rule
|
||||
@ -1139,10 +1560,33 @@ end;
|
||||
function TvEPSVectorialReader.ExecuteGraphicStateOperatorsDI(
|
||||
AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
|
||||
var
|
||||
Param1, Param2: TPSToken;
|
||||
Param1, Param2, Param3: TPSToken;
|
||||
lRed, lGreen, lBlue: Double;
|
||||
lGraphicState: TGraphicState;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
//
|
||||
if AToken.StrValue = 'gsave' then
|
||||
begin
|
||||
GraphicStateStack.Push(CurrentGraphicState.Duplicate());
|
||||
{$ifdef FPVECTORIALDEBUG_PATHS}
|
||||
WriteLn('[TvEPSVectorialReader.ExecuteGraphicStateOperatorsDI] gsave');
|
||||
{$endif}
|
||||
Exit(True);
|
||||
end;
|
||||
//
|
||||
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;
|
||||
//
|
||||
if AToken.StrValue = 'setlinewidth' then
|
||||
begin
|
||||
@ -1155,6 +1599,35 @@ 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)
|
||||
@ -1243,6 +1716,29 @@ begin
|
||||
Param2 := TPSToken(Stack.Pop);
|
||||
Exit(True);
|
||||
end;
|
||||
// tx ty translate – Translate user space by (tx , ty)
|
||||
if AToken.StrValue = 'translate' then
|
||||
begin
|
||||
Param1 := TPSToken(Stack.Pop); // ty
|
||||
Param2 := TPSToken(Stack.Pop); // tx
|
||||
|
||||
if Param2 = nil then Exit(True);
|
||||
|
||||
{$ifdef FPVECTORIALDEBUG_PATHS}
|
||||
WriteLn(Format('[TvEPSVectorialReader.ExecuteGraphicStateOperatorsDI] translate %f, %f', [Param2.FloatValue, Param1.FloatValue]));
|
||||
{$endif}
|
||||
|
||||
CurrentGraphicState.TranslateX := Param2.FloatValue;
|
||||
CurrentGraphicState.TranslateY := Param1.FloatValue;
|
||||
|
||||
Exit(True);
|
||||
end;
|
||||
//
|
||||
if AToken.StrValue = 'rotate' then
|
||||
begin
|
||||
Param1 := TPSToken(Stack.Pop);
|
||||
Exit(True);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Dictionary Operators
|
||||
@ -1284,6 +1780,7 @@ function TvEPSVectorialReader.ExecuteDictionaryOperators(
|
||||
AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
|
||||
var
|
||||
Param1, Param2: TPSToken;
|
||||
NewToken: TExpressionToken;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
@ -1301,6 +1798,17 @@ begin
|
||||
begin
|
||||
Exit(True);
|
||||
end;
|
||||
|
||||
// Find dictionary in which key is defined
|
||||
if AToken.StrValue = 'where' then
|
||||
begin
|
||||
Param1 := TPSToken(Stack.Pop);
|
||||
NewToken := TExpressionToken.Create;
|
||||
NewToken.ETType := ettOperand;
|
||||
NewToken.BoolValue := False;
|
||||
Stack.Push(NewToken);
|
||||
Exit(True);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Miscellaneous Operators
|
||||
@ -1372,14 +1880,18 @@ begin
|
||||
|
||||
Tokenizer := TPSTokenizer.Create;
|
||||
Stack := TObjectStack.Create;
|
||||
GraphicStateStack := TObjectStack.Create;
|
||||
Dictionary := TStringList.Create;
|
||||
CurrentGraphicState := TGraphicState.Create;
|
||||
end;
|
||||
|
||||
destructor TvEPSVectorialReader.Destroy;
|
||||
begin
|
||||
Tokenizer.Free;
|
||||
Stack.Free;
|
||||
GraphicStateStack.Free;
|
||||
Dictionary.Free;
|
||||
CurrentGraphicState.Free;
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
@ -1388,7 +1900,7 @@ procedure TvEPSVectorialReader.ReadFromStream(AStream: TStream;
|
||||
AData: TvVectorialDocument);
|
||||
begin
|
||||
Tokenizer.ReadFromStream(AStream);
|
||||
Tokenizer.DebugOut();
|
||||
// Tokenizer.DebugOut();
|
||||
|
||||
// Make sure we have at least one path
|
||||
AData.StartPath();
|
||||
|
||||
@ -31,7 +31,7 @@ procedure DrawFPVTextToCanvas(ASource: TvVectorialDocument; CurText: TvText;
|
||||
implementation
|
||||
|
||||
{$ifndef Windows}
|
||||
{$define FPVECTORIALDEBUG}
|
||||
{.$define FPVECTORIAL_TOCANVAS_DEBUG}
|
||||
{$endif}
|
||||
|
||||
function Rotate2DPoint(P,Fix :TPoint; alpha:double): TPoint;
|
||||
@ -112,6 +112,10 @@ begin
|
||||
|
||||
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)
|
||||
@ -119,7 +123,7 @@ begin
|
||||
else DrawFPVEntityToCanvas(ASource, CurEntity, ADest, ADestX, ADestY, AMulX, AMulY);
|
||||
end;
|
||||
|
||||
{$ifdef FPVECTORIALDEBUG}
|
||||
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
|
||||
WriteLn(':<DrawFPVectorialToCanvas');
|
||||
{$endif}
|
||||
end;
|
||||
@ -140,7 +144,8 @@ procedure DrawFPVPathToCanvas(ASource: TvVectorialDocument; CurPath: TPath;
|
||||
|
||||
var
|
||||
j, k: Integer;
|
||||
PosX, PosY: Integer; // Not modified by ADestX, etc
|
||||
PosX, PosY: Double; // Not modified by ADestX, etc
|
||||
CoordX, CoordY: Integer;
|
||||
CurSegment: TPathSegment;
|
||||
Cur2DSegment: T2DSegment absolute CurSegment;
|
||||
Cur2DBSegment: T2DBezierSegment absolute CurSegment;
|
||||
@ -164,10 +169,6 @@ begin
|
||||
ADest.Pen.FPColor := CurPath.Pen.Color;
|
||||
ADest.Brush.FPColor := CurPath.Brush.Color;
|
||||
|
||||
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
|
||||
Write(Format('[Path] ID=%d', [i]));
|
||||
{$endif}
|
||||
|
||||
for j := 0 to CurPath.Len - 1 do
|
||||
begin
|
||||
//WriteLn('j = ', j);
|
||||
@ -176,9 +177,13 @@ begin
|
||||
case CurSegment.SegmentType of
|
||||
stMoveTo:
|
||||
begin
|
||||
ADest.MoveTo(CoordToCanvasX(Cur2DSegment.X), CoordToCanvasY(Cur2DSegment.Y));
|
||||
CoordX := CoordToCanvasX(Cur2DSegment.X);
|
||||
CoordY := CoordToCanvasY(Cur2DSegment.Y);
|
||||
ADest.MoveTo(CoordX, CoordY);
|
||||
PosX := Cur2DSegment.X;
|
||||
PosY := Cur2DSegment.Y;
|
||||
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
|
||||
Write(Format(' M%d,%d', [CoordToCanvasX(Cur2DSegment.X), CoordToCanvasY(Cur2DSegment.Y)]));
|
||||
Write(Format(' M%d,%d', [CoordY, CoordY]));
|
||||
{$endif}
|
||||
end;
|
||||
// This element can override temporarely the Pen
|
||||
@ -186,7 +191,11 @@ begin
|
||||
begin
|
||||
ADest.Pen.FPColor := T2DSegmentWithPen(Cur2DSegment).Pen.Color;
|
||||
|
||||
ADest.LineTo(CoordToCanvasX(Cur2DSegment.X), CoordToCanvasY(Cur2DSegment.Y));
|
||||
CoordX := CoordToCanvasX(Cur2DSegment.X);
|
||||
CoordY := CoordToCanvasY(Cur2DSegment.Y);
|
||||
ADest.LineTo(CoordX, CoordY);
|
||||
PosX := Cur2DSegment.X;
|
||||
PosY := Cur2DSegment.Y;
|
||||
|
||||
ADest.Pen.FPColor := CurPath.Pen.Color;
|
||||
|
||||
@ -196,9 +205,13 @@ begin
|
||||
end;
|
||||
st2DLine, st3DLine:
|
||||
begin
|
||||
ADest.LineTo(CoordToCanvasX(Cur2DSegment.X), CoordToCanvasY(Cur2DSegment.Y));
|
||||
CoordX := CoordToCanvasX(Cur2DSegment.X);
|
||||
CoordY := CoordToCanvasY(Cur2DSegment.Y);
|
||||
ADest.LineTo(CoordX, CoordY);
|
||||
PosX := Cur2DSegment.X;
|
||||
PosY := Cur2DSegment.Y;
|
||||
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
|
||||
Write(Format(' L%d,%d', [CoordToCanvasX(Cur2DSegment.X), CoordToCanvasY(Cur2DSegment.Y)]));
|
||||
Write(Format(' L%d,%d', [CoordX, CoordY]));
|
||||
{$endif}
|
||||
end;
|
||||
{ To draw a bezier we need to divide the interval in parts and make
|
||||
@ -206,8 +219,8 @@ begin
|
||||
st2DBezier, st3DBezier:
|
||||
begin
|
||||
CurveLength :=
|
||||
Round(sqrt(sqr(Cur2DBSegment.X3 - PosX) + sqr(Cur2DBSegment.Y3 - PosY))) +
|
||||
Round(sqrt(sqr(Cur2DBSegment.X2 - Cur2DBSegment.X3) + sqr(Cur2DBSegment.Y2 - Cur2DBSegment.Y3))) +
|
||||
Round(sqrt(sqr(Cur2DBSegment.X2 - PosX) + sqr(Cur2DBSegment.Y2 - PosY))) +
|
||||
Round(sqrt(sqr(Cur2DBSegment.X3 - Cur2DBSegment.X2) + sqr(Cur2DBSegment.Y3 - Cur2DBSegment.Y2))) +
|
||||
Round(sqrt(sqr(Cur2DBSegment.X - Cur2DBSegment.X3) + sqr(Cur2DBSegment.Y - Cur2DBSegment.Y3)));
|
||||
|
||||
for k := 1 to CurveLength do
|
||||
@ -215,10 +228,23 @@ begin
|
||||
t := k / CurveLength;
|
||||
CurX := Round(sqr(1 - t) * (1 - t) * PosX + 3 * t * sqr(1 - t) * Cur2DBSegment.X2 + 3 * t * t * (1 - t) * Cur2DBSegment.X3 + t * t * t * Cur2DBSegment.X);
|
||||
CurY := Round(sqr(1 - t) * (1 - t) * PosY + 3 * t * sqr(1 - t) * Cur2DBSegment.Y2 + 3 * t * t * (1 - t) * Cur2DBSegment.Y3 + t * t * t * Cur2DBSegment.Y);
|
||||
ADest.LineTo(CoordToCanvasX(CurX), CoordToCanvasY(CurY));
|
||||
CoordX := CoordToCanvasX(CurX);
|
||||
CoordY := CoordToCanvasY(CurY);
|
||||
ADest.LineTo(CoordX, CoordY);
|
||||
// {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
|
||||
// Write(Format(' CL%d,%d', [CoordX, CoordY]));
|
||||
// {$endif}
|
||||
end;
|
||||
PosX := Round(Cur2DBSegment.X);
|
||||
PosY := Round(Cur2DBSegment.Y);
|
||||
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;
|
||||
|
||||
@ -37,9 +37,10 @@ object frmFPVViewer: TfrmFPVViewer
|
||||
Top = 72
|
||||
Width = 168
|
||||
DecimalPlaces = 6
|
||||
Increment = 1
|
||||
Increment = 0.1
|
||||
MaxValue = 100
|
||||
MinValue = 0
|
||||
OnChange = spinScaleChange
|
||||
TabOrder = 2
|
||||
Value = 1
|
||||
end
|
||||
@ -76,8 +77,8 @@ object frmFPVViewer: TfrmFPVViewer
|
||||
object pageViewer: TPage
|
||||
end
|
||||
object Page2: TPage
|
||||
ClientWidth = 67584
|
||||
ClientHeight = 79872
|
||||
ClientWidth = 135
|
||||
ClientHeight = 159
|
||||
object DXFTreeView: TTreeView
|
||||
Left = 8
|
||||
Height = 313
|
||||
|
||||
@ -31,6 +31,7 @@ type
|
||||
procedure buttonRenderingTestClick(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure spinScaleChange(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
public
|
||||
@ -190,5 +191,12 @@ begin
|
||||
Drawer.Free;
|
||||
end;
|
||||
|
||||
procedure TfrmFPVViewer.spinScaleChange(Sender: TObject);
|
||||
begin
|
||||
if spinScale.Value <= 0.2 then spinScale.Increment := 0.01
|
||||
else if spinScale.Value <= 2 then spinScale.Increment := 0.1
|
||||
else spinScale.Increment := 1;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
Reference in New Issue
Block a user