summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: 8444411)
raw | patch | inline | side by side (parent: 8444411)
| author | Ketmar Dark <ketmar@ketmar.no-ip.org> | |
| Mon, 18 Apr 2016 06:45:47 +0000 (09:45 +0300) | ||
| committer | Ketmar Dark <ketmar@ketmar.no-ip.org> | |
| Mon, 18 Apr 2016 06:49:50 +0000 (09:49 +0300) |
| src/game/Doom2DF.dpr | patch | blob | history | |
| src/sfs/sfs.pas | patch | blob | history | |
| src/sfs/sfsMemFS.pas | [deleted file] | patch | blob | history |
| src/sfs/sfsPlainFS.pas | patch | blob | history | |
| src/sfs/sfsZipFS.pas | patch | blob | history | |
| src/sfs/wadcvt.dpr | patch | blob | history | |
| src/shared/utils.pas | patch | blob | history | |
| src/shared/wadreader.pas | patch | blob | history | |
| src/shared/xstreams.pas | [moved from src/sfs/xstreams.pas with 63% similarity] | patch | blob | history |
| src/unused/xstreams_sdl.pas | [new file with mode: 0644] | patch | blob |
diff --git a/src/game/Doom2DF.dpr b/src/game/Doom2DF.dpr
index d885e2b6147f3da6efac647957eae6c3d5f3d491..5a10057095b200a1a0a8c1daf75c2ef5505994aa 100644 (file)
--- a/src/game/Doom2DF.dpr
+++ b/src/game/Doom2DF.dpr
sfs in '../sfs/sfs.pas',
sfsPlainFS in '../sfs/sfsPlainFS.pas',
sfsZipFS in '../sfs/sfsZipFS.pas',
- sfsMemFS in '../sfs/sfsMemFS.pas',
- xstreams in '../sfs/xstreams.pas',
+ xstreams in '../shared/xstreams.pas',
utils in '../shared/utils.pas',
wadreader in '../shared/wadreader.pas',
MAPSTRUCT in '../shared/MAPSTRUCT.pas',
diff --git a/src/sfs/sfs.pas b/src/sfs/sfs.pas
index 157fbac3c2ccb3d20d5a811fecc34e9a1b6ea142..49f8f7603f24aa3127894783fe01b33a2e3b3073 100644 (file)
--- a/src/sfs/sfs.pas
+++ b/src/sfs/sfs.pas
// streaming file system (virtual)
-{$MODE DELPHI}
-{.$R-}
+{$MODE OBJFPC}
+{$R+}
{.$DEFINE SFS_VOLDEBUG}
unit sfs;
type
ESFSError = class(Exception);
- TSFSChar = AnsiChar;
- TSFSString = AnsiString;
-
TSFSVolume = class;
TSFSFileInfo = class
public
fOwner: TSFSVolume; // òàê, íà âñÿêèé ñëó÷àé
- fPath: TSFSString; // ðàçäåëèòåëè êàòàëîãîâ -- "/"; êîðåíü íèêàê íå îáîçíà÷åí, åñëè íå ïóñòîå, îáÿçàíî çàâåðøàåòñÿ "/"
- fName: TSFSString; // òîëüêî èìÿ
+ fPath: AnsiString; // ðàçäåëèòåëè êàòàëîãîâ -- "/"; êîðåíü íèêàê íå îáîçíà÷åí, åñëè íå ïóñòîå, îáÿçàíî çàâåðøàòüñÿ "/"
+ fName: AnsiString; // òîëüêî èìÿ
fSize: Int64; // unpacked
fOfs: Int64; // in VFS (many of 'em need this %-)
constructor Create (pOwner: TSFSVolume);
destructor Destroy (); override;
- property path: TSFSString read fPath;
- property name: TSFSString read fName;
- property size: Int64 read fSize;
+ property path: AnsiString read fPath;
+ property name: AnsiString read fName;
+ property size: Int64 read fSize; // can be -1 if size is unknown
end;
// âèðòóàëüíàÿ ôàéëîâàÿ ñèñòåìà. ÒÎËÜÊÎ ÄËß ×ÒÅÍÈß!
// òîì ÍÅ ÄÎËÆÅÍ óáèâàòüñÿ íèêàê èíà÷å, ÷åì ïðè ïîìîùè ôàáðèêè!
TSFSVolume = class
protected
- fRC: Integer; // refcounter for other objects
- fFileName: TSFSString;// îáû÷íî èìÿ îðèãèíàëüíîãî ôàéëà
+ fFileName: AnsiString;// îáû÷íî èìÿ îðèãèíàëüíîãî ôàéëà
fFileStream: TStream; // îáû÷íî ïîòîê äëÿ ÷òåíèÿ îðèãèíàëüíîãî ôàéëà
fFiles: TObjectList; // TSFSFileInfo èëè íàñëåäíèêè
// ýòà ïðîöåäóðà ìîæåò ìåíÿòü fFiles!
// fPath -- â ïðàâèëüíîé ôîðìå, ñ "/", êîðíåâîé "/" óáèò, ôèíàëüíûé äîáàâëåí.
// åñëè ôàéë íå íàéäåí, âåðíóòü -1.
- function FindFile (const fPath, fName: TSFSString): Integer; virtual;
+ function FindFile (const fPath, fName: AnsiString): Integer; virtual;
// âîçâðàùàåò êîëè÷åñòâî ôàéëîâ â fFiles
function GetFileCount (): Integer; virtual;
public
// pSt íå îáÿçàòåëüíî çàïîìèíàòü, åñëè îí íå íóæåí.
- constructor Create (const pFileName: TSFSString; pSt: TStream); virtual;
+ constructor Create (const pFileName: AnsiString; pSt: TStream); virtual;
// fFileStream óíè÷òîæàòü íåëüçÿ, åñëè îí ðàâåí ïàðàìåòðó pSt êîíñòðóêòîðà.
destructor Destroy (); override;
function OpenFileByIndex (const index: Integer): TStream; virtual; abstract;
// åñëè íå ñìîãëî îòêóïîðèòü ôàéëî (èëè åù¸ ãäå îøèáëîñü), çàøâûðí¸ò èñêëþ÷åíèå.
- function OpenFileEx (const fName: TSFSString): TStream; virtual;
+ function OpenFileEx (const fName: AnsiString): TStream; virtual;
property FileCount: Integer read GetFileCount; // ìîæåò âåðíóòü íîëü
// ìîæåò âîçâðàùàòü NIL.
// ôàéëà. åñëè íè îäíà ôàáðèêà ïðåôèêñ íå ïðèçíàåò, òî ôàéë íå îòêðîþò.
// èñïîëüçóåòñÿ äëÿ ñêèïàíèÿ àâòîäåòåêòà.
// SFS ÍÅ Ñ×ÈÒÀÅÒ ÏÐÅÔÈÊÑÎÌ ÑÒÐÎÊÓ ÊÎÐÎ×Å ÒÐ¨Õ ÑÈÌÂÎËÎÂ!
- function IsMyVolumePrefix (const prefix: TSFSString): Boolean; virtual; abstract;
+ function IsMyVolumePrefix (const prefix: AnsiString): Boolean; virtual; abstract;
// ïðîâåðÿåò, ìîæåò ëè ôàáðèêà ñäåëàòü òîì äëÿ äàííîãî ôàéëà.
// st -- îòêðûòûé äëÿ ÷òåíèÿ ôàéëîâé ïîòîê. óêàçàòåëü ÷òåíèÿ ñòîèò â íà÷àëå.
// ýòîò ïîòîê íåëüçÿ çàêðûâàòü!
// prefix: òî, ÷òî áûëî ïåðåäàíî â IsMyVolumePrefix() èëè ''.
// èñêëþ÷åíèå ñ÷èòàåòñÿ îøèáêîé, âîçâðàò NIL ñ÷èòàåòñÿ îøèáêîé.
- function Produce (const prefix, fileName: TSFSString; st: TStream): TSFSVolume; virtual; abstract;
+ function Produce (const prefix, fileName: AnsiString; st: TStream): TSFSVolume; virtual; abstract;
// êîãäà òîì áîëüøå íå íóæåí, îí áóäåò îòäàí ôàáðèêå íà ïåðåðàáîòêó.
// äàëåå äâèæîê íå áóäåò þçàòü ñåé òîì.
procedure Recycle (vol: TSFSVolume); virtual; abstract;
// è îáðàùàòüñÿ êàê "datafile::xxx".
// "||" ïðåîáðàçóþòñÿ â ïðîñòîé "|" è ðàçäåëèòåëåì íå ñ÷èòàþòñÿ.
// ïðèíèìàåòñÿ âî âíèìàíèå òîëüêî ïîñëåäíÿÿ òðóáà.
-function SFSAddDataFile (const dataFileName: TSFSString; top: Boolean=false): Boolean;
+function SFSAddDataFile (const dataFileName: AnsiString; top: Boolean=false): Boolean;
// äîáàâèòü ñáîðíèê âðåìåííî
-function SFSAddDataFileTemp (const dataFileName: TSFSString; top: Boolean=false): Boolean;
+function SFSAddDataFileTemp (const dataFileName: AnsiString; top: Boolean=false): Boolean;
// äîáàâèòü â ïîñòîÿííûé ñïèñîê ñáîðíèê èç ïîòîêà ds.
// åñëè âîçâðàùàåò èñòèíó, òî SFS ñòàíîâèòñÿ âëÿäåëüöåì ïîòîêà ds è ñàìà
@@ -183,21 +179,21 @@ function SFSAddDataFileTemp (const dataFileName: TSFSString; top: Boolean=false)
// âåðí¸ò ëîæü ïðè îøèáêå.
// îòêðûâàåò ñáîðíèê èç ïîòîêà. dataFileName -- ÂÈÐÒÓÀËÜÍÎÅ èìÿ.
// ò.å. íà ñàìîì äåëå òàêîãî ôàéëà ìîæåò è íå áûòü íà äèñêå.
-function SFSAddSubDataFile (const virtualName: TSFSString; ds: TStream; top: Boolean=false): Boolean;
+function SFSAddSubDataFile (const virtualName: AnsiString; ds: TStream; top: Boolean=false): Boolean;
// øâûðÿåòñÿ èñêëþ÷åíèÿìè.
// åñëè fName íå èìååò óêàçàíèÿ íà ôàéë äàííûõ (ýòî òî, ÷òî îòäåëåíî îò
// îñòàëüíîãî èìåíè äâîåòî÷èåì), òî èùåì ñíà÷àëà ïî âñåì çàðåãèñòðèðîâàííûì
// ôàéëàì äàííûõ, ïîòîì â òåêóùåì êàòàëîãå, ïîòîì â êàòàëîãå, îòêóäà ñòàðòîâàëè.
// åñëè íè÷åãî íå íàøëè, êèäàåì èñêëþ÷åíèå.
-function SFSFileOpenEx (const fName: TSFSString): TStream;
+function SFSFileOpenEx (const fName: AnsiString): TStream;
// ïðè îøèáêå -- NIL, è íèêàêèõ èñêëþ÷åíèé.
-function SFSFileOpen (const fName: TSFSString): TStream;
+function SFSFileOpen (const fName: AnsiString): TStream;
// âîçâðàùàåò NIL ïðè îøèáêå.
// ïîñëå èñïîëüçîâàíèÿ, íàòóðàëüíî, èòåðàòîð íàäî ãðîõíóòü %-)
-function SFSFileList (const dataFileName: TSFSString): TSFSFileList;
+function SFSFileList (const dataFileName: AnsiString): TSFSFileList;
// çàïðåòèòü îñâîáîæäåíèå âðåìåííûõ òîìîâ (ìîæíî âûçûâàòü ðåêóðñèâíî)
procedure sfsGCDisable ();
// for completeness sake
procedure sfsGCCollect ();
-function SFSReplacePathDelims (const s: TSFSString; newDelim: TSFSChar): TSFSString;
+function SFSReplacePathDelims (const s: AnsiString; newDelim: Char): AnsiString;
// ðàçîáðàòü òîëñòîå èìÿ ôàéëà, âåðíóòü âèðòóàëüíîå èìÿ ïîñëåäíåãî ñïèñêà
// èëè ïóñòóþ ñòîðîêó, åñëè ñïèñêîâ íå áûëî.
-function SFSGetLastVirtualName (const fn: TSFSString): string;
+function SFSGetLastVirtualName (const fn: AnsiString): AnsiString;
// Wildcard matching
// this code is meant to allow wildcard pattern matches. tt is VERY useful
// 'this [e-n]s a [!zy]est' -Would match 'this is a test', but would
// not match 'this as a yest'
//
-function WildMatch (pattern, text: TSFSString): Boolean;
-function WildListMatch (wildList, text: TSFSString; delimChar: AnsiChar=':'): Integer;
-function HasWildcards (const pattern: TSFSString): Boolean;
+function WildMatch (pattern, text: AnsiString): Boolean;
+function WildListMatch (wildList, text: AnsiString; delimChar: AnsiChar=':'): Integer;
+function HasWildcards (const pattern: AnsiString): Boolean;
var
// òåêóùåì. êàòàëîãè ðàçäåëÿþòñÿ òðóáîé ("|").
// <currentdir> çàìåíÿåòñÿ íà òåêóùèé êàòàëîã (ñ çàâåðøàþùèì "/"),
// <exedir> çàìåíÿåòñÿ íà êàòàëîã, ãäå ñèäèò .EXE (ñ çàâåðøàþùèì "/").
- sfsDiskDirs: TSFSString = '<currentdir>|<exedir>';
+ sfsDiskDirs: AnsiString = '<currentdir>|<exedir>';
implementation
WILD_CHAR_RANGE_NOT = '!';
-function HasWildcards (const pattern: TSFSString): Boolean;
+function HasWildcards (const pattern: AnsiString): Boolean;
begin
result :=
(Pos(WILD_CHAR_ESCAPE, pattern) <> 0) or
(Pos(WILD_CHAR_RANGE_OPEN, pattern) <> 0);
end;
-function MatchMask (const pattern: TSFSString; p, pend: Integer; const text: TSFSString; t, tend: Integer): Boolean;
+function MatchMask (const pattern: AnsiString; p, pend: Integer; const text: AnsiString; t, tend: Integer): Boolean;
var
rangeStart, rangeEnd: AnsiChar;
rangeNot, rangeMatched: Boolean;
end;
-function WildMatch (pattern, text: TSFSString): Boolean;
+function WildMatch (pattern, text: AnsiString): Boolean;
begin
if pattern <> '' then pattern := AnsiLowerCase(pattern);
if text <> '' then text := AnsiLowerCase(text);
result := MatchMask(pattern, 1, -1, text, 1, -1);
end;
-function WildListMatch (wildList, text: TSFSString; delimChar: AnsiChar=':'): Integer;
+function WildListMatch (wildList, text: AnsiString; delimChar: AnsiChar=':'): Integer;
var
s, e: Integer;
begin
TVolumeInfo = class
fFactory: TSFSVolumeFactory;
fVolume: TSFSVolume;
- fPackName: TSFSString; // äëÿ îäíîãî è òîãî æå ôàéëà áóäåò òîëüêî îäèí òîì!
+ fPackName: AnsiString; // äëÿ îäíîãî è òîãî æå ôàéëà áóäåò òîëüêî îäèí òîì!
fStream: TStream; // ôàéëîâûé ïîòîê äëÿ ñáîðíèêà
fPermanent: Boolean; // èñòèíà -- íå áóäåò óãðîáëåíà, åñëè íå îñòàíåòñÿ íè îäíîãî îòêðûòîãî òîìà
// èñòèíà -- ýòîò òîì áûë ñîçäàí èç ïîòîêà è íå èìååò äèñêîâîãî ôàéëà, ïîòîìó ôàáðèêå áóäåò ïåðåäàíî íå èìÿ ñáîðíèêà, à ïóñòàÿ ñòðîêà
begin
vi := TVolumeInfo(volumes[f]);
if vi = nil then continue;
- if (not vi.fPermanent) and (vi.fVolume.fRC = 0) and (vi.fOpenedFilesCount = 0) then
+ if (not vi.fPermanent) and (vi.fOpenedFilesCount = 0) then
begin
// this volume probably can be removed
used := false;
// ñîáñòâåííî èìÿ ôàéëà
// èìÿ âûãëÿäèò êàê:
// (("sfspfx:")?"datafile::")*"filename"
-procedure SplitFName (const fn: string; out dataFile, fileName: string);
+procedure SplitFName (const fn: AnsiString; out dataFile, fileName: AnsiString);
var
f: Integer;
begin
end;
// ñàéäýôôåêò: âûðåçàåò âèðòóàëüíîå èìÿ èç dataFile.
-function ExtractVirtName (var dataFile: string): string;
+function ExtractVirtName (var dataFile: AnsiString): AnsiString;
var
f: Integer;
begin
// [sfspfx:]datafile[|virtname]
// åñëè ïåðåä äâîåòî÷èåì ìåíüøå òð¸õ áóêâ, òî ýòî ñ÷èòàåòñÿ íå ïðåôèêñîì,
// à èìåíåì äèñêà.
-procedure SplitDataName (const fn: string; out pfx, dataFile, virtName: string);
+procedure SplitDataName (const fn: AnsiString; out pfx, dataFile, virtName: AnsiString);
var
f: Integer;
begin
// íàéòè ïðîèçâîäèòåëÿ äëÿ ýòîãî ôàéëà (åñëè ôàéë óæå îòêðûò).
// onlyPerm: òîëüêî "ïîñòîÿííûå" ïðîèçâîäèòåëè.
-function FindVolumeInfo (const dataFileName: TSFSString; onlyPerm: Boolean=false): Integer;
+function FindVolumeInfo (const dataFileName: AnsiString; onlyPerm: Boolean=false): Integer;
var
f: Integer;
vi: TVolumeInfo;
// adds '/' too
-function normalizePath (fn: string): string;
+function normalizePath (fn: AnsiString): AnsiString;
var
i: Integer;
begin
if (length(result) > 0) and (result[length(result)] <> '/') then result := result+'/';
end;
-function SFSReplacePathDelims (const s: TSFSString; newDelim: TSFSChar): TSFSString;
+function SFSReplacePathDelims (const s: AnsiString; newDelim: Char): AnsiString;
var
f: Integer;
begin
end;
end;
-function SFSGetLastVirtualName (const fn: TSFSString): string;
+function SFSGetLastVirtualName (const fn: AnsiString): AnsiString;
var
- rest, tmp: string;
+ rest, tmp: AnsiString;
f: Integer;
begin
rest := fn;
used: Boolean; // ôëàæîê çàþçàíîñòè ïîòîêà êåì-òî åù¸
begin
if fFactory <> nil then fFactory.Recycle(fVolume);
- if fVolume <> nil then used := (fVolume.fRC <> 0) else used := false;
+ used := false;
fVolume := nil;
fFactory := nil;
fPackName := '';
{ TSFSVolume }
-constructor TSFSVolume.Create (const pFileName: TSFSString; pSt: TStream);
+constructor TSFSVolume.Create (const pFileName: AnsiString; pSt: TStream);
begin
inherited Create();
- fRC := 0;
fFileStream := pSt;
fFileName := pFileName;
fFiles := TObjectList.Create(true);
var
f, c: Integer;
sfi: TSFSFileInfo;
- tmp: TSFSString;
+ tmp: AnsiString;
begin
fFileName := ExpandFileName(SFSReplacePathDelims(fFileName, '/'));
ReadDirectory();
procedure TSFSVolume.Clear ();
begin
- fRC := 0; //FIXME
fFiles.Clear();
end;
-function TSFSVolume.FindFile (const fPath, fName: TSFSString): Integer;
+function TSFSVolume.FindFile (const fPath, fName: AnsiString): Integer;
begin
if fFiles = nil then result := -1
else
end;
end;
-function TSFSVolume.OpenFileEx (const fName: TSFSString): TStream;
+function TSFSVolume.OpenFileEx (const fName: AnsiString): TStream;
var
- fp, fn: TSFSString;
+ fp, fn: AnsiString;
f, ls: Integer;
begin
fp := fName;
begin
f := FindVolumeInfoByVolumeInstance(fVolume);
ASSERT(f <> -1);
- if fVolume <> nil then Dec(fVolume.fRC);
Dec(TVolumeInfo(volumes[f]).fOpenedFilesCount);
// óáü¸ì çàïèñü, åñëè îíà âðåìåííàÿ, è â íåé íåò áîëüøå íè÷åãî îòêðûòîãî
if (gcdisabled = 0) and not TVolumeInfo(volumes[f]).fPermanent and (TVolumeInfo(volumes[f]).fOpenedFilesCount < 1) then
end;
-function SFSAddDataFileEx (dataFileName: TSFSString; ds: TStream; top, permanent: Integer): Integer;
+function SFSAddDataFileEx (dataFileName: AnsiString; ds: TStream; top, permanent: Integer): Integer;
// dataFileName ìîæåò èìåòü ïðåôèêñ òèïà "zip:" (ñì. âûøå: IsMyPrefix).
// ìîæåò âûêèíóòü èñêëþ÷åíèå!
// top:
vi: TVolumeInfo;
f: Integer;
st, st1: TStream;
- pfx: TSFSString;
- fn, vfn, tmp: TSFSString;
+ pfx: AnsiString;
+ fn, vfn, tmp: AnsiString;
begin
f := Pos('::', dataFileName);
if f <> 0 then
vi.fOpenedFilesCount := 0;
end;
-function SFSAddSubDataFile (const virtualName: TSFSString; ds: TStream; top: Boolean=false): Boolean;
+function SFSAddSubDataFile (const virtualName: AnsiString; ds: TStream; top: Boolean=false): Boolean;
var
tv: Integer;
begin
end;
end;
-function SFSAddDataFile (const dataFileName: TSFSString; top: Boolean=false): Boolean;
+function SFSAddDataFile (const dataFileName: AnsiString; top: Boolean=false): Boolean;
var
tv: Integer;
begin
end;
end;
-function SFSAddDataFileTemp (const dataFileName: TSFSString; top: Boolean=false): Boolean;
+function SFSAddDataFileTemp (const dataFileName: AnsiString; top: Boolean=false): Boolean;
var
tv: Integer;
begin
-function SFSExpandDirName (const s: TSFSString): TSFSString;
+function SFSExpandDirName (const s: AnsiString): AnsiString;
var
f, e: Integer;
- es: TSFSString;
+ es: AnsiString;
begin
f := 1; result := s;
while f < Length(result) do
end;
end;
-function SFSFileOpenEx (const fName: TSFSString): TStream;
+function SFSFileOpenEx (const fName: AnsiString): TStream;
var
- dataFileName, fn: TSFSString;
+ dataFileName, fn: AnsiString;
f: Integer;
vi: TVolumeInfo;
diskChecked: Boolean;
function CheckDisk (): TStream;
// ïðîâåðèì, åñòü ëè ôàëî fn ãäå-òî íà äèñêàõ.
var
- dfn, dirs, cdir: TSFSString;
+ dfn, dirs, cdir: AnsiString;
f: Integer;
begin
result := nil;
if result = nil then raise ESFSError.Create('file not found: "'+fName+'"');
end;
-function SFSFileOpen (const fName: TSFSString): TStream;
+function SFSFileOpen (const fName: AnsiString): TStream;
begin
try
result := SFSFileOpenEx(fName);
end;
end;
-function SFSFileList (const dataFileName: TSFSString): TSFSFileList;
+function SFSFileList (const dataFileName: AnsiString): TSFSFileList;
var
f: Integer;
vi: TVolumeInfo;
try
result := TSFSFileList.Create(vi.fVolume);
- Inc(vi.fVolume.fRC);
except
if (gcdisabled = 0) and not vi.fPermanent and (vi.fOpenedFilesCount < 1) then volumes[f] := nil;
end;
diff --git a/src/sfs/sfsMemFS.pas b/src/sfs/sfsMemFS.pas
--- a/src/sfs/sfsMemFS.pas
+++ /dev/null
@@ -1,247 +0,0 @@
-// Streaming R/O Virtual File System v0.2.0
-// Copyright (C) XL A.S. Ketmar. All rights reserved
-// See the file aplicense.txt for conditions of use.
-//
-// "memory group". reads the whole pack in memory (and decompress it if
-// necessary). memory image has only one file named "<body>".
-//
-// now understands:
-// slh!: DOS Allegro "slh!"
-// mem : raw file (no processing, just read)
-// as a side effect this gives us an opportunity to read enclosed packs
-// from the packs which aren't supporting backseeking (such as zips).
-//
-{.$DEFINE SFS_MSMFS}
-{$MODE DELPHI}
-{.$R-}
-unit sfsMemFS;
-
-interface
-
-{$IFDEF SFS_MSMFS}
-uses
- SysUtils, Classes, Contnrs, sfs;
-
-
-type
- TSFSMemVolumeType = (sfsmvNone, sfsmvRAW, sfsmvSLH);
-
- TSFSMemoryVolume = class(TSFSVolume)
- protected
- fType: TSFSMemVolumeType;
- fMemStream: TMemoryStream;
-
- procedure RAWRead ();
- procedure SLHRead ();
-
- procedure ReadDirectory (); override;
-
- public
- function OpenFileByIndex (const index: Integer): TStream; override;
- end;
-
- TSFSMemoryVolumeFactory = class (TSFSVolumeFactory)
- public
- function IsMyVolumePrefix (const prefix: TSFSString): Boolean; override;
- function Produce (const prefix, fileName: TSFSString; st: TStream): TSFSVolume; override;
- procedure Recycle (vol: TSFSVolume); override;
- end;
-{$ENDIF}
-
-
-implementation
-
-{$IFDEF SFS_MSMFS}
-uses
- xstreams, utils;
-
-
-function SLHCheckMagic (st: TStream): Boolean;
-var
- sign: packed array [0..3] of Char;
-begin
- result := false;
- st.ReadBuffer(sign[0], 4);
- st.Seek(-4, soCurrent);
- if sign <> 'slh!' then exit;
- result := true;
-end;
-
-
-{ TSFSMemoryVolume }
-procedure TSFSMemoryVolume.RAWRead ();
-var
- fi: TSFSFileInfo;
-begin
- fMemStream.CopyFrom(fFileStream, 0); // voila %-)
- fi := TSFSFileInfo.Create(self);
- fi.fName := '<body>';
- fi.fSize := fMemStream.Size;
-end;
-
-procedure TSFSMemoryVolume.SLHRead ();
-// unpack LZSS-packed file
-var
- fi: TSFSFileInfo;
- bufi, bufo: packed array of Byte;
- iused, oused, rpos: Integer;
- dict: packed array of Byte;
- flags, dpos, pos, len: Word;
- c: Integer;
-
- function ReadCh (): Integer;
- begin
- if rpos >= iused then
- begin
- // int64!
- if fFileStream.Size-fFileStream.Position > Length(bufi) then iused := Length(bufi)
- else iused := fFileStream.Size-fFileStream.Position;
- rpos := 0;
- if iused > 0 then fFileStream.ReadBuffer(bufi[0], iused);
- end;
-
- if iused = 0 then result := -1
- else begin result := bufi[rpos]; Inc(rpos); end;
- end;
-
- procedure WriteCh (c: Byte);
- begin
- if oused >= Length(bufo) then
- begin
- fMemStream.WriteBuffer(bufo[0], oused);
- oused := 0;
- end;
- bufo[oused] := c; Inc(oused);
- dict[dpos] := c; dpos := (dpos+1) and $FFF;
- end;
-
-begin
- fFileStream.Seek(4, soCurrent); // skip signature
- SetLength(bufi, 65536); SetLength(bufo, 65536); SetLength(dict, 4096);
- rpos := 0; iused := 0; oused := 0;
- flags := 0; dpos := 4096-18;
- repeat
- if (flags and $FF00) = 0 then
- begin
- c := ReadCh(); if c = -1 then break;
- flags := c or $FF00;
- end;
-
- if (flags and $01) <> 0 then
- begin
- // literal
- c := ReadCh(); if c = -1 then break;
- WriteCh(c);
- end
- else
- begin
- // "copy"
- c := ReadCh(); if c = -1 then break;
- pos := c;
- c := ReadCh(); if c = -1 then break;
- len := c;
- pos := (pos and $FF) or ((len and $F0) shl 4); len := (len and $0F)+3;
- while len > 0 do
- begin
- c := dict[pos]; pos := (pos+1) and $FFF; Dec(len);
- WriteCh(c);
- end;
- end;
- flags := flags shr 1;
- until false;
- if oused > 0 then fMemStream.WriteBuffer(bufo[0], oused);
-
- fi := TSFSFileInfo.Create(self);
- fi.fName := '<body>';
- fi.fSize := fMemStream.Size;
-end;
-
-procedure TSFSMemoryVolume.ReadDirectory ();
-begin
- if fMemStream = nil then fMemStream := TMemoryStream.Create()
- else
- begin
- fMemStream.Position := 0; fMemStream.Size := 0;
- end;
-
- case fType of
- sfsmvSLH: SLHRead();
- sfsmvRAW: RAWRead();
- else raise ESFSError.Create('invalid memory SFS');
- end;
-
- fMemStream.Position := 0;
-end;
-
-function TSFSMemoryVolume.OpenFileByIndex (const index: Integer): TStream;
-var
- fs: TStream;
-begin
- result := nil; fs := nil;
- if fFiles = nil then exit;
- if (index < 0) or (index >= fFiles.Count) or (fFiles[index] = nil) then exit;
-
- try
- fs := TSFSMemoryStreamRO.Create(fMemStream.Memory, fMemStream.Size);
- if fFiles.Count = 1 then
- begin
- result := fs;
- end
- else
- begin
- try
- result := TSFSPartialStream.Create(fs,
- TSFSFileInfo(fFiles[index]).fOfs,
- TSFSFileInfo(fFiles[index]).fSize, true);
- except
- FreeAndNil(fs);
- raise;
- end;
- end;
- except
- result := nil;
- end;
-end;
-
-
-{ TSFSMemoryVolumeFactory }
-function TSFSMemoryVolumeFactory.IsMyVolumePrefix (const prefix: TSFSString): Boolean;
-begin
- result :=
- StrEquCI1251(prefix, 'mem') or
- StrEquCI1251(prefix, 'slh!');
-end;
-
-procedure TSFSMemoryVolumeFactory.Recycle (vol: TSFSVolume);
-begin
- vol.Free();
-end;
-
-function TSFSMemoryVolumeFactory.Produce (const prefix, fileName: TSFSString; st: TStream): TSFSVolume;
-var
- vt: TSFSMemVolumeType;
-begin
- if (prefix <> 'mem') and SLHCheckMagic(st) then vt := sfsmvSLH
- else if prefix <> '' then vt := sfsmvRAW
- else vt := sfsmvNone;
-
- result := TSFSMemoryVolume.Create(fileName, st);
- TSFSMemoryVolume(result).fType := vt;
- try
- result.DoDirectoryRead();
- except
- FreeAndNil(result);
- raise;
- end;
-end;
-
-
-var
- memf: TSFSMemoryVolumeFactory;
-initialization
- memf := TSFSMemoryVolumeFactory.Create();
- SFSRegisterVolumeFactory(memf);
-//finalization
-// SFSUnregisterVolumeFactory(memf);
-{$ENDIF}
-end.
diff --git a/src/sfs/sfsPlainFS.pas b/src/sfs/sfsPlainFS.pas
index b658388b072f311af0bcd78b811375154f0e58ee..e0b2bd0be6648e5be102ac7820920ca6b33938df 100644 (file)
--- a/src/sfs/sfsPlainFS.pas
+++ b/src/sfs/sfsPlainFS.pas
// See the file aplicense.txt for conditions of use.
//
// simple grouping files w/o packing:
-// wad, doom : DooM .WAD (IWAD, PWAD)
-// pak, quake : Quake I/II .PAK (PACK)
-// grp, duke3d : Duke3D .GRP (KenSilverman)
-// spe, spec, abuse: Abuse .SPE (SPEC1.0)
-// wad2 : Quake .WAD (WAD2)
-// allegro : DOS Allegro (slh.ALL.; ALL.)
-// dune2 pak : alas, no signature %-(
-// M.A.X. res : RES0
-// sin : SiN .SIN (SPAK)
+// Quake I/II .PAK (PACK)
+// SiN .SIN (SPAK)
//
-{.$DEFINE SFS_PLAIN_FS_ALTERNATIVE_SPEC}
- // define this and the first byte of each file in .SPE will contain
- // file type.
- // undefine this and file type will be directory name.
-{.$DEFINE SFS_PLAIN_FS_DEBUG_ALLEGRO}
-{.$DEFINE SFS_PLAINFS_FULL}
-{$MODE DELPHI}
-{.$R-}
+{$MODE OBJFPC}
+{$R+}
unit sfsPlainFS;
interface
type
- TSFSPlainVolumeType =
- (sfspvNone,
- sfspvPAK,
- sfspvSIN
- {$IFDEF SFS_PLAINFS_FULL}
- ,sfspvWAD,
- sfspvGRP,
- sfspvSPE,
- sfspvWAD2,
- sfspvALL,
- sfspvDune2,
- sfspvMAX
- {$ENDIF}
- );
+ TSFSPlainVolumeType = (sfspvNone, sfspvPAK, sfspvSIN);
TSFSPlainVolume = class (TSFSVolume)
protected
fType: TSFSPlainVolumeType;
- procedure PAKReadDirectory ();
- procedure SINReadDirectory ();
- {$IFDEF SFS_PLAINFS_FULL}
- procedure WADReadDirectory ();
- procedure GRPReadDirectory ();
- procedure SPEReadDirectory ();
- procedure WAD2ReadDirectory ();
- procedure ALLReadDirectory ();
- procedure Dune2ReadDirectory ();
- procedure MAXReadDirectory ();
- {$ENDIF}
-
procedure ReadDirectory (); override;
public
TSFSPlainVolumeFactory = class (TSFSVolumeFactory)
public
- function IsMyVolumePrefix (const prefix: TSFSString): Boolean; override;
- function Produce (const prefix, fileName: TSFSString; st: TStream): TSFSVolume; override;
+ function IsMyVolumePrefix (const prefix: AnsiString): Boolean; override;
+ function Produce (const prefix, fileName: AnsiString; st: TStream): TSFSVolume; override;
procedure Recycle (vol: TSFSVolume); override;
end;
-
implementation
uses
xstreams, utils;
-type
- TSFSExtFileInfo = class (TSFSFileInfo)
- public
- fVBuf: packed array of Byte;
- fLink: TSFSString;
- end;
-
-{$IFDEF SFS_PLAINFS_FULL}
- TAllegroProperty = class
- name: TSFSString;
- ofs: Int64;
- size: Integer;
- end;
-{$ENDIF}
-
-
-function ReadMD (st: TStream): Integer;
-// read dword in big-endian format. portable.
-var
- buf: packed array [0..3] of Byte;
-begin
- st.ReadBuffer(buf[0], 4);
- result := (buf[0] shl 24) or (buf[1] shl 16) or (buf[2] shl 8) or buf[3];
-end;
-
-{$IFDEF SFS_PLAINFS_FULL}
-function WADCheckMagic (st: TStream): Boolean;
-var
- sign: packed array [0..3] of Char;
- fcnt, dofs: Integer;
-begin
- result := false;
- st.ReadBuffer(sign[0], 4);
- st.ReadBuffer(fcnt, 4); st.ReadBuffer(dofs, 4);
- st.Seek(-12, soCurrent);
- if (sign <> 'IWAD') and (sign <> 'PWAD') then exit;
- if (dofs < 0) or (dofs > st.Size) or (fcnt < 0) or
- (dofs+fcnt*16 > st.Size) then exit;
- result := true;
-end;
-{$ENDIF}
-
-function PAKCheckMagic (st: TStream): Boolean;
-var
- sign: packed array [0..3] of Char;
- dsize, dofs: Integer;
-begin
- result := false;
- st.ReadBuffer(sign[0], 4);
- st.ReadBuffer(dofs, 4); st.ReadBuffer(dsize, 4);
- st.Seek(-12, soCurrent);
- if sign <> 'PACK' then exit;
- if (dsize < 0) or (dofs < 0) or (dofs > st.Size) or (dofs+dsize > st.Size) or
- (dsize mod 64 <> 0) then exit;
- result := true;
-end;
-
-function SINCheckMagic (st: TStream): Boolean;
-var
- sign: packed array [0..3] of Char;
- dsize, dofs: Integer;
-begin
- result := false;
- st.ReadBuffer(sign[0], 4);
- st.ReadBuffer(dofs, 4); st.ReadBuffer(dsize, 4);
- st.Seek(-12, soCurrent);
- if sign <> 'SPAK' then exit;
- if (dsize < 0) or (dofs < 0) or (dofs > st.Size) or (dofs+dsize > st.Size) or
- (dsize mod 64 <> 0) then exit;
- result := true;
-end;
-
-{$IFDEF SFS_PLAINFS_FULL}
-function GRPCheckMagic (st: TStream): Boolean;
-var
- sign: packed array [0..11] of Char;
- fcnt: Integer;
-begin
- result := false;
- st.ReadBuffer(sign[0], 12);
- st.ReadBuffer(fcnt, 4);
- st.Seek(-16, soCurrent);
- if sign <> 'KenSilverman' then exit;
- if (fcnt < 0) or (fcnt*16 > st.Size-16) then exit;
- result := true;
-end;
-
-function SPECheckMagic (st: TStream): Boolean;
-var
- sign: packed array [0..6] of Char;
- b: Byte;
- fcnt: Integer;
-begin
- result := false;
- st.ReadBuffer(sign[0], 7); st.ReadBuffer(b, 1);
- st.ReadBuffer(fcnt, 4);
- st.Seek(-12, soCurrent);
- if (sign <> 'SPEC1.0') or (b <> 0) or (fcnt < 0) then exit;
- result := true;
-end;
-
-function WAD2CheckMagic (st: TStream): Boolean;
-var
- sign: packed array [0..3] of Char;
- fcnt, dofs: Integer;
-begin
- result := false;
- st.ReadBuffer(sign[0], 4);
- st.ReadBuffer(fcnt, 4); st.ReadBuffer(dofs, 4);
- st.Seek(-12, soCurrent);
- if sign <> 'WAD2' then exit;
- if (dofs < 0) or (dofs > st.Size) or (fcnt < 0) or
- (dofs+fcnt*32 > st.Size) then exit;
- result := true;
-end;
-
-function ALLCheckMagic (st: TStream): Boolean;
-var
- sign0, sign1: packed array [0..3] of Char;
-begin
- result := false;
- st.ReadBuffer(sign0[0], 4);
- st.ReadBuffer(sign1[0], 4);
- st.Seek(-8, soCurrent);
- if sign0 = 'slh.' then
- begin
- if sign1 <> 'ALL.' then exit;
- end else if sign0 <> 'ALL.' then exit;
- result := true;
-end;
-
-function Dune2CheckMagic (st: TStream): Boolean;
-var
- cpos, np, f: Integer;
-begin
- cpos := st.Position;
- st.ReadBuffer(np, 4);
- st.Position := np-4;
- st.ReadBuffer(f, 4);
- st.Position := cpos;
- result := (f = 0);
-end;
-
-function MAXCheckMagic (st: TStream): Boolean;
-var
- sign: packed array [0..3] of Char;
- fcnt, dofs: Integer;
-begin
- result := false;
- st.ReadBuffer(sign[0], 4);
- st.ReadBuffer(dofs, 4); st.ReadBuffer(fcnt, 4);
- st.Seek(-12, soCurrent);
- if sign <> 'RES0' then exit;
- if (dofs < 0) or (dofs > st.Size) or (fcnt < 0) or
- (dofs+fcnt > st.Size) then exit;
- result := true;
-end;
-{$ENDIF}
-
-
{ TSFSPlainVolume }
-{$IFDEF SFS_PLAINFS_FULL}
-procedure TSFSPlainVolume.WADReadDirectory ();
-var
- fcnt: LongWord;
- dofs: LongWord;
- fi: TSFSFileInfo;
- name: packed array [0..9] of Char;
-begin
- fFileStream.Seek(4, soCurrent); // skip signature
- fFileStream.ReadBuffer(fcnt, 4);
- fFileStream.ReadBuffer(dofs, 4);
- fFileStream.Position := dofs;
- while fcnt <> 0 do
- begin
- fi := TSFSFileInfo.Create(self);
- fFileStream.ReadBuffer(fi.fOfs, 4);
- fFileStream.ReadBuffer(fi.fSize, 4);
- FillChar(name[0], Length(name), 0);
- fFileStream.ReadBuffer(name[0], 8);
- fi.fName := PChar(@name[0]);
- Dec(fcnt);
- end;
-end;
-{$ENDIF}
-
-procedure TSFSPlainVolume.PAKReadDirectory ();
-var
- dsize, dofs: LongWord;
- fi: TSFSFileInfo;
- name: packed array [0..56] of Char;
-begin
- fFileStream.Seek(4, soCurrent); // skip signature
- fFileStream.ReadBuffer(dofs, 4);
- fFileStream.ReadBuffer(dsize, 4);
- fFileStream.Position := dofs;
- while dsize >= 64 do
- begin
- fi := TSFSFileInfo.Create(self);
- FillChar(name[0], Length(name), 0);
- fFileStream.ReadBuffer(name[0], 56);
- fi.fName := PChar(@name[0]);
- fFileStream.ReadBuffer(fi.fOfs, 4);
- fFileStream.ReadBuffer(fi.fSize, 4);
- Dec(dsize, 64);
- end;
-end;
-
-procedure TSFSPlainVolume.SINReadDirectory ();
+procedure TSFSPlainVolume.ReadDirectory ();
var
- dsize, dofs: LongWord;
+ dsize, dofs, esz: LongWord;
fi: TSFSFileInfo;
name: packed array [0..120] of Char;
begin
+ if (fType <> sfspvPAK) and (fType <> sfspvSIN) then raise ESFSError.Create('invalid archive');
fFileStream.Seek(4, soCurrent); // skip signature
fFileStream.ReadBuffer(dofs, 4);
fFileStream.ReadBuffer(dsize, 4);
fFileStream.Position := dofs;
- while dsize >= 128 do
- begin
- fi := TSFSFileInfo.Create(self);
- FillChar(name[0], Length(name), 0);
- fFileStream.ReadBuffer(name[0], 120);
- fi.fName := PChar(@name[0]);
- fFileStream.ReadBuffer(fi.fOfs, 4);
- fFileStream.ReadBuffer(fi.fSize, 4);
- Dec(dsize, 128);
- end;
-end;
-
-{$IFDEF SFS_PLAINFS_FULL}
-procedure TSFSPlainVolume.GRPReadDirectory ();
-var
- fcnt: LongWord;
- fi: TSFSFileInfo;
- name: packed array [0..12] of Char;
- ofs: Int64;
-begin
- fFileStream.Seek(12, soCurrent); // skip signature
- fFileStream.ReadBuffer(fcnt, 4);
- ofs := fFileStream.Position+fcnt*16;
- while fcnt <> 0 do
- begin
- fi := TSFSFileInfo.Create(self);
- fi.fOfs := ofs;
- FillChar(name[0], Length(name), 0);
- fFileStream.ReadBuffer(name[0], 12);
- fi.fName := PChar(@name[0]);
- fFileStream.ReadBuffer(fi.fSize, 4);
- Inc(ofs, fi.fSize);
- Dec(fcnt);
- end;
-end;
-
-procedure TSFSPlainVolume.SPEReadDirectory ();
-var
- fcnt: Word;
- fi: TSFSExtFileInfo;
- {$IFNDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC}
- pp: TSFSString;
- {$ENDIF}
- name: ShortString;
- f, c: Integer;
- b: Byte;
- wasUnfixedLink: Boolean;
-begin
- fFileStream.Seek(8, soCurrent); // skip signature
- fFileStream.ReadBuffer(fcnt, 2);
- while fcnt <> 0 do
- begin
- fi := TSFSExtFileInfo.Create(self);
- {$IFDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC}
- SetLength(fi.fVBuf, 1); fFileStream.ReadBuffer(fi.fVBuf[0], 1);
- {$ELSE}
- SetLength(fi.fVBuf, 0);
- fFileStream.ReadBuffer(b, 1);
- pp := IntToHex(b, 2)+'/';
- {$ENDIF}
- fFileStream.ReadBuffer(name[0], 1);
- if name[0] <> #0 then fFileStream.ReadBuffer(name[1], Length(name));
- f := 1; while (f <= ord(name[0])) and (name[f] <> #0) do Inc(f); name[0] := chr(f-1);
- fi.fName := SFSReplacePathDelims(name, '/');
- if fi.fName = '' then fi.fName := 'untitled_file';
- if fi.fName[1] = '/' then Delete(fi.fName, 1, 1);
- {$IFNDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC}
- fi.fName := pp+fi.fName;
- {$ENDIF}
- fFileStream.ReadBuffer(b, 1);
- if (b and $01) <> 0 then
- begin
- // link
- fFileStream.ReadBuffer(name[0], 1);
- if name[0] <> #0 then fFileStream.ReadBuffer(name[1], Length(name));
- f := 1; while (f <= ord(name[0])) and (name[f] <> #0) do Inc(f); name[0] := chr(f-1);
- if name[0] = #0 then name := #0;
- fi.fLink := name;
- end
- else
- begin
- fi.fLink := '';
- fFileStream.ReadBuffer(fi.fSize, 4);
- {$IFDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC}
- Inc(fi.fSize); // plus type byte
- {$ENDIF}
- fFileStream.ReadBuffer(fi.fOfs, 4);
- end;
- Dec(fcnt);
- end;
-
- // now fixup links
- // nobody uses this shit, but it was documented by JC. %-)
- // i even allow links to links! %-)
- wasUnfixedLink := true;
- while wasUnfixedLink do
- begin
- f := 0; wasUnfixedLink := false;
- while f < fFiles.Count do
- begin
- fi := TSFSExtFileInfo(fFiles[f]); Inc(f);
- if (fi = nil) or (fi.fLink = '') then continue;
- c := 0;
- while c < fFiles.Count do
- begin
- if c <> f then
- begin
- // link can't be linked to itself
- if StrEquCI1251(TSFSExtFileInfo(fFiles[c]).fName, fi.fLink) then break;
- end;
- Inc(c);
- end;
- if c < fFiles.Count then
- begin
- if TSFSExtFileInfo(fFiles[c]).fLink <> '' then wasUnfixedLink := true
- else
- begin
- TSFSExtFileInfo(fFiles[c]).fOfs := fi.fOfs;
- TSFSExtFileInfo(fFiles[c]).fSize := fi.fSize;
- TSFSExtFileInfo(fFiles[c]).fLink := '';
- end;
- end
- else begin Dec(f); fFiles.Delete(f); end; // invalid link
- end;
- end;
-end;
-
-procedure TSFSPlainVolume.WAD2ReadDirectory ();
-var
- fcnt, dofs: LongWord;
- fi: TSFSFileInfo;
- name: packed array [0..16] of Char;
- f, c: Integer;
-begin
- fFileStream.Seek(4, soCurrent); // skip signature
- fFileStream.ReadBuffer(fcnt, 4);
- fFileStream.ReadBuffer(dofs, 4);
- fFileStream.Position := dofs;
- while fcnt <> 0 do
+ if fType = sfspvPAK then esz := 64 else esz := 128;
+ while dsize >= esz do
begin
fi := TSFSFileInfo.Create(self);
- fFileStream.ReadBuffer(fi.fOfs, 4);
- fFileStream.ReadBuffer(fi.fSize, 4);
- fFileStream.ReadBuffer(f, 4);
- fFileStream.ReadBuffer(c, 4);
- FillChar(name[0], Length(name), 0);
- fFileStream.ReadBuffer(name[0], 16);
+ FillChar(name[0], length(name), 0);
+ fFileStream.ReadBuffer(name[0], esz-8);
fi.fName := PChar(@name[0]);
- Dec(fcnt);
- end;
-end;
-
-procedure TSFSPlainVolume.ALLReadDirectory ();
-var
- fcnt: Integer;
- fi: TSFSFileInfo;
- sign: packed array [0..3] of Char;
- nameList: TStringList;
- propList: TObjectList;
- name: ShortString;
- f, c: Integer;
- prp: TAllegroProperty;
-begin
- nameList := TStringList.Create(); propList := nil;
- try
- propList := TObjectList.Create(true);
- fFileStream.ReadBuffer(sign[0], 4);
- if sign[0] = 's' then fFileStream.ReadBuffer(sign[0], 4);
- // signature skipped
- fcnt := ReadMD(fFileStream);
- while fcnt > 0 do
- begin
- // collect properties
- nameList.Clear(); propList.Clear();
- repeat
- fFileStream.ReadBuffer(sign[0], 4);
- if sign <> 'prop' then break;
- fFileStream.ReadBuffer(sign[0], 4);
- f := ReadMD(fFileStream); // size
- if f < 0 then
- begin
- {$IFDEF SFS_PLAIN_FS_DEBUG_ALLEGRO}
- WriteLn(ErrOutput, 'ALLEGRO: invalid property length at $', IntToHex(fFileStream.Position-8, 8));
- {$ENDIF}
- raise ESFSError.Create('invalid ALLEGRO file');
- end;
- if sign = 'NAME' then
- begin
- if f > 255 then c := 255 else c := f;
- FillChar(name, SizeOf(name), 0);
- fFileStream.ReadBuffer(name[1], c); name[0] := chr(c);
- Dec(f, c);
- c := 1; while (c <= ord(name[0])) and (name[c] <> #0) do Inc(c); name[0] := chr(c-1);
- nameList.Add(name);
- end
- else
- begin
- prp := TAllegroProperty.Create();
- Move(sign[0], name[1], 4); name[0] := #4;
- c := 1; while (c <= ord(name[0])) and (name[c] <> #0) do Inc(c); name[0] := chr(c-1);
- prp.name := sign;
- prp.ofs := fFileStream.Position;
- prp.size := f;
- propList.Add(prp);
- end;
- fFileStream.Seek(f, soCurrent);
- until false;
- if nameList.Count = 0 then nameList.Add('untitled_file');
-
- Move(sign[0], name[1], 4); name[5] := #0;
- f := 1; while (f <= 4) and (name[f] <> #0) do Inc(f);
- while (f > 0) and (name[f] <= ' ') do Dec(f);
- name[0] := chr(f);
-
- // read size
- f := ReadMD(fFileStream);
- c := ReadMD(fFileStream);
- if f <> c then
- begin
- {$IFDEF SFS_PLAIN_FS_DEBUG_ALLEGRO}
- WriteLn(ErrOutput, 'ALLEGRO: probably a packed data at $', IntToHex(fFileStream.Position-8, 8));
- {$ENDIF}
- raise ESFSError.Create('invalid ALLEGRO file');
- end;
-
- // add files
- while nameList.Count > 0 do
- begin
- fi := TSFSFileInfo.Create(self);
- fi.fName := nameList[0];
- fi.fPath := name;
- fi.fSize := c;
- fi.fOfs := fFileStream.Position;
- // add properties
- for f := 0 to propList.Count-1 do
- begin
- prp := TAllegroProperty(propList[f]);
- fi := TSFSFileInfo.Create(self);
- fi.fName := prp.name;
- fi.fPath := name+'.props/'+nameList[0];
- fi.fSize := prp.size;
- fi.fOfs := prp.ofs;
- end;
- nameList.Delete(0);
- end;
- fFileStream.Seek(c, soCurrent);
- Dec(fcnt);
- end;
- {$IFDEF SFS_PLAIN_FS_DEBUG_ALLEGRO}
- WriteLn(ErrOutput, 'ALLEGRO: ok');
- {$ENDIF}
- finally
- propList.Free();
- nameList.Free();
- end;
-end;
-
-procedure TSFSPlainVolume.Dune2ReadDirectory ();
-var
- ofs: LongWord;
- fi: TSFSFileInfo;
- name: string[255];
- ch: Char;
-begin
- repeat
- fFileStream.ReadBuffer(ofs, 4);
- if ofs = 0 then break;
- name[0] := #0;
- fFileStream.ReadBuffer(ch, 1);
- while ch <> #0 do
- begin
- if name[0] <> #255 then
- begin
- Inc(name[0]); name[ord(name[0])] := ch;
- end;
- fFileStream.ReadBuffer(ch, 1);
- end;
- if fFiles.Count > 0 then
- begin
- fi := TSFSFileInfo(fFiles[fFiles.Count-1]);
- fi.fSize := ofs-fi.fOfs;
- end;
- fi := TSFSFileInfo.Create(self);
- fi.fOfs := ofs;
- fi.fSize := 0;
- fi.fName := name;
- until false;
- if fFiles.Count > 0 then
- begin
- fi := TSFSFileInfo(fFiles[fFiles.Count-1]);
- fi.fSize := fFileStream.Size-fi.fOfs;
- end;
-end;
-
-procedure TSFSPlainVolume.MAXReadDirectory ();
-var
- fcnt: LongInt;
- dofs: LongWord;
- fi: TSFSFileInfo;
- name: packed array [0..9] of Char;
-begin
- fFileStream.Seek(4, soCurrent); // skip signature
- fFileStream.ReadBuffer(dofs, 4);
- fFileStream.ReadBuffer(fcnt, 4);
- fFileStream.Position := dofs;
- while fcnt >= 16 do
- begin
- fi := TSFSFileInfo.Create(self);
- FillChar(name[0], Length(name), 0);
- fFileStream.ReadBuffer(name[0], 8);
fFileStream.ReadBuffer(fi.fOfs, 4);
fFileStream.ReadBuffer(fi.fSize, 4);
- fi.fName := PChar(@name[0]);
- Dec(fcnt, 16);
- end;
-end;
-{$ENDIF}
-
-procedure TSFSPlainVolume.ReadDirectory ();
-begin
- case fType of
- sfspvPAK: PAKReadDirectory();
- sfspvSIN: SINReadDirectory();
- {$IFDEF SFS_PLAINFS_FULL}
- sfspvWAD: WADReadDirectory();
- sfspvGRP: GRPReadDirectory();
- sfspvSPE: SPEReadDirectory();
- sfspvWAD2: WAD2ReadDirectory();
- sfspvALL: ALLReadDirectory();
- sfspvDune2: Dune2ReadDirectory();
- sfspvMAX: MAXReadDirectory();
- {$ENDIF}
- else raise ESFSError.Create('invalid plain SFS');
+ Dec(dsize, esz);
end;
end;
function TSFSPlainVolume.OpenFileByIndex (const index: Integer): TStream;
-var
- fs: TStream;
- kill: Boolean;
begin
- result := nil; fs := nil;
+ result := nil;
if fFiles = nil then exit;
if (index < 0) or (index >= fFiles.Count) or (fFiles[index] = nil) then exit;
- if not (fFiles[index] is TSFSExtFileInfo) or
- (Length(TSFSExtFileInfo(fFiles[index]).fVBuf) < 1) then
- begin
- kill := false;
- try
- try
- fs := TFileStream.Create(fFileName, fmOpenRead or {fmShareDenyWrite}fmShareDenyNone);
- kill := true;
- except
- fs := fFileStream;
- end;
- result := TSFSPartialStream.Create(fs,
- TSFSFileInfo(fFiles[index]).fOfs,
- TSFSFileInfo(fFiles[index]).fSize, kill);
- except
- if kill then FreeAndNil(fs);
- result := nil;
- end;
- end
- else
- begin
- kill := false;
- try
- try
- fs := TFileStream.Create(fFileName, fmOpenRead or {fmShareDenyWrite}fmShareDenyNone);
- kill := true;
- except
- fs := fFileStream;
- end;
- result := TSFSPartialStream.Create(fs,
- TSFSExtFileInfo(fFiles[index]).fOfs,
- TSFSExtFileInfo(fFiles[index]).fSize-Length(TSFSExtFileInfo(fFiles[index]).fVBuf),
- kill,
- @(TSFSExtFileInfo(fFiles[index]).fVBuf[0]),
- Length(TSFSExtFileInfo(fFiles[index]).fVBuf));
- except
- if kill then FreeAndNil(fs);
- result := nil;
- end;
- end;
+ result := TSFSPartialStream.Create(fFileStream, TSFSFileInfo(fFiles[index]).fOfs, TSFSFileInfo(fFiles[index]).fSize, false);
end;
{ TSFSPlainVolumeFactory }
-function TSFSPlainVolumeFactory.IsMyVolumePrefix (const prefix: TSFSString): Boolean;
+function TSFSPlainVolumeFactory.IsMyVolumePrefix (const prefix: AnsiString): Boolean;
begin
result :=
StrEquCI1251(prefix, 'pak') or
- StrEquCI1251(prefix, 'sin') or
- StrEquCI1251(prefix, 'quake')
- {$IFDEF SFS_PLAINFS_FULL}
- or
- StrEquCI1251(prefix, 'wad') or // sorry
- StrEquCI1251(prefix, 'wad2') or
- StrEquCI1251(prefix, 'grp') or
- StrEquCI1251(prefix, 'spe') or
- StrEquCI1251(prefix, 'spec') or
- StrEquCI1251(prefix, 'doom') or
- StrEquCI1251(prefix, 'duke3d') or
- StrEquCI1251(prefix, 'abuse') or
- StrEquCI1251(prefix, 'allegro') or
- StrEquCI1251(prefix, 'dune2') or
- StrEquCI1251(prefix, 'max')
- {$ENDIF}
- ;
+ StrEquCI1251(prefix, 'sin');
end;
procedure TSFSPlainVolumeFactory.Recycle (vol: TSFSVolume);
vol.Free();
end;
-function TSFSPlainVolumeFactory.Produce (const prefix, fileName: TSFSString; st: TStream): TSFSVolume;
+function TSFSPlainVolumeFactory.Produce (const prefix, fileName: AnsiString; st: TStream): TSFSVolume;
var
vt: TSFSPlainVolumeType;
+ sign: packed array [0..3] of Char;
+ dsize, dofs: Integer;
begin
+ result := nil;
vt := sfspvNone;
- if PAKCheckMagic(st) then vt := sfspvPAK
- else if SINCheckMagic(st) then vt := sfspvSIN
- {$IFDEF SFS_PLAINFS_FULL}
- else if WADCheckMagic(st) then vt := sfspvWAD
- else if GRPCheckMagic(st) then vt := sfspvGRP
- else if SPECheckMagic(st) then vt := sfspvSPE
- else if WAD2CheckMagic(st) then vt := sfspvWAD2
- //else if ALLCheckMagic(st) then vt := sfspvALL
- else if MAXCheckMagic(st) then vt := sfspvMAX
- //else if Dune2CheckMagic(st) then vt := sfspvDune2 // this must be the last!
- {$ENDIF}
- ;
- if vt <> sfspvNone then
+ st.ReadBuffer(sign[0], 4);
+ st.ReadBuffer(dofs, 4);
+ st.ReadBuffer(dsize, 4);
+ st.Seek(-12, soCurrent);
+ if sign = 'PACK' then
begin
- result := TSFSPlainVolume.Create(fileName, st);
- TSFSPlainVolume(result).fType := vt;
- try
- result.DoDirectoryRead();
- except
- FreeAndNil(result);
- raise;
- end;
+ if (dsize < 0) or (dofs < 0) or (dofs > st.Size) or (dofs+dsize > st.Size) or (dsize mod 64 <> 0) then exit;
+ vt := sfspvPAK;
end
- else result := nil;
+ else if sign = 'SPAK' then
+ begin
+ if (dsize < 0) or (dofs < 0) or (dofs > st.Size) or (dofs+dsize > st.Size) or (dsize mod 64 <> 0) then exit;
+ vt := sfspvSIN;
+ end;
+
+ result := TSFSPlainVolume.Create(fileName, st);
+ TSFSPlainVolume(result).fType := vt;
+ try
+ result.DoDirectoryRead();
+ except
+ FreeAndNil(result);
+ raise;
+ end;
end;
diff --git a/src/sfs/sfsZipFS.pas b/src/sfs/sfsZipFS.pas
index 7a1852a483234eb17258564015322b3b38a76550..892dd636802cbf3e3e3edbb605a6401468064ce8 100644 (file)
--- a/src/sfs/sfsZipFS.pas
+++ b/src/sfs/sfsZipFS.pas
//
{.$DEFINE SFS_DEBUG_ZIPFS}
{.$DEFINE SFS_ZIPFS_FULL}
-{$MODE DELPHI}
-{.$R-}
+{$MODE OBJFPC}
+{$R+}
unit sfsZipFS;
interface
TSFSZipVolumeFactory = class (TSFSVolumeFactory)
public
- function IsMyVolumePrefix (const prefix: TSFSString): Boolean; override;
- function Produce (const prefix, fileName: TSFSString; st: TStream): TSFSVolume; override;
+ function IsMyVolumePrefix (const prefix: AnsiString): Boolean; override;
+ function Produce (const prefix, fileName: AnsiString; st: TStream): TSFSVolume; override;
procedure Recycle (vol: TSFSVolume); override;
end;
{ TSFSZipVolumeFactory }
-function TSFSZipVolumeFactory.IsMyVolumePrefix (const prefix: TSFSString): Boolean;
+function TSFSZipVolumeFactory.IsMyVolumePrefix (const prefix: AnsiString): Boolean;
begin
result :=
StrEquCI1251(prefix, 'zip') or
vol.Free();
end;
-function TSFSZipVolumeFactory.Produce (const prefix, fileName: TSFSString; st: TStream): TSFSVolume;
+function TSFSZipVolumeFactory.Produce (const prefix, fileName: AnsiString; st: TStream): TSFSVolume;
var
vt: TSFSZipVolumeType;
begin
diff --git a/src/sfs/wadcvt.dpr b/src/sfs/wadcvt.dpr
index 1fa828ae227b104858feeefd3d3f2fcc685bdb8e..34ffcfbbb74f84bc68fb2c6b86aff164aca10a9f 100644 (file)
--- a/src/sfs/wadcvt.dpr
+++ b/src/sfs/wadcvt.dpr
uses
SysUtils,
Classes,
- SDL2 in '../lib/sdl2/sdl2.pas',
- utils in '../shared/utils.pas',
+ utils in '../shared/utils.pas',
+ xstreams in '../shared/xstreams.pas',
sfs,
sfsPlainFS,
sfsZipFS,
- sfsMemFS,
zipper;
diff --git a/src/shared/utils.pas b/src/shared/utils.pas
index 712923e93b6c2a2fa2abefe95a1b282f51429ebc..235dee4a95627e1a39f8335aa81ade78f6648f1f 100644 (file)
--- a/src/shared/utils.pas
+++ b/src/shared/utils.pas
interface
+uses
+ SysUtils, Classes;
+
+
// does filename have one of ".wad", ".pk3", ".zip" extensions?
function hasWadExtension (fn: AnsiString): Boolean;
// nobody cares about shitdoze, so i'll use the same code path for it
function findFileCI (var pathname: AnsiString; lastIsDir: Boolean=false): Boolean;
+// they throws
+function openDiskFileRO (pathname: AnsiString): TStream;
+function createDiskFile (pathname: AnsiString): TStream;
-implementation
-
-uses
- SysUtils;
+implementation
function hasWadExtension (fn: AnsiString): Boolean;
begin
end;
+function openDiskFileRO (pathname: AnsiString): TStream;
+begin
+ if not findFileCI(pathname) then raise Exception.Create('can''t open file "'+pathname+'"');
+ result := TFileStream.Create(pathname, fmOpenRead or {fmShareDenyWrite}fmShareDenyNone);
+end;
+
+function createDiskFile (pathname: AnsiString): TStream;
+var
+ path: AnsiString;
+begin
+ path := ExtractFilePath(pathname);
+ if length(path) > 0 then
+ begin
+ if not findFileCI(path, true) then raise Exception.Create('can''t create file "'+pathname+'"');
+ end;
+ result := TFileStream.Create(path+ExtractFileName(pathname), fmCreate);
+end;
+
+
end.
index 3cce5df6c0053f1b7f0c5445799feaa78a06c97b..343c92f684fe81ba28ece6a79e502db30675e3da 100644 (file)
--- a/src/shared/wadreader.pas
+++ b/src/shared/wadreader.pas
TWADFile = class(TObject)
private
- fFileName: string; // empty: not opened
+ fFileName: AnsiString; // empty: not opened
fIter: TSFSFileList;
function getIsOpen (): Boolean;
procedure FreeWAD();
- function ReadFile (FileName: string): Boolean;
+ function ReadFile (FileName: AnsiString): Boolean;
function ReadMemory (Data: Pointer; Len: LongWord): Boolean;
- function GetResource (Section, Resource: string; var pData: Pointer; var Len: Integer): Boolean;
- function GetResourcesList (Section: string): SArray;
+ function GetResource (Section, Resource: AnsiString; var pData: Pointer; var Len: Integer): Boolean;
+ function GetResourcesList (Section: AnsiString): SArray;
property isOpen: Boolean read getIsOpen;
end;
-procedure g_ProcessResourceStr (ResourceStr: String; var FileName, SectionName, ResourceName: String); overload;
-procedure g_ProcessResourceStr (ResourceStr: String; FileName, SectionName, ResourceName: PString); overload;
+procedure g_ProcessResourceStr (ResourceStr: AnsiString; var FileName, SectionName, ResourceName: AnsiString); overload;
+procedure g_ProcessResourceStr (ResourceStr: AnsiString; FileName, SectionName, ResourceName: PString); overload;
-// return fixed string or empty string
-function findDiskWad (fname: string): string;
+// return fixed AnsiString or empty AnsiString
+function findDiskWad (fname: AnsiString): AnsiString;
implementation
SysUtils, Classes, BinEditor, e_log, g_options, utils;
-function findDiskWad (fname: string): string;
+function findDiskWad (fname: AnsiString): AnsiString;
begin
result := '';
if not findFileCI(fname) then
end;
-procedure g_ProcessResourceStr (ResourceStr: String; var FileName, SectionName, ResourceName: String);
+procedure g_ProcessResourceStr (ResourceStr: AnsiString; var FileName, SectionName, ResourceName: AnsiString);
var
a, i: Integer;
begin
//e_WriteLog(Format('g_ProcessResourceStr0: [%s]', [ResourceStr]), MSG_NOTIFY);
- for i := Length(ResourceStr) downto 1 do
- if ResourceStr[i] = ':' then
- Break;
-
+ for i := Length(ResourceStr) downto 1 do if ResourceStr[i] = ':' then break;
FileName := Copy(ResourceStr, 1, i-1);
-
- for a := i+1 to Length(ResourceStr) do
- if (ResourceStr[a] = '\') or (ResourceStr[a] = '/') then Break;
-
+ for a := i+1 to Length(ResourceStr) do if (ResourceStr[a] = '\') or (ResourceStr[a] = '/') then Break;
ResourceName := Copy(ResourceStr, a+1, Length(ResourceStr)-Abs(a));
SectionName := Copy(ResourceStr, i+1, Length(ResourceStr)-Length(ResourceName)-Length(FileName)-2);
end;
procedure g_ProcessResourceStr (ResourceStr: AnsiString; FileName, SectionName, ResourceName: PAnsiString);
var
a, i, l1, l2: Integer;
-
begin
//e_WriteLog(Format('g_ProcessResourceStr1: [%s]', [ResourceStr]), MSG_NOTIFY);
- for i := Length(ResourceStr) downto 1 do
- if ResourceStr[i] = ':' then
- Break;
-
+ for i := Length(ResourceStr) downto 1 do if ResourceStr[i] = ':' then break;
if FileName <> nil then
- begin
- FileName^ := Copy(ResourceStr, 1, i-1);
- l1 := Length(FileName^);
- end
+ begin
+ FileName^ := Copy(ResourceStr, 1, i-1);
+ l1 := Length(FileName^);
+ end
else
+ begin
l1 := 0;
-
- for a := i+1 to Length(ResourceStr) do
- if (ResourceStr[a] = '\') or (ResourceStr[a] = '/') then Break;
-
+ end;
+ for a := i+1 to Length(ResourceStr) do if (ResourceStr[a] = '\') or (ResourceStr[a] = '/') then break;
if ResourceName <> nil then
- begin
- ResourceName^ := Copy(ResourceStr, a+1, Length(ResourceStr)-Abs(a));
- l2 := Length(ResourceName^);
- end
+ begin
+ ResourceName^ := Copy(ResourceStr, a+1, Length(ResourceStr)-Abs(a));
+ l2 := Length(ResourceName^);
+ end
else
+ begin
l2 := 0;
-
- if SectionName <> nil then
- SectionName^ := Copy(ResourceStr, i+1, Length(ResourceStr)-l2-l1-2);
+ end;
+ if SectionName <> nil then SectionName^ := Copy(ResourceStr, i+1, Length(ResourceStr)-l2-l1-2);
end;
end;
-function removeExt (s: string): string;
+function removeExt (s: AnsiString): AnsiString;
var
i: Integer;
begin
result := s;
end;
-function TWADFile.GetResource (Section, Resource: string; var pData: Pointer; var Len: Integer): Boolean;
+function TWADFile.GetResource (Section, Resource: AnsiString; var pData: Pointer; var Len: Integer): Boolean;
var
f: Integer;
fi: TSFSFileInfo;
fs: TStream;
fpp: Pointer;
- //fn: string;
+ //fn: AnsiString;
begin
Result := False;
if not isOpen or (fIter = nil) then Exit;
end;
-function TWADFile.GetResourcesList (Section: string): SArray;
+function TWADFile.GetResourcesList (Section: AnsiString): SArray;
var
f: Integer;
fi: TSFSFileInfo;
end;
-function TWADFile.ReadFile (FileName: string): Boolean;
+function TWADFile.ReadFile (FileName: AnsiString): Boolean;
var
- rfn: string;
+ rfn: AnsiString;
//f: Integer;
//fi: TSFSFileInfo;
begin
function TWADFile.ReadMemory (Data: Pointer; Len: LongWord): Boolean;
var
- fn: string;
+ fn: AnsiString;
st: TStream = nil;
//f: Integer;
//fi: TSFSFileInfo;
diff --git a/src/sfs/xstreams.pas b/src/shared/xstreams.pas
similarity index 63%
rename from src/sfs/xstreams.pas
rename to src/shared/xstreams.pas
index 1861c616d0972578f2fcb967dc051dc4e9fc9443..f62582b1bd0854acf19a77242f37788fb80732b9 100644 (file)
rename from src/sfs/xstreams.pas
rename to src/shared/xstreams.pas
index 1861c616d0972578f2fcb967dc051dc4e9fc9443..f62582b1bd0854acf19a77242f37788fb80732b9 100644 (file)
--- a/src/sfs/xstreams.pas
+++ b/src/shared/xstreams.pas
// special stream classes
-{$MODE DELPHI}
-{.$R-}
+{$MODE OBJFPC}
+{$R+}
unit xstreams;
interface
uses
- SysUtils, Classes, SDL2;
+ SysUtils, Classes,
+ zbase{z_stream};
type
- // ïîòîê-îá¸ðòêà äëÿ SDL_RWops
- TSFSSDLStream = class(TStream)
- protected
- fRW: PSDL_RWops; // SDL-íàÿ ïðîêëàäêà
- fFreeSource: Boolean; // óáèâàòü èñõîäíèê ïðè ïîìèðàíèè?
-
- public
- constructor Create (aSrc: PSDL_RWops; aFreeSource: Boolean=true);
- destructor Destroy (); override;
-
- function Read (var buffer; count: LongInt): LongInt; override;
- function Write (const buffer; count: LongInt): LongInt; override;
- function Seek (const offset: Int64; origin: TSeekOrigin): Int64; override;
- end;
+ XStreamError = class(Exception);
// read-only ïîòîê äëÿ èçâëå÷åíèÿ èç èñõîäíîãî òîëüêî êóñî÷êà
TSFSPartialStream = class(TStream)
function Seek (const offset: Int64; origin: TSeekOrigin): Int64; override;
end;
+ // this stream can kill both `proxied` and `guarded` streams on closing
TSFSGuardStream = class(TStream)
protected
fSource: TStream; // èñõîäíûé ïîòîê
function Write (const buffer; count: LongInt): LongInt; override;
end;
+ TUnZStream = class(TStream)
+ protected
+ fSrcSt: TStream;
+ fZlibSt: z_stream;
+ fBuffer: PByte;
+ fPos: Int64;
+ fSkipHeader: Boolean;
+ fSize: Int64; // can be -1
+ fSrcStPos: Int64;
+ fSkipToPos: Int64; // >0: skip to this position
+
+ procedure reset ();
+ function readBuf (var buffer; count: LongInt): LongInt;
+ procedure fixPos ();
+ procedure determineSize ();
-implementation
-
-uses
- sfs; // for ESFSError
-
-{ TSFSSDLStream }
-constructor TSFSSDLStream.Create (aSrc: PSDL_RWops; aFreeSource: Boolean=true);
-begin
- inherited Create();
- //ASSERT(aSrc <> nil);
- fRW := aSrc;
- fFreeSource := aFreeSource;
-end;
-
-destructor TSFSSDLStream.Destroy ();
-begin
- if fFreeSource and (fRW <> nil) then SDL_FreeRW(fRW);
- inherited Destroy();
-end;
+ public
+ // `aSize` can be -1 if stream size is unknown
+ constructor create (asrc: TStream; aSize: Int64; aSkipHeader: boolean=false);
+ destructor destroy (); override;
+ function read (var buffer; count: LongInt): LongInt; override;
+ function write (const buffer; count: LongInt): LongInt; override;
+ function seek (const offset: Int64; origin: TSeekOrigin): Int64; override;
+ end;
-function TSFSSDLStream.Read (var buffer; count: LongInt): LongInt;
-begin
- if (fRW = nil) or (count <= 0) then begin result := 0; exit; end;
- result := SDL_RWread(fRW, @buffer, 1, count);
-end;
-function TSFSSDLStream.Write (const buffer; count: LongInt): LongInt;
-begin
- if (fRW = nil) or (count <= 0) then begin result := 0; exit; end;
- result := SDL_RWwrite(fRW, @buffer, 1, count);
-end;
+implementation
-function TSFSSDLStream.Seek (const offset: Int64; origin: TSeekOrigin): Int64;
-var
- ss: Integer;
-begin
- if fRW = nil then begin result := 0; exit; end;
- case origin of
- soBeginning: ss := RW_SEEK_SET;
- soCurrent: ss := RW_SEEK_CUR;
- soEnd: ss := RW_SEEK_END;
- else raise ESFSError.Create('invalid Seek() call');
- // äðóãèõ íå áûâàåò. à ó êîãî áûâàåò, òîìó ÿ íå äîêòîð.
- end;
- result := SDL_RWseek(fRW, offset, ss);
- if result = -1 then raise ESFSError.Create('Seek() error');
-end;
+uses
+ zinflate;
{ TSFSPartialStream }
function TSFSPartialStream.Write (const buffer; count: LongInt): LongInt;
begin
result := 0;
- raise ESFSError.Create('can''t write to read-only stream');
+ raise XStreamError.Create('can''t write to read-only stream');
// à íå õîäè, íåõîðîøèé, â íàø ñàäèê ãóëÿòü!
end;
pc: Pointer;
rd: LongInt;
begin
- if count < 0 then raise ESFSError.Create('invalid Read() call'); // ñêàçî÷íûé äîëáî¸á...
+ if count < 0 then raise XStreamError.Create('invalid Read() call'); // ñêàçî÷íûé äîëáî¸á...
if count = 0 then begin result := 0; exit; end;
pc := @buffer;
result := 0;
soBeginning: result := offset;
soCurrent: result := offset+fCurrentPos;
soEnd: result := fSize+offset;
- else raise ESFSError.Create('invalid Seek() call');
+ else raise XStreamError.Create('invalid Seek() call');
// äðóãèõ íå áûâàåò. à ó êîãî áûâàåò, òîìó ÿ íå äîêòîð.
end;
if result < 0 then result := 0
function TSFSMemoryStreamRO.Write (const buffer; count: LongInt): LongInt;
begin
result := 0;
- raise ESFSError.Create('can''t write to read-only stream');
+ raise XStreamError.Create('can''t write to read-only stream');
// ñîâñåì ñáðåíäèë...
end;
+// ////////////////////////////////////////////////////////////////////////// //
+{ TUnZStream }
+const ZBufSize = 32768; // size of the buffer used for temporarily storing data from the child stream
+
+constructor TUnZStream.create (asrc: TStream; aSize: Int64; aSkipHeader: boolean=false);
+var
+ err: Integer;
+begin
+ fPos := 0;
+ fSkipToPos := -1;
+ fSrcSt := asrc;
+ fSize := aSize;
+ GetMem(fBuffer, ZBufSize);
+ fSkipHeader := aSkipHeader;
+ if fSkipHeader then err := inflateInit2(fZlibSt, -MAX_WBITS) else err := inflateInit(fZlibSt);
+ if err <> Z_OK then raise XStreamError.Create(zerror(err));
+ fSrcStPos := fSrcSt.position;
+end;
+
+destructor TUnZStream.destroy ();
+begin
+ inflateEnd(fZlibSt);
+ FreeMem(fBuffer);
+ fSrcSt.Free;
+ inherited destroy;
+end;
+
+function TUnZStream.readBuf (var buffer; count: LongInt): LongInt;
+var
+ err: Integer;
+ lastavail: LongInt;
+begin
+ fZlibSt.next_out := @buffer;
+ fZlibSt.avail_out := count;
+ lastavail := count;
+ while fZlibSt.avail_out <> 0 do
+ begin
+ if fZlibSt.avail_in = 0 then
+ begin
+ // refill the buffer
+ fZlibSt.next_in := fBuffer;
+ fZlibSt.avail_in := fSrcSt.read(Fbuffer^, ZBufSize);
+ //Inc(compressed_read, fZlibSt.avail_in);
+ Inc(fPos, lastavail-fZlibSt.avail_out);
+ lastavail := fZlibSt.avail_out;
+ end;
+ err := inflate(fZlibSt, Z_NO_FLUSH);
+ if err = Z_STREAM_END then fSize := fPos; break;
+ if err <> Z_OK then raise XStreamError.Create(zerror(err));
+ end;
+ //if err = Z_STREAM_END then Dec(compressed_read, fZlibSt.avail_in);
+ Inc(fPos, lastavail-fZlibSt.avail_out);
+ result := count-fZlibSt.avail_out;
+end;
+
+procedure TUnZStream.fixPos ();
+var
+ buf: array [0..4095] of Byte;
+ rd, rr: LongInt;
+begin
+ if fSkipToPos < 0 then exit;
+ if fSkipToPos > fPos then reset();
+ while fPos < fSkipToPos do
+ begin
+ if fSkipToPos-fPos > 4096 then rd := 4096 else rd := LongInt(fSkipToPos-fPos);
+ rr := readBuf(buf, rd);
+ if rd <> rr then raise XStreamError.Create('seek error');
+ end;
+ fSkipToPos := -1;
+end;
+
+procedure TUnZStream.determineSize ();
+var
+ buf: array [0..4095] of Byte;
+ rd: LongInt;
+begin
+ if fSize >= 0 then exit;
+ while true do
+ begin
+ rd := readBuf(buf, 4096);
+ if rd <> 4096 then break;
+ end;
+ fSize := fPos;
+end;
+
+function TUnZStream.read (var buffer; count: LongInt): LongInt;
+begin
+ if fSkipToPos >= 0 then fixPos();
+ result := readBuf(buffer, count);
+end;
+
+function TUnZStream.write (const buffer; count: LongInt): LongInt;
+begin
+ result := 0;
+ raise XStreamError.Create('can''t write to read-only stream');
+end;
+
+procedure TUnZStream.reset ();
+var
+ err: Integer;
+begin
+ fSrcSt.position := fSrcStPos;
+ fPos := 0;
+ inflateEnd(fZlibSt);
+ if fSkipHeader then err := inflateInit2(fZlibSt, -MAX_WBITS) else err := inflateInit(fZlibSt);
+ if err <> Z_OK then raise XStreamError.Create(zerror(err));
+end;
+
+function TUnZStream.Seek (const offset: Int64; origin: TSeekOrigin): Int64;
+begin
+ case origin of
+ soBeginning: result := offset;
+ soCurrent: result := offset+fPos;
+ soEnd: begin if fSize = -1 then determineSize(); result := fSize+offset; end;
+ else raise XStreamError.Create('invalid Seek() call');
+ // äðóãèõ íå áûâàåò. à ó êîãî áûâàåò, òîìó ÿ íå äîêòîð.
+ end;
+ if result < 0 then result := 0;
+ fSkipToPos := result;
+end;
+
+
end.
diff --git a/src/unused/xstreams_sdl.pas b/src/unused/xstreams_sdl.pas
--- /dev/null
@@ -0,0 +1,76 @@
+// special stream classes
+{$MODE OBJFPC}
+{$R+}
+unit xstreams_sdl;
+
+interface
+
+uses
+ SysUtils, Classes, xstreams;
+
+
+type
+ // ïîòîê-îá¸ðòêà äëÿ SDL_RWops
+ TSFSSDLStream = class(TStream)
+ protected
+ fRW: PSDL_RWops; // SDL-íàÿ ïðîêëàäêà
+ fFreeSource: Boolean; // óáèâàòü èñõîäíèê ïðè ïîìèðàíèè?
+
+ public
+ constructor Create (aSrc: PSDL_RWops; aFreeSource: Boolean=true);
+ destructor Destroy (); override;
+
+ function Read (var buffer; count: LongInt): LongInt; override;
+ function Write (const buffer; count: LongInt): LongInt; override;
+ function Seek (const offset: Int64; origin: TSeekOrigin): Int64; override;
+ end;
+
+
+implementation
+
+
+{ TSFSSDLStream }
+constructor TSFSSDLStream.Create (aSrc: PSDL_RWops; aFreeSource: Boolean=true);
+begin
+ inherited Create();
+ //ASSERT(aSrc <> nil);
+ fRW := aSrc;
+ fFreeSource := aFreeSource;
+end;
+
+destructor TSFSSDLStream.Destroy ();
+begin
+ if fFreeSource and (fRW <> nil) then SDL_FreeRW(fRW);
+ inherited Destroy();
+end;
+
+function TSFSSDLStream.Read (var buffer; count: LongInt): LongInt;
+begin
+ if (fRW = nil) or (count <= 0) then begin result := 0; exit; end;
+ result := SDL_RWread(fRW, @buffer, 1, count);
+end;
+
+function TSFSSDLStream.Write (const buffer; count: LongInt): LongInt;
+begin
+ if (fRW = nil) or (count <= 0) then begin result := 0; exit; end;
+ result := SDL_RWwrite(fRW, @buffer, 1, count);
+end;
+
+function TSFSSDLStream.Seek (const offset: Int64; origin: TSeekOrigin): Int64;
+var
+ ss: Integer;
+begin
+ if fRW = nil then begin result := 0; exit; end;
+ case origin of
+ soBeginning: ss := RW_SEEK_SET;
+ soCurrent: ss := RW_SEEK_CUR;
+ soEnd: ss := RW_SEEK_END;
+ else raise XStreamError.Create('invalid Seek() call');
+ // äðóãèõ íå áûâàåò. à ó êîãî áûâàåò, òîìó ÿ íå äîêòîð.
+ end;
+ result := SDL_RWseek(fRW, offset, ss);
+ if result = -1 then raise XStreamError.Create('Seek() error');
+end;
+
+
+end.