src/editor/g_resources.pas

   1 unit g_resources;
   2
   3 interface
   4
   5   (**
   6     g_GetResourceSection
   7       Parse path in form 'path/to/file.wad:some/section/resouce' to
   8       wad = 'path/to/file.wa', section = 'some/section', name = 'resource'
   9
  10     g_DeleteFile
  11       Delete file if it exists. Make backup if enabled.
  12
  13     g_ReadResource
  14       Read whole file from wad
  15       (data <> nil) and (len > 0) when ok
  16       use FreeMem(data) when done
  17
  18     g_ReadSubResource
  19       Read whole file from folded wad
  20       (data <> nil) and (len > 0) when ok
  21       use FreeMem(data) when done
  22
  23     g_DeleteResource
  24       Delete file from wad
  25       res = 0 when ok
  26
  27     g_AddResource
  28       Add/overwrite file to wad
  29       res = 0 when ok
  30
  31     g_ExistsResource
  32       Check that resource exists
  33       res = 0 when ok
  34   **)
  35
  36   (* Editor options *)
  37   var
  38     Compress: Boolean;
  39     Backup: Boolean;
  40
  41   procedure g_GetResourceSection (path: String; out wad, section, name: String);
  42   procedure g_DeleteFile(wad: String; backupPostfix: String = '.bak');
  43
  44   procedure g_ReadResource (wad, section, name: String; out data: PByte; out len: Integer);
  45   procedure g_ReadSubResource (wad, section0, name0, section1, name1: String; out data: PByte; out len: Integer);
  46   procedure g_DeleteResource (wad, section, name: String; out res: Integer);
  47   procedure g_AddResource (wad, section, name: String; const data: PByte; len: Integer; out res: Integer);
  48   procedure g_ExistsResource (wad, section, name: String; out res: Integer);
  49
  50 implementation
  51
  52   uses sfs, xstreams, dfzip, utils, Classes, SysUtils, WADEDITOR, e_log;
  53
  54   function NoTrailing (path: String): String;
  55     var i: Integer;
  56   begin
  57     i := Length(path);
  58     while (i > 0) and ((path[i] = '/') or (path[i] = '\')) do dec(i);
  59     result := Copy(path, 1, i)
  60   end;
  61
  62   function g_CleanPath (path: String; sys: Boolean = False): String;
  63     var i, len: Integer;
  64   begin
  65     i := 1;
  66     result := '';
  67     len := Length(path);
  68     (* drop separators at the end *)
  69     while (len > 1) and ((path[i] = '/') or (path[i] = '\')) do dec(len);
  70     while i <= len do
  71     begin
  72       while (i <= len) and (path[i] <> '/') and (path[i] <> '\') do
  73       begin
  74         result := result + path[i];
  75         inc(i)
  76       end;
  77       if i <= len then
  78         if sys then
  79           result := result + DirectorySeparator
  80         else
  81           result := result + '/';
  82       inc(i);
  83       while (i <= len) and ((path[i] = '/') or (path[i] = '\')) do inc(i)
  84     end;
  85   end;
  86
  87   procedure g_GetResourceSection (path: String; out wad, section, name: String);
  88     var i, j, len: Integer;
  89   begin
  90     len := Length(path);
  91     i := len;
  92     while (i > 0) and (path[i] <> '/') and (path[i] <> '\') do dec(i);
  93     name := Copy(path, i + 1, len);
  94     j := i;
  95     while (i > 0) and (path[i] <> ':') do dec(i);
  96     section := Copy(path, i + 1, j - i - 1);
  97     wad := Copy(path, 1, i - 1);
  98   end;
  99
 100   procedure g_DeleteFile (wad: String; backupPostfix: String = '.bak');
 101     var newwad: String;
 102   begin
 103     if Backup then
 104     begin
 105       if FileExists(wad) then
 106       begin
 107         newwad := wad + backupPostfix;
 108         if FileExists(newwad) then
 109           ASSERT(DeleteFile(newwad));
 110         ASSERT(RenameFile(wad, newwad))
 111       end
 112     end
 113     else
 114     begin
 115       if FileExists(wad) then
 116         ASSERT(DeleteFile(wad))
 117     end
 118   end;
 119
 120   procedure g_AddResourceToDFWAD (wad, section, name: String; const data: PByte; len: Integer; out res: Integer);
 121     var f: TWADEditor_1;
 122   begin
 123     res := 1; (* error *)
 124     section := utf2win(NoTrailing(section));
 125     name := utf2win(name);
 126     ASSERT(name <> '');
 127     f := TWADEditor_1.Create();
 128     if not f.ReadFile(wad) then
 129     begin
 130       (* do nothing *)
 131     end;
 132     f.CreateImage;
 133     f.RemoveResource(section, name);
 134     f.AddResource(data, len, name, section);
 135     g_DeleteFile(wad);
 136     f.SaveTo(wad);
 137     f.Free;
 138     res := 0
 139   end;
 140
 141   procedure g_AddResourceToZip (wad, section, name: String; const data: PByte; len: Integer; out res: Integer);
 142     var
 143       i, n, len0: Integer;
 144       data0: PByte;
 145       list: TSFSFileList;
 146       tmp, path: String;
 147       ts: TFileStream;
 148       dir: array of TFileInfo;
 149
 150     procedure Add (name: String; data: PByte; len: Integer);
 151       var ds: TSFSMemoryChunkStream;
 152     begin
 153       SetLength(dir, n + 1);
 154       ds := TSFSMemoryChunkStream.Create(data, len, False);
 155       dir[n] := dfzip.ZipOne(ts, name, ds, Compress);
 156       ds.Free;
 157       INC(n);
 158     end;
 159
 160   begin
 161     res := 1;
 162     wad := ExpandFileName(wad);
 163     section := utf2win(NoTrailing(section));
 164     name := utf2win(name);
 165     ASSERT(name <> '');
 166     list := SFSFileList(wad);
 167     tmp := wad + '.tmp' + IntToStr(Random(100000));
 168     ts := TFileStream.Create(tmp, fmCreate);
 169     n := 0;
 170     SetLength(dir, 0);
 171     if list <> nil then
 172     begin
 173       for i := 0 to list.Count - 1 do
 174       begin
 175         path := NoTrailing(list.Files[i].path);
 176         if (path <> section) or (list.Files[i].name <> name) then
 177         begin
 178           g_ReadResource(wad, win2utf(path), win2utf(list.Files[i].name), data0, len0);
 179           ASSERT(data0 <> nil);
 180           if path = '' then
 181             path := list.Files[i].name
 182           else
 183             path := path + '/' + list.Files[i].name;
 184           Add(path, data0, len0);
 185           FreeMem(data0)
 186         end
 187       end;
 188       list.Destroy
 189     end;
 190
 191     if section = '' then
 192       path := name
 193     else
 194       path := section + '/' + name;
 195     Add(path, data, len);
 196
 197     dfzip.writeCentralDir(ts, dir);
 198     ts.Free;
 199
 200     g_DeleteFile(wad);
 201     ASSERT(RenameFile(tmp, wad));
 202     res := 0
 203   end;
 204
 205   procedure g_AddResource (wad, section, name: String; const data: PByte; len: Integer; out res: Integer);
 206     var ext: String;
 207   begin
 208     ASSERT(name <> '');
 209     res := 2; (* unknown type *)
 210     ext := LowerCase(SysUtils.ExtractFileExt(wad));
 211     e_WriteLog('g_AddResource "' + wad + '" "' + section + '" "' + name + '"', MSG_NOTIFY);
 212     if ext = '.wad' then
 213       g_AddResourceToDFWAD(wad, section, name, data, len, res)
 214     else
 215       g_AddResourceToZip(wad, section, name, data, len, res)
 216   end;
 217
 218   procedure g_DeleteResourceFromDFWAD (wad, section, name: String; out res: Integer);
 219     var f: TWADEditor_1;
 220   begin
 221     ASSERT(name <> '');
 222     res := 1; (* error *)
 223     section := utf2win(NoTrailing(section));
 224     name := utf2win(name);
 225     f := TWADEditor_1.Create;
 226     if not f.ReadFile(wad) then
 227     begin
 228       f.Free;
 229       Exit
 230     end;
 231     f.CreateImage;
 232     f.RemoveResource(section, name);
 233     g_DeleteFile(wad);
 234     f.SaveTo(wad);
 235     f.Free;
 236     res := 0 (* ok *)
 237   end;
 238
 239   procedure g_DeleteResourceFromZip (wad, section, name: String; out res: Integer);
 240     var
 241       data0: PByte;
 242       i, n, len0: Integer;
 243       list: TSFSFileList;
 244       tmp, path: String;
 245       ts: TFileStream;
 246       dir: array of TFileInfo;
 247
 248     procedure Add (name: String; data: PByte; len: Integer);
 249       var ds: TSFSMemoryChunkStream;
 250     begin
 251       SetLength(dir, n + 1);
 252       ds := TSFSMemoryChunkStream.Create(data, len, False);
 253       dir[n] := dfzip.ZipOne(ts, name, ds, Compress);
 254       ds.Free;
 255       INC(n);
 256     end;
 257
 258   begin
 259     res := 1;
 260     wad := ExpandFileName(wad);
 261     section := utf2win(NoTrailing(section));
 262     name := utf2win(name);
 263     ASSERT(name <> '');
 264     list := SFSFileList(wad);
 265     tmp := wad + '.tmp' + IntToStr(Random(100000));
 266     ts := TFileStream.Create(tmp, fmCreate);
 267     n := 0;
 268     SetLength(dir, 0);
 269     if list <> nil then
 270     begin
 271       for i := 0 to list.Count - 1 do
 272       begin
 273         path := NoTrailing(list.Files[i].path);
 274         if (path <> section) or (list.Files[i].name <> name) then
 275         begin
 276           g_ReadResource(wad, win2utf(path), win2utf(list.Files[i].name), data0, len0);
 277           ASSERT(data0 <> nil);
 278           if path = '' then
 279             path := list.Files[i].name
 280           else
 281             path := path + '/' + list.Files[i].name;
 282           Add(path, data0, len0);
 283           FreeMem(data0)
 284         end
 285       end;
 286       list.Destroy
 287     end;
 288
 289     dfzip.writeCentralDir(ts, dir);
 290     ts.Free;
 291
 292     g_DeleteFile(wad);
 293     ASSERT(RenameFile(tmp, wad));
 294     res := 0
 295   end;
 296
 297   procedure g_DeleteResource (wad, section, name: String; out res: Integer);
 298     var ext: String;
 299   begin
 300     ASSERT(name <> '');
 301     res := 2; (* unknown type *)
 302     ext := LowerCase(SysUtils.ExtractFileExt(wad));
 303     if ext = '.wad' then
 304       g_DeleteResourceFromDFWAD(wad, section, name, res)
 305     else
 306       g_DeleteResourceFromZip(wad, section, name, res)
 307   end;
 308
 309   procedure g_ExistsResource (wad, section, name: String; out res: Integer);
 310     var str: String; stream: TStream;
 311   begin
 312     res := 1;
 313     section := utf2win(NoTrailing(section));
 314     name := utf2win(name);
 315     ASSERT(name <> '');
 316     if SFSAddDataFileTemp(wad, TRUE) then
 317     begin
 318       str := SFSGetLastVirtualName(section + '\' + name);
 319       stream := SFSFileOpen(wad + '::' + str);
 320       if stream <> nil then
 321       begin
 322         res := 0;
 323         stream.Destroy
 324       end
 325     end;
 326     SFSGCCollect
 327   end;
 328
 329   procedure g_ReadResource (wad, section, name: String; out data: PByte; out len: Integer);
 330     var stream: TStream; str: String; i: Integer;
 331   begin
 332     e_WriteLog('g_ReadResource: "' + wad + '" "' + section + '" "' + name + '"', MSG_NOTIFY);
 333     section := utf2win(NoTrailing(section));
 334     name := utf2win(name);
 335     data := nil;
 336     len := 0;
 337     //ASSERT(name <> '');
 338     if name = '' then Exit; (* SKY can be void *)
 339     if SFSAddDataFileTemp(wad, TRUE) then
 340     begin
 341       str := SFSGetLastVirtualName(section + '/' + name);
 342       stream := SFSFileOpen(wad + '::' + str);
 343       if stream <> nil then
 344       begin
 345         len := stream.Size;
 346         GetMem(data, len);
 347         ASSERT(data <> nil);
 348         //stream.ReadBuffer(data, len); (* leads to segfault *)
 349         for i := 0 to len - 1 do
 350           data[i] := stream.ReadByte();
 351         stream.Destroy
 352       end
 353     end;
 354     SFSGCCollect
 355   end;
 356
 357   procedure g_ReadSubResource (wad, section0, name0, section1, name1: String; out data: PByte; out len: Integer);
 358     var stream0, stream1: TStream; str0, str1: String; i: Integer;
 359   begin
 360     data := nil;
 361     len := 0;
 362     section0 := utf2win(NoTrailing(section0));
 363     name0 := utf2win(name0);
 364     section1 := utf2win(NoTrailing(section1));
 365     name1 := utf2win(name1);
 366     //ASSERT(name0 <> '');
 367     //ASSERT(name1 <> '');
 368     if (wad = '') OR (name0 = '') OR (name1 = '') then Exit; (* ??? *)
 369     if SFSAddDataFileTemp(wad, TRUE) then
 370     begin
 371       str0 := SFSGetLastVirtualName(section0 + '\' + name0);
 372       stream0 := SFSFileOpen(wad + '::' + str0);
 373       if stream0 <> nil then
 374       begin
 375         if SFSAddSubDataFile(wad + '\' + str0, stream0, TRUE) then
 376         begin
 377           str1 := SFSGetLastVirtualName(section1 + '\' + name1);
 378           stream1 := SFSFileOpen(wad + '\' + str0 + '::' + str1);
 379           if stream1 <> nil then
 380           begin
 381             len := stream1.Size;
 382             GetMem(data, len);
 383             ASSERT(data <> nil);
 384             //stream1.ReadBuffer(data, len); (* leads to segfault *)
 385             for i := 0 to len - 1 do
 386               data[i] := stream1.ReadByte();
 387             stream1.Destroy
 388           end
 389         end
 390       end
 391       else
 392       begin
 393         stream0.Destroy
 394       end
 395     end;
 396     SFSGCCollect
 397   end;
 398
 399 end.