* synchronized with trunk

git-svn-id: branches/z80@44671 -
This commit is contained in:
nickysn 2020-04-09 22:01:59 +00:00
commit 611ac9076b
5 changed files with 107 additions and 37 deletions

View File

@ -314,21 +314,9 @@ unit cpubase;
R_INTREGISTER :
reg_cgsize:=OS_32;
R_FPUREGISTER :
reg_cgsize:=OS_F80;
R_MMREGISTER :
begin
case getsubreg(reg) of
R_SUBFD,
R_SUBWHOLE:
result:=OS_F64;
R_SUBFS:
result:=OS_F32;
else
internalerror(2009112903);
end;
end;
reg_cgsize:=OS_F32;
else
internalerror(200303181);
internalerror(2020040501);
end;
end;

View File

@ -92,6 +92,7 @@ unit cpupi;
localsize : aint;
i : longint;
begin
maxpushedparasize:=Align(maxpushedparasize,4);
tg.setfirsttemp(maxpushedparasize);
if po_nostackframe in procdef.procoptions then

View File

@ -199,6 +199,15 @@ type
class function Command: string;
end;
{ TPDFClipPath }
TPDFClipPath = class(TPDFDocumentObject)
protected
procedure Write(const AStream: TStream); override;
public
class function Command: string;
end;
TPDFPushGraphicsStack = class(TPDFDocumentObject)
protected
@ -668,6 +677,9 @@ type
{ When the WriteXXX() and DrawXXX() methods specify coordinates, they do it as
per the PDF specification, from the bottom-left. }
{ TPDFPage }
TPDFPage = Class(TPDFDocumentObject)
private
FObjects : TObjectList;
@ -731,6 +743,7 @@ type
procedure DrawPolyLine(const APoints: array of TPDFCoord; const ALineWidth: TPDFFloat);
{ start a new subpath }
procedure ResetPath;
procedure ClipPath;
{ Close the current subpath by appending a straight line segment from the current point to the starting point of the subpath. }
procedure ClosePath;
procedure ClosePathStroke;
@ -740,6 +753,9 @@ type
procedure FillStrokePath;
{ Fill using the Even-Odd rule. }
procedure FillEvenOddStrokePath;
{ Graphic stack management }
procedure PushGraphicsStack;
procedure PopGraphicsStack;
{ Move the current drawing position to (x, y) }
procedure MoveTo(x, y: TPDFFloat); overload;
procedure MoveTo(APos: TPDFCoord); overload;
@ -849,10 +865,13 @@ type
end;
{ TPDFFontDefs }
TPDFFontDefs = Class(TCollection)
private
function GetF(AIndex : Integer): TPDFFont;
Public
Function FindFont(const AName:string):integer;
Function AddFontDef : TPDFFont;
Property FontDefs[AIndex : Integer] : TPDFFont Read GetF; Default;
end;
@ -1457,7 +1476,6 @@ begin
SetLength(result, iPos - 1);
end;
{ TPDFMemoryStream }
procedure TPDFMemoryStream.Write(const AStream: TStream);
@ -1814,6 +1832,19 @@ begin
Result := 'S' + CRLF;
end;
{ TPDFClipPath }
procedure TPDFClipPath.Write(const AStream: TStream);
begin
WriteString(Command, AStream);
end;
class function TPDFClipPath.Command: string;
begin
Result := 'W n' + CRLF;
end;
{ TPDFPushGraphicsStack }
procedure TPDFPushGraphicsStack.Write(const AStream: TStream);
@ -1831,6 +1862,9 @@ end;
procedure TPDFPopGraphicsStack.Write(const AStream: TStream);
begin
WriteString(Command, AStream);
// disable cache
Self.Document.CurrentWidth:='';
Self.Document.CurrentColor:='';
end;
class function TPDFPopGraphicsStack.Command: string;
@ -2616,6 +2650,12 @@ begin
AddObject(TPDFResetPath.Create(Document));
end;
procedure TPDFPage.ClipPath;
begin
AddObject(TPDFClipPath.Create(Document));
end;
procedure TPDFPage.ClosePath;
begin
AddObject(TPDFClosePath.Create(Document));
@ -2641,6 +2681,16 @@ begin
AddObject(TPDFFreeFormString.Create(Document, 'B*'+CRLF));
end;
procedure TPDFPage.PushGraphicsStack;
begin
AddObject(TPDFPushGraphicsStack.Create(Document));
end;
procedure TPDFPage.PopGraphicsStack;
begin
AddObject(TPDFPopGraphicsStack.Create(Document));
end;
procedure TPDFPage.MoveTo(x, y: TPDFFloat);
var
p1: TPDFCoord;
@ -2764,6 +2814,21 @@ begin
Result:=Items[AIndex] as TPDFFont;
end;
function TPDFFontDefs.FindFont(const AName: string): integer;
var
i:integer;
begin
Result:=-1;
for i := 0 to Count-1 do
begin
if GetF(i).Name = AName then
begin
Result := i;
Exit;
end;
end;
end;
function TPDFFontDefs.AddFontDef: TPDFFont;
begin
Result:=Add as TPDFFont;
@ -6046,14 +6111,8 @@ var
i: integer;
begin
{ reuse existing font definition if it exists }
for i := 0 to Fonts.Count-1 do
begin
if Fonts[i].Name = AName then
begin
Result := i;
Exit;
end;
end;
Result:=Fonts.FindFont(AName);
if Result>=0 then exit;
F := Fonts.AddFontDef;
F.Name := AName;
F.IsStdFont := True;
@ -6067,14 +6126,8 @@ var
lFName: string;
begin
{ reuse existing font definition if it exists }
for i := 0 to Fonts.Count-1 do
begin
if Fonts[i].Name = AName then
begin
Result := i;
Exit;
end;
end;
Result:=Fonts.FindFont(AName);
if Result>=0 then exit;
F := Fonts.AddFontDef;
if ExtractFilePath(AFontFile) <> '' then
// assume AFontFile is the full path to the TTF file

