X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Feditor%2Ff_packmap.pas;h=cdbe1056f9fde71dd1a11c5d2bfd53dac216faff;hb=a140ef8433c5e5cdf3d2ec4a6343c5380535e200;hp=c9e093e88197ff6c0929feb88dba9c996199d9dc;hpb=212386359ea0af4e0a861f9bf92c45a1516ac87c;p=d2df-editor.git

diff --git a/src/editor/f_packmap.pas b/src/editor/f_packmap.pas
index c9e093e..cdbe105 100644
--- a/src/editor/f_packmap.pas
+++ b/src/editor/f_packmap.pas
@@ -1,12 +1,12 @@
 unit f_packmap;
 
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
 
 interface
 
 uses
   LCLIntf, LCLType, LMessages, SysUtils, Variants, Classes,
-  Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;
+  Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, utils;
 
 type
   TPackMapForm = class (TForm)
@@ -53,7 +53,7 @@ implementation
 
 uses
   BinEditor, WADEDITOR, g_map, MAPREADER, MAPWRITER, MAPSTRUCT,
-  f_main, math, g_language;
+  f_main, math, g_language, g_resources, e_log;
 
 {$R *.lfm}
 
@@ -70,71 +70,44 @@ begin
     eWAD.Text := SaveDialog.FileName;
 end;
 
-function ProcessResource(wad_to: TWADEditor_1;
-           section_to, filename, section, resource: String): Boolean;
-var
-  wad2: TWADEditor_1;
-  data: Pointer;
-  reslen: Integer;
-  //s: string;
-
+function ProcessResource(wad_to, section_to, filename, section, resource: String): Boolean;
+  var
+    data: Pointer;
+    res, len: Integer;
+    us, un: String;
 begin
-  Result := False;
- 
+  Result := True;
   if filename = '' then
-    g_ProcessResourceStr(OpenedMap, @filename, nil, nil)
+    g_GetResourceSection(OpenedMap, filename, us, un)
   else
-    filename := EditorDir+'wads/'+filename;
-
-// Читаем ресурс из WAD-файла карты или какого-то другого:
-  wad2 := TWADEditor_1.Create();
-
-  if not wad2.ReadFile(filename) then
-  begin
-    MessageBox(0, PChar(Format(_lc[I_MSG_WAD_ERROR],
-                                   [ExtractFileName(filename)])),
-               PChar(_lc[I_MSG_ERROR]), MB_OK + MB_ICONERROR);
-    wad2.Free();
-    Exit;
-  end;
-
-  if not wad2.GetResource(section, resource, data, reslen) then
-  begin
-    MessageBox(0, PChar(Format(_lc[I_MSG_RES_ERROR],
-                                   [filename, section, resource])),
-               PChar(_lc[I_MSG_ERROR]), MB_OK + MB_ICONERROR);
-    wad2.Free();
-    Exit;
-  end;
+    filename := EditorDir + 'wads/' + filename;
+  e_WriteLog('ProcessResource: "' + wad_to + '" "' + section_to + '" "' + filename + '" "' + section + '" "' + resource + '"', MSG_NOTIFY);
 
-  wad2.Free();
+  if resource = '' then Exit;
 
- {if wad_to.HaveResource(section_to, resource) then
- begin
-  for a := 2 to 256 do
+  g_ReadResource(filename, section, resource, data, len);
+  if data <> nil then
   begin
-   s := IntToStr(a);
-   if not wad_to.HaveResource(section_to, resource+s) then Break;
-  end;
-  resource := resource+s;
- end;}
-
-// Если такого ресурса нет в WAD-файле-назначении, то копируем:
-  if not wad_to.HaveResource(section_to, resource) then
+    (* Write resource only if it does not exists *)
+    g_ExistsResource(wad_to, section_to, resource, res);
+    if res <> 0 then
+    begin
+      g_AddResource(wad_to, section_to, resource, data, len, res);
+      ASSERT(res = 0)
+    end;
+    FreeMem(data);
+  end
+  else
   begin
-    if not wad_to.HaveSection(section_to) then
-      wad_to.AddSection(section_to);
-    wad_to.AddResource(data, reslen, resource, section_to);
-  end;
-
-  FreeMem(data);
-
-  Result := True;
+    //MessageBox(0, PChar(Format(_lc[I_MSG_WAD_ERROR], [ExtractFileName(filename)])), PChar(_lc[I_MSG_ERROR]), MB_OK + MB_ICONERROR);
+    MessageBox(0, PChar(Format(_lc[I_MSG_RES_ERROR], [filename, section, resource])), PChar(_lc[I_MSG_ERROR]), MB_OK + MB_ICONERROR);
+    Result := False
+  end
 end;
 
 procedure TPackMapForm.bPackClick(Sender: TObject);
 var
