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

fpvectorial: Advances the eps reader, but still didnt find out why a part of the drawing ends up with negative coords

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1884 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat
2011-09-01 11:56:28 +00:00
parent d887861a83
commit 26832a9a73
1 changed files with 218 additions and 41 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -7,15 +7,21 @@ License: The same modified LGPL as the Free Pascal RTL
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_PATHS}
{.$define FPVECTORIALDEBUG_COLORS}
{.$define FPVECTORIALDEBUG_ROLL}
{.$define FPVECTORIALDEBUG_CODEFLOW}
{$define FPVECTORIALDEBUG_CODEFLOW}
{$define FPVECTORIALDEBUG_INDEX}
{$define FPVECTORIALDEBUG_DICTIONARY}
{$define FPVECTORIALDEBUG_CONTROL}
{$define FPVECTORIALDEBUG_ARITHMETIC}
interface
@ -51,7 +57,7 @@ type
destructor Destroy; override;
end;
TETType = (ettNamedElement, ettOperand, ettOperator);
TETType = (ettNamedElement, ettOperand, ettOperator, ettDictionary);
{ TExpressionToken }
@ -71,8 +77,10 @@ type
public
Color: TFPColor;
TranslateX, TranslateY: Double;
ScaleX, ScaleY: Double; // not used currently
ClipPath: TPath;
ClipMode: TvClipMode;
OverPrint: Boolean; // not used currently
function Duplicate: TGraphicState;
end;
@ -81,7 +89,8 @@ type
TPSTokenizer = class
public
Tokens: TPSTokens;
constructor Create;
FCurLine: Integer;
constructor Create(ACurLine: Integer = -1);
destructor Destroy; override;
procedure ReadFromStream(AStream: TStream);
procedure DebugOut();
@ -147,6 +156,7 @@ begin
Result.TranslateX := TranslateX;
Result.TranslateY := TranslateY;
Result.ClipPath := ClipPath;
Result.OverPrint := OverPrint;
end;
{ TPSToken }
@ -202,10 +212,13 @@ end;
{ TPSTokenizer }
constructor TPSTokenizer.Create;
// 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;
@ -243,6 +256,7 @@ begin
lIsEndOfLine := IsEndOfLine(Byte(CurChar), AStream);
if lIsEndOfLine then Inc(CurLine);
if FCurLine >= 0 then CurLine := FCurLine;
case State of
{ Searching for a token }
@ -540,7 +554,7 @@ begin
if not AToken.Parsed then
begin
ProcTokenizer := TPSTokenizer.Create;
ProcTokenizer := TPSTokenizer.Create(AToken.Line);
lStream := TMemoryStream.Create;
try
// Copy the string to a Stream
@ -773,13 +787,21 @@ begin
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
@ -788,7 +810,7 @@ begin
Param2 := lTokens[i];
if Param2 = nil then
begin
// raise Exception.Create('[TvEPSVectorialReader.ExecuteStackManipulationOperator] nil element poped in operator index');
//raise Exception.Create(Format('[TvEPSVectorialReader.ExecuteStackManipulationOperator] nil element poped in operator index. Error at line %d', [AToken.Line]));
Exit(True);
end;
end;
@ -839,7 +861,7 @@ begin
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 lIndexN < 0 then raise Exception.Create('[TvEPSVectorialReader.ExecuteStackManipulationOperator] rool operator: n must be positive or zero');
if lIndexJ = 0 then Exit;
@ -853,8 +875,8 @@ begin
Param2 := lTokens[i];
if Param2 = nil then
begin
// raise Exception.Create('[TvEPSVectorialReader.ExecuteStackManipulationOperator] nil element poped in operator index');
Exit(True);
raise Exception.Create('[TvEPSVectorialReader.ExecuteStackManipulationOperator] nil element poped in operator index');
//Exit(True);
end;
end;
@ -972,9 +994,33 @@ begin
Exit(True);
end;
// Establish context for catching stop
{
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
@ -1028,6 +1074,12 @@ begin
ExecuteProcedureToken(TProcedureToken(Param1), AData);
FloatCounter := FloatCounter + Param3.FloatValue;
if ExitCalled then
begin
ExitCalled := False;
Break;
end;
end;
Exit(True);
@ -1036,6 +1088,11 @@ begin
// 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;
@ -1378,7 +1435,7 @@ begin
Result := False;
// Division
// Param2 Param1 div ==> Param2 div Param1
// Param2 Param1 div ==> (Param2 div Param1)
if AToken.StrValue = 'div' then
begin
Param1 := TPSToken(Stack.Pop);
@ -1386,12 +1443,15 @@ begin
NewToken := TExpressionToken.Create;
NewToken.ETType := ettOperand;
NewToken.FloatValue := Param2.FloatValue / Param1.FloatValue;
NewToken.StrValue := FloatToStr(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
// Param2 Param1 mul ==> (Param2 mul Param1)
if AToken.StrValue = 'mul' then
begin
Param1 := TPSToken(Stack.Pop);
@ -1399,7 +1459,7 @@ begin
NewToken := TExpressionToken.Create;
NewToken.ETType := ettOperand;
NewToken.FloatValue := Param2.FloatValue * Param1.FloatValue;
NewToken.StrValue := FloatToStr(Param1.FloatValue);
NewToken.StrValue := FloatToStr(NewToken.FloatValue);
Stack.Push(NewToken);
Exit(True);
end;
@ -1411,7 +1471,7 @@ begin
Param1 := TPSToken(Stack.Pop); // num2
Param2 := TPSToken(Stack.Pop); // num1
NewToken.FloatValue := Param2.FloatValue - Param1.FloatValue;
NewToken.StrValue := FloatToStr(Param1.FloatValue);
NewToken.StrValue := FloatToStr(NewToken.FloatValue);
Stack.Push(NewToken);
Exit(True);
end;
@ -1464,7 +1524,7 @@ var
begin
Result := False;
//
// – newpath – Initialize current path to be empty
if AToken.StrValue = 'newpath' then
begin
{$ifdef FPVECTORIALDEBUG_PATHS}
@ -1479,21 +1539,23 @@ begin
Exit(True);
end;
// Param2 Param1 moveto ===> moveto(X=Param2, Y=Param1);
// 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);
{$ifdef FPVECTORIALDEBUG_PATHS}
WriteLn(Format('[TvEPSVectorialReader.ExecutePathConstructionOperator] moveto %f, %f CurrentGraphicState.Translate %f, %f',
[PosX, PosY, CurrentGraphicState.TranslateX, CurrentGraphicState.TranslateY]));
{$endif}
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;
// Absolute LineTo
// x y lineto – Append straight line to (x, y)
if AToken.StrValue = 'lineto' then
begin
Param1 := TPSToken(Stack.Pop);
@ -1508,6 +1570,7 @@ begin
Exit(True);
end;
// Relative LineTo
// dx dy rlineto – Perform relative lineto
if AToken.StrValue = 'rlineto' then
begin
Param1 := TPSToken(Stack.Pop);
@ -1554,6 +1617,7 @@ begin
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
@ -1613,12 +1677,23 @@ begin
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
AData.SetPenStyle(psClear);
AData.EndPath();
CurrentGraphicState.ClipPath := AData.GetPath(AData.GetPathCount()-1);
CurrentGraphicState.ClipMode := vcmEvenOddRule;
//CurrentGraphicState.ClipPath := AData.GetPath(AData.GetPathCount()-1);
//CurrentGraphicState.ClipMode := vcmEvenOddRule;
Exit(True);
end
end;
@ -1681,7 +1756,7 @@ var
begin
Result := False;
//
// – gsave – Push graphics state
if AToken.StrValue = 'gsave' then
begin
GraphicStateStack.Push(CurrentGraphicState.Duplicate());
@ -1690,7 +1765,7 @@ begin
{$endif}
Exit(True);
end;
//
// – grestore - Pop graphics state
if AToken.StrValue = 'grestore' then
begin
lGraphicState := TGraphicState(GraphicStateStack.Pop());
@ -1702,19 +1777,21 @@ begin
{$endif}
Exit(True);
end;
//
// num setlinewidth – Set line width
if AToken.StrValue = 'setlinewidth' then
begin
Param1 := TPSToken(Stack.Pop);
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);
@ -1830,34 +1907,84 @@ var
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;
// tx ty translate – Translate user space by (tx , ty)
{
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 Exit(True);
if Param2 = nil then
begin
{$ifdef FPVECTORIALDEBUG_PATHS}
WriteLn('[TvEPSVectorialReader.ExecuteGraphicStateOperatorsDI] translate with stack underflow');
{$endif}
Exit(True);
end;
{$ifdef FPVECTORIALDEBUG_PATHS}
WriteLn(Format('[TvEPSVectorialReader.ExecuteGraphicStateOperatorsDI] translate %f, %f', [Param2.FloatValue, Param1.FloatValue]));
WriteLn(Format('[TvEPSVectorialReader.ExecuteGraphicStateOperatorsDI] translate %f, %f CurrentGraphicState.Translate %f %f',
[Param2.FloatValue, Param1.FloatValue, CurrentGraphicState.TranslateX, CurrentGraphicState.TranslateY]));
{$endif}
CurrentGraphicState.TranslateX := Param2.FloatValue;
CurrentGraphicState.TranslateY := Param1.FloatValue;
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;
@ -1906,6 +2033,7 @@ 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);
@ -1914,20 +2042,61 @@ begin
Exit(True);
end;
// Can be ignored
// 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);
NewToken := TExpressionToken.Create;
NewToken.ETType := ettOperand;
NewToken.BoolValue := False;
Stack.Push(NewToken);
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;
@ -1954,8 +2123,16 @@ 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;
@ -2003,7 +2180,7 @@ begin
FPointSeparator.DecimalSeparator := '.';
FPointSeparator.ThousandSeparator := ',';
Tokenizer := TPSTokenizer.Create;
Tokenizer := TPSTokenizer.Create(-1);
Stack := TObjectStack.Create;
GraphicStateStack := TObjectStack.Create;
Dictionary := TStringList.Create;