View File

@ -14,9 +14,13 @@
**********************************************************************}
unit getopts;
Interface
{$modeswitch advancedrecords}
{$modeswitch defaultparameters}
{$h+}
Interface
Const
No_Argument = 0;
Required_Argument = 1;
@ -51,11 +55,6 @@ Function GetLongOpts (ShortOpts : String;LongOpts : POption;var Longind : Longin
Implementation
Procedure TOption.SetOption(const aName:String;AHas_Arg:integer=0;AFlag:PChar=nil;AValue:Char=#0);
begin
Name:=aName; Has_Arg:=AHas_Arg; Flag:=AFlag; Value:=Avalue;
end;
{$IFNDEF FPC}
{***************************************************************************
@ -147,6 +146,20 @@ end;
{$ENDIF}
function strpas(p : pchar) : ansistring;
begin
if p=nil then
strpas:=''
else
strpas:=p;
end;
Procedure TOption.SetOption(const aName:String;AHas_Arg:integer=0;AFlag:PChar=nil;AValue:Char=#0);
begin
Name:=aName; Has_Arg:=AHas_Arg; Flag:=AFlag; Value:=Avalue;
end;
{***************************************************************************
Real Getopts
***************************************************************************}

View File

@ -291,10 +291,14 @@ type
{ open an epoll file descriptor }
function epoll_create(size: cint): cint; {$ifdef FPC_USE_LIBC} cdecl; external name 'epoll_create'; {$endif}
function epoll_create1(flags: cint): cint; {$ifdef FPC_USE_LIBC} cdecl; external name 'epoll_create1'; {$endif}
{ control interface for an epoll descriptor }
function epoll_ctl(epfd, op, fd: cint; event: pepoll_event): cint; {$ifdef FPC_USE_LIBC} cdecl; external name 'epoll_ctl'; {$endif}
{ wait for an I/O event on an epoll file descriptor }
function epoll_wait(epfd: cint; events: pepoll_event; maxevents, timeout: cint): cint; {$ifdef FPC_USE_LIBC} cdecl; external name 'epoll_wait'; {$endif}
function epoll_pwait(epfd: cint; events: pepoll_event; maxevents, timeout: cint; sigmask: PSigSet): cint; {$ifdef FPC_USE_LIBC} cdecl; external name 'epoll_pwait'; {$endif}
type Puser_cap_header=^user_cap_header;
user_cap_header=record
@ -630,6 +634,17 @@ begin
{$endif}
end;
function epoll_create1(flags: cint): cint;
begin
epoll_create1 := do_syscall(syscall_nr_epoll_create1, tsysparam(flags));
end;
function epoll_pwait(epfd: cint; events: pepoll_event; maxevents, timeout: cint; sigmask: PSigSet): cint;
begin
epoll_pwait := do_syscall(syscall_nr_epoll_pwait, tsysparam(epfd),
tsysparam(events), tsysparam(maxevents), tsysparam(timeout), tsysparam(sigmask));
end;
function capget(header:Puser_cap_header;data:Puser_cap_data):cint;
begin