Packmap works with zip files

diff --git a/src/editor/f_main.pas b/src/editor/f_main.pas
index 32c13a2751b0f54851c87a98e2e5d105c10073ee..5624e6a3def924542f32448cd3f59d6138b67cef 100644 (file)
--- a/src/editor/f_main.pas
+++ b/src/editor/f_main.pas
@@ -6178,7 +6178,7 @@ begin
   if MessageBox(0, PChar(Format(_lc[I_MSG_DELETE_MAP_PROMT], [MapName, OpenDialog.FileName])), PChar(_lc[I_MSG_DELETE_MAP]), MB_ICONQUESTION or MB_YESNO or MB_DEFBUTTON2) <> mrYes then
     Exit;
 
-  g_DeleteResource(FileName, '', utf2win(MapName), res);
+  g_DeleteResource(FileName, '', MapName, res);
   if res <> 0 then
   begin
     MessageBox(0, PChar('Cant delete map res=' + IntToStr(res)), PChar('Map not deleted!'), MB_ICONINFORMATION or MB_OK or MB_DEFBUTTON1);

diff --git a/src/editor/f_packmap.pas b/src/editor/f_packmap.pas
index ac1d07d3d2f216a815d4483442e9876c5c380f75..f9bb418620c837651fb936c85030e7d0d13ddd53 100644 (file)
--- a/src/editor/f_packmap.pas
+++ b/src/editor/f_packmap.pas
@@ -70,25 +70,25 @@ begin
     eWAD.Text := SaveDialog.FileName;
 end;
 
-function ProcessResource(wad_to: TWADEditor_1; section_to, filename, section, resource: String): Boolean;
+function ProcessResource(wad_to, section_to, filename, section, resource: String): Boolean;
   var
     data: Pointer;
-    reslen: Integer;
+    res, len: Integer;
 begin
   if filename = '' then
     g_ProcessResourceStr(OpenedMap, @filename, nil, nil)
   else
     filename := EditorDir + 'wads/' + filename;
 
-  g_ReadResource(filename, section, resource, data, reslen);
+  g_ReadResource(filename, section, resource, data, len);
   if data <> nil then
   begin
     (* Write resource only if it does not exists *)
-    if not wad_to.HaveResource(utf2win(section_to), utf2win(resource)) then
+    g_ExistsResource(wad_to, section_to, resource, res);
+    if res <> 0 then
     begin
-      if not wad_to.HaveSection(utf2win(section_to)) then
-        wad_to.AddSection(utf2win(section_to));
-      wad_to.AddResource(data, reslen, utf2win(resource), utf2win(section_to))
+      g_AddResource(wad_to, section_to, resource, data, len, res);
+      ASSERT(res = 0)
     end;
     FreeMem(data);
     Result := True
@@ -103,7 +103,6 @@ end;
 
 procedure TPackMapForm.bPackClick(Sender: TObject);
 var
-  WAD: TWADEditor_1;
   mr: TMapReader_1;
   mw: TMapWriter_1;
   data: Pointer;
@@ -128,12 +127,10 @@ begin
   if data = nil then
     Exit;
 
-  WAD := TWADEditor_1.Create();
-
 // Не перезаписывать WAD, а дополнить:
-  if cbAdd.Checked then
-    if WAD.ReadFile(eWAD.Text) then
-      WAD.CreateImage();
+  if not cbAdd.Checked then
+    if FileExists(eWAD.Text) then
+      ASSERT(RenameFile(eWAD.Text, eWAD.Text + '.bak0'));
 
 // Читаем карту из памяти:
   mr := TMapReader_1.Create();
@@ -159,10 +156,9 @@ begin
            (AnsiLowerCase(filename) <> SHRSHADE_WAD) ) then
       begin
       // Копируем ресурс текстуры:
-        if not f_packmap.ProcessResource(WAD, tsection, filename, section, resource) then
+        if not f_packmap.ProcessResource(eWAD.Text, tsection, filename, section, resource) then
         begin
           mr.Free();
-          WAD.Free();
           Exit;
         end;
 
@@ -188,10 +184,9 @@ begin
          (AnsiLowerCase(filename) <> SHRSHADE_WAD) ) then
     begin
     // Копируем ресурс неба:
-      if not f_packmap.ProcessResource(WAD, ssection, filename, section, resource) then
+      if not f_packmap.ProcessResource(eWAD.Text, ssection, filename, section, resource) then
       begin
         mr.Free();
