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   pr := TFileTextParser.Create(st, false); // don't own
 269   try
 270     dfmapdef := TDynMapDef.Create(pr);
 271   except on e: Exception do
 272     begin
 273       writeln('ERROR at (', pr.tokLine, ',', pr.tokCol, '): ', e.message);
 274       Halt(1);
 275     end;
 276   end;
 277   pr.Free();
 278
 279   writeln('writing "mapdef.inc"...');
 280   AssignFile(fo, 'mapdef.inc');
 281   {$I+}Rewrite(fo);{$I-}
 282
 283   AssignFile(fohlp, 'mapdef_help.inc');
 284   {$I+}Rewrite(fohlp);{$I-}
 285
 286   AssignFile(foimpl, 'mapdef_impl.inc');
 287   {$I+}Rewrite(foimpl);{$I-}
 288
 289   write(fo, '// *** WARNING! ***'#10);
 290   write(fo, '//   regenerate this part directly from "mapdef.txt" with ''mapgen'', NEVER manually change anything here!'#10#10#10);
 291   write(fo, dfmapdef.pasdefconst);
 292
 293   write(fohlp, '// *** WARNING! ***'#10);
 294   write(fohlp, '//   regenerate this part directly from "mapdef.txt" with ''mapgen'', NEVER manually change anything here!'#10#10);
 295
 296   // generate trigger helpers
 297   write(foimpl, #10#10'// ////////////////////////////////////////////////////////////////////////// //'#10);
 298   write(foimpl, '// trigger helpers'#10);
 299   for tidx := 0 to dfmapdef.trigTypeCount-1 do
 300   begin
 301     // header comment
 302     write(foimpl, #10'// ');
 303     write(fohlp, #10'// ');
 304     needComma := false;
 305     trec := dfmapdef.trigTypeAt[tidx];
 306     for nidx := 0 to trec.forTrigCount-1 do
 307     begin
 308       if needComma then write(fohlp, ', ');
 309       if needComma then write(foimpl, ', ') else needComma := true;
 310       write(fohlp, trec.forTrigAt[nidx]);
 311       write(foimpl, trec.forTrigAt[nidx]);
 312     end;
 313     write(foimpl, #10);
 314     write(fohlp, #10);
 315     // fields
 316     for fidx := 0 to trec.count-1 do
 317     begin
 318       fld := trec.fieldAt[fidx];
 319       if fld.internal then continue;
 320       //if (fld.binOfs < 0) then continue;
 321       // HACK!
 322       if (fld.name = 'panelid') or (fld.name = 'monsterid') then
 323       begin
 324         writeln('skipping <', fld.name, '>');
 325         continue;
 326       end;
 327       palias := fld.palias(true);
 328       // check for known aliases
 329       //writeln('<', palias, '> : <', toLowerCase1251(palias), '>');
 330       knownfld := nil;
 331       if fldknown.get(toLowerCase1251(palias), knownfld) then
 332       begin
 333         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]));
 334         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]));
 335         writeln('skipped duplicate field ''', fld.name, '''');
 336         continue;
 337       end;
 338       fldknown.put(toLowerCase1251(palias), fld);
 339       // write it
 340       if (fld.baseType <> TDynField.TType.TPoint) and (fld.baseType <> TDynField.TType.TSize) then
 341       begin
 342         write(foimpl, 'function TDynRecordHelper.trig', palias, ' (): ');
 343         write(fohlp, 'function trig', palias, ' (): ');
 344       end;
 345       case fld.baseType of
 346         TDynField.TType.TBool:
 347           begin
 348             write(fohlp, 'Boolean; inline;'#10);
 349             write(foimpl, 'Boolean; inline; begin result := (getFieldWithType(''', fld.name, ''', TDynField.TType.TBool).ival ');
 350             if fld.negbool then write(foimpl, '=') else write(foimpl, '<>');
 351             write(foimpl, ' 0); end;'#10);
 352           end;
 353         TDynField.TType.TChar:
 354           begin
 355             write(fohlp, 'AnsiString; inline;'#10);
 356             write(foimpl, 'AnsiString; inline; begin result := utf2win(getFieldWithType(''', fld.name, ''', TDynField.TType.TChar).sval); end;'#10);
 357           end;
 358         TDynField.TType.TByte:
 359           begin
 360             write(fohlp, 'SmallInt; inline;'#10);
 361             write(foimpl, 'SmallInt; inline; begin result := ShortInt(getFieldWithType(''', fld.name, ''', TDynField.TType.TByte).ival); end;'#10);
 362           end;
 363         TDynField.TType.TUByte:
 364           begin
 365             write(fohlp, 'Byte; inline;'#10);
 366             write(foimpl, 'Byte; inline; begin result := Byte(getFieldWithType(''', fld.name, ''', TDynField.TType.TUByte).ival); end;'#10);
 367           end;
 368         TDynField.TType.TShort:
 369           begin
 370             write(fohlp, 'ShortInt; inline;'#10);
 371             write(foimpl, 'ShortInt; inline; begin result := SmallInt(getFieldWithType(''', fld.name, ''', TDynField.TType.TShort).ival); end;'#10);
 372           end;
 373         TDynField.TType.TUShort:
 374           begin
 375             write(fohlp, 'Word; inline;'#10);
 376             write(foimpl, 'Word; inline; begin result := Word(getFieldWithType(''', fld.name, ''', TDynField.TType.TUShort).ival); end;'#10);
 377           end;
 378         TDynField.TType.TInt:
 379           begin
 380             write(fohlp, 'LongInt; inline;'#10);
 381             write(foimpl, 'LongInt; inline; begin result := LongInt(getFieldWithType(''', fld.name, ''', TDynField.TType.TInt).ival); end;'#10);
 382           end;
 383         TDynField.TType.TUInt:
 384           begin
 385             write(fohlp, 'LongWord; inline;'#10);
 386             write(foimpl, 'LongWord; inline; begin result := LongWord(getFieldWithType(''', fld.name, ''', TDynField.TType.TUInt).ival); end;'#10);
 387           end;
 388         TDynField.TType.TString:
 389           begin
 390             write(fohlp, 'AnsiString; inline;'#10);
 391             write(foimpl, 'AnsiString; inline; begin result := utf2win(getFieldWithType(''', fld.name, ''', TDynField.TType.TString).sval); end;'#10);
 392           end;
 393         TDynField.TType.TPoint:
 394           begin
 395             if fld.hasTPrefix or fld.separatePasFields then
 396             begin
 397               write(fohlp, 'function trig'); if fld.hasTPrefix then write(fohlp, 'T'); write(fohlp, 'X (): LongInt; inline;'#10);
 398               write(fohlp, 'function trig'); if fld.hasTPrefix then write(fohlp, 'T'); write(fohlp, 'Y (): LongInt; inline;'#10);
 399               // [T]X
 400               write(foimpl, 'function TDynRecordHelper.trig');
 401               if fld.hasTPrefix then write(foimpl, 'T');
 402               write(foimpl, 'X (): LongInt; inline; begin result := LongInt(getFieldWithType(''', fld.name, ''', TDynField.TType.TPoint).ival); end;'#10);
 403               // [T]Y
 404               write(foimpl, 'function TDynRecordHelper.trig');
 405               if fld.hasTPrefix then write(foimpl, 'T');
 406               write(foimpl, 'Y (): LongInt; inline; begin result := LongInt(getFieldWithType(''', fld.name, ''', TDynField.TType.TPoint).ival2); end;'#10);
 407             end
 408             else
 409             begin
 410               write(fohlp, 'function trig', palias, ' (): TDFPoint; inline;'#10);
 411               write(foimpl, 'function TDynRecordHelper.trig', palias, ' (): TDFPoint; inline; begin result := getPointField(''', fld.name, '''); end;'#10);
 412             end;
 413           end;
 414         TDynField.TType.TSize:
 415           begin
 416             if fld.hasTPrefix or fld.separatePasFields then
 417             begin
 418               write(fohlp, 'function trig'); if fld.hasTPrefix then write(fohlp, 'T'); write(fohlp, 'Width (): Word; inline;'#10);
 419               write(fohlp, 'function trig'); if fld.hasTPrefix then write(fohlp, 'T'); write(fohlp, 'Height (): Word; inline;'#10);
 420               // [T]X
 421               write(foimpl, 'function TDynRecordHelper.trig');
 422               if fld.hasTPrefix then write(foimpl, 'T');
 423               write(foimpl, 'Width (): Word; inline; begin result := Word(getFieldWithType(''', fld.name, ''', TDynField.TType.TSize).ival); end;'#10);
 424               // [T]Y
 425               write(foimpl, 'function TDynRecordHelper.trig');
 426               if fld.hasTPrefix then write(foimpl, 'T');
 427               write(foimpl, 'Height (): Word; inline; begin result := Word(getFieldWithType(''', fld.name, ''', TDynField.TType.TSize).ival2); end;'#10);
 428             end
 429             else
 430             begin
 431               //raise Exception.Create('no non-separate sizes in triggers, pelase');
 432               write(fohlp, 'function trig', palias, ' (): TDFSize; inline;'#10);
 433               write(foimpl, 'function TDynRecordHelper.trig', palias, ' (): TDFSize; inline; begin result := getSizeField(''', fld.name, '''); end;'#10);
 434             end;
 435           end;
 436         TDynField.TType.TList:
 437           raise Exception.Create('no lists in triggers, pelase');
 438         TDynField.TType.TTrigData:
 439           raise Exception.Create('no triggers in triggers, pelase');
 440       end;
 441     end;
 442   end;
 443
 444   genTrigCacheVars('mapdef_tgc_def.inc');
 445   genTrigLoadCache('mapdef_tgc_impl.inc');
 446
 447   //st := openDiskFileRO('mapdef.txt');
 448   st.position := 0;
 449   write(fo, #10#10'const defaultMapDef: AnsiString = ''''+'#10'  ');
 450   wdt := 2;
 451   while true do
 452   begin
 453     if (st.Read(ch, 1) <> 1) then break;
 454     s := formatstrf('#%d', [Byte(ch)]);
 455     if (wdt+Length(s) > 78) then begin wdt := 2; write(fo, '+'#10'  '); end;
 456     write(fo, s);
 457     Inc(wdt, Length(s));
 458   end;
 459   write(fo, #10';');
 460
 461   CloseFile(fo);
 462   CloseFile(fohlp);
 463   CloseFile(foimpl);
 464 end.