# revisions: 44443,44667,44714,44724

git-svn-id: branches/fixes_3_2@44864 -
This commit is contained in:
marco 2020-04-19 18:13:59 +00:00
parent 8250336193
commit 32b4647870
6 changed files with 121 additions and 27 deletions

1
.gitattributes vendored
View File

@ -15315,6 +15315,7 @@ tests/test/units/math/tdivmod.pp svneol=native#text/plain
tests/test/units/math/tmask.inc svneol=native#text/plain tests/test/units/math/tmask.inc svneol=native#text/plain
tests/test/units/math/tmask.pp svneol=native#text/plain tests/test/units/math/tmask.pp svneol=native#text/plain
tests/test/units/math/tmask2.pp svneol=native#text/plain tests/test/units/math/tmask2.pp svneol=native#text/plain
tests/test/units/math/tminmaxconst.pp svneol=native#text/pascal
tests/test/units/math/tnaninf.pp svneol=native#text/plain tests/test/units/math/tnaninf.pp svneol=native#text/plain
tests/test/units/math/tpower.pp svneol=native#text/pascal tests/test/units/math/tpower.pp svneol=native#text/pascal
tests/test/units/math/troundm.pp svneol=native#text/plain tests/test/units/math/troundm.pp svneol=native#text/plain

View File

