1 {$INCLUDE ../shared/a_modes.inc}
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 // ////////////////////////////////////////////////////////////////////////// //
21 THashStrFld = specialize THashBase<AnsiString, TDynField, THashKeyStr>;
24 // ////////////////////////////////////////////////////////////////////////// //
29 // ////////////////////////////////////////////////////////////////////////// //
30 procedure genTrigCacheVars (const fname: AnsiString);
33 tidx, fidx, nidx: Integer;
37 fldknown: THashStrFld = nil; // key: palias; value: prev field
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
49 trec := dfmapdef.trigTypeAt[tidx];
50 for nidx := 0 to trec.forTrigCount-1 do
52 write(fo, '//', trec.forTrigAt[nidx], #10);
55 for fidx := 0 to trec.count-1 do
57 fld := trec.fieldAt[fidx];
58 if fld.internal then continue;
60 if (fld.name = 'panelid') or (fld.name = 'monsterid') then
62 //writeln('skipping <', fld.name, '>');
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
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:
82 if fld.hasTPrefix then
84 write(fo, 'tgcTX: LongInt;'#10);
85 write(fo, 'tgcTY: LongInt;'#10);
87 else if fld.separatePasFields then
89 write(fo, 'tgcX: LongInt;'#10);
90 write(fo, 'tgcY: LongInt;'#10);
94 write(fo, 'tgc', palias, ': TDFPoint;'#10);
97 TDynField.TType.TSize:
99 if fld.hasTPrefix then
101 write(fo, 'tgcTWidth: LongInt;'#10);
102 write(fo, 'tgcTHeight: LongInt;'#10);
104 else if fld.separatePasFields then
106 write(fo, 'tgcWidth: LongInt;'#10);
107 write(fo, 'tgcHeight: LongInt;'#10);
111 write(fo, 'tgc', palias, ': TDFSize;'#10);
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');
127 // ////////////////////////////////////////////////////////////////////////// //
128 procedure genTrigLoadCache (const fname: AnsiString);
131 tidx, fidx, nidx: Integer;
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
150 trec := dfmapdef.trigTypeAt[tidx];
151 for nidx := 0 to trec.forTrigCount-1 do
153 if needComma then write(fo, ','#10' ') else needComma := true;
154 write(fo, trec.forTrigAt[nidx]);
157 write(fo, ' begin'#10);
159 for fidx := 0 to trec.count-1 do
161 fld := trec.fieldAt[fidx];
162 if fld.internal then continue;
164 if (fld.name = 'panelid') or (fld.name = 'monsterid') then
166 //writeln('skipping <', fld.name, '>');
169 palias := fld.palias(true);
170 // write field definition
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:
184 if fld.hasTPrefix then
186 write(fo, ' tgt.tgcTX := tdata.trigTX;'#10);
187 write(fo, ' tgt.tgcTY := tdata.trigTY;'#10);
189 else if fld.separatePasFields then
191 write(fo, ' tgt.tgcX := tdata.trigX;'#10);
192 write(fo, ' tgt.tgcY := tdata.trigY;'#10);
196 write(fo, ' tgt.tgc', palias, ' := tdata.trig', palias, ';'#10);
199 TDynField.TType.TSize:
201 if fld.hasTPrefix then
203 write(fo, ' tgt.tgcTWidth := tdata.trigTWidth;'#10);
204 write(fo, ' tgt.tgcTHeight := tdata.trigTHeight;'#10);
206 else if fld.separatePasFields then
208 write(fo, ' tgt.tgcWidth := tdata.trigWidth;'#10);
209 write(fo, ' tgt.tgcHeight := tdata.trigHeight;'#10);
213 write(fo, ' tgt.tgc', palias, ' := tdata.trig', palias, ';'#10);
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');
222 write(fo, ' end;'#10);
224 write(fo, ' end;'#10);
225 write(fo, 'end;'#10);
231 // ////////////////////////////////////////////////////////////////////////// //
234 fo, fohlp, foimpl: TextFile;
239 tidx, nidx, fidx: Integer;
244 fldknown: THashStrFld = nil; // key: palias; value: prev field
247 fldknown := THashStrFld.Create();
248 //writeln(getFilenamePath(ParamStr(0)), '|');
250 e_InitWritelnDriver();
251 conbufDumpToStdOut := true;
252 conbufConPrefix := false;
254 writeln('parsing "mapdef.txt"...');
256 st := openDiskFileRO('mapdef.txt');
257 writeln('found: local mapdef');
262 writeln(filenameConcat(getFilenamePath(ParamStr(0)), '../mapdef/mapdef.txt'), '|');
263 st := openDiskFileRO(filenameConcat(getFilenamePath(ParamStr(0)), '../mapdef/mapdef.txt'));
264 writeln('found: system mapdef');
266 writeln('FATAL: mapdef not found!');
269 writeln('parsing "mapdef.txt"...');
270 pr := TFileTextParser.Create(st, false); // don't own
272 dfmapdef := TDynMapDef.Create(pr);
274 on e: TDynParseException do
276 writeln('ERROR at (', e.tokLine, ',', e.tokCol, '): ', e.message);
281 writeln('ERROR: ', e.message);
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
310 write(foimpl, #10'// ');
311 write(fohlp, #10'// ');
313 trec := dfmapdef.trigTypeAt[tidx];
314 for nidx := 0 to trec.forTrigCount-1 do
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]);
324 for fidx := 0 to trec.count-1 do
326 fld := trec.fieldAt[fidx];
327 if fld.internal then continue;
328 //if (fld.binOfs < 0) then continue;
330 if (fld.name = 'panelid') or (fld.name = 'monsterid') then
332 writeln('skipping <', fld.name, '>');
335 palias := fld.palias(true);
336 // check for known aliases
337 //writeln('<', palias, '> : <', toLowerCase1251(palias), '>');
339 if fldknown.get(toLowerCase1251(palias), knownfld) then
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, '''');
346 fldknown.put(toLowerCase1251(palias), fld);
348 if (fld.baseType <> TDynField.TType.TPoint) and (fld.baseType <> TDynField.TType.TSize) then
350 write(foimpl, 'function TDynRecordHelper.trig', palias, ' (): ');
351 write(fohlp, 'function trig', palias, ' (): ');
354 TDynField.TType.TBool:
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);
361 TDynField.TType.TChar:
363 write(fohlp, 'AnsiString; inline;'#10);
364 write(foimpl, 'AnsiString; inline; begin result := utf2win(getFieldWithType(''', fld.name, ''', TDynField.TType.TChar).sval); end;'#10);
366 TDynField.TType.TByte:
368 write(fohlp, 'SmallInt; inline;'#10);
369 write(foimpl, 'SmallInt; inline; begin result := ShortInt(getFieldWithType(''', fld.name, ''', TDynField.TType.TByte).ival); end;'#10);
371 TDynField.TType.TUByte:
373 write(fohlp, 'Byte; inline;'#10);
374 write(foimpl, 'Byte; inline; begin result := Byte(getFieldWithType(''', fld.name, ''', TDynField.TType.TUByte).ival); end;'#10);
376 TDynField.TType.TShort:
378 write(fohlp, 'ShortInt; inline;'#10);
379 write(foimpl, 'ShortInt; inline; begin result := SmallInt(getFieldWithType(''', fld.name, ''', TDynField.TType.TShort).ival); end;'#10);
381 TDynField.TType.TUShort:
383 write(fohlp, 'Word; inline;'#10);
384 write(foimpl, 'Word; inline; begin result := Word(getFieldWithType(''', fld.name, ''', TDynField.TType.TUShort).ival); end;'#10);
386 TDynField.TType.TInt:
388 write(fohlp, 'LongInt; inline;'#10);
389 write(foimpl, 'LongInt; inline; begin result := LongInt(getFieldWithType(''', fld.name, ''', TDynField.TType.TInt).ival); end;'#10);
391 TDynField.TType.TUInt:
393 write(fohlp, 'LongWord; inline;'#10);
394 write(foimpl, 'LongWord; inline; begin result := LongWord(getFieldWithType(''', fld.name, ''', TDynField.TType.TUInt).ival); end;'#10);
396 TDynField.TType.TString:
398 write(fohlp, 'AnsiString; inline;'#10);
399 write(foimpl, 'AnsiString; inline; begin result := utf2win(getFieldWithType(''', fld.name, ''', TDynField.TType.TString).sval); end;'#10);
401 TDynField.TType.TPoint:
403 if fld.hasTPrefix or fld.separatePasFields then
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);
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);
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);
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);
422 TDynField.TType.TSize:
424 if fld.hasTPrefix or fld.separatePasFields then
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);
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);
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);
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);
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');
452 genTrigCacheVars('mapdef_tgc_def.inc');
453 genTrigLoadCache('mapdef_tgc_impl.inc');
455 //st := openDiskFileRO('mapdef.txt');
457 write(fo, #10#10'const defaultMapDef: AnsiString = ''''+'#10' ');
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;