paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-19 16:09:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Use read buffer to speed up things

Browse Source 
git-svn-id: trunk@45226 -
This commit is contained in:
michael 2020-05-02 16:15:28 +00:00
parent 8182669e79
commit 112b48a5e0
1 changed files with 48 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
packages/fcl-image/src/fpreadpnm.pp
View File

@ -28,12 +28,24 @@ interface
uses FPImage, classes, sysutils; uses FPImage, classes, sysutils;
Const
BufSize = 1024;
type type
{ TFPReaderPNM }
TFPReaderPNM=class (TFPCustomImageReader) TFPReaderPNM=class (TFPCustomImageReader)
private private
FBitMapType : Integer; FBitMapType : Integer;
FWidth : Integer; FWidth : Integer;
FHeight : Integer; FHeight : Integer;
FBufPos : Integer;
FBufLen : Integer;
FBuffer : Array of char;
function DropWhiteSpaces(Stream: TStream): Char;
function ReadChar(Stream: TStream): Char;
function ReadInteger(Stream: TStream): Integer;
protected protected
FMaxVal : Cardinal; FMaxVal : Cardinal;
FBitPP : Byte; FBitPP : Byte;
@ -54,11 +66,12 @@ const
{ The magic number at the beginning of a pnm file is 'P1', 'P2', ..., 'P7' { The magic number at the beginning of a pnm file is 'P1', 'P2', ..., 'P7'
followed by a WhiteSpace character } followed by a WhiteSpace character }
function TFPReaderPNM.InternalCheck(Stream:TStream):boolean; function TFPReaderPNM.InternalCheck(Stream:TStream):boolean;
var var
hdr: array[0..2] of char; hdr: array[0..2] of char;
oldPos: Int64; oldPos: Int64;
n: Integer; i,n: Integer;
begin begin
Result:=False; Result:=False;
if Stream = nil then if Stream = nil then
@ -66,32 +79,36 @@ begin
oldPos := Stream.Position; oldPos := Stream.Position;
try try
n := SizeOf(hdr); n := SizeOf(hdr);
Result:=(Stream.Read(hdr[0], n) = n) Result:=(Stream.Size-OldPos>=N);
and (hdr[0] = 'P') if not Result then exit;
For I:=0 to N-1 do
hdr[i]:=ReadChar(Stream);
Result:=(hdr[0] = 'P')
and (hdr[1] in ['1'..'7']) and (hdr[1] in ['1'..'7'])
and (hdr[2] in WhiteSpaces); and (hdr[2] in WhiteSpaces);
finally finally
Stream.Position := oldPos; Stream.Position := oldPos;
FBufLen:=0;
end; end;
end; end;
function DropWhiteSpaces(Stream : TStream) :Char; function TFPReaderPNM.DropWhiteSpaces(Stream : TStream) :Char;
begin begin
with Stream do with Stream do
begin begin
repeat repeat
ReadBuffer(DropWhiteSpaces,1); Result:=ReadChar(Stream);
{If we encounter comment then eate line} {If we encounter comment then eate line}
if DropWhiteSpaces='#' then if DropWhiteSpaces='#' then
repeat repeat
ReadBuffer(DropWhiteSpaces,1); Result:=ReadChar(Stream);
until DropWhiteSpaces=#10; until Result=#10;
until not(DropWhiteSpaces in WhiteSpaces); until not (Result in WhiteSpaces);
end; end;
end; end;
function ReadInteger(Stream : TStream) :Integer; function TFPReaderPNM.ReadInteger(Stream : TStream) :Integer;
var var
s:String[7]; s:String[7];
@ -99,25 +116,39 @@ var
begin begin
s:=''; s:='';
s[1]:=DropWhiteSpaces(Stream); s[1]:=DropWhiteSpaces(Stream);
with Stream do repeat
repeat Inc(s[0]);
Inc(s[0]); s[Length(s)+1]:=ReadChar(Stream);
ReadBuffer(s[Length(s)+1],1) until (s[0]=#7) or (s[Length(s)+1] in WhiteSpaces);
until (s[0]=#7) or (s[Length(s)+1] in WhiteSpaces);
Result:=StrToInt(s); Result:=StrToInt(s);
end; end;
Function TFPReaderPNM.ReadChar(Stream : TStream) : Char;
begin
If (FBufPos>=FBufLen) then
begin
if Length(FBuffer)=0 then
SetLength(FBuffer,BufSize);
FBufLen:=Stream.Read(FBuffer[0],Length(FBuffer));
if FBuflen=0 then
Raise EReadError.Create('Failed to read from stream');
FBufPos:=0;
end;
Result:=FBuffer[FBufPos];
Inc(FBufPos);
end;
procedure TFPReaderPNM.ReadHeader(Stream : TStream); procedure TFPReaderPNM.ReadHeader(Stream : TStream);
Var Var
C : Char; C : Char;
begin begin
C:=#0; C:=ReadChar(Stream);
Stream.ReadBuffer(C,1);
If (C<>'P') then If (C<>'P') then
Raise Exception.Create('Not a valid PNM image.'); Raise Exception.Create('Not a valid PNM image.');
Stream.ReadBuffer(C,1); C:=ReadChar(Stream);
FBitmapType:=Ord(C)-Ord('0'); FBitmapType:=Ord(C)-Ord('0');
If Not (FBitmapType in [1..6]) then If Not (FBitmapType in [1..6]) then
Raise Exception.CreateFmt('Unknown PNM subtype : %s',[C]); Raise Exception.CreateFmt('Unknown PNM subtype : %s',[C]);