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