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