-        WAD.Free();
         Exit;
       end;
 
@@ -214,10 +209,9 @@ begin
          (AnsiLowerCase(filename) <> SHRSHADE_WAD) ) then
     begin
     // Копируем ресурс музыки:
-      if not f_packmap.ProcessResource(WAD, msection, filename, section, resource) then
+      if not f_packmap.ProcessResource(eWAD.Text, msection, filename, section, resource) then
       begin
         mr.Free();
-        WAD.Free();
         Exit;
       end;
 
@@ -275,7 +269,7 @@ begin
                (AnsiLowerCase(filename) <> SHRSHADE_WAD) ) then
           begin
           // Копируем ресурс дополнительной текстуры:
-            if f_packmap.ProcessResource(WAD, tsection, filename, section, resource) then
+            if f_packmap.ProcessResource(eWAD.Text, tsection, filename, section, resource) then
             begin
 
               Нужно проверять есть такая текстура textures и есть ли она вообще?
@@ -307,18 +301,13 @@ begin
 
 // Сохраняем карту из памяти под новым именем в WAD-файл:
   len := mw.SaveMap(data);
-  WAD.AddResource(data, len, eResource.Text, '');
-  WAD.SaveTo(eWAD.Text);
-
+  g_AddResource(eWAD.Text, '', eResource.Text, data, len, a);
   mw.Free();
   mr.Free();
-  WAD.Free();
-
-  MessageDlg(Format(_lc[I_MSG_PACKED],
-                    [eResource.Text, ExtractFileName(eWAD.Text)]),
-             mtInformation, [mbOK], 0);
-
   Close();
+
+  ASSERT(a = 0); (* saved *)
+  MessageDlg(Format(_lc[I_MSG_PACKED], [eResource.Text, ExtractFileName(eWAD.Text)]), mtInformation, [mbOK], 0);
 end;
 
 procedure TPackMapForm.FormCreate(Sender: TObject);

diff --git a/src/editor/g_map.pas b/src/editor/g_map.pas
index 15a83dcd348800152892aca67197aa3577f4fc69..d461fd818d8de50f3452d2c0b510e86a85e3f12e 100644 (file)
--- a/src/editor/g_map.pas
+++ b/src/editor/g_map.pas
@@ -1339,7 +1339,7 @@ begin
   if Res <> '' then
   begin
     g_ProcessResourceStr(Res, FileName, SectionName, ResName);
-    g_AddResource(FileName, SectionName, utf2win(ResName), Data, Len, a);
+    g_AddResource(FileName, SectionName, ResName, Data, Len, a);
     ASSERT(a = 0);
     FreeMem(Data);
     Result := nil

diff --git a/src/editor/g_resources.pas b/src/editor/g_resources.pas
index 6b73f6518988695352cb2f7b325629d2c9b805a9..6a5dbeedd227e3c8da2cc61bd07e6828342b6028 100644 (file)
--- a/src/editor/g_resources.pas
+++ b/src/editor/g_resources.pas
@@ -5,21 +5,32 @@ interface
   (**
     g_ReadResource
       Read whole file from wad
+      (data <> nil) and (len > 0) when ok
+      use FreeMem(data) when done
 
     g_ReadSubResource
       Read whole file from folded wad
+      (data <> nil) and (len > 0) when ok
+      use FreeMem(data) when done
 
     g_DeleteResource
-      Delete file from wad, res = 0 when ok
+      Delete file from wad
+      res = 0 when ok
 
     g_AddResource
-      Add/overwrite file to wad, res = 0 when ok
+      Add/overwrite file to wad
+      res = 0 when ok
+
+    g_ExistsResource
+      Check that resource exists
+      res = 0 when ok
   **)
 
   procedure g_ReadResource (wad, section, name: String; out data: PByte; out len: Integer);
   procedure g_ReadSubResource (wad, section0, name0, section1, name1: String; out data: PByte; out len: Integer);
   procedure g_DeleteResource (wad, section, name: String; out res: Integer);
   procedure g_AddResource (wad, section, name: String; const data: PByte; len: Integer; out res: Integer);
+  procedure g_ExistsResource (wad, section, name: String; out res: Integer);
 
 implementation
 
@@ -29,6 +40,9 @@ implementation
     var f: TWADEditor_1;
   begin
     res := 1; (* error *)
+    wad := utf2win(wad);
+    section := utf2win(section);
+    name := utf2win(name);
     f := TWADEditor_1.Create();
     if not f.ReadFile(wad) then
     begin
