index c9e093e88197ff6c0929feb88dba9c996199d9dc..cdbe1056f9fde71dd1a11c5d2bfd53dac216faff 100644 (file)
--- a/src/editor/f_packmap.pas
+++ b/src/editor/f_packmap.pas
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)
uses
BinEditor, WADEDITOR, g_map, MAPREADER, MAPWRITER, MAPSTRUCT,
- f_main, math, g_language;
+ f_main, math, g_language, g_resources, e_log;
{$R *.lfm}
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;
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();
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
(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;
// Нужно копировать небо:
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
(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;
// Нужно копировать музыку:
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
(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;
if res = '' then
Break;
- g_ProcessResourceStr(res, @filename, @section, @resource);
+ g_GetResourceSection(res, @filename, @section, @resource);
// Не записывать стандартные дополнительные текстуры:
if (not cbNonStandart.Checked) or
(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));
// Сохраняем карту из памяти под новым именем в 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);