3 {$INCLUDE ../shared/a_modes.inc}
8 LCLIntf
, LCLType
, LMessages
, SysUtils
, Variants
, Classes
,
9 Graphics
, Controls
, Forms
, Dialogs
, StdCtrls
, ExtCtrls
, utils
;
12 TPackMapForm
= class (TForm
)
14 SaveDialog
: TSaveDialog
;
24 cbTextrures
: TCheckBox
;
25 LabelTextures
: TLabel
;
37 cbNonStandart
: TCheckBox
;
39 procedure bSelectWADClick(Sender
: TObject
);
40 procedure bPackClick(Sender
: TObject
);
41 procedure FormCreate(Sender
: TObject
);
44 { Private declarations }
46 { Public declarations }
50 PackMapForm
: TPackMapForm
;
55 BinEditor
, WADEDITOR
, g_map
, MAPREADER
, MAPWRITER
, MAPSTRUCT
,
56 f_main
, math
, g_language
;
61 STANDART_WAD
= 'standart.wad';
62 SHRSHADE_WAD
= 'shrshade.wad';
65 procedure TPackMapForm
.bSelectWADClick(Sender
: TObject
);
67 SaveDialog
.Filter
:= _lc
[I_FILE_FILTER_WAD
];
69 if SaveDialog
.Execute() then
70 eWAD
.Text := SaveDialog
.FileName
;
73 function ProcessResource(wad_to
: TWADEditor_1
;
74 section_to
, filename
, section
, resource
: String): Boolean;
85 g_ProcessResourceStr(OpenedMap
, @filename
, nil, nil)
87 filename
:= EditorDir
+'wads/'+filename
;
89 // Читаем ресурс из WAD-файла карты или какого-то другого:
90 wad2
:= TWADEditor_1
.Create();
92 if not wad2
.ReadFile(filename
) then
94 MessageBox(0, PChar(Format(_lc
[I_MSG_WAD_ERROR
],
95 [ExtractFileName(filename
)])),
96 PChar(_lc
[I_MSG_ERROR
]), MB_OK
+ MB_ICONERROR
);
101 if not wad2
.GetResource(utf2win(section
), utf2win(resource
), data
, reslen
) then
103 MessageBox(0, PChar(Format(_lc
[I_MSG_RES_ERROR
],
104 [filename
, section
, resource
])),
105 PChar(_lc
[I_MSG_ERROR
]), MB_OK
+ MB_ICONERROR
);
112 {if wad_to.HaveResource(utf2win(section_to), utf2win(resource)) then
117 if not wad_to.HaveResource(utf2win(section_to), utf2win(resource+s)) then Break;
119 resource := resource+s;
122 // Если такого ресурса нет в WAD-файле-назначении, то копируем:
123 if not wad_to
.HaveResource(utf2win(section_to
), utf2win(resource
)) then
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
));
135 procedure TPackMapForm
.bPackClick(Sender
: TObject
);
142 textures
: TTexturesRec1Array
;
143 header
: TMapHeaderRec_1
;
145 res
, tsection
, ssection
, msection
, filename
, section
, resource
: String;
148 if eWAD
.Text = '' then
150 if eResource
.Text = '' then
153 tsection
:= eTSection
.Text;
154 ssection
:= eSSection
.Text;
155 msection
:= eMSection
.Text;
157 // Сохраняем карту в память:
162 WAD
:= TWADEditor_1
.Create();
164 // Не перезаписывать WAD, а дополнить:
165 if cbAdd
.Checked
then
166 if WAD
.ReadFile(eWAD
.Text) then
169 // Читаем карту из памяти:
170 mr
:= TMapReader_1
.Create();
174 // Получаем текстуры:
175 textures
:= mr
.GetTextures();
177 // Нужно копировать текстуры:
178 if cbTextrures
.Checked
and (textures
<> nil) then
179 for a
:= 0 to High(textures
) do
181 res
:= win2utf(textures
[a
].Resource
);
182 if IsSpecialTexture(res
) then
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
192 // Копируем ресурс текстуры:
193 if not f_packmap
.ProcessResource(WAD
, tsection
, filename
, section
, resource
) then
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));
207 // Получаем заголовок карты:
208 header
:= mr
.GetMapHeader();
210 // Нужно копировать небо:
211 if cbSky
.Checked
then
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
221 // Копируем ресурс неба:
222 if not f_packmap
.ProcessResource(WAD
, ssection
, filename
, section
, resource
) then
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));
236 // Нужно копировать музыку:
237 if cbMusic
.Checked
then
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
247 // Копируем ресурс музыки:
248 if not f_packmap
.ProcessResource(WAD
, msection
, filename
, section
, resource
) then
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));
263 // Нужно копировать дополнительные текстуры:
264 if cbTextrures.Checked and (textures <> nil) and
265 (gPanels <> nil) and (gTriggers <> nil) then
267 for a := 0 to High(gPanels) do
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
284 // Есть триггеры на эту панель:
285 if ok and (gPanels[a].TextureName <> '') and
286 (not IsSpecialTexture(gPanels[a].TextureName) and
287 g_Texture_NumNameFindStart(gPanels[a].TextureName) then
291 r := g_Texture_NumNameFindNext(res);
294 NNF_NAME_EQUALS: Continue;
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
308 // Копируем ресурс дополнительной текстуры:
309 if f_packmap.ProcessResource(WAD, tsection, filename, section, resource) then
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));
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);
348 MessageDlg(Format(_lc
[I_MSG_PACKED
],
349 [eResource
.Text, ExtractFileName(eWAD
.Text)]),
350 mtInformation
, [mbOK
], 0);
355 procedure TPackMapForm
.FormCreate(Sender
: TObject
);
357 SaveDialog
.InitialDir
:= EditorDir
;