src/lib/vampimg/ImagingIO.pas

   1 {
   2   Vampyre Imaging Library
   3   by Marek Mauder
   4   http://imaginglib.sourceforge.net
   5
   6   The contents of this file are used with permission, subject to the Mozilla
   7   Public License Version 1.1 (the "License"); you may not use this file except
   8   in compliance with the License. You may obtain a copy of the License at
   9   http://www.mozilla.org/MPL/MPL-1.1.html
  10
  11   Software distributed under the License is distributed on an "AS IS" basis,
  12   WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
  13   the specific language governing rights and limitations under the License.
  14
  15   Alternatively, the contents of this file may be used under the terms of the
  16   GNU Lesser General Public License (the  "LGPL License"), in which case the
  17   provisions of the LGPL License are applicable instead of those above.
  18   If you wish to allow use of your version of this file only under the terms
  19   of the LGPL License and not to allow others to use your version of this file
  20   under the MPL, indicate your decision by deleting  the provisions above and
  21   replace  them with the notice and other provisions required by the LGPL
  22   License.  If you do not delete the provisions above, a recipient may use
  23   your version of this file under either the MPL or the LGPL License.
  24
  25   For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
  26 }
  27
  28 { This unit contains default IO functions for reading from/writting to
  29   files, streams and memory.}
  30 unit ImagingIO;
  31
  32 {$I ImagingOptions.inc}
  33
  34 interface
  35
  36 uses
  37   SysUtils, Classes, ImagingTypes, Imaging, ImagingUtility;
  38
  39 type
  40   TMemoryIORec = record
  41     Data: ImagingUtility.PByteArray;
  42     Position: LongInt;
  43     Size: LongInt;
  44   end;
  45   PMemoryIORec = ^TMemoryIORec;
  46
  47 var
  48   OriginalFileIO: TIOFunctions;
  49   FileIO: TIOFunctions;
  50   StreamIO: TIOFunctions;
  51   MemoryIO: TIOFunctions;
  52
  53 { Helper function that returns size of input (from current position to the end)
  54   represented by Handle (and opened and operated on by members of IOFunctions).}
  55 function GetInputSize(IOFunctions: TIOFunctions; Handle: TImagingHandle): LongInt;
  56 { Helper function that initializes TMemoryIORec with given params.}
  57 function PrepareMemIO(Data: Pointer; Size: LongInt): TMemoryIORec;
  58 { Reads one text line from input (CR+LF, CR, or LF as line delimiter).}
  59 function ReadLine(IOFunctions: TIOFunctions; Handle: TImagingHandle;
  60   out Line: AnsiString; FailOnControlChars: Boolean = False): Boolean;
  61 { Writes one text line to input with optional line delimiter.}
  62 procedure WriteLine(IOFunctions: TIOFunctions; Handle: TImagingHandle;
  63   const Line: AnsiString; const LineEnding: AnsiString = sLineBreak);
  64
  65 implementation
  66
  67 const
  68   DefaultBufferSize = 16 * 1024;
  69
  70 type
  71   { Based on TaaBufferedStream
  72     Copyright (c) Julian M Bucknall 1997, 1999 }
  73   TBufferedStream = class
  74   private
  75     FBuffer: PByteArray;
  76     FBufSize: Integer;
  77     FBufStart: Integer;
  78     FBufPos: Integer;
  79     FBytesInBuf: Integer;
  80     FSize: Integer;
  81     FDirty: Boolean;
  82     FStream: TStream;
  83     function GetPosition: Integer;
  84     function GetSize: Integer;
  85     procedure ReadBuffer;
  86     procedure WriteBuffer;
  87     procedure SetPosition(const Value: Integer);
  88   public
  89     constructor Create(AStream: TStream);
  90     destructor Destroy; override;
  91     function Read(var Buffer; Count: Integer): Integer;
  92     function Write(const Buffer; Count: Integer): Integer;
  93     function Seek(Offset: Integer; Origin: Word): Integer;
  94     procedure Commit;
  95     property Stream: TStream read FStream;
  96     property Position: Integer read GetPosition write SetPosition;
  97     property Size: Integer read GetSize;
  98   end;
  99
 100 constructor TBufferedStream.Create(AStream: TStream);
 101 begin
 102   inherited Create;
 103   FStream := AStream;
 104   FBufSize := DefaultBufferSize;
 105   GetMem(FBuffer, FBufSize);
 106   FBufPos := 0;
 107   FBytesInBuf := 0;
 108   FBufStart := 0;
 109   FDirty := False;
 110   FSize := AStream.Size;
 111 end;
 112
 113 destructor TBufferedStream.Destroy;
 114 begin
 115   if FBuffer <> nil then
 116   begin
 117     Commit;
 118     FreeMem(FBuffer);
 119   end;
 120   FStream.Position := Position; // Make sure source stream has right position
 121   inherited Destroy;
 122 end;
 123
 124 function TBufferedStream.GetPosition: Integer;
 125 begin
 126   Result := FBufStart + FBufPos;
 127 end;
 128
 129 procedure TBufferedStream.SetPosition(const Value: Integer);
 130 begin
 131   Seek(Value, soFromCurrent);
 132 end;
 133
 134 function TBufferedStream.GetSize: Integer;
 135 begin
 136   Result := FSize;
 137 end;
 138
 139 procedure TBufferedStream.ReadBuffer;
 140 var
 141   SeekResult: Integer;
 142 begin
 143   SeekResult := FStream.Seek(FBufStart, 0);
 144   if SeekResult = -1 then
 145     raise Exception.Create('TBufferedStream.ReadBuffer: seek failed');
 146   FBytesInBuf := FStream.Read(FBuffer^, FBufSize);
 147   if FBytesInBuf <= 0 then
 148     raise Exception.Create('TBufferedStream.ReadBuffer: read failed');
 149 end;
 150
 151 procedure TBufferedStream.WriteBuffer;
 152 var
 153   SeekResult: Integer;
 154   BytesWritten: Integer;
 155 begin
 156   SeekResult := FStream.Seek(FBufStart, 0);
 157   if SeekResult = -1 then
 158     raise Exception.Create('TBufferedStream.WriteBuffer: seek failed');
 159   BytesWritten := FStream.Write(FBuffer^, FBytesInBuf);
 160   if BytesWritten <> FBytesInBuf then
 161     raise Exception.Create('TBufferedStream.WriteBuffer: write failed');
 162 end;
 163
 164 procedure TBufferedStream.Commit;
 165 begin
 166   if FDirty then
 167   begin
 168     WriteBuffer;
 169     FDirty := False;
 170   end;
 171 end;
 172
 173 function TBufferedStream.Read(var Buffer; Count: Integer): Integer;
 174 var
 175   BufAsBytes  : TByteArray absolute Buffer;
 176   BufIdx, BytesToGo, BytesToRead: Integer;
 177 begin
 178   // Calculate the actual number of bytes we can read - this depends on
 179   // the current position and size of the stream as well as the number
 180   // of bytes requested.
 181   BytesToGo := Count;
 182   if FSize < (FBufStart + FBufPos + Count) then
 183     BytesToGo := FSize - (FBufStart + FBufPos);
 184
 185   if BytesToGo <= 0 then
 186   begin
 187     Result := 0;
 188     Exit;
 189   end;
 190   // Remember to return the result of our calculation
 191   Result := BytesToGo;
 192
 193   BufIdx := 0;
 194   if FBytesInBuf = 0 then
 195     ReadBuffer;
 196   // Calculate the number of bytes we can read prior to the loop
 197   BytesToRead := FBytesInBuf - FBufPos;
 198   if BytesToRead > BytesToGo then
 199     BytesToRead := BytesToGo;
 200   // Copy from the stream buffer to the caller's buffer
 201   Move(FBuffer^[FBufPos], BufAsBytes[BufIdx], BytesToRead);
 202   // Calculate the number of bytes still to read}
 203   Dec(BytesToGo, BytesToRead);
 204
 205   // while we have bytes to read, read them
 206   while BytesToGo > 0 do
 207   begin
 208     Inc(BufIdx, BytesToRead);
 209     // As we've exhausted this buffer-full, advance to the next, check
 210     //  to see whether we need to write the buffer out first
 211     if FDirty then
 212     begin
 213       WriteBuffer;
 214       FDirty := false;
 215     end;
 216     Inc(FBufStart, FBufSize);
 217     FBufPos := 0;
 218     ReadBuffer;
 219     // Calculate the number of bytes we can read in this cycle
 220     BytesToRead := FBytesInBuf;
 221     if BytesToRead > BytesToGo then
 222       BytesToRead := BytesToGo;
 223     // Ccopy from the stream buffer to the caller's buffer
 224     Move(FBuffer^, BufAsBytes[BufIdx], BytesToRead);
 225     // Calculate the number of bytes still to read
 226     Dec(BytesToGo, BytesToRead);
 227   end;
 228   // Remember our new position
 229   Inc(FBufPos, BytesToRead);
 230   if FBufPos = FBufSize then
 231   begin
 232     Inc(FBufStart, FBufSize);
 233     FBufPos := 0;
 234     FBytesInBuf := 0;
 235   end;
 236 end;
 237
 238 function TBufferedStream.Seek(Offset: Integer; Origin: Word): Integer;
 239 var
 240   NewBufStart, NewPos: Integer;
 241 begin
 242   // Calculate the new position
 243   case Origin of
 244     soFromBeginning : NewPos := Offset;
 245     soFromCurrent   : NewPos := FBufStart + FBufPos + Offset;
 246     soFromEnd       : NewPos := FSize + Offset;
 247   else
 248     raise Exception.Create('TBufferedStream.Seek: invalid origin');
 249   end;
 250
 251   if (NewPos < 0) or (NewPos > FSize) then
 252   begin
 253     //NewPos := ClampInt(NewPos, 0, FSize); don't do this - for writing
 254   end;
 255   // Calculate which page of the file we need to be at
 256   NewBufStart := NewPos and not Pred(FBufSize);
 257   // If the new page is different than the old, mark the buffer as being
 258   // ready to be replenished, and if need be write out any dirty data
 259   if NewBufStart <> FBufStart then
 260   begin
 261     if FDirty then
 262     begin
 263       WriteBuffer;
 264       FDirty := False;
 265     end;
 266     FBufStart := NewBufStart;
 267     FBytesInBuf := 0;
 268   end;
 269   // Save the new position
 270   FBufPos := NewPos - NewBufStart;
 271   Result := NewPos;
 272 end;
 273
 274 function TBufferedStream.Write(const Buffer; Count: Integer): Integer;
 275 var
 276   BufAsBytes: TByteArray absolute Buffer;
 277   BufIdx, BytesToGo, BytesToWrite: Integer;
 278 begin
 279   // When we write to this stream we always assume that we can write the
 280   // requested number of bytes: if we can't (eg, the disk is full) we'll
 281   // get an exception somewhere eventually.
 282   BytesToGo := Count;
 283   // Remember to return the result of our calculation
 284   Result := BytesToGo;
 285
 286   BufIdx := 0;
 287   if (FBytesInBuf = 0) and (FSize > FBufStart) then
 288     ReadBuffer;
 289   // Calculate the number of bytes we can write prior to the loop
 290   BytesToWrite := FBufSize - FBufPos;
 291   if BytesToWrite > BytesToGo then
 292     BytesToWrite := BytesToGo;
 293   // Copy from the caller's buffer to the stream buffer
 294   Move(BufAsBytes[BufIdx], FBuffer^[FBufPos], BytesToWrite);
 295   // Mark our stream buffer as requiring a save to the actual stream,
 296   // note that this will suffice for the rest of the routine as well: no
 297   // inner routine will turn off the dirty flag.
 298   FDirty := True;
 299   // Calculate the number of bytes still to write
 300   Dec(BytesToGo, BytesToWrite);
 301
 302   // While we have bytes to write, write them
 303   while BytesToGo > 0 do
 304   begin
 305     Inc(BufIdx, BytesToWrite);
 306     // As we've filled this buffer, write it out to the actual stream
 307     // and advance to the next buffer, reading it if required
 308     FBytesInBuf := FBufSize;
 309     WriteBuffer;
 310     Inc(FBufStart, FBufSize);
 311     FBufPos := 0;
 312     FBytesInBuf := 0;
 313     if FSize > FBufStart then
 314       ReadBuffer;
 315     // Calculate the number of bytes we can write in this cycle
 316     BytesToWrite := FBufSize;
 317     if BytesToWrite > BytesToGo then
 318       BytesToWrite := BytesToGo;
 319     // Copy from the caller's buffer to our buffer
 320     Move(BufAsBytes[BufIdx], FBuffer^, BytesToWrite);
 321     // Calculate the number of bytes still to write
 322     Dec(BytesToGo, BytesToWrite);
 323   end;
 324   // Remember our new position
 325   Inc(FBufPos, BytesToWrite);
 326   // Make sure the count of valid bytes is correct
 327   if FBytesInBuf < FBufPos then
 328     FBytesInBuf := FBufPos;
 329   // Make sure the stream size is correct
 330   if FSize < (FBufStart + FBytesInBuf) then
 331     FSize := FBufStart + FBytesInBuf;
 332   // If we're at the end of the buffer, write it out and advance to the
 333   // start of the next page
 334   if FBufPos = FBufSize then
 335   begin
 336     WriteBuffer;
 337     FDirty := False;
 338     Inc(FBufStart, FBufSize);
 339     FBufPos := 0;
 340     FBytesInBuf := 0;
 341   end;
 342 end;
 343
 344 { File IO functions }
 345
 346 function FileOpen(FileName: PChar; Mode: TOpenMode): TImagingHandle; cdecl;
 347 var
 348   Stream: TStream;
 349 begin
 350   Stream := nil;
 351
 352   case Mode of
 353     omReadOnly:  Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
 354     omCreate:    Stream := TFileStream.Create(FileName, fmCreate);
 355     omReadWrite:
 356       begin
 357         if FileExists(FileName) then
 358           Stream := TFileStream.Create(FileName, fmOpenReadWrite or fmShareExclusive)
 359         else
 360           Stream := TFileStream.Create(FileName, fmCreate);
 361       end;
 362   end;
 363
 364   Assert(Stream <> nil);
 365   Result := TBufferedStream.Create(Stream);
 366 end;
 367
 368 procedure FileClose(Handle: TImagingHandle); cdecl;
 369 var
 370   Stream: TStream;
 371 begin
 372   Stream := TBufferedStream(Handle).Stream;
 373   TBufferedStream(Handle).Free;
 374   Stream.Free;
 375 end;
 376
 377 function FileEof(Handle: TImagingHandle): Boolean; cdecl;
 378 begin
 379   Result := TBufferedStream(Handle).Position = TBufferedStream(Handle).Size;
 380 end;
 381
 382 function FileSeek(Handle: TImagingHandle; Offset: LongInt; Mode: TSeekMode):
 383   LongInt; cdecl;
 384 begin
 385   Result := TBufferedStream(Handle).Seek(Offset, LongInt(Mode));
 386 end;
 387
 388 function FileTell(Handle: TImagingHandle): LongInt; cdecl;
 389 begin
 390   Result := TBufferedStream(Handle).Position;
 391 end;
 392
 393 function FileRead(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt):
 394   LongInt; cdecl;
 395 begin
 396   Result := TBufferedStream(Handle).Read(Buffer^, Count);
 397 end;
 398
 399 function FileWrite(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt):
 400   LongInt; cdecl;
 401 begin
 402   Result := TBufferedStream(Handle).Write(Buffer^, Count);
 403 end;
 404
 405 { Stream IO functions }
 406
 407 function StreamOpen(FileName: PChar; Mode: TOpenMode): TImagingHandle; cdecl;
 408 begin
 409   Result := FileName;
 410 end;
 411
 412 procedure StreamClose(Handle: TImagingHandle); cdecl;
 413 begin
 414 end;
 415
 416 function StreamEof(Handle: TImagingHandle): Boolean; cdecl;
 417 begin
 418   Result := TStream(Handle).Position = TStream(Handle).Size;
 419 end;
 420
 421 function StreamSeek(Handle: TImagingHandle; Offset: LongInt; Mode: TSeekMode):
 422   LongInt; cdecl;
 423 begin
 424   Result := TStream(Handle).Seek(Offset, LongInt(Mode));
 425 end;
 426
 427 function StreamTell(Handle: TImagingHandle): LongInt; cdecl;
 428 begin
 429   Result := TStream(Handle).Position;
 430 end;
 431
 432 function StreamRead(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt):
 433   LongInt; cdecl;
 434 begin
 435   Result := TStream(Handle).Read(Buffer^, Count);
 436 end;
 437
 438 function StreamWrite(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt):
 439   LongInt; cdecl;
 440 begin
 441   Result := TStream(Handle).Write(Buffer^, Count);
 442 end;
 443
 444 { Memory IO functions }
 445
 446 function MemoryOpen(FileName: PChar; Mode: TOpenMode): TImagingHandle; cdecl;
 447 begin
 448   Result := FileName;
 449 end;
 450
 451 procedure MemoryClose(Handle: TImagingHandle); cdecl;
 452 begin
 453 end;
 454
 455 function MemoryEof(Handle: TImagingHandle): Boolean; cdecl;
 456 begin
 457   Result := PMemoryIORec(Handle).Position = PMemoryIORec(Handle).Size;
 458 end;
 459
 460 function MemorySeek(Handle: TImagingHandle; Offset: LongInt; Mode: TSeekMode):
 461   LongInt; cdecl;
 462 begin
 463   Result := PMemoryIORec(Handle).Position;
 464   case Mode of
 465     smFromBeginning: Result := Offset;
 466     smFromCurrent:   Result := PMemoryIORec(Handle).Position + Offset;
 467     smFromEnd:       Result := PMemoryIORec(Handle).Size + Offset;
 468   end;
 469   //Result := ClampInt(Result, 0, PMemoryIORec(Handle).Size); don't do this - some file formats use it
 470   PMemoryIORec(Handle).Position := Result;
 471 end;
 472
 473 function MemoryTell(Handle: TImagingHandle): LongInt; cdecl;
 474 begin
 475   Result := PMemoryIORec(Handle).Position;
 476 end;
 477
 478 function MemoryRead(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt):
 479   LongInt; cdecl;
 480 var
 481   Rec: PMemoryIORec;
 482 begin
 483   Rec := PMemoryIORec(Handle);
 484   Result := Count;
 485   if Rec.Position + Count > Rec.Size then
 486     Result := Rec.Size - Rec.Position;
 487   Move(Rec.Data[Rec.Position], Buffer^, Result);
 488   Rec.Position := Rec.Position + Result;
 489 end;
 490
 491 function MemoryWrite(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt):
 492   LongInt; cdecl;
 493 var
 494   Rec: PMemoryIORec;
 495 begin
 496   Rec := PMemoryIORec(Handle);
 497   Result := Count;
 498   if Rec.Position + Count > Rec.Size then
 499     Result := Rec.Size - Rec.Position;
 500   Move(Buffer^, Rec.Data[Rec.Position], Result);
 501   Rec.Position := Rec.Position + Result;
 502 end;
 503
 504 { Helper IO functions }
 505
 506 function GetInputSize(IOFunctions: TIOFunctions; Handle: TImagingHandle): LongInt;
 507 var
 508   OldPos: Int64;
 509 begin
 510   OldPos := IOFunctions.Tell(Handle);
 511   IOFunctions.Seek(Handle, 0, smFromEnd);
 512   Result := IOFunctions.Tell(Handle);
 513   IOFunctions.Seek(Handle, OldPos, smFromBeginning);
 514 end;
 515
 516 function PrepareMemIO(Data: Pointer; Size: LongInt): TMemoryIORec;
 517 begin
 518   Result.Data := Data;
 519   Result.Position := 0;
 520   Result.Size := Size;
 521 end;
 522
 523 function ReadLine(IOFunctions: TIOFunctions; Handle: TImagingHandle;
 524   out Line: AnsiString; FailOnControlChars: Boolean): Boolean;
 525 const
 526   MaxLine = 1024;
 527 var
 528   EolPos, Pos: Integer;
 529   C: AnsiChar;
 530   EolReached: Boolean;
 531   Endings: set of AnsiChar;
 532 begin
 533   Line := '';
 534   Pos := 0;
 535   EolPos := 0;
 536   EolReached := False;
 537   Endings := [#10, #13];
 538   Result := True;
 539
 540   while not IOFunctions.Eof(Handle) do
 541   begin
 542     IOFunctions.Read(Handle, @C, SizeOf(C));
 543
 544     if FailOnControlChars and (Byte(C) < $20) then
 545     begin
 546       Break;
 547     end;
 548
 549     if not (C in Endings) then
 550     begin
 551       if EolReached then
 552       begin
 553         IOFunctions.Seek(Handle, EolPos, smFromBeginning);
 554         Exit;
 555       end
 556       else
 557       begin
 558         SetLength(Line, Length(Line) + 1);
 559         Line[Length(Line)] := C;
 560       end;
 561     end
 562     else if not EolReached then
 563     begin
 564       EolReached := True;
 565       EolPos := IOFunctions.Tell(Handle);
 566     end;
 567
 568     Inc(Pos);
 569     if Pos >= MaxLine then
 570     begin
 571       Break;
 572     end;
 573   end;
 574
 575   Result := False;
 576   IOFunctions.Seek(Handle, -Pos, smFromCurrent);
 577 end;
 578
 579 procedure WriteLine(IOFunctions: TIOFunctions; Handle: TImagingHandle;
 580   const Line: AnsiString; const LineEnding: AnsiString);
 581 var
 582   ToWrite: AnsiString;
 583 begin
 584   ToWrite := Line + LineEnding;
 585   IOFunctions.Write(Handle, @ToWrite[1], Length(ToWrite));
 586 end;
 587
 588 initialization
 589   OriginalFileIO.Open := FileOpen;
 590   OriginalFileIO.Close := FileClose;
 591   OriginalFileIO.Eof := FileEof;
 592   OriginalFileIO.Seek := FileSeek;
 593   OriginalFileIO.Tell := FileTell;
 594   OriginalFileIO.Read := FileRead;
 595   OriginalFileIO.Write := FileWrite;
 596
 597   StreamIO.Open := StreamOpen;
 598   StreamIO.Close := StreamClose;
 599   StreamIO.Eof := StreamEof;
 600   StreamIO.Seek := StreamSeek;
 601   StreamIO.Tell := StreamTell;
 602   StreamIO.Read := StreamRead;
 603   StreamIO.Write := StreamWrite;
 604
 605   MemoryIO.Open := MemoryOpen;
 606   MemoryIO.Close := MemoryClose;
 607   MemoryIO.Eof := MemoryEof;
 608   MemoryIO.Seek := MemorySeek;
 609   MemoryIO.Tell := MemoryTell;
 610   MemoryIO.Read := MemoryRead;
 611   MemoryIO.Write := MemoryWrite;
 612
 613   ResetFileIO;
 614
 615 {
 616   File Notes:
 617
 618   -- TODOS ----------------------------------------------------
 619     - nothing now
 620
 621   -- 0.77.1 ---------------------------------------------------
 622    - Updated IO Open functions according to changes in ImagingTypes.
 623    - Added ReadLine and WriteLine functions.
 624
 625   -- 0.23 Changes/Bug Fixes -----------------------------------
 626     - Added merge between buffered read-only and write-only file
 627       stream adapters - TIFF saving needed both reading and writing.
 628     - Fixed bug causing wrong value of TBufferedWriteFile.Size
 629       (needed to add buffer pos to size).
 630
 631   -- 0.21 Changes/Bug Fixes -----------------------------------
 632     - Removed TMemoryIORec.Written, use Position to get proper memory
 633       position (Written didn't take Seeks into account).
 634     - Added TBufferedReadFile and TBufferedWriteFile classes for
 635       buffered file reading/writting. File IO functions now use these
 636       classes resulting in performance increase mainly in file formats
 637       that read/write many small chunks.
 638     - Added fmShareDenyWrite to FileOpenRead. You can now read
 639       files opened for reading by Imaging from other apps.
 640     - Added GetInputSize and PrepareMemIO helper functions.
 641
 642   -- 0.19 Changes/Bug Fixes -----------------------------------
 643     - changed behaviour of MemorySeek to act as TStream
 644       based Seeks
 645 }
 646 end.