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;
  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: TWADEditor_1;
  74            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 := EditorDir+'wads/'+filename;
  88
  89 // Читаем ресурс из WAD-файла карты или какого-то другого:
  90   wad2 := TWADEditor_1.Create();
  91
  92   if not wad2.ReadFile(filename) then
  93   begin
  94     MessageBox(0, PChar(Format(_lc[I_MSG_WAD_ERROR],
  95                                    [ExtractFileName(filename)])),
  96                PChar(_lc[I_MSG_ERROR]), MB_OK + MB_ICONERROR);
  97     wad2.Free();
  98     Exit;
  99   end;
 100
 101   if not wad2.GetResource(utf2win(section), utf2win(resource), data, reslen) then
 102   begin
 103     MessageBox(0, PChar(Format(_lc[I_MSG_RES_ERROR],
 104                                    [filename, section, resource])),
 105                PChar(_lc[I_MSG_ERROR]), MB_OK + MB_ICONERROR);
 106     wad2.Free();
 107     Exit;
 108   end;
 109
 110   wad2.Free();
 111
 112  {if wad_to.HaveResource(utf2win(section_to), utf2win(resource)) then
 113  begin
 114   for a := 2 to 256 do
 115   begin
 116    s := IntToStr(a);
 117    if not wad_to.HaveResource(utf2win(section_to), utf2win(resource+s)) then Break;
 118   end;
 119   resource := resource+s;
 120  end;}
 121
 122 // Если такого ресурса нет в WAD-файле-назначении, то копируем:
 123   if not wad_to.HaveResource(utf2win(section_to), utf2win(resource)) then
 124   begin
 125     if not wad_to.HaveSection(utf2win(section_to)) then
 126       wad_to.AddSection(utf2win(section_to));
 127     wad_to.AddResource(data, reslen, utf2win(resource), utf2win(section_to));
 128   end;
 129
 130   FreeMem(data);
 131
 132   Result := True;
 133 end;
 134
 135 procedure TPackMapForm.bPackClick(Sender: TObject);
 136 var
 137   WAD: TWADEditor_1;
 138   mr: TMapReader_1;
 139   mw: TMapWriter_1;
 140   data: Pointer;
 141   len: LongWord;
 142   textures: TTexturesRec1Array;
 143   header: TMapHeaderRec_1;
 144   a: Integer;
 145   res, tsection, ssection, msection, filename, section, resource: String;
 146
 147 begin
 148   if eWAD.Text = '' then
 149     Exit;
 150   if eResource.Text = '' then
 151     Exit;
 152
 153   tsection := eTSection.Text;
 154   ssection := eSSection.Text;
 155   msection := eMSection.Text;
 156
 157 // Сохраняем карту в память:
 158   data := SaveMap('');
 159   if data = nil then
 160     Exit;
 161
 162   WAD := TWADEditor_1.Create();
 163
 164 // Не перезаписывать WAD, а дополнить:
 165   if cbAdd.Checked then
 166     if WAD.ReadFile(eWAD.Text) then
 167       WAD.CreateImage();
 168
 169 // Читаем карту из памяти:
 170   mr := TMapReader_1.Create();
 171   mr.LoadMap(data);
 172   FreeMem(data);
 173
 174 // Получаем текстуры:
 175   textures := mr.GetTextures();
 176
 177 // Нужно копировать текстуры:
 178   if cbTextrures.Checked and (textures <> nil) then
 179     for a := 0 to High(textures) do
 180     begin
 181       res := win2utf(textures[a].Resource);
 182       if IsSpecialTexture(res) then
 183         Continue;
 184
 185       g_ProcessResourceStr(res, @filename, @section, @resource);
 186
 187     // Не записывать стандартные текстуры:
 188       if (not cbNonStandart.Checked) or
 189          ( (AnsiLowerCase(filename) <> STANDART_WAD) and
 190            (AnsiLowerCase(filename) <> SHRSHADE_WAD) ) then
 191       begin
 192       // Копируем ресурс текстуры:
 193         if not ProcessResource(WAD, tsection, filename, section, resource) then
 194         begin
 195           mr.Free();
 196           WAD.Free();
 197           Exit;
 198         end;
 199
 200       // Переименовываем ресурс текстуры:
 201         res := utf2win(Format(':%s\%s', [tsection, resource]));
 202         ZeroMemory(@textures[a].Resource[0], 64);
 203         CopyMemory(@textures[a].Resource[0], @res[1], Min(Length(res), 64));
 204       end;
 205     end;
 206
 207 // Получаем заголовок карты:
 208   header := mr.GetMapHeader();
 209
 210 // Нужно копировать небо:
 211   if cbSky.Checked then
 212   begin
 213     res := win2utf(header.SkyName);
 214     g_ProcessResourceStr(res, @filename, @section, @resource);
 215
 216   // Не записывать стандартное небо:
 217     if (not cbNonStandart.Checked) or
 218        ( (AnsiLowerCase(filename) <> STANDART_WAD) and
 219          (AnsiLowerCase(filename) <> SHRSHADE_WAD) ) then
 220     begin
 221     // Копируем ресурс неба:
 222       if not ProcessResource(WAD, ssection, filename, section, resource) then
 223       begin
 224         mr.Free();
 225         WAD.Free();
 226         Exit;
 227       end;
 228
 229     // Переименовываем ресурс неба:
 230       res := utf2win(Format(':%s\%s', [ssection, resource]));
 231       ZeroMemory(@header.SkyName[0], 64);
 232       CopyMemory(@header.SkyName[0], @res[1], Min(Length(res), 64));
 233     end;
 234   end;
 235
 236 // Нужно копировать музыку:
 237   if cbMusic.Checked then
 238   begin
 239     res := win2utf(header.MusicName);
 240     g_ProcessResourceStr(res, @filename, @section, @resource);
 241
 242   // Не записывать стандартную музыку:
 243     if (not cbNonStandart.Checked) or
 244        ( (AnsiLowerCase(filename) <> STANDART_WAD) and
 245          (AnsiLowerCase(filename) <> SHRSHADE_WAD) ) then
 246     begin
 247     // Копируем ресурс музыки:
 248       if not ProcessResource(WAD, msection, filename, section, resource) then
 249       begin
 250         mr.Free();
 251         WAD.Free();
 252         Exit;
 253       end;
 254
 255     // Переименовываем ресурс музыки:
 256       res := utf2win(Format(':%s\%s', [msection, resource]));
 257       ZeroMemory(@header.MusicName[0], 64);
 258       CopyMemory(@header.MusicName[0], @res[1], Min(Length(res), 64));
 259     end;
 260   end;
 261
 262   {
 263 // Нужно копировать дополнительные текстуры:
 264   if cbTextrures.Checked and (textures <> nil) and
 265      (gPanels <> nil) and (gTriggers <> nil) then
 266   begin
 267     for a := 0 to High(gPanels) do
 268     begin
 269       ok := False;
 270
 271     // Ссылаются ли на эту панель триггеры:
 272       for b := 0 to High(gTriggers) do
 273         if ( (gTriggers[b].TriggerType in [TRIGGER_OPENDOOR,
 274                 TRIGGER_CLOSEDOOR, TRIGGER_DOOR, TRIGGER_DOOR5,
 275                 TRIGGER_CLOSETRAP, TRIGGER_TRAP, TRIGGER_LIFTUP,
 276                 TRIGGER_LIFTDOWN, TRIGGER_LIFT]) and
 277              (gTriggers[b].Data.PanelID = a) ) or
 278            (gTriggers[b].TexturePanel = a) then
 279         begin
 280           ok := True;
 281           Break;
 282         end;
 283
 284     // Есть триггеры на эту панель:
 285       if ok and (gPanels[a].TextureName <> '') and
 286          (not IsSpecialTexture(gPanels[a].TextureName) and
 287          g_Texture_NumNameFindStart(gPanels[a].TextureName) then
 288       begin
 289         while True do
 290         begin
 291           r := g_Texture_NumNameFindNext(res);
 292           case r of
 293             NNF_NAME_FOUND: ;
 294             NNF_NAME_EQUALS: Continue;
 295             else Break;
 296           end;
 297
 298           if res = '' then
 299             Break;
 300
 301           g_ProcessResourceStr(res, @filename, @section, @resource);
 302
 303         // Не записывать стандартные дополнительные текстуры:
 304           if (not cbNonStandart.Checked) or
 305              ( (AnsiLowerCase(filename) <> STANDART_WAD) and
 306                (AnsiLowerCase(filename) <> SHRSHADE_WAD) ) then
 307           begin
 308           // Копируем ресурс дополнительной текстуры:
 309             if ProcessResource(WAD, tsection, filename, section, resource) then
 310             begin
 311
 312               Нужно проверять есть такая текстура textures и есть ли она вообще?
 313             // Переименовываем ресурс текстуры:
 314               res := utf2win(Format(':%s\%s', [tsection, resource]));
 315               ZeroMemory(@textures[a].Resource[0], 64);
 316               CopyMemory(@textures[a].Resource[0], @res[1], Min(Length(res), 64));
 317
 318
 319
 320             end;
 321           end;
 322         end; // while True
 323       end;
 324     end;
 325   end;
 326   }
 327
 328 // Записываем изменения карты:
 329   mw := TMapWriter_1.Create();
 330
 331   mw.AddHeader(header);
 332   mw.AddTextures(textures);
 333   mw.AddPanels(mr.GetPanels());
 334   mw.AddItems(mr.GetItems());
 335   mw.AddAreas(mr.GetAreas());
 336   mw.AddMonsters(mr.GetMonsters());
 337   mw.AddTriggers(mr.GetTriggers());
 338
 339 // Сохраняем карту из памяти под новым именем в WAD-файл:
 340   len := mw.SaveMap(data);
 341   WAD.AddResource(data, len, eResource.Text, '');
 342   WAD.SaveTo(eWAD.Text);
 343
 344   mw.Free();
 345   mr.Free();
 346   WAD.Free();
 347
 348   MessageDlg(Format(_lc[I_MSG_PACKED],
 349                     [eResource.Text, ExtractFileName(eWAD.Text)]),
 350              mtInformation, [mbOK], 0);
 351
 352   Close();
 353 end;
 354
 355 procedure TPackMapForm.FormCreate(Sender: TObject);
 356 begin
 357   SaveDialog.InitialDir := EditorDir;
 358 end;
 359
 360 end.