CentrED/Imaging/ImagingIO.pas

575 lines
17 KiB
Plaintext

{
$Id: ImagingIO.pas 100 2007-06-28 21:09:52Z galfar $
Vampyre Imaging Library
by Marek Mauder
http://imaginglib.sourceforge.net
The contents of this file are used with permission, subject to the Mozilla
Public License Version 1.1 (the "License"); you may not use this file except
in compliance with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
the specific language governing rights and limitations under the License.
Alternatively, the contents of this file may be used under the terms of the
GNU Lesser General Public License (the "LGPL License"), in which case the
provisions of the LGPL License are applicable instead of those above.
If you wish to allow use of your version of this file only under the terms
of the LGPL License and not to allow others to use your version of this file
under the MPL, indicate your decision by deleting the provisions above and
replace them with the notice and other provisions required by the LGPL
License. If you do not delete the provisions above, a recipient may use
your version of this file under either the MPL or the LGPL License.
For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
}
{ This unit contains default IO functions for reading from/writting to
files, streams and memory.}
unit ImagingIO;
{$I ImagingOptions.inc}
interface
uses
SysUtils, Classes, ImagingTypes, Imaging, ImagingUtility;
type
TMemoryIORec = record
Data: ImagingUtility.PByteArray;
Position: LongInt;
Size: LongInt;
end;
PMemoryIORec = ^TMemoryIORec;
var
OriginalFileIO: TIOFunctions;
FileIO: TIOFunctions;
StreamIO: TIOFunctions;
MemoryIO: TIOFunctions;
{ Helper function that returns size of input (from current position to the end)
represented by Handle (and opened and operated on by members of IOFunctions).}
function GetInputSize(IOFunctions: TIOFunctions; Handle: TImagingHandle): LongInt;
{ Helper function that initializes TMemoryIORec with given params.}
function PrepareMemIO(Data: Pointer; Size: LongInt): TMemoryIORec;
implementation
const
DefaultBufferSize = 16 * 1024;
type
{ Based on TaaBufferedStream
Copyright (c) Julian M Bucknall 1997, 1999 }
TBufferedStream = class(TObject)
private
FBuffer: PByteArray;
FBufSize: Integer;
FBufStart: Integer;
FBufPos: Integer;
FBytesInBuf: Integer;
FSize: Integer;
FDirty: Boolean;
FStream: TStream;
function GetPosition: Integer;
function GetSize: Integer;
procedure ReadBuffer;
procedure WriteBuffer;
procedure SetPosition(const Value: Integer);
public
constructor Create(AStream: TStream);
destructor Destroy; override;
function Read(var Buffer; Count: Integer): Integer;
function Write(const Buffer; Count: Integer): Integer;
function Seek(Offset: Integer; Origin: Word): Integer;
procedure Commit;
property Stream: TStream read FStream;
property Position: Integer read GetPosition write SetPosition;
property Size: Integer read GetSize;
end;
constructor TBufferedStream.Create(AStream: TStream);
begin
inherited Create;
FStream := AStream;
FBufSize := DefaultBufferSize;
GetMem(FBuffer, FBufSize);
FBufPos := 0;
FBytesInBuf := 0;
FBufStart := 0;
FDirty := False;
FSize := AStream.Size;
end;
destructor TBufferedStream.Destroy;
begin
if FBuffer <> nil then
begin
Commit;
FreeMem(FBuffer);
end;
FStream.Position := Position; // Make sure source stream has right position
inherited Destroy;
end;
function TBufferedStream.GetPosition: Integer;
begin
Result := FBufStart + FBufPos;
end;
procedure TBufferedStream.SetPosition(const Value: Integer);
begin
Seek(Value, soFromCurrent);
end;
function TBufferedStream.GetSize: Integer;
begin
Result := FSize;
end;
procedure TBufferedStream.ReadBuffer;
var
SeekResult: Integer;
begin
SeekResult := FStream.Seek(FBufStart, 0);
if SeekResult = -1 then
raise Exception.Create('TBufferedStream.ReadBuffer: seek failed');
FBytesInBuf := FStream.Read(FBuffer^, FBufSize);
if FBytesInBuf <= 0 then
raise Exception.Create('TBufferedStream.ReadBuffer: read failed');
end;
procedure TBufferedStream.WriteBuffer;
var
SeekResult: Integer;
BytesWritten: Integer;
begin
SeekResult := FStream.Seek(FBufStart, 0);
if SeekResult = -1 then
raise Exception.Create('TBufferedStream.WriteBuffer: seek failed');
BytesWritten := FStream.Write(FBuffer^, FBytesInBuf);
if BytesWritten <> FBytesInBuf then
raise Exception.Create('TBufferedStream.WriteBuffer: write failed');
end;
procedure TBufferedStream.Commit;
begin
if FDirty then
begin
WriteBuffer;
FDirty := False;
end;
end;
function TBufferedStream.Read(var Buffer; Count: Integer): Integer;
var
BufAsBytes : TByteArray absolute Buffer;
BufIdx, BytesToGo, BytesToRead: Integer;
begin
// Calculate the actual number of bytes we can read - this depends on
// the current position and size of the stream as well as the number
// of bytes requested.
BytesToGo := Count;
if FSize < (FBufStart + FBufPos + Count) then
BytesToGo := FSize - (FBufStart + FBufPos);
if BytesToGo <= 0 then
begin
Result := 0;
Exit;
end;
// Remember to return the result of our calculation
Result := BytesToGo;
BufIdx := 0;
if FBytesInBuf = 0 then
ReadBuffer;
// Calculate the number of bytes we can read prior to the loop
BytesToRead := FBytesInBuf - FBufPos;
if BytesToRead > BytesToGo then
BytesToRead := BytesToGo;
// Copy from the stream buffer to the caller's buffer
Move(FBuffer^[FBufPos], BufAsBytes[BufIdx], BytesToRead);
// Calculate the number of bytes still to read}
Dec(BytesToGo, BytesToRead);
// while we have bytes to read, read them
while BytesToGo > 0 do
begin
Inc(BufIdx, BytesToRead);
// As we've exhausted this buffer-full, advance to the next, check
// to see whether we need to write the buffer out first
if FDirty then
begin
WriteBuffer;
FDirty := false;
end;
Inc(FBufStart, FBufSize);
FBufPos := 0;
ReadBuffer;
// Calculate the number of bytes we can read in this cycle
BytesToRead := FBytesInBuf;
if BytesToRead > BytesToGo then
BytesToRead := BytesToGo;
// Ccopy from the stream buffer to the caller's buffer
Move(FBuffer^, BufAsBytes[BufIdx], BytesToRead);
// Calculate the number of bytes still to read
Dec(BytesToGo, BytesToRead);
end;
// Remember our new position
Inc(FBufPos, BytesToRead);
if FBufPos = FBufSize then
begin
Inc(FBufStart, FBufSize);
FBufPos := 0;
FBytesInBuf := 0;
end;
end;
function TBufferedStream.Seek(Offset: Integer; Origin: Word): Integer;
var
NewBufStart, NewPos: Integer;
begin
// Calculate the new position
case Origin of
soFromBeginning : NewPos := Offset;
soFromCurrent : NewPos := FBufStart + FBufPos + Offset;
soFromEnd : NewPos := FSize + Offset;
else
raise Exception.Create('TBufferedStream.Seek: invalid origin');
end;
if (NewPos < 0) or (NewPos > FSize) then
begin
//NewPos := ClampInt(NewPos, 0, FSize); don't do this - for writing
end;
// Calculate which page of the file we need to be at
NewBufStart := NewPos and not Pred(FBufSize);
// If the new page is different than the old, mark the buffer as being
// ready to be replenished, and if need be write out any dirty data
if NewBufStart <> FBufStart then
begin
if FDirty then
begin
WriteBuffer;
FDirty := False;
end;
FBufStart := NewBufStart;
FBytesInBuf := 0;
end;
// Save the new position
FBufPos := NewPos - NewBufStart;
Result := NewPos;
end;
function TBufferedStream.Write(const Buffer; Count: Integer): Integer;
var
BufAsBytes: TByteArray absolute Buffer;
BufIdx, BytesToGo, BytesToWrite: Integer;
begin
// When we write to this stream we always assume that we can write the
// requested number of bytes: if we can't (eg, the disk is full) we'll
// get an exception somewhere eventually.
BytesToGo := Count;
// Remember to return the result of our calculation
Result := BytesToGo;
BufIdx := 0;
if (FBytesInBuf = 0) and (FSize > FBufStart) then
ReadBuffer;
// Calculate the number of bytes we can write prior to the loop
BytesToWrite := FBufSize - FBufPos;
if BytesToWrite > BytesToGo then
BytesToWrite := BytesToGo;
// Copy from the caller's buffer to the stream buffer
Move(BufAsBytes[BufIdx], FBuffer^[FBufPos], BytesToWrite);
// Mark our stream buffer as requiring a save to the actual stream,
// note that this will suffice for the rest of the routine as well: no
// inner routine will turn off the dirty flag.
FDirty := True;
// Calculate the number of bytes still to write
Dec(BytesToGo, BytesToWrite);
// While we have bytes to write, write them
while BytesToGo > 0 do
begin
Inc(BufIdx, BytesToWrite);
// As we've filled this buffer, write it out to the actual stream
// and advance to the next buffer, reading it if required
FBytesInBuf := FBufSize;
WriteBuffer;
Inc(FBufStart, FBufSize);
FBufPos := 0;
FBytesInBuf := 0;
if FSize > FBufStart then
ReadBuffer;
// Calculate the number of bytes we can write in this cycle
BytesToWrite := FBufSize;
if BytesToWrite > BytesToGo then
BytesToWrite := BytesToGo;
// Copy from the caller's buffer to our buffer
Move(BufAsBytes[BufIdx], FBuffer^, BytesToWrite);
// Calculate the number of bytes still to write
Dec(BytesToGo, BytesToWrite);
end;
// Remember our new position
Inc(FBufPos, BytesToWrite);
// Make sure the count of valid bytes is correct
if FBytesInBuf < FBufPos then
FBytesInBuf := FBufPos;
// Make sure the stream size is correct
if FSize < (FBufStart + FBytesInBuf) then
FSize := FBufStart + FBytesInBuf;
// If we're at the end of the buffer, write it out and advance to the
// start of the next page
if FBufPos = FBufSize then
begin
WriteBuffer;
FDirty := False;
Inc(FBufStart, FBufSize);
FBufPos := 0;
FBytesInBuf := 0;
end;
end;
{ File IO functions }
function FileOpenRead(FileName: PChar): TImagingHandle; cdecl;
begin
Result := TBufferedStream.Create(TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite));
end;
function FileOpenWrite(FileName: PChar): TImagingHandle; cdecl;
begin
Result := TBufferedStream.Create(TFileStream.Create(FileName, fmCreate or fmShareDenyWrite));
end;
procedure FileClose(Handle: TImagingHandle); cdecl;
var
Stream: TStream;
begin
Stream := TBufferedStream(Handle).Stream;
TBufferedStream(Handle).Free;
Stream.Free;
end;
function FileEof(Handle: TImagingHandle): Boolean; cdecl;
begin
Result := TBufferedStream(Handle).Position = TBufferedStream(Handle).Size;
end;
function FileSeek(Handle: TImagingHandle; Offset: LongInt; Mode: TSeekMode):
LongInt; cdecl;
begin
Result := TBufferedStream(Handle).Seek(Offset, LongInt(Mode));
end;
function FileTell(Handle: TImagingHandle): LongInt; cdecl;
begin
Result := TBufferedStream(Handle).Position;
end;
function FileRead(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt):
LongInt; cdecl;
begin
Result := TBufferedStream(Handle).Read(Buffer^, Count);
end;
function FileWrite(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt):
LongInt; cdecl;
begin
Result := TBufferedStream(Handle).Write(Buffer^, Count);
end;
{ Stream IO functions }
function StreamOpenRead(FileName: PChar): TImagingHandle; cdecl;
begin
Result := FileName;
end;
function StreamOpenWrite(FileName: PChar): TImagingHandle; cdecl;
begin
Result := FileName;
end;
procedure StreamClose(Handle: TImagingHandle); cdecl;
begin
end;
function StreamEof(Handle: TImagingHandle): Boolean; cdecl;
begin
Result := TStream(Handle).Position = TStream(Handle).Size;
end;
function StreamSeek(Handle: TImagingHandle; Offset: LongInt; Mode: TSeekMode):
LongInt; cdecl;
begin
Result := TStream(Handle).Seek(Offset, LongInt(Mode));
end;
function StreamTell(Handle: TImagingHandle): LongInt; cdecl;
begin
Result := TStream(Handle).Position;
end;
function StreamRead(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt):
LongInt; cdecl;
begin
Result := TStream(Handle).Read(Buffer^, Count);
end;
function StreamWrite(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt):
LongInt; cdecl;
begin
Result := TStream(Handle).Write(Buffer^, Count);
end;
{ Memory IO functions }
function MemoryOpenRead(FileName: PChar): TImagingHandle; cdecl;
begin
Result := FileName;
end;
function MemoryOpenWrite(FileName: PChar): TImagingHandle; cdecl;
begin
Result := FileName;
end;
procedure MemoryClose(Handle: TImagingHandle); cdecl;
begin
end;
function MemoryEof(Handle: TImagingHandle): Boolean; cdecl;
begin
Result := PMemoryIORec(Handle).Position = PMemoryIORec(Handle).Size;
end;
function MemorySeek(Handle: TImagingHandle; Offset: LongInt; Mode: TSeekMode):
LongInt; cdecl;
begin
Result := PMemoryIORec(Handle).Position;
case Mode of
smFromBeginning: Result := Offset;
smFromCurrent: Result := PMemoryIORec(Handle).Position + Offset;
smFromEnd: Result := PMemoryIORec(Handle).Size + Offset;
end;
//Result := ClampInt(Result, 0, PMemoryIORec(Handle).Size); don't do this - some file formats use it
PMemoryIORec(Handle).Position := Result;
end;
function MemoryTell(Handle: TImagingHandle): LongInt; cdecl;
begin
Result := PMemoryIORec(Handle).Position;
end;
function MemoryRead(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt):
LongInt; cdecl;
var
Rec: PMemoryIORec;
begin
Rec := PMemoryIORec(Handle);
Result := Count;
if Rec.Position + Count > Rec.Size then
Result := Rec.Size - Rec.Position;
Move(Rec.Data[Rec.Position], Buffer^, Result);
Rec.Position := Rec.Position + Result;
end;
function MemoryWrite(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt):
LongInt; cdecl;
var
Rec: PMemoryIORec;
begin
Rec := PMemoryIORec(Handle);
Result := Count;
if Rec.Position + Count > Rec.Size then
Result := Rec.Size - Rec.Position;
Move(Buffer^, Rec.Data[Rec.Position], Result);
Rec.Position := Rec.Position + Result;
end;
{ Helper IO functions }
function GetInputSize(IOFunctions: TIOFunctions; Handle: TImagingHandle): LongInt;
var
OldPos: Int64;
begin
OldPos := IOFunctions.Tell(Handle);
IOFunctions.Seek(Handle, 0, smFromEnd);
Result := IOFunctions.Tell(Handle);
IOFunctions.Seek(Handle, OldPos, smFromBeginning);
end;
function PrepareMemIO(Data: Pointer; Size: LongInt): TMemoryIORec;
begin
Result.Data := Data;
Result.Position := 0;
Result.Size := Size;
end;
initialization
OriginalFileIO.OpenRead := FileOpenRead;
OriginalFileIO.OpenWrite := FileOpenWrite;
OriginalFileIO.Close := FileClose;
OriginalFileIO.Eof := FileEof;
OriginalFileIO.Seek := FileSeek;
OriginalFileIO.Tell := FileTell;
OriginalFileIO.Read := FileRead;
OriginalFileIO.Write := FileWrite;
StreamIO.OpenRead := StreamOpenRead;
StreamIO.OpenWrite := StreamOpenWrite;
StreamIO.Close := StreamClose;
StreamIO.Eof := StreamEof;
StreamIO.Seek := StreamSeek;
StreamIO.Tell := StreamTell;
StreamIO.Read := StreamRead;
StreamIO.Write := StreamWrite;
MemoryIO.OpenRead := MemoryOpenRead;
MemoryIO.OpenWrite := MemoryOpenWrite;
MemoryIO.Close := MemoryClose;
MemoryIO.Eof := MemoryEof;
MemoryIO.Seek := MemorySeek;
MemoryIO.Tell := MemoryTell;
MemoryIO.Read := MemoryRead;
MemoryIO.Write := MemoryWrite;
ResetFileIO;
{
File Notes:
-- TODOS ----------------------------------------------------
- nothing now
-- 0.23 Changes/Bug Fixes -----------------------------------
- Added merge between buffered read-only and write-only file
stream adapters - TIFF saving needed both reading and writing.
- Fixed bug causing wrong value of TBufferedWriteFile.Size
(needed to add buffer pos to size).
-- 0.21 Changes/Bug Fixes -----------------------------------
- Removed TMemoryIORec.Written, use Position to get proper memory
position (Written didn't take Seeks into account).
- Added TBufferedReadFile and TBufferedWriteFile classes for
buffered file reading/writting. File IO functions now use these
classes resulting in performance increase mainly in file formats
that read/write many small chunks.
- Added fmShareDenyWrite to FileOpenRead. You can now read
files opened for reading by Imaging from other apps.
- Added GetInputSize and PrepareMemIO helper functions.
-- 0.19 Changes/Bug Fixes -----------------------------------
- changed behaviour of MemorySeek to act as TStream
based Seeks
}
end.