From 5fd28f40b978042653b18006bd33ff5c93152518 Mon Sep 17 00:00:00 2001 From: DeaDDooMER Date: Fri, 4 Jan 2019 18:43:30 +0300 Subject: [PATCH] Packmap works with zip files --- src/editor/f_main.pas | 2 +- src/editor/f_packmap.pas | 47 +++++++--------- src/editor/g_map.pas | 2 +- src/editor/g_resources.pas | 106 +++++++++++++++++++++++++++++++++---- 4 files changed, 115 insertions(+), 42 deletions(-) diff --git a/src/editor/f_main.pas b/src/editor/f_main.pas index 32c13a2..5624e6a 100644 --- 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 ac1d07d..f9bb418 100644 --- 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 15a83dc..d461fd8 100644 --- 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 6b73f65..6a5dbee 100644 --- 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; -- 2.29.2