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