DEADSOFTWARE

Two small additional fixes for Lazarus
[d2df-editor.git] / src / editor / f_packmap.pas
1 unit f_packmap;
3 {$INCLUDE ../shared/a_modes.inc}
5 interface
7 uses
8 LCLIntf, LCLType, LMessages, SysUtils, Variants, Classes,
9 Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, utils;
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;
39 procedure bSelectWADClick(Sender: TObject);
40 procedure bPackClick(Sender: TObject);
41 procedure FormCreate(Sender: TObject);
43 private
44 { Private declarations }
45 public
46 { Public declarations }
47 end;
49 var
50 PackMapForm: TPackMapForm;
52 implementation
54 uses
55 BinEditor, WADEDITOR, g_map, MAPREADER, MAPWRITER, MAPSTRUCT,
56 f_main, math, g_language;
58 {$R *.lfm}
60 const
61 STANDART_WAD = 'standart.wad';
62 SHRSHADE_WAD = 'shrshade.wad';
65 procedure TPackMapForm.bSelectWADClick(Sender: TObject);
66 begin
67 SaveDialog.Filter := _lc[I_FILE_FILTER_WAD];
69 if SaveDialog.Execute() then
70 eWAD.Text := SaveDialog.FileName;
71 end;
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;
81 begin
82 Result := False;
84 if filename = '' then
85 g_ProcessResourceStr(OpenedMap, @filename, nil, nil)
86 else
87 filename := EditorDir+'wads/'+filename;
89 // Читаем ресурс из WAD-файла карты или какого-то другого:
90 wad2 := TWADEditor_1.Create();
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;
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;
110 wad2.Free();
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;}
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;
130 FreeMem(data);
132 Result := True;
133 end;
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;
147 begin
148 if eWAD.Text = '' then
149 Exit;
150 if eResource.Text = '' then
151 Exit;
153 tsection := eTSection.Text;
154 ssection := eSSection.Text;
155 msection := eMSection.Text;
157 // Сохраняем карту в память:
158 data := SaveMap('');
159 if data = nil then
160 Exit;
162 WAD := TWADEditor_1.Create();
164 // Не перезаписывать WAD, а дополнить:
165 if cbAdd.Checked then
166 if WAD.ReadFile(eWAD.Text) then
167 WAD.CreateImage();
169 // Читаем карту из памяти:
170 mr := TMapReader_1.Create();
171 mr.LoadMap(data);
172 FreeMem(data);
174 // Получаем текстуры:
175 textures := mr.GetTextures();
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;
185 g_ProcessResourceStr(res, @filename, @section, @resource);
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;
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;
207 // Получаем заголовок карты:
208 header := mr.GetMapHeader();
210 // Нужно копировать небо:
211 if cbSky.Checked then
212 begin
213 res := win2utf(header.SkyName);
214 g_ProcessResourceStr(res, @filename, @section, @resource);
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;
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;
236 // Нужно копировать музыку:
237 if cbMusic.Checked then
238 begin
239 res := win2utf(header.MusicName);
240 g_ProcessResourceStr(res, @filename, @section, @resource);
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;
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;
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;
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;
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;
298 if res = '' then
299 Break;
301 g_ProcessResourceStr(res, @filename, @section, @resource);
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
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));
320 end;
321 end;
322 end; // while True
323 end;
324 end;
325 end;
328 // Записываем изменения карты:
329 mw := TMapWriter_1.Create();
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());
339 // Сохраняем карту из памяти под новым именем в WAD-файл:
340 len := mw.SaveMap(data);
341 WAD.AddResource(data, len, eResource.Text, '');
342 WAD.SaveTo(eWAD.Text);
344 mw.Free();
345 mr.Free();
346 WAD.Free();
348 MessageDlg(Format(_lc[I_MSG_PACKED],
349 [eResource.Text, ExtractFileName(eWAD.Text)]),
350 mtInformation, [mbOK], 0);
352 Close();
353 end;
355 procedure TPackMapForm.FormCreate(Sender: TObject);
356 begin
357 SaveDialog.InitialDir := EditorDir;
358 end;
360 end.