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

fpvectorial: Fixes some bugs in the PostScript interpreter, previously it didnt run some procedures, and adds more commands to it

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1743 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat
2011-07-15 10:17:44 +00:00
parent 8608497d12
commit b1dffdca6a
2 changed files with 111 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -15,6 +15,7 @@ unit epsvectorialreader;
{.$define FPVECTORIALDEBUG_PATHS}
{.$define FPVECTORIALDEBUG_COLORS}
{.$define FPVECTORIALDEBUG_ROLL}
{.$define FPVECTORIALDEBUG_CODEFLOW}
interface
@ -96,6 +97,8 @@ type
ExitCalled: Boolean;
CurrentGraphicState: TGraphicState;
//
procedure DebugStack();
//
procedure RunPostScript(ATokens: TPsTokens; AData: TvVectorialDocument);
//
procedure ExecuteProcedureToken(AToken: TProcedureToken; AData: TvVectorialDocument);
@ -114,7 +117,7 @@ type
function ExecuteStringOperator(AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
//
procedure PostScriptCoordsToFPVectorialCoords(AParam1, AParam2: TPSToken; var APosX, APosY: Double);
procedure DictionarySubstituteOperator(ADictionary: TStringList; var ACurToken: TPSToken);
function DictionarySubstituteOperator(ADictionary: TStringList; var ACurToken: TPSToken): Boolean;
public
{ General reading methods }
Tokenizer: TPSTokenizer;
@ -125,6 +128,10 @@ type
implementation
type
TStackAccess = class(TObjectStack)
end;
var
FPointSeparator: TFormatSettings;
@ -257,6 +264,7 @@ begin
begin
ExpressionToken := TExpressionToken.Create;
ExpressionToken.Line := CurLine;
ExpressionToken.StrValue := '';
if CurChar = '/' then
ExpressionToken.ETType := ettNamedElement
else
@ -301,9 +309,17 @@ 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:
@ -403,10 +419,26 @@ end;
{ 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: TvVectorialDocument);
var
i: Integer;
lSubstituted: Boolean;
CurToken: TPSToken;
begin
{$ifdef FPVECTORIALDEBUG_CODEFLOW}
@ -423,6 +455,11 @@ begin
begin
CurToken := TPSToken(ATokens.Items[i]);
{ if CurToken.StrValue = 'J' then
begin
DebugStack();
end;}
if CurToken is TCommentToken then
begin
{$ifdef FPVECTORIALDEBUG_CODEFLOW}
@ -447,14 +484,22 @@ begin
WriteLn(Format('[TvEPSVectorialReader.RunPostScript] Type: TExpressionToken Token: %s', [CurToken.StrValue]));
{$endif}
if TExpressionToken(CurToken).ETType <> ettOperator then
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
DictionarySubstituteOperator(Dictionary, CurToken);
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)
else ExecuteOperatorToken(TExpressionToken(CurToken), AData);
@ -1069,7 +1114,7 @@ begin
if AToken.StrValue = 'eofill' then
begin
AData.SetBrushStyle(bsDiagCross);
AData.SetBrushStyle(bsSolid);
Exit(True);
end;
@ -1483,6 +1528,19 @@ begin
AData.AddBezierToPath(BaseX + PosX, BaseY + PosY, BaseX + PosX2, BaseY + PosY2, BaseX + PosX3, BaseY + PosY3);
Exit(True);
end;
//
if AToken.StrValue = 'closepath' then
begin
{$ifdef FPVECTORIALDEBUG_PATHS}
WriteLn('[TvEPSVectorialReader.ExecutePathConstructionOperator] closepath');
{$endif}
AData.EndPath();
AData.StartPath();
AData.SetPenColor(CurrentGraphicState.Color);
Exit(True);
end;
// x y r angle1 angle2 arc – Append counterclockwise arc
if AToken.StrValue = 'arc' then
begin
@ -1594,6 +1652,12 @@ begin
Exit(True);
end;
//
if AToken.StrValue = 'setlinecap' then
begin
Param1 := TPSToken(Stack.Pop);
Exit(True);
end;
//
if AToken.StrValue = 'setlinejoin' then
begin
Param1 := TPSToken(Stack.Pop);
@ -1846,15 +1910,19 @@ begin
APosY := AParam1.FloatValue;
end;
procedure TvEPSVectorialReader.DictionarySubstituteOperator(
ADictionary: TStringList; var ACurToken: TPSToken);
// 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
@ -1882,6 +1950,7 @@ begin
Stack := TObjectStack.Create;
GraphicStateStack := TObjectStack.Create;
Dictionary := TStringList.Create;
Dictionary.CaseSensitive := True;
CurrentGraphicState := TGraphicState.Create;
end;

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

@ -4,7 +4,7 @@ unit fpvtocanvas;
interface
{$define USE_LCL_CANVAS}
{.$define USE_LCL_CANVAS}
uses
Classes, SysUtils, Math,
@ -153,6 +153,8 @@ var
CurX, CurY: Integer; // Not modified by ADestX, etc
CurveLength: Integer;
t: Double;
// For polygons
Points: array of TPoint;
begin
PosX := 0;
PosY := 0;
@ -165,10 +167,38 @@ begin
// Set the path Pen and Brush options
ADest.Pen.Style := CurPath.Pen.Style;
ADest.Pen.Width := CurPath.Pen.Width;
ADest.Brush.Style := CurPath.Brush.Style;
ADest.Pen.FPColor := CurPath.Pen.Color;
ADest.Brush.FPColor := CurPath.Brush.Color;
//
// For solid paths, draw a polygon instead
//
if CurPath.Brush.Style = bsSolid then
begin
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;
end;
ADest.Polygon(Points);
Exit;
end;
//
// For other paths, draw more carefully
//
for j := 0 to CurPath.Len - 1 do
begin
//WriteLn('j = ', j);