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
, g_options
, e_log
;
61 STANDART_WAD
= 'standart.wad';
62 SHRSHADE_WAD
= 'shrshade.wad';
65 procedure TPackMapForm
.bSelectWADClick(Sender
: TObject
);
67 SaveDialog
.Filter
:= MsgFileFilterWad
;
69 if SaveDialog
.Execute() then
70 eWAD
.Text := SaveDialog
.FileName
;
73 function ProcessResource(wad_to
: TWADEditor_1
; section_to
, filename
, section
, resource
: String): Boolean;
84 g_ProcessResourceStr(OpenedMap
, @filename
, nil, nil)
86 filename
:= WadsDir
+ DirectorySeparator
+ filename
;
88 // Читаем ресурс из WAD-файла карты или какого-то другого:
89 wad2
:= TWADEditor_1
.Create();
91 if not wad2
.ReadFile(filename
) then
93 Application
.MessageBox(PChar(Format(MsgMsgWadError
, [ExtractFileName(filename
)])), PChar(MsgMsgError
), MB_OK
+ MB_ICONERROR
);
98 if not wad2
.GetResource(utf2win(section
), utf2win(resource
), data
, reslen
) then
100 Application
.MessageBox(PChar(Format(MsgMsgResError
, [filename
, section
, resource
])), PChar(MsgMsgError
), MB_OK
+ MB_ICONERROR
);
107 {if wad_to.HaveResource(utf2win(section_to), utf2win(resource)) then
112 if not wad_to.HaveResource(utf2win(section_to), utf2win(resource+s)) then Break;
114 resource := resource+s;
117 // Если такого ресурса нет в WAD-файле-назначении, то копируем:
118 if not wad_to
.HaveResource(utf2win(section_to
), utf2win(resource
)) then
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
));
130 procedure TPackMapForm
.bPackClick(Sender
: TObject
);
137 textures
: TTexturesRec1Array
;
138 header
: TMapHeaderRec_1
;
140 res
, tsection
, ssection
, msection
, filename
, section
, resource
: String;
143 if eWAD
.Text = '' then
145 if eResource
.Text = '' then
148 tsection
:= eTSection
.Text;
149 ssection
:= eSSection
.Text;
150 msection
:= eMSection
.Text;
152 // Сохраняем карту в память:
153 data
:= SaveMap('', '');
157 WAD
:= TWADEditor_1
.Create();
159 // Не перезаписывать WAD, а дополнить:
160 if cbAdd
.Checked
then
161 if WAD
.ReadFile(eWAD
.Text) then
164 // Читаем карту из памяти:
165 mr
:= TMapReader_1
.Create();
169 // Получаем текстуры:
170 textures
:= mr
.GetTextures();
172 // Нужно копировать текстуры:
173 if cbTextrures
.Checked
and (textures
<> nil) then
174 for a
:= 0 to High(textures
) do
176 res
:= win2utf(textures
[a
].Resource
);
177 if IsSpecialTexture(res
) then
180 g_ProcessResourceStr(res
, @filename
, @section
, @resource
);
182 // Не записывать стандартные текстуры:
183 if (not cbNonStandart
.Checked
) or
184 ( (AnsiLowerCase(filename
) <> STANDART_WAD
) and
185 (AnsiLowerCase(filename
) <> SHRSHADE_WAD
) ) then
187 // Копируем ресурс текстуры:
188 if not f_packmap
.ProcessResource(WAD
, tsection
, filename
, section
, resource
) then
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));
202 // Получаем заголовок карты:
203 header
:= mr
.GetMapHeader();
205 // Нужно копировать небо:
206 if cbSky
.Checked
then
208 res
:= win2utf(header
.SkyName
);
209 g_ProcessResourceStr(res
, @filename
, @section
, @resource
);
211 // Не записывать стандартное небо:
212 if (not cbNonStandart
.Checked
) or
213 ( (AnsiLowerCase(filename
) <> STANDART_WAD
) and
214 (AnsiLowerCase(filename
) <> SHRSHADE_WAD
) ) then
216 // Копируем ресурс неба:
217 if not f_packmap
.ProcessResource(WAD
, ssection
, filename
, section
, resource
) then
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));
231 // Нужно копировать музыку:
232 if cbMusic
.Checked
then
234 res
:= win2utf(header
.MusicName
);
235 g_ProcessResourceStr(res
, @filename
, @section
, @resource
);
237 // Не записывать стандартную музыку:
238 if (not cbNonStandart
.Checked
) or
239 ( (AnsiLowerCase(filename
) <> STANDART_WAD
) and
240 (AnsiLowerCase(filename
) <> SHRSHADE_WAD
) ) then
242 // Копируем ресурс музыки:
243 if not f_packmap
.ProcessResource(WAD
, msection
, filename
, section
, resource
) then
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));
258 // Нужно копировать дополнительные текстуры:
259 if cbTextrures.Checked and (textures <> nil) and
260 (gPanels <> nil) and (gTriggers <> nil) then
262 for a := 0 to High(gPanels) do
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
279 // Есть триггеры на эту панель:
280 if ok and (gPanels[a].TextureName <> '') and
281 (not IsSpecialTexture(gPanels[a].TextureName) and
282 g_Texture_NumNameFindStart(gPanels[a].TextureName) then
286 r := g_Texture_NumNameFindNext(res);
289 NNF_NAME_EQUALS: Continue;
296 g_ProcessResourceStr(res, @filename, @section, @resource);
298 // Не записывать стандартные дополнительные текстуры:
299 if (not cbNonStandart.Checked) or
300 ( (AnsiLowerCase(filename) <> STANDART_WAD) and
301 (AnsiLowerCase(filename) <> SHRSHADE_WAD) ) then
303 // Копируем ресурс дополнительной текстуры:
304 if f_packmap.ProcessResource(WAD, tsection, filename, section, resource) then
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));
323 // Записываем изменения карты:
324 mw
:= TMapWriter_1
.Create();
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());
334 // Сохраняем карту из памяти под новым именем в WAD-файл:
335 len
:= mw
.SaveMap(data
);
336 WAD
.AddResource(data
, len
, eResource
.Text, '');
337 WAD
.SaveTo(eWAD
.Text);
343 MessageDlg(Format(MsgMsgPacked
, [eResource
.Text, ExtractFileName(eWAD
.Text)]), mtInformation
, [mbOK
], 0);
347 procedure TPackMapForm
.FormCreate(Sender
: TObject
);
349 SaveDialog
.InitialDir
:= MapsDir
;