@@ -37,6 +51,8 @@ implementation
     f.CreateImage;
     f.RemoveResource(section, name);
     f.AddResource(data, len, name, section);
+    if FileExists(wad) then
+      ASSERT(RenameFile(wad, wad + '.bak'));
     f.SaveTo(wad);
     f.Free;
     res := 0
@@ -64,6 +80,8 @@ implementation
   begin
     res := 1;
     wad := ExpandFileName(wad);
+    section := utf2win(section);
+    name := utf2win(name);
     list := SFSFileList(wad);
     tmp := wad + '.tmp' + IntToStr(Random(100000));
     ts := TFileStream.Create(tmp, fmCreate);
@@ -117,6 +135,8 @@ implementation
     var f: TWADEditor_1;
   begin
     res := 1; (* error *)
+    section := utf2win(section);
+    name := utf2win(name);
     f := TWADEditor_1.Create;
     if not f.ReadFile(wad) then
     begin
@@ -131,8 +151,59 @@ implementation
   end;
 
   procedure g_DeleteResourceFromZip (wad, section, name: String; out res: Integer);
+    var
+      data0: PByte;
+      i, n, len0: Integer;
+      list: TSFSFileList;
+      tmp, entry: String;
+      ts: TFileStream;
+      dir: array of TFileInfo;
+
+    procedure Add (name: String; data: PByte; len: Integer);
+      var ds: TSFSMemoryChunkStream;
+    begin
+      SetLength(dir, n + 1);
+      ds := TSFSMemoryChunkStream.Create(data, len, false);
+      dir[n] := dfzip.ZipOne(ts, name, ds);
+      ds.Free;
+      INC(n);
+    end;
+
   begin
-    res := 1 (* not implemented *)
+    res := 1;
+    wad := ExpandFileName(wad);
+    section := utf2win(section);
+    name := utf2win(name);
+    list := SFSFileList(wad);
+    tmp := wad + '.tmp' + IntToStr(Random(100000));
+    ts := TFileStream.Create(tmp, fmCreate);
+    n := 0;
+    SetLength(dir, 0);
+    if list <> nil then
+    begin
+      for i := 0 to list.Count - 1 do
+      begin
+        if (list.Files[i].path <> section) or (list.Files[i].name <> section) then
+        begin
+          g_ReadResource(wad, list.Files[i].path, list.Files[i].name, data0, len0);
+          if list.Files[i].path = '' then
+            entry := list.Files[i].name
+          else
+            entry := list.Files[i].path + '/' + list.Files[i].name;
+          Add(entry, data0, len0);
+          FreeMem(data0)
+        end
+      end;
+      list.Destroy
+    end;
+
+    dfzip.writeCentralDir(ts, dir);
+    ts.Free;
+
+    if FileExists(wad) then
+      ASSERT(RenameFile(wad, wad + '.bak'));
+    ASSERT(RenameFile(tmp, wad));
+    res := 0
   end;
 
   procedure g_DeleteResource (wad, section, name: String; out res: Integer);
@@ -146,11 +217,27 @@ implementation
       g_DeleteResourceFromZip(wad, section, name, res)
   end;
 
+  procedure g_ExistsResource (wad, section, name: String; out res: Integer);
+    var str: String; stream: TStream;
+  begin
+    res := 1;
+    section := utf2win(section);
+    name := utf2win(name);
+    if SFSAddDataFileTemp(wad, TRUE) then
+    begin
+      str := SFSGetLastVirtualName(section + '\' + name);
+      stream := SFSFileOpen(wad + '::' + str);
+      if stream <> nil then
+      begin
+        res := 0;
+        stream.Destroy
+      end
+    end;
+    SFSGCCollect
+  end;
+
   procedure g_ReadResource (wad, section, name: String; out data: PByte; out len: Integer);
-    var
-      stream: TStream;
-      str: String;
-      i: Integer;
+    var stream: TStream; str: String; i: Integer;
   begin
     section := utf2win(section);
     name := utf2win(name);
@@ -174,10 +261,7 @@ implementation
   end;
 
   procedure g_ReadSubResource (wad, section0, name0, section1, name1: String; out data: PByte; out len: Integer);
-    var
-      stream0, stream1: TStream;
-      str0, str1: String;
-      i: Integer;
+    var stream0, stream1: TStream; str0, str1: String; i: Integer;
   begin
     data := nil;
     len := 0;