src/editor/f_packmap.pas

   1 unit f_packmap;
   2
   3 {$INCLUDE ../shared/a_modes.inc}
   4
   5 interface
   6
   7 uses
   8   LCLIntf, LCLType, LMessages, SysUtils, Variants, Classes,
   9   Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, utils;
  10
  11 type
  12   TPackMapForm = class (TForm)
  13     bPack: TButton;
  14     SaveDialog: TSaveDialog;
  15     Panel1: TPanel;
  16   // Сохранить в:
  17     LabelSaveTo: TLabel;
  18     eWAD: TEdit;
  19     bSelectWAD: TButton;
  20   // Имя карты:
  21     LabelMapName: TLabel;
  22     eResource: TEdit;
  23   // Текстуры:
  24     cbTextrures: TCheckBox;
  25     LabelTextures: TLabel;
  26     eTSection: TEdit;
  27   // Небо:
  28     cbSky: TCheckBox;
  29     LabelSky: TLabel;
  30     eSSection: TEdit;
  31   // Музыка:
  32     cbMusic: TCheckBox;
  33     LabelMusic: TLabel;
  34     eMSection: TEdit;
  35   // Дополнительно:
  36     cbAdd: TCheckBox;
  37     cbNonStandart: TCheckBox;
  38
  39     procedure bSelectWADClick(Sender: TObject);
  40     procedure bPackClick(Sender: TObject);
  41     procedure FormCreate(Sender: TObject);
  42
  43   private
  44     { Private declarations }
  45   public
  46     { Public declarations }
  47   end;
  48
  49 var
  50   PackMapForm: TPackMapForm;
  51
  52 implementation
  53
  54 uses
  55   BinEditor, WADEDITOR, g_map, MAPREADER, MAPWRITER, MAPSTRUCT,
  56   f_main, math, g_language, g_resources, e_log;
  57
  58 {$R *.lfm}
  59
  60 const
  61   STANDART_WAD = 'standart.wad';
  62   SHRSHADE_WAD = 'shrshade.wad';
  63
  64
  65 procedure TPackMapForm.bSelectWADClick(Sender: TObject);
  66 begin
  67   SaveDialog.Filter := _lc[I_FILE_FILTER_WAD];
  68
  69   if SaveDialog.Execute() then
  70     eWAD.Text := SaveDialog.FileName;
  71 end;
  72
  73 function ProcessResource(wad_to, section_to, filename, section, resource: String): Boolean;
  74   var
  75     data: Pointer;
  76     res, len: Integer;
  77     us, un: String;
  78 begin
  79   Result := True;
  80   if filename = '' then
  81     g_GetResourceSection(OpenedMap, filename, us, un)
  82   else
  83     filename := EditorDir + 'wads/' + filename;
  84   e_WriteLog('ProcessResource: "' + wad_to + '" "' + section_to + '" "' + filename + '" "' + section + '" "' + resource + '"', MSG_NOTIFY);
  85
  86   if resource = '' then Exit;
  87
  88   g_ReadResource(filename, section, resource, data, len);
  89   if data <> nil then
  90   begin
  91     (* Write resource only if it does not exists *)
  92     g_ExistsResource(wad_to, section_to, resource, res);
  93     if res <> 0 then
  94     begin
  95       g_AddResource(wad_to, section_to, resource, data, len, res);
  96       ASSERT(res = 0)
  97     end;
  98     FreeMem(data);
  99   end
 100   else
 101   begin
 102     //MessageBox(0, PChar(Format(_lc[I_MSG_WAD_ERROR], [ExtractFileName(filename)])), PChar(_lc[I_MSG_ERROR]), MB_OK + MB_ICONERROR);
 103     MessageBox(0, PChar(Format(_lc[I_MSG_RES_ERROR], [filename, section, resource])), PChar(_lc[I_MSG_ERROR]), MB_OK + MB_ICONERROR);
 104     Result := False
 105   end
 106 end;
 107
 108 procedure TPackMapForm.bPackClick(Sender: TObject);
 109 var
 110   WadFile: String;
 111   mr: TMapReader_1;
 112   mw: TMapWriter_1;
 113   data: Pointer;
 114   len: LongWord;
 115   textures: TTexturesRec1Array;
 116   header: TMapHeaderRec_1;
 117   a: Integer;
 118   res, tsection, ssection, msection, filename, section, resource: String;
 119
 120 begin
 121   if eWAD.Text = '' then
 122     Exit;
 123   if eResource.Text = '' then
 124     Exit;
 125
 126   tsection := eTSection.Text;
 127   ssection := eSSection.Text;
 128   msection := eMSection.Text;
 129
 130 // Сохраняем карту в память:
 131   data := SaveMap('');
 132   if data = nil then
 133     Exit;
 134
 135   if not cbAdd.Checked then
 136   begin
 137     (* Overwrite wad *)
 138     if FileExists(eWAD.Text) then
 139     begin
 140       if FileExists(eWAD.Text + '.bak0') then
 141         ASSERT(DeleteFile(eWAD.Text + '.bak0'));
 142       ASSERT(RenameFile(eWAD.Text, eWAD.Text + '.bak0'))
 143     end
 144   end;
 145
 146 // Читаем карту из памяти:
 147   mr := TMapReader_1.Create();
 148   mr.LoadMap(data);
 149   FreeMem(data);
 150
 151 // Получаем текстуры:
 152   textures := mr.GetTextures();
 153
 154 // Нужно копировать текстуры:
 155   if cbTextrures.Checked and (textures <> nil) then
 156     for a := 0 to High(textures) do
 157     begin
 158       res := win2utf(textures[a].Resource);
 159       if IsSpecialTexture(res) then
 160         Continue;
 161
 162       g_GetResourceSection(res, filename, section, resource);
 163
 164     // Не записывать стандартные текстуры:
 165       if (not cbNonStandart.Checked) or
 166          ( (AnsiLowerCase(filename) <> STANDART_WAD) and
 167            (AnsiLowerCase(filename) <> SHRSHADE_WAD) ) then
 168       begin
 169       // Копируем ресурс текстуры:
 170         if not f_packmap.ProcessResource(eWAD.Text, tsection, filename, section, resource) then
 171         begin
 172           mr.Free();
 173           Exit;
 174         end;
 175
 176       // Переименовываем ресурс текстуры:
 177         res := utf2win(Format(':%s\%s', [tsection, resource]));
 178         ZeroMemory(@textures[a].Resource[0], 64);
 179         CopyMemory(@textures[a].Resource[0], @res[1], Min(Length(res), 64));
 180       end;
 181     end;
 182
 183 // Получаем заголовок карты:
 184   header := mr.GetMapHeader();
 185
 186 // Нужно копировать небо:
 187   if cbSky.Checked then
 188   begin
 189     res := win2utf(header.SkyName);
 190     g_GetResourceSection(res, filename, section, resource);
 191
 192   // Не записывать стандартное небо:
 193     if (not cbNonStandart.Checked) or
 194        ( (AnsiLowerCase(filename) <> STANDART_WAD) and
 195          (AnsiLowerCase(filename) <> SHRSHADE_WAD) ) then
 196     begin
 197     // Копируем ресурс неба:
 198       if not f_packmap.ProcessResource(eWAD.Text, ssection, filename, section, resource) then
 199       begin
 200         mr.Free();
 201         Exit;
 202       end;
 203
 204     // Переименовываем ресурс неба:
 205       res := utf2win(Format(':%s\%s', [ssection, resource]));
 206       ZeroMemory(@header.SkyName[0], 64);
 207       CopyMemory(@header.SkyName[0], @res[1], Min(Length(res), 64));
 208     end;
 209   end;
 210
 211 // Нужно копировать музыку:
 212   if cbMusic.Checked then
 213   begin
 214     res := win2utf(header.MusicName);
 215     g_GetResourceSection(res, filename, section, resource);
 216
 217   // Не записывать стандартную музыку:
 218     if (not cbNonStandart.Checked) or
 219        ( (AnsiLowerCase(filename) <> STANDART_WAD) and
 220          (AnsiLowerCase(filename) <> SHRSHADE_WAD) ) then
 221     begin
 222     // Копируем ресурс музыки:
 223       if not f_packmap.ProcessResource(eWAD.Text, msection, filename, section, resource) then
 224       begin
 225         mr.Free();
 226         Exit;
 227       end;
 228
 229     // Переименовываем ресурс музыки:
 230       res := utf2win(Format(':%s\%s', [msection, resource]));
 231       ZeroMemory(@header.MusicName[0], 64);
 232       CopyMemory(@header.MusicName[0], @res[1], Min(Length(res), 64));
 233     end;
 234   end;
 235
 236   {
 237 // Нужно копировать дополнительные текстуры:
 238   if cbTextrures.Checked and (textures <> nil) and
 239      (gPanels <> nil) and (gTriggers <> nil) then
 240   begin
 241     for a := 0 to High(gPanels) do
 242     begin
 243       ok := False;
 244
 245     // Ссылаются ли на эту панель триггеры:
 246       for b := 0 to High(gTriggers) do
 247         if ( (gTriggers[b].TriggerType in [TRIGGER_OPENDOOR,
 248                 TRIGGER_CLOSEDOOR, TRIGGER_DOOR, TRIGGER_DOOR5,
 249                 TRIGGER_CLOSETRAP, TRIGGER_TRAP, TRIGGER_LIFTUP,
 250                 TRIGGER_LIFTDOWN, TRIGGER_LIFT]) and
 251              (gTriggers[b].Data.PanelID = a) ) or
 252            (gTriggers[b].TexturePanel = a) then
 253         begin
 254           ok := True;
 255           Break;
 256         end;
 257
 258     // Есть триггеры на эту панель:
 259       if ok and (gPanels[a].TextureName <> '') and
 260          (not IsSpecialTexture(gPanels[a].TextureName) and
 261          g_Texture_NumNameFindStart(gPanels[a].TextureName) then
 262       begin
 263         while True do
 264         begin
 265           r := g_Texture_NumNameFindNext(res);
 266           case r of
 267             NNF_NAME_FOUND: ;
 268             NNF_NAME_EQUALS: Continue;
 269             else Break;
 270           end;
 271
 272           if res = '' then
 273             Break;
 274
 275           g_GetResourceSection(res, @filename, @section, @resource);
 276
 277         // Не записывать стандартные дополнительные текстуры:
 278           if (not cbNonStandart.Checked) or
 279              ( (AnsiLowerCase(filename) <> STANDART_WAD) and
 280                (AnsiLowerCase(filename) <> SHRSHADE_WAD) ) then
 281           begin
 282           // Копируем ресурс дополнительной текстуры:
 283             if f_packmap.ProcessResource(eWAD.Text, tsection, filename, section, resource) then
 284             begin
 285
 286               Нужно проверять есть такая текстура textures и есть ли она вообще?
 287             // Переименовываем ресурс текстуры:
 288               res := utf2win(Format(':%s\%s', [tsection, resource]));
 289               ZeroMemory(@textures[a].Resource[0], 64);
 290               CopyMemory(@textures[a].Resource[0], @res[1], Min(Length(res), 64));
 291
 292
 293
 294             end;
 295           end;
 296         end; // while True
 297       end;
 298     end;
 299   end;
 300   }
 301
 302 // Записываем изменения карты:
 303   mw := TMapWriter_1.Create();
 304
 305   mw.AddHeader(header);
 306   mw.AddTextures(textures);
 307   mw.AddPanels(mr.GetPanels());
 308   mw.AddItems(mr.GetItems());
 309   mw.AddAreas(mr.GetAreas());
 310   mw.AddMonsters(mr.GetMonsters());
 311   mw.AddTriggers(mr.GetTriggers());
 312
 313 // Сохраняем карту из памяти под новым именем в WAD-файл:
 314   len := mw.SaveMap(data);
 315   g_AddResource(eWAD.Text, '', eResource.Text, data, len, a);
 316   mw.Free();
 317   mr.Free();
 318   Close();
 319
 320   ASSERT(a = 0); (* saved *)
 321   MessageDlg(Format(_lc[I_MSG_PACKED], [eResource.Text, ExtractFileName(eWAD.Text)]), mtInformation, [mbOK], 0);
 322 end;
 323
 324 procedure TPackMapForm.FormCreate(Sender: TObject);
 325 begin
 326   SaveDialog.InitialDir := EditorDir;
 327 end;
 328
 329 end.