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