src/tools/mapgen.dpr

   1 {$INCLUDE ../shared/a_modes.inc}
   2 {$IFDEF WINDOWS}
   3   {$APPTYPE CONSOLE}
   4 {$ENDIF}
   5
   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';
  17
  18
  19 // ////////////////////////////////////////////////////////////////////////// //
  20 type
  21   THashStrFld = specialize THashBase<AnsiString, TDynField, THashKeyStr>;
  22
  23
  24 // ////////////////////////////////////////////////////////////////////////// //
  25 var
  26   dfmapdef: TDynMapDef;
  27
  28
  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-}
  41
  42   fldknown := THashStrFld.Create();
  43
  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;
 121
 122   CloseFile(fo);
 123   fldknown.Free();
 124 end;
 125
 126
 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-}
 139
 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);
 226
 227   CloseFile(fo);
 228 end;
 229
 230
 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)), '|');
 249
 250   e_InitWritelnDriver();
 251   conbufDumpToStdOut := true;
 252   conbufConPrefix := false;
 253
 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;
 268
 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();
 286
 287   writeln('writing "mapdef.inc"...');
 288   AssignFile(fo, 'mapdef.inc');
 289   {$I+}Rewrite(fo);{$I-}
 290
 291   AssignFile(fohlp, 'mapdef_help.inc');
 292   {$I+}Rewrite(fohlp);{$I-}
 293
 294   AssignFile(foimpl, 'mapdef_impl.inc');
 295   {$I+}Rewrite(foimpl);{$I-}
 296
 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);
 300
 301   write(fohlp, '// *** WARNING! ***'#10);
 302   write(fohlp, '//   regenerate this part directly from "mapdef.txt" with ''mapgen'', NEVER manually change anything here!'#10#10);
 303
 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;
 451
 452   genTrigCacheVars('mapdef_tgc_def.inc');
 453   genTrigLoadCache('mapdef_tgc_impl.inc');
 454
 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';');
 468
 469   CloseFile(fo);
 470   CloseFile(fohlp);
 471   CloseFile(foimpl);
 472 end.