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