src/shared/WADEDITOR.pas

   1 unit WADEDITOR;
   2
   3 {$DEFINE SFS_DWFAD_DEBUG}
   4
   5 interface
   6
   7 uses
   8   sfs, xstreams;
   9
  10
  11 type
  12   SArray = array of ShortString;
  13
  14   TWADEditor_1 = class(TObject)
  15   private
  16     fFileName: string; // empty: not opened
  17     fIter: TSFSFileList;
  18
  19     function getIsOpen (): Boolean;
  20
  21    public
  22     constructor Create();
  23     destructor Destroy(); override;
  24
  25     procedure FreeWAD();
  26
  27     function ReadFile (FileName: string): Boolean;
  28     function ReadMemory (Data: Pointer; Len: LongWord): Boolean;
  29     function GetResource (Section, Resource: string; var pData: Pointer; var Len: Integer): Boolean;
  30     function GetResourcesList (Section: string): SArray;
  31
  32     property isOpen: Boolean read getIsOpen;
  33   end;
  34
  35 {
  36 const
  37   DFWAD_NOERROR                = 0;
  38   DFWAD_ERROR_WADNOTFOUND      = -1;
  39   DFWAD_ERROR_CANTOPENWAD      = -2;
  40   DFWAD_ERROR_RESOURCENOTFOUND = -3;
  41   DFWAD_ERROR_FILENOTWAD       = -4;
  42   DFWAD_ERROR_WADNOTLOADED     = -5;
  43   DFWAD_ERROR_READRESOURCE     = -6;
  44   DFWAD_ERROR_READWAD          = -7;
  45   DFWAD_ERROR_WRONGVERSION     = -8;
  46 }
  47
  48
  49 procedure g_ProcessResourceStr (ResourceStr: String; var FileName, SectionName, ResourceName: String); overload;
  50 procedure g_ProcessResourceStr (ResourceStr: String; FileName, SectionName, ResourceName: PString); overload;
  51
  52 // return fixed string or empty string
  53 function findDiskWad (fname: string): string;
  54
  55
  56 implementation
  57
  58 uses
  59   SysUtils, Classes, BinEditor, e_log, g_options;
  60
  61
  62 function findDiskWad (fname: string): string;
  63 var
  64   path, rfn: string;
  65 begin
  66   result := '';
  67   path := ExtractFilePath(fname);
  68   rfn := ExtractFileName(fname);
  69   if not sfsFindFileCI(path, rfn) then
  70   begin
  71     //e_WriteLog(Format('TWADEditor_1.ReadFile: error looking for [%s] [%s]', [path, ExtractFileName(fname)]), MSG_NOTIFY);
  72     if SFSStrEqu(ExtractFileExt(fname), '.wad') then
  73     begin
  74       rfn := ChangeFileExt(ExtractFileName(fname), '.pk3');
  75       //e_WriteLog(Format('  looking for [%s] [%s]', [path, rfn]), MSG_NOTIFY);
  76       if not sfsFindFileCI(path, rfn) then
  77       begin
  78         //e_WriteLog(Format('  looking for [%s] [%s]', [path, rfn]), MSG_NOTIFY);
  79         rfn := ChangeFileExt(ExtractFileName(fname), '.zip');
  80         if not sfsFindFileCI(path, rfn) then exit;
  81       end;
  82     end
  83     else
  84     begin
  85       exit;
  86     end;
  87     //e_WriteLog(Format('TWADEditor_1.ReadFile: FOUND [%s]', [rfn]), MSG_NOTIFY);
  88   end
  89   else
  90   begin
  91     //if rfn <> ExtractFileName(FileName) then e_WriteLog(Format('TWADEditor_1.ReadFile: FOUND [%s]', [rfn]), MSG_NOTIFY);
  92   end;
  93   result := path+rfn;
  94 end;
  95
  96
  97 procedure g_ProcessResourceStr (ResourceStr: String; var FileName, SectionName, ResourceName: String);
  98 var
  99   a, i: Integer;
 100
 101 begin
 102   //e_WriteLog(Format('g_ProcessResourceStr0: [%s]', [ResourceStr]), MSG_NOTIFY);
 103   for i := Length(ResourceStr) downto 1 do
 104     if ResourceStr[i] = ':' then
 105       Break;
 106
 107   FileName := Copy(ResourceStr, 1, i-1);
 108
 109   for a := i+1 to Length(ResourceStr) do
 110     if (ResourceStr[a] = '\') or (ResourceStr[a] = '/') then Break;
 111
 112   ResourceName := Copy(ResourceStr, a+1, Length(ResourceStr)-Abs(a));
 113   SectionName := Copy(ResourceStr, i+1, Length(ResourceStr)-Length(ResourceName)-Length(FileName)-2);
 114 end;
 115
 116
 117 procedure g_ProcessResourceStr (ResourceStr: AnsiString; FileName, SectionName, ResourceName: PAnsiString);
 118 var
 119   a, i, l1, l2: Integer;
 120
 121 begin
 122   //e_WriteLog(Format('g_ProcessResourceStr1: [%s]', [ResourceStr]), MSG_NOTIFY);
 123   for i := Length(ResourceStr) downto 1 do
 124     if ResourceStr[i] = ':' then
 125       Break;
 126
 127   if FileName <> nil then
 128     begin
 129       FileName^ := Copy(ResourceStr, 1, i-1);
 130       l1 := Length(FileName^);
 131     end
 132   else
 133     l1 := 0;
 134
 135   for a := i+1 to Length(ResourceStr) do
 136     if (ResourceStr[a] = '\') or (ResourceStr[a] = '/') then Break;
 137
 138   if ResourceName <> nil then
 139     begin
 140       ResourceName^ := Copy(ResourceStr, a+1, Length(ResourceStr)-Abs(a));
 141       l2 := Length(ResourceName^);
 142     end
 143   else
 144     l2 := 0;
 145
 146   if SectionName <> nil then
 147     SectionName^ := Copy(ResourceStr, i+1, Length(ResourceStr)-l2-l1-2);
 148 end;
 149
 150
 151 { TWADEditor_1 }
 152 constructor TWADEditor_1.Create();
 153 begin
 154   fFileName := '';
 155 end;
 156
 157
 158 destructor TWADEditor_1.Destroy();
 159 begin
 160   FreeWAD();
 161   inherited;
 162 end;
 163
 164
 165 function TWADEditor_1.getIsOpen (): Boolean;
 166 begin
 167   result := (fFileName <> '');
 168 end;
 169
 170
 171 procedure TWADEditor_1.FreeWAD();
 172 begin
 173   if fIter <> nil then FreeAndNil(fIter);
 174   //if fFileName <> '' then e_WriteLog(Format('TWADEditor_1.ReadFile: [%s] closed', [fFileName]), MSG_NOTIFY);
 175   fFileName := '';
 176 end;
 177
 178
 179 function removeExt (s: string): string;
 180 var
 181   i: Integer;
 182 begin
 183   i := length(s)+1;
 184   while (i > 1) and (s[i-1] <> '.') and (s[i-1] <> '/') do Dec(i);
 185   if (i > 1) and (s[i-1] = '.') then
 186   begin
 187     //writeln('[', s, '] -> [', Copy(s, 1, i-2), ']');
 188     s := Copy(s, 1, i-2);
 189   end;
 190   result := s;
 191 end;
 192
 193 function TWADEditor_1.GetResource (Section, Resource: string; var pData: Pointer; var Len: Integer): Boolean;
 194 var
 195   f: Integer;
 196   fi: TSFSFileInfo;
 197   fs: TStream;
 198   fpp: Pointer;
 199   //fn: string;
 200 begin
 201   Result := False;
 202   if not isOpen or (fIter = nil) then Exit;
 203   if length(Resource) = 0 then Exit; // just in case
 204   if (length(Section) <> 0) and (Section[length(Section)] <> '/') then Section := Section+'/';
 205   // backwards, due to possible similar names and such
 206   for f := fIter.Count-1 downto 0 do
 207   begin
 208     fi := fIter.Files[f];
 209     if fi = nil then continue;
 210     //e_WriteLog(Format('DFWAD: searching for [%s : %s] in [%s]; current is [%s : %s]', [Section, Resource, fFileName, fi.path, fi.name]), MSG_NOTIFY);
 211     if {SFSStrEqu}SFSDFPathEqu(fi.path, Section) and SFSStrEqu(removeExt(fi.name), Resource) then
 212     begin
 213       // i found her!
 214       //fn := fFileName+'::'+fi.path+fi.name;
 215       //fs := SFSFileOpen(fn);
 216       try
 217         fs := fIter.volume.OpenFileByIndex(f);
 218       except
 219         fs := nil;
 220       end;
 221       if fs = nil then
 222       begin
 223         e_WriteLog(Format('DFWAD: can''t open file [%s%s] in [%s]', [Section, Resource, fFileName]), MSG_WARNING);
 224         break;
 225       end;
 226       Len := Integer(fs.size);
 227       GetMem(pData, Len);
 228       fpp := pData;
 229       try
 230         fs.ReadBuffer(pData^, Len);
 231         fpp := nil;
 232       finally
 233         if fpp <> nil then
 234         begin
 235           FreeMem(fpp);
 236           pData := nil;
 237           Len := 0;
 238         end;
 239         fs.Free;
 240       end;
 241       result := true;
 242       {$IFDEF SFS_DWFAD_DEBUG}
 243       if gSFSDebug then
 244         e_WriteLog(Format('DFWAD: file [%s%s] FOUND in [%s]; size is %d bytes', [Section, Resource, fFileName, Len]), MSG_NOTIFY);
 245       {$ENDIF}
 246       exit;
 247     end;
 248   end;
 249   e_WriteLog(Format('DFWAD: file [%s%s] not found in [%s]', [Section, Resource, fFileName]), MSG_WARNING);
 250 end;
 251
 252
 253 function TWADEditor_1.GetResourcesList (Section: string): SArray;
 254 var
 255   f: Integer;
 256   fi: TSFSFileInfo;
 257 begin
 258   Result := nil;
 259   if not isOpen or (fIter = nil) then Exit;
 260   if (length(Section) <> 0) and (Section[length(Section)] <> '/') then Section := Section+'/';
 261   for f := 0 to fIter.Count-1 do
 262   begin
 263     fi := fIter.Files[f];
 264     if fi = nil then continue;
 265     if length(fi.name) = 0 then continue;
 266     if {SFSStrEqu}SFSDFPathEqu(fi.path, Section) then
 267     begin
 268       SetLength(result, Length(result)+1);
 269       result[high(result)] := removeExt(fi.name);
 270     end;
 271   end;
 272 end;
 273
 274
 275 function TWADEditor_1.ReadFile (FileName: string): Boolean;
 276 var
 277   rfn: string;
 278   //f: Integer;
 279   //fi: TSFSFileInfo;
 280 begin
 281   Result := False;
 282   //e_WriteLog(Format('TWADEditor_1.ReadFile: [%s]', [FileName]), MSG_NOTIFY);
 283   FreeWAD();
 284   rfn := findDiskWad(FileName);
 285   if length(rfn) = 0 then
 286   begin
 287     e_WriteLog(Format('TWADEditor_1.ReadFile: error looking for [%s]', [FileName]), MSG_NOTIFY);
 288     exit;
 289   end;
 290   {$IFDEF SFS_DWFAD_DEBUG}
 291   if gSFSDebug then e_WriteLog(Format('TWADEditor_1.ReadFile: FOUND [%s]', [rfn]), MSG_NOTIFY);
 292   {$ENDIF}
 293   // cache this wad
 294   try
 295     if gSFSFastMode then
 296     begin
 297       if not SFSAddDataFile(rfn, true) then exit;
 298     end
 299     else
 300     begin
 301       if not SFSAddDataFileTemp(rfn, true) then exit;
 302     end;
 303   except
 304     exit;
 305   end;
 306   fIter := SFSFileList(rfn);
 307   if fIter = nil then Exit;
 308   fFileName := rfn;
 309   {$IFDEF SFS_DWFAD_DEBUG}
 310   if gSFSDebug then e_WriteLog(Format('TWADEditor_1.ReadFile: [%s] opened', [fFileName]), MSG_NOTIFY);
 311   {$ENDIF}
 312   Result := True;
 313 end;
 314
 315
 316 var
 317   uniqueCounter: Integer = 0;
 318
 319 function TWADEditor_1.ReadMemory (Data: Pointer; Len: LongWord): Boolean;
 320 var
 321   fn: string;
 322   st: TStream = nil;
 323   //f: Integer;
 324   //fi: TSFSFileInfo;
 325 begin
 326   Result := False;
 327   FreeWAD();
 328   if (Data = nil) or (Len = 0) then
 329   begin
 330     e_WriteLog('TWADEditor_1.ReadMemory: EMPTY SUBWAD!', MSG_WARNING);
 331     Exit;
 332   end;
 333
 334   fn := Format(' -- memwad %d -- ', [uniqueCounter]);
 335   Inc(uniqueCounter);
 336   {$IFDEF SFS_DWFAD_DEBUG}
 337     e_WriteLog(Format('TWADEditor_1.ReadMemory: [%s]', [fn]), MSG_NOTIFY);
 338   {$ENDIF}
 339
 340   try
 341     st := TSFSMemoryStreamRO.Create(Data, Len);
 342     if not SFSAddSubDataFile(fn, st, true) then
 343     begin
 344       st.Free;
 345       Exit;
 346     end;
 347   except
 348     st.Free;
 349     Exit;
 350   end;
 351
 352   fIter := SFSFileList(fn);
 353   if fIter = nil then Exit;
 354
 355   fFileName := fn;
 356   {$IFDEF SFS_DWFAD_DEBUG}
 357     e_WriteLog(Format('TWADEditor_1.ReadMemory: [%s] opened', [fFileName]), MSG_NOTIFY);
 358   {$ENDIF}
 359
 360   {
 361   for f := 0 to fIter.Count-1 do
 362   begin
 363     fi := fIter.Files[f];
 364     if fi = nil then continue;
 365     st := fIter.volume.OpenFileByIndex(f);
 366     if st = nil then
 367     begin
 368       e_WriteLog(Format('[%s]: [%s : %s] CAN''T OPEN', [fFileName, fi.path, fi.name]), MSG_NOTIFY);
 369     end
 370     else
 371     begin
 372       e_WriteLog(Format('[%s]: [%s : %s] %u', [fFileName, fi.path, fi.name, st.size]), MSG_NOTIFY);
 373       st.Free;
 374     end;
 375   end;
 376   //fIter.volume.OpenFileByIndex(0);
 377   }
 378
 379   Result := True;
 380 end;
 381
 382
 383 begin
 384   sfsDiskDirs := '<exedir>/data'; //FIXME
 385 end.