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     wad := utf2win(wad);
 125     section := utf2win(NoTrailing(section));
 126     name := utf2win(name);
 127     ASSERT(name <> '');
 128     f := TWADEditor_1.Create();
 129     if not f.ReadFile(wad) then
 130     begin
 131       (* do nothing *)
 132     end;
 133     f.CreateImage;
 134     f.RemoveResource(section, name);
 135     f.AddResource(data, len, name, section);
 136     g_DeleteFile(wad);
 137     f.SaveTo(wad);
 138     f.Free;
 139     res := 0
 140   end;
 141
 142   procedure g_AddResourceToZip (wad, section, name: String; const data: PByte; len: Integer; out res: Integer);
 143     var
 144       i, n, len0: Integer;
 145       data0: PByte;
 146       list: TSFSFileList;
 147       tmp, path: String;
 148       ts: TFileStream;
 149       dir: array of TFileInfo;
 150
 151     procedure Add (name: String; data: PByte; len: Integer);
 152       var ds: TSFSMemoryChunkStream;
 153     begin
 154       SetLength(dir, n + 1);
 155       ds := TSFSMemoryChunkStream.Create(data, len, False);
 156       dir[n] := dfzip.ZipOne(ts, name, ds, Compress);
 157       ds.Free;
 158       INC(n);
 159     end;
 160
 161   begin
 162     res := 1;
 163     wad := ExpandFileName(wad);
 164     section := utf2win(NoTrailing(section));
 165     name := utf2win(name);
 166     ASSERT(name <> '');
 167     list := SFSFileList(wad);
 168     tmp := wad + '.tmp' + IntToStr(Random(100000));
 169     ts := TFileStream.Create(tmp, fmCreate);
 170     n := 0;
 171     SetLength(dir, 0);
 172     if list <> nil then
 173     begin
 174       for i := 0 to list.Count - 1 do
 175       begin
 176         path := NoTrailing(list.Files[i].path);
 177         if (path <> section) or (list.Files[i].name <> name) then
 178         begin
 179           g_ReadResource(wad, path, list.Files[i].name, data0, len0);
 180           ASSERT(data0 <> nil);
 181           if path = '' then
 182             path := list.Files[i].name
 183           else
 184             path := path + '/' + list.Files[i].name;
 185           Add(path, data0, len0);
 186           FreeMem(data0)
 187         end
 188       end;
 189       list.Destroy
 190     end;
 191
 192     if section = '' then
 193       path := name
 194     else
 195       path := section + '/' + name;
 196     Add(path, data, len);
 197
 198     dfzip.writeCentralDir(ts, dir);
 199     ts.Free;
 200
 201     g_DeleteFile(wad);
 202     ASSERT(RenameFile(tmp, wad));
 203     res := 0
 204   end;
 205
 206   procedure g_AddResource (wad, section, name: String; const data: PByte; len: Integer; out res: Integer);
 207     var ext: String;
 208   begin
 209     ASSERT(name <> '');
 210     res := 2; (* unknown type *)
 211     ext := LowerCase(SysUtils.ExtractFileExt(wad));
 212     e_WriteLog('g_AddResource "' + wad + '" "' + section + '" "' + name + '"', MSG_NOTIFY);
 213     if ext = '.wad' then
 214       g_AddResourceToDFWAD(wad, section, name, data, len, res)
 215     else
 216       g_AddResourceToZip(wad, section, name, data, len, res)
 217   end;
 218
 219   procedure g_DeleteResourceFromDFWAD (wad, section, name: String; out res: Integer);
 220     var f: TWADEditor_1;
 221   begin
 222     ASSERT(name <> '');
 223     res := 1; (* error *)
 224     section := utf2win(NoTrailing(section));
 225     name := utf2win(name);
 226     f := TWADEditor_1.Create;
 227     if not f.ReadFile(wad) then
 228     begin
 229       f.Free;
 230       Exit
 231     end;
 232     f.CreateImage;
 233     f.RemoveResource(section, name);
 234     g_DeleteFile(wad);
 235     f.SaveTo(wad);
 236     f.Free;
 237     res := 0 (* ok *)
 238   end;
 239
 240   procedure g_DeleteResourceFromZip (wad, section, name: String; out res: Integer);
 241     var
 242       data0: PByte;
 243       i, n, len0: Integer;
 244       list: TSFSFileList;
 245       tmp, path: String;
 246       ts: TFileStream;
 247       dir: array of TFileInfo;
 248
 249     procedure Add (name: String; data: PByte; len: Integer);
 250       var ds: TSFSMemoryChunkStream;
 251     begin
 252       SetLength(dir, n + 1);
 253       ds := TSFSMemoryChunkStream.Create(data, len, False);
 254       dir[n] := dfzip.ZipOne(ts, name, ds, Compress);
 255       ds.Free;
 256       INC(n);
 257     end;
 258
 259   begin
 260     res := 1;
 261     wad := ExpandFileName(wad);
 262     section := utf2win(NoTrailing(section));
 263     name := utf2win(name);
 264     ASSERT(name <> '');
 265     list := SFSFileList(wad);
 266     tmp := wad + '.tmp' + IntToStr(Random(100000));
 267     ts := TFileStream.Create(tmp, fmCreate);
 268     n := 0;
 269     SetLength(dir, 0);
 270     if list <> nil then
 271     begin
 272       for i := 0 to list.Count - 1 do
 273       begin
 274         path := NoTrailing(list.Files[i].path);
 275         if (path <> section) or (list.Files[i].name <> name) then
 276         begin
 277           g_ReadResource(wad, path, list.Files[i].name, data0, len0);
 278           ASSERT(data0 <> nil);
 279           if path = '' then
 280             path := list.Files[i].name
 281           else
 282             path := path + '/' + list.Files[i].name;
 283           Add(path, data0, len0);
 284           FreeMem(data0)
 285         end
 286       end;
 287       list.Destroy
 288     end;
 289
 290     dfzip.writeCentralDir(ts, dir);
 291     ts.Free;
 292
 293     g_DeleteFile(wad);
 294     ASSERT(RenameFile(tmp, wad));
 295     res := 0
 296   end;
 297
 298   procedure g_DeleteResource (wad, section, name: String; out res: Integer);
 299     var ext: String;
 300   begin
 301     ASSERT(name <> '');
 302     res := 2; (* unknown type *)
 303     ext := LowerCase(SysUtils.ExtractFileExt(wad));
 304     if ext = '.wad' then
 305       g_DeleteResourceFromDFWAD(wad, section, name, res)
 306     else
 307       g_DeleteResourceFromZip(wad, section, name, res)
 308   end;
 309
 310   procedure g_ExistsResource (wad, section, name: String; out res: Integer);
 311     var str: String; stream: TStream;
 312   begin
 313     res := 1;
 314     section := utf2win(NoTrailing(section));
 315     name := utf2win(name);
 316     ASSERT(name <> '');
 317     if SFSAddDataFileTemp(wad, TRUE) then
 318     begin
 319       str := SFSGetLastVirtualName(section + '\' + name);
 320       stream := SFSFileOpen(wad + '::' + str);
 321       if stream <> nil then
 322       begin
 323         res := 0;
 324         stream.Destroy
 325       end
 326     end;
 327     SFSGCCollect
 328   end;
 329
 330   procedure g_ReadResource (wad, section, name: String; out data: PByte; out len: Integer);
 331     var stream: TStream; str: String; i: Integer;
 332   begin
 333     e_WriteLog('g_ReadResource: "' + wad + '" "' + section + '" "' + name + '"', MSG_NOTIFY);
 334     section := utf2win(NoTrailing(section));
 335     name := utf2win(name);
 336     data := nil;
 337     len := 0;
 338     //ASSERT(name <> '');
 339     if name = '' then Exit; (* SKY can be void *)
 340     if SFSAddDataFileTemp(wad, TRUE) then
 341     begin
 342       str := SFSGetLastVirtualName(section + '/' + name);
 343       stream := SFSFileOpen(wad + '::' + str);
 344       if stream <> nil then
 345       begin
 346         len := stream.Size;
 347         GetMem(data, len);
 348         ASSERT(data <> nil);
 349         //stream.ReadBuffer(data, len); (* leads to segfault *)
 350         for i := 0 to len - 1 do
 351           data[i] := stream.ReadByte();
 352         stream.Destroy
 353       end
 354     end;
 355     SFSGCCollect
 356   end;
 357
 358   procedure g_ReadSubResource (wad, section0, name0, section1, name1: String; out data: PByte; out len: Integer);
 359     var stream0, stream1: TStream; str0, str1: String; i: Integer;
 360   begin
 361     data := nil;
 362     len := 0;
 363     section0 := utf2win(NoTrailing(section0));
 364     name0 := utf2win(name0);
 365     section1 := utf2win(NoTrailing(section1));
 366     name1 := utf2win(name1);
 367     //ASSERT(name0 <> '');
 368     //ASSERT(name1 <> '');
 369     if (wad = '') OR (name0 = '') OR (name1 = '') then Exit; (* ??? *)
 370     if SFSAddDataFileTemp(wad, TRUE) then
 371     begin
 372       str0 := SFSGetLastVirtualName(section0 + '\' + name0);
 373       stream0 := SFSFileOpen(wad + '::' + str0);
 374       if stream0 <> nil then
 375       begin
 376         if SFSAddSubDataFile(wad + '\' + str0, stream0, TRUE) then
 377         begin
 378           str1 := SFSGetLastVirtualName(section1 + '\' + name1);
 379           stream1 := SFSFileOpen(wad + '\' + str0 + '::' + str1);
 380           if stream1 <> nil then
 381           begin
 382             len := stream1.Size;
 383             GetMem(data, len);
 384             ASSERT(data <> nil);
 385             //stream1.ReadBuffer(data, len); (* leads to segfault *)
 386             for i := 0 to len - 1 do
 387               data[i] := stream1.ReadByte();
 388             stream1.Destroy
 389           end
 390         end
 391       end
 392       else
 393       begin
 394         stream0.Destroy
 395       end
 396     end;
 397     SFSGCCollect
 398   end;
 399
 400 end.