-  WAD: TWADEditor_1;
+  WadFile: String;
   mr: TMapReader_1;
   mw: TMapWriter_1;
   data: Pointer;
@@ -159,12 +132,16 @@ 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
+  begin
+    (* Overwrite wad *)
+    if FileExists(eWAD.Text) then
+    begin
+      if FileExists(eWAD.Text + '.bak0') then
+        ASSERT(DeleteFile(eWAD.Text + '.bak0'));
+      ASSERT(RenameFile(eWAD.Text, eWAD.Text + '.bak0'))
+    end
+  end;
 
 // Читаем карту из памяти:
   mr := TMapReader_1.Create();
@@ -178,11 +155,11 @@ begin
   if cbTextrures.Checked and (textures <> nil) then
     for a := 0 to High(textures) do
     begin
-      res := textures[a].Resource;
+      res := win2utf(textures[a].Resource);
       if IsSpecialTexture(res) then
         Continue;
 
-      g_ProcessResourceStr(res, @filename, @section, @resource);
+      g_GetResourceSection(res, filename, section, resource);
 
     // Не записывать стандартные текстуры:
       if (not cbNonStandart.Checked) or
@@ -190,15 +167,14 @@ begin
            (AnsiLowerCase(filename) <> SHRSHADE_WAD) ) then
       begin
       // Копируем ресурс текстуры:
-        if not 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;
 
       // Переименовываем ресурс текстуры:
-        res := Format(':%s\%s', [tsection, resource]);
+        res := utf2win(Format(':%s\%s', [tsection, resource]));
         ZeroMemory(@textures[a].Resource[0], 64);
         CopyMemory(@textures[a].Resource[0], @res[1], Min(Length(res), 64));
       end;
@@ -210,8 +186,8 @@ begin
 // Нужно копировать небо:
   if cbSky.Checked then
   begin
-    res := header.SkyName;
-    g_ProcessResourceStr(res, @filename, @section, @resource);
+    res := win2utf(header.SkyName);
+    g_GetResourceSection(res, filename, section, resource);
 
   // Не записывать стандартное небо:
     if (not cbNonStandart.Checked) or
@@ -219,15 +195,14 @@ begin
          (AnsiLowerCase(filename) <> SHRSHADE_WAD) ) then
     begin
     // Копируем ресурс неба:
-      if not 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;
 
     // Переименовываем ресурс неба:
-      res := Format(':%s\%s', [ssection, resource]);
+      res := utf2win(Format(':%s\%s', [ssection, resource]));
       ZeroMemory(@header.SkyName[0], 64);
       CopyMemory(@header.SkyName[0], @res[1], Min(Length(res), 64));
     end;
@@ -236,8 +211,8 @@ begin
 // Нужно копировать музыку:
   if cbMusic.Checked then
   begin
-    res := header.MusicName;
-    g_ProcessResourceStr(res, @filename, @section, @resource);
+    res := win2utf(header.MusicName);
+    g_GetResourceSection(res, filename, section, resource);
 
   // Не записывать стандартную музыку:
     if (not cbNonStandart.Checked) or
@@ -245,15 +220,14 @@ begin
          (AnsiLowerCase(filename) <> SHRSHADE_WAD) ) then
     begin
     // Копируем ресурс музыки:
-      if not 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;
 
     // Переименовываем ресурс музыки:
-      res := Format(':%s\%s', [msection, resource]);
+      res := utf2win(Format(':%s\%s', [msection, resource]));
       ZeroMemory(@header.MusicName[0], 64);
       CopyMemory(@header.MusicName[0], @res[1], Min(Length(res), 64));
     end;
@@ -298,7 +272,7 @@ begin
           if res = '' then
             Break;
 
-          g_ProcessResourceStr(res, @filename, @section, @resource);
+          g_GetResourceSection(res, @filename, @section, @resource);
 
         // Не записывать стандартные дополнительные текстуры:
           if (not cbNonStandart.Checked) or
@@ -306,12 +280,12 @@ begin
                (AnsiLowerCase(filename) <> SHRSHADE_WAD) ) then
           begin
           // Копируем ресурс дополнительной текстуры:
-            if ProcessResource(WAD, tsection, filename, section, resource) then
+            if f_packmap.ProcessResource(eWAD.Text, tsection, filename, section, resource) then
             begin
 
               Нужно проверять есть такая текстура textures и есть ли она вообще?
             // Переименовываем ресурс текстуры:
-              res := Format(':%s\%s', [tsection, resource]);
+              res := utf2win(Format(':%s\%s', [tsection, resource]));
               ZeroMemory(@textures[a].Resource[0], 64);
               CopyMemory(@textures[a].Resource[0], @res[1], Min(Length(res), 64));
 
@@ -338,18 +312,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);