src/lib/vampimg/ImagingIO.pas

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