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