@ -199,6 +199,15 @@ type
class function Command: string; class function Command: string;
end; end;
{ TPDFClipPath }
TPDFClipPath = class(TPDFDocumentObject)
protected
procedure Write(const AStream: TStream); override;
public
class function Command: string;
end;
TPDFPushGraphicsStack = class(TPDFDocumentObject) TPDFPushGraphicsStack = class(TPDFDocumentObject)
protected protected
@ -646,6 +655,9 @@ type
{ When the WriteXXX() and DrawXXX() methods specify coordinates, they do it as { When the WriteXXX() and DrawXXX() methods specify coordinates, they do it as
per the PDF specification, from the bottom-left. } per the PDF specification, from the bottom-left. }
{ TPDFPage }
TPDFPage = Class(TPDFDocumentObject) TPDFPage = Class(TPDFDocumentObject)
private private
FObjects : TObjectList; FObjects : TObjectList;
@ -709,6 +721,7 @@ type
procedure DrawPolyLine(const APoints: array of TPDFCoord; const ALineWidth: TPDFFloat); procedure DrawPolyLine(const APoints: array of TPDFCoord; const ALineWidth: TPDFFloat);
{ start a new subpath } { start a new subpath }
procedure ResetPath; 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. } { Close the current subpath by appending a straight line segment from the current point to the starting point of the subpath. }
procedure ClosePath; procedure ClosePath;
procedure ClosePathStroke; procedure ClosePathStroke;
@ -718,6 +731,9 @@ type
procedure FillStrokePath; procedure FillStrokePath;
{ Fill using the Even-Odd rule. } { Fill using the Even-Odd rule. }
procedure FillEvenOddStrokePath; procedure FillEvenOddStrokePath;
{ Graphic stack management }
procedure PushGraphicsStack;
procedure PopGraphicsStack;
{ Move the current drawing position to (x, y) } { Move the current drawing position to (x, y) }
procedure MoveTo(x, y: TPDFFloat); overload; procedure MoveTo(x, y: TPDFFloat); overload;
procedure MoveTo(APos: TPDFCoord); overload; procedure MoveTo(APos: TPDFCoord); overload;
@ -827,10 +843,13 @@ type
end; end;
{ TPDFFontDefs }
TPDFFontDefs = Class(TCollection) TPDFFontDefs = Class(TCollection)
private private
function GetF(AIndex : Integer): TPDFFont; function GetF(AIndex : Integer): TPDFFont;
Public Public
Function FindFont(const AName:string):integer;
Function AddFontDef : TPDFFont; Function AddFontDef : TPDFFont;
Property FontDefs[AIndex : Integer] : TPDFFont Read GetF; Default; Property FontDefs[AIndex : Integer] : TPDFFont Read GetF; Default;
end; end;
@ -1433,7 +1452,6 @@ begin
SetLength(result, iPos - 1); SetLength(result, iPos - 1);
end; end;
{ TPDFMemoryStream } { TPDFMemoryStream }
procedure TPDFMemoryStream.Write(const AStream: TStream); procedure TPDFMemoryStream.Write(const AStream: TStream);
@ -1790,6 +1808,19 @@ begin
Result := 'S' + CRLF; Result := 'S' + CRLF;
end; 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 } { TPDFPushGraphicsStack }
procedure TPDFPushGraphicsStack.Write(const AStream: TStream); procedure TPDFPushGraphicsStack.Write(const AStream: TStream);
@ -1807,6 +1838,9 @@ end;
procedure TPDFPopGraphicsStack.Write(const AStream: TStream); procedure TPDFPopGraphicsStack.Write(const AStream: TStream);
begin begin
WriteString(Command, AStream); WriteString(Command, AStream);
// disable cache
Self.Document.CurrentWidth:='';
Self.Document.CurrentColor:='';
end; end;
class function TPDFPopGraphicsStack.Command: string; class function TPDFPopGraphicsStack.Command: string;
@ -2592,6 +2626,12 @@ begin
AddObject(TPDFResetPath.Create(Document)); AddObject(TPDFResetPath.Create(Document));
end; end;
procedure TPDFPage.ClipPath;
begin
AddObject(TPDFClipPath.Create(Document));
end;
procedure TPDFPage.ClosePath; procedure TPDFPage.ClosePath;
begin begin
AddObject(TPDFClosePath.Create(Document)); AddObject(TPDFClosePath.Create(Document));
@ -2617,6 +2657,16 @@ begin
AddObject(TPDFFreeFormString.Create(Document, 'B*'+CRLF)); AddObject(TPDFFreeFormString.Create(Document, 'B*'+CRLF));
end; 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); procedure TPDFPage.MoveTo(x, y: TPDFFloat);
var var
p1: TPDFCoord; p1: TPDFCoord;
@ -2740,6 +2790,21 @@ begin
Result:=Items[AIndex] as TPDFFont; Result:=Items[AIndex] as TPDFFont;
end; 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; function TPDFFontDefs.AddFontDef: TPDFFont;
begin begin
Result:=Add as TPDFFont; Result:=Add as TPDFFont;
@ -5858,14 +5923,8 @@ var
i: integer; i: integer;
begin begin
{ reuse existing font definition if it exists } { reuse existing font definition if it exists }
for i := 0 to Fonts.Count-1 do Result:=Fonts.FindFont(AName);
begin if Result>=0 then exit;
if Fonts[i].Name = AName then
begin
Result := i;
Exit;
end;
end;
F := Fonts.AddFontDef; F := Fonts.AddFontDef;
F.Name := AName; F.Name := AName;
F.IsStdFont := True; F.IsStdFont := True;
@ -5879,14 +5938,8 @@ var
lFName: string; lFName: string;
begin begin
{ reuse existing font definition if it exists } { reuse existing font definition if it exists }
for i := 0 to Fonts.Count-1 do Result:=Fonts.FindFont(AName);
begin if Result>=0 then exit;
if Fonts[i].Name = AName then
begin
Result := i;
Exit;
end;
end;
F := Fonts.AddFontDef; F := Fonts.AddFontDef;
if ExtractFilePath(AFontFile) <> '' then if ExtractFilePath(AFontFile) <> '' then
// assume AFontFile is the full path to the TTF file // assume AFontFile is the full path to the TTF file

View File

@ -79,6 +79,10 @@ begin
AddInclude('collation_ru_le.inc'); AddInclude('collation_ru_le.inc');
end; end;
T:=P.Targets.AddImplicitUnit('collation_de.pas',CollationOSes); T:=P.Targets.AddImplicitUnit('collation_de.pas',CollationOSes);
with T.Dependencies do
begin
AddInclude('collation_de_le.inc');
end;
T:=P.Targets.AddImplicitUnit('collation_ja.pas',CollationOSes); T:=P.Targets.AddImplicitUnit('collation_ja.pas',CollationOSes);
with T.Dependencies do with T.Dependencies do
begin begin

View File

