src/flexui/fui_wadread.pas

   1 (* coded by Ketmar // Invisible Vector <ketmar@ketmar.no-ip.org>
   2  * Understanding is not required. Only obedience.
   3  *
   4  * This program is free software: you can redistribute it and/or modify
   5  * it under the terms of the GNU General Public License as published by
   6  * the Free Software Foundation, version 3 of the License ONLY.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this program. If not, see <http://www.gnu.org/licenses/>.
  15  *)
  16 {$INCLUDE ../shared/a_modes.inc}
  17 {.$DEFINE FUI_WADREAD_DEBUG}
  18 unit fui_wadread;
  19
  20 interface
  21
  22 uses
  23   SysUtils, Classes;
  24
  25
  26 function fuiAddWad (const wadfile: AnsiString): Boolean;
  27
  28 // returns `nil` if file wasn't found
  29 function fuiOpenFile (const fname: AnsiString): TStream;
  30
  31
  32 var
  33   fuiDiskFirst: Boolean = true;
  34
  35
  36 implementation
  37
  38 uses
  39   sfs, utils;
  40
  41
  42 // ////////////////////////////////////////////////////////////////////////// //
  43 type
  44   TFUIWad = class
  45   public
  46     wadname: AnsiString;
  47     iter: TSFSFileList;
  48
  49   public
  50     constructor Create (const awadname: AnsiString);
  51     destructor Destroy (); override;
  52
  53     // returns `nil` if file wasn't found
  54     function openFile (const fname: AnsiString): TStream;
  55   end;
  56
  57
  58 constructor TFUIWad.Create (const awadname: AnsiString);
  59 {$IFDEF FUI_WADREAD_DEBUG}
  60 var
  61   f: Integer;
  62 {$ENDIF}
  63 begin
  64   if not SFSAddDataFile(awadname, true) then raise Exception.Create('cannot open wad');
  65   wadname := awadname;
  66   iter := SFSFileList(awadname);
  67   {$IFDEF FUI_WADREAD_DEBUG}
  68   if (iter <> nil) then
  69   begin
  70     writeln('==== ', awadname, ' ====');
  71     for f := 0 to iter.Count-1 do
  72     begin
  73       if (iter.Files[f] = nil) then continue;
  74       writeln('  ', f, ': ', iter.Files[f].path, iter.Files[f].name);
  75     end;
  76     writeln('========');
  77   end;
  78   {$ENDIF}
  79 end;
  80
  81
  82 destructor TFUIWad.Destroy ();
  83 begin
  84   wadname := '';
  85   FreeAndNil(iter);
  86   inherited;
  87 end;
  88
  89
  90 function TFUIWad.openFile (const fname: AnsiString): TStream;
  91 var
  92   f: Integer;
  93   fi: TSFSFileInfo;
  94 begin
  95   result := nil;
  96   if (iter = nil) then exit;
  97   // backwards, due to possible similar names and such
  98   for f := iter.Count-1 downto 0 do
  99   begin
 100     fi := iter.Files[f];
 101     if (fi = nil) then continue;
 102     if (StrEquCI1251(fi.path+fi.name, fname)) then
 103     begin
 104       try
 105         result := iter.volume.OpenFileByIndex(f);
 106       except
 107         result := nil;
 108       end;
 109       if (result <> nil) then exit;
 110     end;
 111   end;
 112 end;
 113
 114
 115
 116 // ////////////////////////////////////////////////////////////////////////// //
 117 function getExeDataPath (): AnsiString;
 118 begin
 119   result := getFilenamePath(ParamStr(0))+'data/';
 120 end;
 121
 122
 123 // ////////////////////////////////////////////////////////////////////////// //
 124 var
 125   wadlist: array of TFUIWad = nil;
 126
 127
 128 function fuiAddWad (const wadfile: AnsiString): Boolean;
 129 var
 130   exepath: AnsiString;
 131   awadname: AnsiString;
 132   f, c: Integer;
 133   wad: TFUIWad;
 134 begin
 135   result := false;
 136
 137   // find disk file
 138   if (Length(wadfile) = 0) then exit;
 139
 140   if (Length(wadfile) > 2) and (wadfile[1] = '.') and ((wadfile[2] = '/') or (wadfile[2] = '\')) then
 141   begin
 142     awadname := wadfile;
 143     awadname := findDiskWad(awadname);
 144     if (Length(awadname) = 0) then
 145     begin
 146       writeln('WARNING: FlexUI WAD ''', wadfile, ''' not found');
 147       exit;
 148     end;
 149   end
 150   else
 151   begin
 152     exepath := getExeDataPath();
 153     awadname := exepath+wadfile;
 154     awadname := findDiskWad(awadname);
 155     if (Length(awadname) = 0) then
 156     begin
 157       awadname := wadfile;
 158       awadname := findDiskWad(awadname);
 159       if (Length(awadname) = 0) then
 160       begin
 161         writeln('WARNING: FlexUI WAD ''', exepath+wadfile, ''' not found');
 162         exit;
 163       end;
 164     end;
 165   end;
 166
 167   // check if we already have this file opened
 168   for f := 0 to High(wadlist) do
 169   begin
 170     wad := wadlist[f];
 171     if (strEquCI1251(awadname, wad.wadname)) then
 172     begin
 173       // i found her! move it to the bottom of the list, so it will be checked first
 174       for c := f+1 to High(wadlist) do wadlist[c-1] := wadlist[c];
 175       wadlist[High(wadlist)] := wad;
 176       exit;
 177     end;
 178   end;
 179
 180   // create new wad file
 181   try
 182     wad := TFUIWad.Create(awadname);
 183   except // sorry
 184     writeln('WARNING: error opening FlexUI WAD ''', wadfile, '''');
 185     exit;
 186   end;
 187
 188   SetLength(wadlist, Length(wadlist)+1);
 189   wadlist[High(wadlist)] := wad;
 190   {$IFDEF FUI_WADREAD_DEBUG}writeln('FUI: added WAD: ''', wad.wadname, '''');{$ENDIF}
 191
 192   result := true;
 193 end;
 194
 195
 196 // ////////////////////////////////////////////////////////////////////////// //
 197 // returns `nil` if file wasn't found
 198 function tryDiskFile (const fname: AnsiString): TStream;
 199 var
 200   fn: AnsiString;
 201 begin
 202   fn := getExeDataPath()+fname;
 203   try
 204     result := openDiskFileRO(fn);
 205     {$IFDEF FUI_WADREAD_DEBUG}writeln('FUI: opened DISK file: ''', fn, '''');{$ENDIF}
 206   except
 207     result := nil;
 208   end;
 209 end;
 210
 211
 212 // returns `nil` if file wasn't found
 213 function fuiOpenFile (const fname: AnsiString): TStream;
 214 var
 215   f: Integer;
 216 begin
 217   // disk
 218   if (fuiDiskFirst) then
 219   begin
 220     result := tryDiskFile(fname);
 221     if (result <> nil) then exit;
 222   end;
 223   // wads
 224   for f := High(wadlist) downto 0 do
 225   begin
 226     result := wadlist[f].openFile(fname);
 227     if (result <> nil) then
 228     begin
 229       {$IFDEF FUI_WADREAD_DEBUG}writeln('FUI: opened WAD file: ''', fname, ''' (from ''', wadlist[f].wadname, ''')');{$ENDIF}
 230       exit;
 231     end;
 232   end;
 233   // disk
 234   if (not fuiDiskFirst) then
 235   begin
 236     result := tryDiskFile(fname);
 237     if (result <> nil) then exit;
 238   end;
 239   {$IFDEF FUI_WADREAD_DEBUG}writeln('FUI: file: ''', fname, ''' NOT FOUND!');{$ENDIF}
 240   result := nil;
 241 end;
 242
 243
 244 end.