DEADSOFTWARE

info: show enet version on startup
[d2df-sdl.git] / src / tools / mapgen.dpr
1 {$INCLUDE ../shared/a_modes.inc}
2 {$IFDEF WINDOWS}
3 {$APPTYPE CONSOLE}
4 {$ENDIF}
6 uses
7 SysUtils, Classes,
8 mempool in '../shared/mempool.pas',
9 xstreams in '../shared/xstreams.pas',
10 xparser in '../shared/xparser.pas',
11 xdynrec in '../shared/xdynrec.pas',
12 xprofiler in '../shared/xprofiler.pas',
13 utils in '../shared/utils.pas',
14 hashtable in '../shared/hashtable.pas',
15 conbuf in '../shared/conbuf.pas',
16 e_log in '../engine/e_log.pas';
19 // ////////////////////////////////////////////////////////////////////////// //
20 type
21 THashStrFld = specialize THashBase<AnsiString, TDynField, THashKeyStr>;
24 // ////////////////////////////////////////////////////////////////////////// //
25 var
26 dfmapdef: TDynMapDef;
29 // ////////////////////////////////////////////////////////////////////////// //
30 procedure genTrigCacheVars (const fname: AnsiString);
31 var
32 fo: TextFile;
33 tidx, fidx, nidx: Integer;
34 trec: TDynRecord;
35 fld: TDynField;
36 palias: AnsiString;
37 fldknown: THashStrFld = nil; // key: palias; value: prev field
38 begin
39 AssignFile(fo, fname);
40 {$I+}Rewrite(fo);{$I-}
42 fldknown := THashStrFld.Create();
44 write(fo, '// trigger cache'#10);
45 for tidx := 0 to dfmapdef.trigTypeCount-1 do
46 begin
47 // header comment
48 write(fo, #10);
49 trec := dfmapdef.trigTypeAt[tidx];
50 for nidx := 0 to trec.forTrigCount-1 do
51 begin
52 write(fo, '//', trec.forTrigAt[nidx], #10);
53 end;
54 // fields
55 for fidx := 0 to trec.count-1 do
56 begin
57 fld := trec.fieldAt[fidx];
58 if fld.internal then continue;
59 // HACK!
60 if (fld.name = 'panelid') or (fld.name = 'monsterid') then
61 begin
62 //writeln('skipping <', fld.name, '>');
63 continue;
64 end;
65 palias := fld.palias(true);
66 // don't write duplicate fields
67 if fldknown.has(toLowerCase1251(palias)) then continue;
68 fldknown.put(toLowerCase1251(palias), fld);
69 // write field definition
70 case fld.baseType of
71 TDynField.TType.TBool: write(fo, 'tgc', palias, ': Boolean;'#10);
72 TDynField.TType.TChar: write(fo, 'tgc', palias, ': AnsiString;'#10);
73 TDynField.TType.TByte: write(fo, 'tgc', palias, ': SmallInt;'#10);
74 TDynField.TType.TUByte: write(fo, 'tgc', palias, ': Byte;'#10);
75 TDynField.TType.TShort: write(fo, 'tgc', palias, ': ShortInt;'#10);
76 TDynField.TType.TUShort: write(fo, 'tgc', palias, ': Word;'#10);
77 TDynField.TType.TInt: write(fo, 'tgc', palias, ': LongInt;'#10);
78 TDynField.TType.TUInt: write(fo, 'tgc', palias, ': LongWord;'#10);
79 TDynField.TType.TString: write(fo, 'tgc', palias, ': AnsiString;'#10);
80 TDynField.TType.TPoint:
81 begin
82 if fld.hasTPrefix then
83 begin
84 write(fo, 'tgcTX: LongInt;'#10);
85 write(fo, 'tgcTY: LongInt;'#10);
86 end
87 else if fld.separatePasFields then
88 begin
89 write(fo, 'tgcX: LongInt;'#10);
90 write(fo, 'tgcY: LongInt;'#10);
91 end
92 else
93 begin
94 write(fo, 'tgc', palias, ': TDFPoint;'#10);
95 end;
96 end;
97 TDynField.TType.TSize:
98 begin
99 if fld.hasTPrefix then
100 begin
101 write(fo, 'tgcTWidth: LongInt;'#10);
102 write(fo, 'tgcTHeight: LongInt;'#10);
103 end
104 else if fld.separatePasFields then
105 begin
106 write(fo, 'tgcWidth: LongInt;'#10);
107 write(fo, 'tgcHeight: LongInt;'#10);
108 end
109 else
110 begin
111 write(fo, 'tgc', palias, ': TDFSize;'#10);
112 end;
113 end;
114 TDynField.TType.TList:
115 raise Exception.Create('no lists in triggers, pelase');
116 TDynField.TType.TTrigData:
117 raise Exception.Create('no triggers in triggers, pelase');
118 end;
119 end;
120 end;
122 CloseFile(fo);
123 fldknown.Free();
124 end;
127 // ////////////////////////////////////////////////////////////////////////// //
128 procedure genTrigLoadCache (const fname: AnsiString);
129 var
130 fo: TextFile;
131 tidx, fidx, nidx: Integer;
132 trec: TDynRecord;
133 fld: TDynField;
134 palias: AnsiString;
135 needComma: Boolean;
136 begin
137 AssignFile(fo, fname);
138 {$I+}Rewrite(fo);{$I-}
140 write(fo, '// trigger cache loader'#10);
141 write(fo, '// set `TriggerType` in `tgt` before calling this'#10);
142 write(fo, 'procedure trigUpdateCacheData (var tgt: TTrigger; tdata: TDynRecord);'#10);
143 write(fo, 'begin'#10);
144 write(fo, ' case tgt.TriggerType of'#10);
145 for tidx := 0 to dfmapdef.trigTypeCount-1 do
146 begin
147 // case switch
148 needComma := false;
149 write(fo, ' ');
150 trec := dfmapdef.trigTypeAt[tidx];
151 for nidx := 0 to trec.forTrigCount-1 do
152 begin
153 if needComma then write(fo, ','#10' ') else needComma := true;
154 write(fo, trec.forTrigAt[nidx]);
155 end;
156 write(fo, ':'#10);
157 write(fo, ' begin'#10);
158 // fields
159 for fidx := 0 to trec.count-1 do
160 begin
161 fld := trec.fieldAt[fidx];
162 if fld.internal then continue;
163 // HACK!
164 if (fld.name = 'panelid') or (fld.name = 'monsterid') then
165 begin
166 //writeln('skipping <', fld.name, '>');
167 continue;
168 end;
169 palias := fld.palias(true);
170 // write field definition
171 case fld.baseType of
172 TDynField.TType.TBool,
173 TDynField.TType.TChar,
174 TDynField.TType.TByte,
175 TDynField.TType.TUByte,
176 TDynField.TType.TShort,
177 TDynField.TType.TUShort,
178 TDynField.TType.TInt,
179 TDynField.TType.TUInt,
180 TDynField.TType.TString:
181 write(fo, ' tgt.tgc', palias, ' := tdata.trig', palias, ';'#10);
182 TDynField.TType.TPoint:
183 begin
184 if fld.hasTPrefix then
185 begin
186 write(fo, ' tgt.tgcTX := tdata.trigTX;'#10);
187 write(fo, ' tgt.tgcTY := tdata.trigTY;'#10);
188 end
189 else if fld.separatePasFields then
190 begin
191 write(fo, ' tgt.tgcX := tdata.trigX;'#10);
192 write(fo, ' tgt.tgcY := tdata.trigY;'#10);
193 end
194 else
195 begin
196 write(fo, ' tgt.tgc', palias, ' := tdata.trig', palias, ';'#10);
197 end;
198 end;
199 TDynField.TType.TSize:
200 begin
201 if fld.hasTPrefix then
202 begin
203 write(fo, ' tgt.tgcTWidth := tdata.trigTWidth;'#10);
204 write(fo, ' tgt.tgcTHeight := tdata.trigTHeight;'#10);
205 end
206 else if fld.separatePasFields then
207 begin
208 write(fo, ' tgt.tgcWidth := tdata.trigWidth;'#10);
209 write(fo, ' tgt.tgcHeight := tdata.trigHeight;'#10);
210 end
211 else
212 begin
213 write(fo, ' tgt.tgc', palias, ' := tdata.trig', palias, ';'#10);
214 end;
215 end;
216 TDynField.TType.TList:
217 raise Exception.Create('no lists in triggers, pelase');
218 TDynField.TType.TTrigData:
219 raise Exception.Create('no triggers in triggers, pelase');
220 end;
221 end;
222 write(fo, ' end;'#10);
223 end;
224 write(fo, ' end;'#10);
225 write(fo, 'end;'#10);
227 CloseFile(fo);
228 end;
231 // ////////////////////////////////////////////////////////////////////////// //
232 var
233 pr: TTextParser;
234 fo, fohlp, foimpl: TextFile;
235 st: TStream = nil;
236 ch: AnsiChar;
237 wdt: Integer;
238 s: AnsiString;
239 tidx, nidx, fidx: Integer;
240 needComma: Boolean;
241 trec: TDynRecord;
242 fld: TDynField;
243 palias: AnsiString;
244 fldknown: THashStrFld = nil; // key: palias; value: prev field
245 knownfld: TDynField;
246 begin
247 fldknown := THashStrFld.Create();
248 //writeln(getFilenamePath(ParamStr(0)), '|');
250 e_InitWritelnDriver();
251 conbufDumpToStdOut := true;
252 conbufConPrefix := false;
254 writeln('parsing "mapdef.txt"...');
255 try
256 st := openDiskFileRO('mapdef.txt');
257 writeln('found: local mapdef');
258 except // sorry
259 st := nil;
260 end;
261 try
262 writeln(filenameConcat(getFilenamePath(ParamStr(0)), '../mapdef/mapdef.txt'), '|');
263 st := openDiskFileRO(filenameConcat(getFilenamePath(ParamStr(0)), '../mapdef/mapdef.txt'));
264 writeln('found: system mapdef');
265 except // sorry
266 writeln('FATAL: mapdef not found!');
267 end;
269 writeln('parsing "mapdef.txt"...');
270 pr := TFileTextParser.Create(st, false); // don't own
271 try
272 dfmapdef := TDynMapDef.Create(pr);
273 except
274 on e: TDynParseException do
275 begin
276 writeln('ERROR at (', e.tokLine, ',', e.tokCol, '): ', e.message);
277 Halt(1);
278 end;
279 on e: Exception do
280 begin
281 writeln('ERROR: ', e.message);
282 Halt(1);
283 end;
284 end;
285 pr.Free();
287 writeln('writing "mapdef.inc"...');
288 AssignFile(fo, 'mapdef.inc');
289 {$I+}Rewrite(fo);{$I-}
291 AssignFile(fohlp, 'mapdef_help.inc');
292 {$I+}Rewrite(fohlp);{$I-}
294 AssignFile(foimpl, 'mapdef_impl.inc');
295 {$I+}Rewrite(foimpl);{$I-}
297 write(fo, '// *** WARNING! ***'#10);
298 write(fo, '// regenerate this part directly from "mapdef.txt" with ''mapgen'', NEVER manually change anything here!'#10#10#10);
299 write(fo, dfmapdef.pasdefconst);
301 write(fohlp, '// *** WARNING! ***'#10);
302 write(fohlp, '// regenerate this part directly from "mapdef.txt" with ''mapgen'', NEVER manually change anything here!'#10#10);
304 // generate trigger helpers
305 write(foimpl, #10#10'// ////////////////////////////////////////////////////////////////////////// //'#10);
306 write(foimpl, '// trigger helpers'#10);
307 for tidx := 0 to dfmapdef.trigTypeCount-1 do
308 begin
309 // header comment
310 write(foimpl, #10'// ');
311 write(fohlp, #10'// ');
312 needComma := false;
313 trec := dfmapdef.trigTypeAt[tidx];
314 for nidx := 0 to trec.forTrigCount-1 do
315 begin
316 if needComma then write(fohlp, ', ');
317 if needComma then write(foimpl, ', ') else needComma := true;
318 write(fohlp, trec.forTrigAt[nidx]);
319 write(foimpl, trec.forTrigAt[nidx]);
320 end;
321 write(foimpl, #10);
322 write(fohlp, #10);
323 // fields
324 for fidx := 0 to trec.count-1 do
325 begin
326 fld := trec.fieldAt[fidx];
327 if fld.internal then continue;
328 //if (fld.binOfs < 0) then continue;
329 // HACK!
330 if (fld.name = 'panelid') or (fld.name = 'monsterid') then
331 begin
332 writeln('skipping <', fld.name, '>');
333 continue;
334 end;
335 palias := fld.palias(true);
336 // check for known aliases
337 //writeln('<', palias, '> : <', toLowerCase1251(palias), '>');
338 knownfld := nil;
339 if fldknown.get(toLowerCase1251(palias), knownfld) then
340 begin
341 if (fld.name <> knownfld.name) then raise Exception.Create(formatstrf('field ''%s'' of record ''%s'' conflicts with other field ''%s''', [fld.name, trec.typeName, knownfld.name]));
342 if (fld.baseType <> knownfld.baseType) then raise Exception.Create(formatstrf('field ''%s'' of record ''%s'' conflicts with other field ''%s'' by type', [fld.name, trec.typeName, knownfld.name]));
343 writeln('skipped duplicate field ''', fld.name, '''');
344 continue;
345 end;
346 fldknown.put(toLowerCase1251(palias), fld);
347 // write it
348 if (fld.baseType <> TDynField.TType.TPoint) and (fld.baseType <> TDynField.TType.TSize) then
349 begin
350 write(foimpl, 'function TDynRecordHelper.trig', palias, ' (): ');
351 write(fohlp, 'function trig', palias, ' (): ');
352 end;
353 case fld.baseType of
354 TDynField.TType.TBool:
355 begin
356 write(fohlp, 'Boolean; inline;'#10);
357 write(foimpl, 'Boolean; inline; begin result := (getFieldWithType(''', fld.name, ''', TDynField.TType.TBool).ival ');
358 if fld.negbool then write(foimpl, '=') else write(foimpl, '<>');
359 write(foimpl, ' 0); end;'#10);
360 end;
361 TDynField.TType.TChar:
362 begin
363 write(fohlp, 'AnsiString; inline;'#10);
364 write(foimpl, 'AnsiString; inline; begin result := utf2win(getFieldWithType(''', fld.name, ''', TDynField.TType.TChar).sval); end;'#10);
365 end;
366 TDynField.TType.TByte:
367 begin
368 write(fohlp, 'SmallInt; inline;'#10);
369 write(foimpl, 'SmallInt; inline; begin result := ShortInt(getFieldWithType(''', fld.name, ''', TDynField.TType.TByte).ival); end;'#10);
370 end;
371 TDynField.TType.TUByte:
372 begin
373 write(fohlp, 'Byte; inline;'#10);
374 write(foimpl, 'Byte; inline; begin result := Byte(getFieldWithType(''', fld.name, ''', TDynField.TType.TUByte).ival); end;'#10);
375 end;
376 TDynField.TType.TShort:
377 begin
378 write(fohlp, 'ShortInt; inline;'#10);
379 write(foimpl, 'ShortInt; inline; begin result := SmallInt(getFieldWithType(''', fld.name, ''', TDynField.TType.TShort).ival); end;'#10);
380 end;
381 TDynField.TType.TUShort:
382 begin
383 write(fohlp, 'Word; inline;'#10);
384 write(foimpl, 'Word; inline; begin result := Word(getFieldWithType(''', fld.name, ''', TDynField.TType.TUShort).ival); end;'#10);
385 end;
386 TDynField.TType.TInt:
387 begin
388 write(fohlp, 'LongInt; inline;'#10);
389 write(foimpl, 'LongInt; inline; begin result := LongInt(getFieldWithType(''', fld.name, ''', TDynField.TType.TInt).ival); end;'#10);
390 end;
391 TDynField.TType.TUInt:
392 begin
393 write(fohlp, 'LongWord; inline;'#10);
394 write(foimpl, 'LongWord; inline; begin result := LongWord(getFieldWithType(''', fld.name, ''', TDynField.TType.TUInt).ival); end;'#10);
395 end;
396 TDynField.TType.TString:
397 begin
398 write(fohlp, 'AnsiString; inline;'#10);
399 write(foimpl, 'AnsiString; inline; begin result := utf2win(getFieldWithType(''', fld.name, ''', TDynField.TType.TString).sval); end;'#10);
400 end;
401 TDynField.TType.TPoint:
402 begin
403 if fld.hasTPrefix or fld.separatePasFields then
404 begin
405 write(fohlp, 'function trig'); if fld.hasTPrefix then write(fohlp, 'T'); write(fohlp, 'X (): LongInt; inline;'#10);
406 write(fohlp, 'function trig'); if fld.hasTPrefix then write(fohlp, 'T'); write(fohlp, 'Y (): LongInt; inline;'#10);
407 // [T]X
408 write(foimpl, 'function TDynRecordHelper.trig');
409 if fld.hasTPrefix then write(foimpl, 'T');
410 write(foimpl, 'X (): LongInt; inline; begin result := LongInt(getFieldWithType(''', fld.name, ''', TDynField.TType.TPoint).ival); end;'#10);
411 // [T]Y
412 write(foimpl, 'function TDynRecordHelper.trig');
413 if fld.hasTPrefix then write(foimpl, 'T');
414 write(foimpl, 'Y (): LongInt; inline; begin result := LongInt(getFieldWithType(''', fld.name, ''', TDynField.TType.TPoint).ival2); end;'#10);
415 end
416 else
417 begin
418 write(fohlp, 'function trig', palias, ' (): TDFPoint; inline;'#10);
419 write(foimpl, 'function TDynRecordHelper.trig', palias, ' (): TDFPoint; inline; begin result := getPointField(''', fld.name, '''); end;'#10);
420 end;
421 end;
422 TDynField.TType.TSize:
423 begin
424 if fld.hasTPrefix or fld.separatePasFields then
425 begin
426 write(fohlp, 'function trig'); if fld.hasTPrefix then write(fohlp, 'T'); write(fohlp, 'Width (): Word; inline;'#10);
427 write(fohlp, 'function trig'); if fld.hasTPrefix then write(fohlp, 'T'); write(fohlp, 'Height (): Word; inline;'#10);
428 // [T]X
429 write(foimpl, 'function TDynRecordHelper.trig');
430 if fld.hasTPrefix then write(foimpl, 'T');
431 write(foimpl, 'Width (): Word; inline; begin result := Word(getFieldWithType(''', fld.name, ''', TDynField.TType.TSize).ival); end;'#10);
432 // [T]Y
433 write(foimpl, 'function TDynRecordHelper.trig');
434 if fld.hasTPrefix then write(foimpl, 'T');
435 write(foimpl, 'Height (): Word; inline; begin result := Word(getFieldWithType(''', fld.name, ''', TDynField.TType.TSize).ival2); end;'#10);
436 end
437 else
438 begin
439 //raise Exception.Create('no non-separate sizes in triggers, pelase');
440 write(fohlp, 'function trig', palias, ' (): TDFSize; inline;'#10);
441 write(foimpl, 'function TDynRecordHelper.trig', palias, ' (): TDFSize; inline; begin result := getSizeField(''', fld.name, '''); end;'#10);
442 end;
443 end;
444 TDynField.TType.TList:
445 raise Exception.Create('no lists in triggers, pelase');
446 TDynField.TType.TTrigData:
447 raise Exception.Create('no triggers in triggers, pelase');
448 end;
449 end;
450 end;
452 genTrigCacheVars('mapdef_tgc_def.inc');
453 genTrigLoadCache('mapdef_tgc_impl.inc');
455 //st := openDiskFileRO('mapdef.txt');
456 st.position := 0;
457 write(fo, #10#10'const defaultMapDef: AnsiString = ''''+'#10' ');
458 wdt := 2;
459 while true do
460 begin
461 if (st.Read(ch, 1) <> 1) then break;
462 s := formatstrf('#%d', [Byte(ch)]);
463 if (wdt+Length(s) > 78) then begin wdt := 2; write(fo, '+'#10' '); end;
464 write(fo, s);
465 Inc(wdt, Length(s));
466 end;
467 write(fo, #10';');
469 CloseFile(fo);
470 CloseFile(fohlp);
471 CloseFile(foimpl);
472 end.