@ -71,13 +71,19 @@ Const
{ Ranges of the IEEE floating point types, including denormals } { Ranges of the IEEE floating point types, including denormals }
{$ifdef FPC_HAS_TYPE_SINGLE} {$ifdef FPC_HAS_TYPE_SINGLE}
const const
MinSingle = 1.5e-45; { values according to
MaxSingle = 3.4e+38; https://en.wikipedia.org/wiki/Single-precision_floating-point_format#Single-precision_examples
}
MinSingle = 1.1754943508e-38;
MaxSingle = 3.4028234664e+38;
{$endif FPC_HAS_TYPE_SINGLE} {$endif FPC_HAS_TYPE_SINGLE}
{$ifdef FPC_HAS_TYPE_DOUBLE} {$ifdef FPC_HAS_TYPE_DOUBLE}
const const
MinDouble = 5.0e-324; { values according to
MaxDouble = 1.7e+308; https://en.wikipedia.org/wiki/Double-precision_floating-point_format#Double-precision_examples
}
MinDouble = 2.2250738585072014e-308;
MaxDouble = 1.7976931348623157e+308;
{$endif FPC_HAS_TYPE_DOUBLE} {$endif FPC_HAS_TYPE_DOUBLE}
{$ifdef FPC_HAS_TYPE_EXTENDED} {$ifdef FPC_HAS_TYPE_EXTENDED}
const const

View File

@ -5955,10 +5955,16 @@ const
// IMAGE_LIBRARY_PROCESS_TERM 0x0002 // Reserved. // IMAGE_LIBRARY_PROCESS_TERM 0x0002 // Reserved.
// IMAGE_LIBRARY_THREAD_INIT 0x0004 // Reserved. // IMAGE_LIBRARY_THREAD_INIT 0x0004 // Reserved.
// IMAGE_LIBRARY_THREAD_TERM 0x0008 // Reserved. // IMAGE_LIBRARY_THREAD_TERM 0x0008 // Reserved.
IMAGE_DLLCHARACTERISTICS_HIGH_ENTROPY_VA = $0020; // Image can handle a high entropy 64-bit virtual address space.
IMAGE_DLLCHARACTERISTICS_DYNAMIC_BASE = $0040; // DLL can move.
IMAGE_DLLCHARACTERISTICS_FORCE_INTEGRITY = $0080; // Code Integrity Image
IMAGE_DLLCHARACTERISTICS_NX_COMPAT = $0100; // Image is NX compatible
IMAGE_DLLCHARACTERISTICS_NO_ISOLATION = $0200; // Image understands isolation and doesn't want it IMAGE_DLLCHARACTERISTICS_NO_ISOLATION = $0200; // Image understands isolation and doesn't want it
IMAGE_DLLCHARACTERISTICS_NO_SEH = $0400; // Image does not use SEH. No SE handler may reside in this image IMAGE_DLLCHARACTERISTICS_NO_SEH = $0400; // Image does not use SEH. No SE handler may reside in this image
IMAGE_DLLCHARACTERISTICS_NO_BIND = $0800; // Do not bind this image. IMAGE_DLLCHARACTERISTICS_NO_BIND = $0800; // Do not bind this image.
IMAGE_DLLCHARACTERISTICS_APPCONTAINER = $1000; // Image should execute in an AppContainer
IMAGE_DLLCHARACTERISTICS_WDM_DRIVER = $2000; // Driver uses WDM model IMAGE_DLLCHARACTERISTICS_WDM_DRIVER = $2000; // Driver uses WDM model
IMAGE_DLLCHARACTERISTICS_GUARD_CF = $4000; // Image supports Control Flow Guard.
IMAGE_DLLCHARACTERISTICS_TERMINAL_SERVER_AWARE = $8000; IMAGE_DLLCHARACTERISTICS_TERMINAL_SERVER_AWARE = $8000;

View File

@ -0,0 +1,24 @@
uses
sysutils,math;
var
s: Single;
d: Double;
begin
s := MaxSingle;
d := MaxDouble;
Writeln(IntToHex(PLongInt(@s)^, 8));
if IntToHex(PLongInt(@s)^, 8)<>'7F7FFFFF' then
halt(1);
Writeln(IntToHex(PInt64(@d)^, 16));
if IntToHex(PInt64(@d)^, 16)<>'7FEFFFFFFFFFFFFF' then
halt(2);
s := MinSingle;
d := MinDouble;
Writeln(IntToHex(PLongInt(@s)^, 8));
if IntToHex(PLongInt(@s)^, 8)<>'00800000' then
halt(3);
Writeln(IntToHex(PInt64(@d)^, 16));
if IntToHex(PInt64(@d)^, 16)<>'0010000000000000' then
halt(4);
writeln('ok');
end.