src/shared/wadreader.pas

   1 (* Copyright (C)  DooM 2D:Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, either version 3 of the License, or
   6  * (at your option) any later version.
   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 a_modes.inc}
  17 unit wadreader;
  18
  19 {$DEFINE SFS_DFWAD_DEBUG}
  20 {$DEFINE SFS_MAPDETECT_FX}
  21
  22 interface
  23
  24 uses
  25   mempool, sfs, xstreams, Classes;
  26
  27
  28 type
  29   SArray = array of ShortString;
  30
  31   TWADFile = class(TPoolObject)
  32   private
  33     fFileName: AnsiString; // empty: not opened
  34     fIter: TSFSFileList;
  35
  36     function getIsOpen (): Boolean;
  37     function isMapResource (idx: Integer): Boolean;
  38
  39     function GetResourceEx (name: AnsiString; wantMap: Boolean; var pData: Pointer; var Len: Integer; logError: Boolean=true): Boolean;
  40
  41    public
  42     constructor Create ();
  43     destructor Destroy (); override;
  44
  45     procedure FreeWAD ();
  46
  47     function ReadFile (FileName: AnsiString): Boolean;
  48     function ReadMemory (Data: Pointer; Len: LongWord): Boolean;
  49
  50     function GetResource (name: AnsiString; var pData: Pointer; var Len: Integer; logError: Boolean=true): Boolean;
  51     function GetMapResource (name: AnsiString; var pData: Pointer; var Len: Integer; logError: Boolean=true): Boolean;
  52     function GetMapResources (): SArray;
  53
  54     // returns `nil` if file wasn't found
  55     function openFileStream (name: AnsiString): TStream;
  56
  57     property isOpen: Boolean read getIsOpen;
  58   end;
  59
  60
  61 function g_ExtractWadName (resourceStr: AnsiString): AnsiString;
  62 function g_ExtractWadNameNoPath (resourceStr: AnsiString): AnsiString;
  63 function g_ExtractFilePath (resourceStr: AnsiString): AnsiString;
  64 function g_ExtractFileName (resourceStr: AnsiString): AnsiString; // without path
  65 function g_ExtractFilePathName (resourceStr: AnsiString): AnsiString;
  66
  67 // return fixed AnsiString or empty AnsiString
  68 function findDiskWad (fname: AnsiString): AnsiString;
  69
  70
  71 var
  72   wadoptDebug: Boolean = false;
  73   wadoptFast: Boolean = false;
  74
  75
  76 implementation
  77
  78 uses
  79   SysUtils, e_log, utils, MAPDEF, xdynrec;
  80
  81
  82 function findDiskWad (fname: AnsiString): AnsiString;
  83 begin
  84   result := '';
  85   if not findFileCI(fname) then
  86   begin
  87     //e_WriteLog(Format('findDiskWad: error looking for [%s]', [fname]), MSG_NOTIFY);
  88     if StrEquCI1251(ExtractFileExt(fname), '.wad') then
  89     begin
  90       fname := ChangeFileExt(fname, '.pk3');
  91       //e_WriteLog(Format('  looking for [%s]', [fname]), MSG_NOTIFY);
  92       if not findFileCI(fname) then
  93       begin
  94         fname := ChangeFileExt(fname, '.zip');
  95         //e_WriteLog(Format('  looking for [%s]', [fname]), MSG_NOTIFY);
  96         if not findFileCI(fname) then exit;
  97       end;
  98     end
  99     else
 100     begin
 101       exit;
 102     end;
 103   end;
 104   //e_WriteLog(Format('findDiskWad: FOUND [%s]', [fname]), MSG_NOTIFY);
 105   result := fname;
 106 end;
 107
 108
 109 function normSlashes (s: AnsiString): AnsiString;
 110 var
 111   f: Integer;
 112 begin
 113   for f := 1 to length(s) do if s[f] = '\' then s[f] := '/';
 114   result := s;
 115 end;
 116
 117 function g_ExtractWadNameNoPath (resourceStr: AnsiString): AnsiString;
 118 var
 119   f, c: Integer;
 120 begin
 121   for f := length(resourceStr) downto 1 do
 122   begin
 123     if resourceStr[f] = ':' then
 124     begin
 125       result := normSlashes(Copy(resourceStr, 1, f-1));
 126       c := length(result);
 127       while (c > 0) and (result[c] <> '/') do Dec(c);
 128       if c > 0 then result := Copy(result, c+1, length(result));
 129       exit;
 130     end;
 131   end;
 132   result := '';
 133 end;
 134
 135 function g_ExtractWadName (resourceStr: AnsiString): AnsiString;
 136 var
 137   f: Integer;
 138 begin
 139   for f := length(resourceStr) downto 1 do
 140   begin
 141     if resourceStr[f] = ':' then
 142     begin
 143       result := normSlashes(Copy(resourceStr, 1, f-1));
 144       exit;
 145     end;
 146   end;
 147   result := '';
 148 end;
 149
 150 function g_ExtractFilePath (resourceStr: AnsiString): AnsiString;
 151 var
 152   f, lastSlash: Integer;
 153 begin
 154   result := '';
 155   lastSlash := -1;
 156   for f := length(resourceStr) downto 1 do
 157   begin
 158     if (lastSlash < 0) and (resourceStr[f] = '\') or (resourceStr[f] = '/') then lastSlash := f;
 159     if resourceStr[f] = ':' then
 160     begin
 161       if lastSlash > 0 then
 162       begin
 163         result := normSlashes(Copy(resourceStr, f, lastSlash-f));
 164         while (length(result) > 0) and (result[1] = '/') do Delete(result, 1, 1);
 165       end;
 166       exit;
 167     end;
 168   end;
 169   if lastSlash > 0 then result := normSlashes(Copy(resourceStr, 1, lastSlash-1));
 170 end;
 171
 172 function g_ExtractFileName (resourceStr: AnsiString): AnsiString; // without path
 173 var
 174   f, lastSlash: Integer;
 175 begin
 176   result := '';
 177   lastSlash := -1;
 178   for f := length(resourceStr) downto 1 do
 179   begin
 180     if (lastSlash < 0) and (resourceStr[f] = '\') or (resourceStr[f] = '/') then lastSlash := f;
 181     if resourceStr[f] = ':' then
 182     begin
 183       if lastSlash > 0 then result := Copy(resourceStr, lastSlash+1, length(resourceStr));
 184       exit;
 185     end;
 186   end;
 187   if lastSlash > 0 then result := Copy(resourceStr, lastSlash+1, length(resourceStr));
 188 end;
 189
 190 function g_ExtractFilePathName (resourceStr: AnsiString): AnsiString;
 191 var
 192   f: Integer;
 193 begin
 194   result := '';
 195   for f := length(resourceStr) downto 1 do
 196   begin
 197     if resourceStr[f] = ':' then
 198     begin
 199       result := normSlashes(Copy(resourceStr, f+1, length(resourceStr)));
 200       while (length(result) > 0) and (result[1] = '/') do Delete(result, 1, 1);
 201       exit;
 202     end;
 203   end;
 204   result := normSlashes(resourceStr);
 205   while (length(result) > 0) and (result[1] = '/') do Delete(result, 1, 1);
 206 end;
 207
 208
 209
 210 { TWADFile }
 211 constructor TWADFile.Create();
 212 begin
 213   fFileName := '';
 214 end;
 215
 216
 217 destructor TWADFile.Destroy();
 218 begin
 219   FreeWAD();
 220   inherited;
 221 end;
 222
 223
 224 function TWADFile.getIsOpen (): Boolean;
 225 begin
 226   result := (fFileName <> '');
 227 end;
 228
 229
 230 procedure TWADFile.FreeWAD();
 231 begin
 232   if fIter <> nil then FreeAndNil(fIter);
 233   //if fFileName <> '' then e_WriteLog(Format('TWADFile.ReadFile: [%s] closed', [fFileName]), MSG_NOTIFY);
 234   fFileName := '';
 235 end;
 236
 237
 238 //FIXME: detect text maps properly here
 239 function TWADFile.isMapResource (idx: Integer): Boolean;
 240 var
 241   //sign: packed array [0..2] of Char;
 242   fs: TStream = nil;
 243 begin
 244   result := false;
 245   if not isOpen or (fIter = nil) then exit;
 246   if (idx < 0) or (idx >= fIter.Count) then exit;
 247   try
 248     fs := fIter.volume.OpenFileByIndex(idx);
 249     result := TDynMapDef.canBeMap(fs);
 250     (*
 251     fs.readBuffer(sign, 3);
 252     result := (sign = MAP_SIGNATURE);
 253     if not result then result := (sign[0] = 'm') and (sign[1] = 'a') and (sign[2] = 'p');
 254     *)
 255   except
 256     fs.Free();
 257     result := false; // just in case
 258     exit;
 259   end;
 260   fs.Free();
 261 end;
 262
 263
 264 // returns `nil` if file wasn't found
 265 function TWADFile.openFileStream (name: AnsiString): TStream;
 266 var
 267   f: Integer;
 268   fi: TSFSFileInfo;
 269 begin
 270   result := nil;
 271   // backwards, due to possible similar names and such
 272   for f := fIter.Count-1 downto 0 do
 273   begin
 274     fi := fIter.Files[f];
 275     if fi = nil then continue;
 276     if StrEquCI1251(fi.name, name) then
 277     begin
 278       try
 279         result := fIter.volume.OpenFileByIndex(f);
 280       except
 281         result := nil;
 282       end;
 283       if (result <> nil) then exit;
 284     end;
 285   end;
 286 end;
 287
 288
 289 function removeExt (s: AnsiString): AnsiString;
 290 var
 291   i: Integer;
 292 begin
 293   i := length(s)+1;
 294   while (i > 1) and (s[i-1] <> '.') and (s[i-1] <> '/') do Dec(i);
 295   if (i > 1) and (s[i-1] = '.') then
 296   begin
 297     //writeln('[', s, '] -> [', Copy(s, 1, i-2), ']');
 298     s := Copy(s, 1, i-2);
 299   end;
 300   result := s;
 301 end;
 302
 303
 304 function TWADFile.GetResourceEx (name: AnsiString; wantMap: Boolean; var pData: Pointer; var Len: Integer; logError: Boolean=true): Boolean;
 305 var
 306   f, lastSlash: Integer;
 307   fi: TSFSFileInfo;
 308   fs: TStream;
 309   fpp: Pointer;
 310   rpath, rname: AnsiString;
 311   //sign: packed array [0..2] of Char;
 312   goodMap: Boolean;
 313   {$IFNDEF SFS_MAPDETECT_FX}
 314   wst: TSFSMemoryChunkStream;
 315   {$ENDIF}
 316 begin
 317   Result := False;
 318   if not isOpen or (fIter = nil) then Exit;
 319   rname := removeExt(name);
 320   if length(rname) = 0 then Exit; // just in case
 321   lastSlash := -1;
 322   for f := 1 to length(rname) do
 323   begin
 324     if rname[f] = '\' then rname[f] := '/';
 325     if rname[f] = '/' then lastSlash := f;
 326   end;
 327   if lastSlash > 0 then
 328   begin
 329     rpath := Copy(rname, 1, lastSlash);
 330     Delete(rname, 1, lastSlash);
 331   end
 332   else
 333   begin
 334     rpath := '';
 335   end;
 336   // backwards, due to possible similar names and such
 337   for f := fIter.Count-1 downto 0 do
 338   begin
 339     fi := fIter.Files[f];
 340     if fi = nil then continue;
 341     if StrEquCI1251(removeExt(fi.name), rname) then
 342     begin
 343       // i found her (maybe)
 344       if not wantMap then
 345       begin
 346         if length(fi.path) < length(rpath) then continue; // alas
 347         if length(fi.path) = length(rpath) then
 348         begin
 349           if not StrEquCI1251(fi.path, rpath) then continue; // alas
 350         end
 351         else
 352         begin
 353           if fi.path[length(fi.path)-length(rpath)] <> '/' then continue; // alas
 354           if not StrEquCI1251(Copy(fi.path, length(fi.path)+1-length(rpath), length(fi.path)), rpath) then continue; // alas
 355         end;
 356       end;
 357       try
 358         fs := fIter.volume.OpenFileByIndex(f);
 359       except
 360         fs := nil;
 361       end;
 362       if fs = nil then
 363       begin
 364         if wantMap then continue;
 365         if logError then e_WriteLog(Format('DFWAD: can''t open file [%s] in [%s]', [name, fFileName]), TMsgType.Warning);
 366         break;
 367       end;
 368       // if we want only maps, check if this is map
 369 {$IFDEF SFS_MAPDETECT_FX}
 370       if wantMap then
 371       begin
 372         goodMap := false;
 373         {$IF DEFINED(D2D_NEW_MAP_READER_DBG)}
 374         e_LogWritefln('DFWAD: checking for good map in wad [%s], file [%s] (#%d)', [fFileName, fi.fname, f]);
 375         {$ENDIF}
 376         try
 377           //fs.readBuffer(sign, 3);
 378           //goodMap := (sign = MAP_SIGNATURE);
 379           //if not goodMap then goodMap := (sign[0] = 'm') and (sign[1] = 'a') and (sign[2] = 'p');
 380           goodMap := TDynMapDef.canBeMap(fs);
 381           {$IF DEFINED(D2D_NEW_MAP_READER_DBG)}
 382           if goodMap then
 383             e_LogWritefln('  GOOD map in wad [%s], file [%s] (#%d)', [fFileName, fi.fname, f])
 384           else
 385             e_LogWritefln('  BAD map in wad [%s], file [%s] (#%d)', [fFileName, fi.fname, f]);
 386           {$ENDIF}
 387         except
 388         end;
 389         if not goodMap then
 390         begin
 391           {$IF DEFINED(D2D_NEW_MAP_READER_DBG)}
 392           e_LogWritefln('  not a map in wad [%s], file [%s] (#%d)', [fFileName, fi.fname, f]);
 393           {$ENDIF}
 394           fs.Free();
 395           continue;
 396         end;
 397         fs.position := 0;
 398       end;
 399 {$ENDIF}
 400       Len := Integer(fs.size);
 401       GetMem(pData, Len);
 402       fpp := pData;
 403       try
 404         fs.ReadBuffer(pData^, Len);
 405         fpp := nil;
 406       finally
 407         if fpp <> nil then
 408         begin
 409           FreeMem(fpp);
 410           pData := nil;
 411           Len := 0;
 412         end;
 413         fs.Free;
 414       end;
 415 {$IFNDEF SFS_MAPDETECT_FX}
 416       if wantMap then
 417       begin
 418         goodMap := false;
 419         if Len >= 3 then
 420         begin
 421           //Move(pData^, sign, 3);
 422           //goodMap := (sign = MAP_SIGNATURE);
 423           wst := TSFSMemoryChunkStream.Create(pData, Len);
 424           try
 425             goodMap := TDynMapDef.canBeMap(wst);
 426           except
 427             goodMap := false;
 428           end;
 429           wst.Free();
 430         end;
 431         if not goodMap then
 432         begin
 433           //e_WriteLog(Format('  not a map in wad [%s], file [%s] (#%d)', [fFileName, fi.fname, f]), MSG_NOTIFY);
 434           FreeMem(pData);
 435           pData := nil;
 436           Len := 0;
 437           continue;
 438         end;
 439       end;
 440 {$ENDIF}
 441       result := true;
 442       {$IFDEF SFS_DFWAD_DEBUG}
 443       if wadoptDebug then
 444         e_WriteLog(Format('DFWAD: file [%s] FOUND in [%s]; size is %d bytes', [name, fFileName, Len]), TMsgType.Notify);
 445       {$ENDIF}
 446       exit;
 447     end;
 448   end;
 449   if logError then e_WriteLog(Format('DFWAD: file [%s] not found in [%s]', [name, fFileName]), TMsgType.Warning);
 450 end;
 451
 452 function TWADFile.GetResource (name: AnsiString; var pData: Pointer; var Len: Integer; logError: Boolean=true): Boolean;
 453 begin
 454   result := GetResourceEx(name, false, pData, Len, logError);
 455 end;
 456
 457 function TWADFile.GetMapResource (name: AnsiString; var pData: Pointer; var Len: Integer; logError: Boolean=true): Boolean;
 458 begin
 459   result := GetResourceEx(name, true, pData, Len, logError);
 460 end;
 461
 462 function TWADFile.GetMapResources (): SArray;
 463 var
 464   f, c: Integer;
 465   fi: TSFSFileInfo;
 466   s: AnsiString;
 467 begin
 468   Result := nil;
 469   if not isOpen or (fIter = nil) then Exit;
 470   for f := fIter.Count-1 downto 0 do
 471   begin
 472     fi := fIter.Files[f];
 473     if fi = nil then continue;
 474     if length(fi.name) = 0 then continue;
 475     {$IF DEFINED(D2D_NEW_MAP_READER)}
 476     //e_LogWritefln('DFWAD: checking for map in wad [%s], file [%s] (#%d)', [fFileName, fi.fname, f]);
 477     {$ENDIF}
 478     if isMapResource(f) then
 479     begin
 480       s := removeExt(fi.name);
 481       c := High(result);
 482       while c >= 0 do
 483       begin
 484         if StrEquCI1251(result[c], s) then break;
 485         Dec(c);
 486       end;
 487       if c < 0 then
 488       begin
 489         SetLength(result, Length(result)+1);
 490         result[high(result)] := removeExt(fi.name);
 491       end;
 492     end;
 493   end;
 494 end;
 495
 496
 497 function TWADFile.ReadFile (FileName: AnsiString): Boolean;
 498 var
 499   rfn: AnsiString;
 500   //f: Integer;
 501   //fi: TSFSFileInfo;
 502 begin
 503   Result := False;
 504   //e_WriteLog(Format('TWADFile.ReadFile: [%s]', [FileName]), MSG_NOTIFY);
 505   FreeWAD();
 506   rfn := findDiskWad(FileName);
 507   if length(rfn) = 0 then
 508   begin
 509     e_WriteLog(Format('TWADFile.ReadFile: error looking for [%s]', [FileName]), TMsgType.Notify);
 510     exit;
 511   end;
 512   {$IFDEF SFS_DFWAD_DEBUG}
 513   if wadoptDebug then e_WriteLog(Format('TWADFile.ReadFile: FOUND [%s]', [rfn]), TMsgType.Notify);
 514   {$ENDIF}
 515   // cache this wad
 516   try
 517     if wadoptFast then
 518     begin
 519       if not SFSAddDataFile(rfn, true) then exit;
 520     end
 521     else
 522     begin
 523       if not SFSAddDataFileTemp(rfn, true) then exit;
 524     end;
 525   except
 526     exit;
 527   end;
 528   fIter := SFSFileList(rfn);
 529   if fIter = nil then Exit;
 530   fFileName := rfn;
 531   {$IFDEF SFS_DFWAD_DEBUG}
 532   if wadoptDebug then e_WriteLog(Format('TWADFile.ReadFile: [%s] opened', [fFileName]), TMsgType.Notify);
 533   {$ENDIF}
 534   Result := True;
 535 end;
 536
 537
 538 var
 539   uniqueCounter: Integer = 0;
 540
 541 function TWADFile.ReadMemory (Data: Pointer; Len: LongWord): Boolean;
 542 var
 543   fn: AnsiString;
 544   st: TStream = nil;
 545   //f: Integer;
 546   //fi: TSFSFileInfo;
 547 begin
 548   Result := False;
 549   FreeWAD();
 550   if (Data = nil) or (Len = 0) then
 551   begin
 552     e_WriteLog('TWADFile.ReadMemory: EMPTY SUBWAD!', TMsgType.Warning);
 553     Exit;
 554   end;
 555
 556   fn := Format(' -- memwad %d -- ', [uniqueCounter]);
 557   Inc(uniqueCounter);
 558   {$IFDEF SFS_DFWAD_DEBUG}
 559   if wadoptDebug then e_WriteLog(Format('TWADFile.ReadMemory: [%s]', [fn]), TMsgType.Notify);
 560   {$ENDIF}
 561
 562   try
 563     st := TSFSMemoryStreamRO.Create(Data, Len);
 564     if not SFSAddSubDataFile(fn, st, true) then
 565     begin
 566       st.Free;
 567       Exit;
 568     end;
 569   except
 570     st.Free;
 571     Exit;
 572   end;
 573
 574   fIter := SFSFileList(fn);
 575   if fIter = nil then Exit;
 576
 577   fFileName := fn;
 578   {$IFDEF SFS_DFWAD_DEBUG}
 579   if wadoptDebug then e_WriteLog(Format('TWADFile.ReadMemory: [%s] opened', [fFileName]), TMsgType.Notify);
 580   {$ENDIF}
 581
 582   {
 583   for f := 0 to fIter.Count-1 do
 584   begin
 585     fi := fIter.Files[f];
 586     if fi = nil then continue;
 587     st := fIter.volume.OpenFileByIndex(f);
 588     if st = nil then
 589     begin
 590       e_WriteLog(Format('[%s]: [%s : %s] CAN''T OPEN', [fFileName, fi.path, fi.name]), MSG_NOTIFY);
 591     end
 592     else
 593     begin
 594       e_WriteLog(Format('[%s]: [%s : %s] %u', [fFileName, fi.path, fi.name, st.size]), MSG_NOTIFY);
 595       st.Free;
 596     end;
 597   end;
 598   //fIter.volume.OpenFileByIndex(0);
 599   }
 600
 601   Result := True;
 602 end;
 603
 604
 605 begin
 606   sfsDiskDirs := '<exedir>/data'; //FIXME
 607 end.