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 var
  20   pr: TTextParser;
  21   dfmapdef: TDynMapDef;
  22   fo, fohlp, foimpl: TextFile;
  23   st: TStream = nil;
  24   ch: AnsiChar;
  25   wdt: Integer;
  26   s: AnsiString;
  27   tidx, nidx, fidx: Integer;
  28   needComma: Boolean;
  29   trec: TDynRecord;
  30   fld: TDynField;
  31 begin
  32   //writeln(getFilenamePath(ParamStr(0)), '|');
  33
  34   e_InitWritelnDriver();
  35   conbufDumpToStdOut := true;
  36   conbufConPrefix := false;
  37
  38   writeln('parsing "mapdef.txt"...');
  39   try
  40     st := openDiskFileRO('mapdef.txt');
  41     writeln('found: local mapdef');
  42   except // sorry
  43     st := nil;
  44   end;
  45   try
  46     writeln(filenameConcat(getFilenamePath(ParamStr(0)), '../mapdef/mapdef.txt'), '|');
  47     st := openDiskFileRO(filenameConcat(getFilenamePath(ParamStr(0)), '../mapdef/mapdef.txt'));
  48     writeln('found: system mapdef');
  49   except // sorry
  50     writeln('FATAL: mapdef not found!');
  51   end;
  52
  53   pr := TFileTextParser.Create(st, false); // don't own
  54   try
  55     dfmapdef := TDynMapDef.Create(pr);
  56   except on e: Exception do
  57     begin
  58       writeln('ERROR at (', pr.line, ',', pr.col, '): ', e.message);
  59       Halt(1);
  60     end;
  61   end;
  62   pr.Free();
  63
  64   writeln('writing "mapdef.inc"...');
  65   AssignFile(fo, 'mapdef.inc');
  66   Rewrite(fo);
  67
  68   AssignFile(fohlp, 'mapdef_help.inc');
  69   Rewrite(fohlp);
  70
  71   AssignFile(foimpl, 'mapdef_impl.inc');
  72   Rewrite(foimpl);
  73
  74   write(fo, '// *** WARNING! ***'#10);
  75   write(fo, '//   regenerate this part directly from "mapdef.txt" with ''mapgen'', NEVER manually change anything here!'#10#10#10);
  76   write(fo, dfmapdef.pasdefconst);
  77
  78   write(fohlp, '// *** WARNING! ***'#10);
  79   write(fohlp, '//   regenerate this part directly from "mapdef.txt" with ''mapgen'', NEVER manually change anything here!'#10#10);
  80
  81   // generate trigger helpers
  82 {
  83 function TDynRecordHelper.trigTargetPoint (): TDFPoint; inline; begin result := getPointField('target'); end;
  84 function TDynRecordHelper.trigD2DTeleport (): Boolean; inline; begin result := (getFieldWithType('d2d', TDynField.TType.TBool).ival <> 0); end;
  85 function TDynRecordHelper.trigSilentTeleport (): Boolean; inline; begin result := (getFieldWithType('silent', TDynField.TType.TBool).ival <> 0); end;
  86 function TDynRecordHelper.trigTlpDir (): Byte; inline; begin result := Byte(getFieldWithType('direction', TDynField.TType.TUByte).ival); end;
  87 }
  88
  89   write(foimpl, #10#10'// ////////////////////////////////////////////////////////////////////////// //'#10);
  90   write(foimpl, '// trigger helpers'#10);
  91   for tidx := 0 to dfmapdef.trigTypeCount-1 do
  92   begin
  93     // header comment
  94     write(foimpl, #10'// ');
  95     needComma := false;
  96     trec := dfmapdef.trigType[tidx];
  97     for nidx := 0 to trec.forTrigCount-1 do
  98     begin
  99       if needComma then write(foimpl, ', ') else needComma := true;
 100       write(foimpl, trec.forTrigAt[nidx]);
 101     end;
 102     write(foimpl, #10);
 103     // fields
 104     for fidx := 0 to trec.count-1 do
 105     begin
 106       fld := trec.fieldAt[fidx];
 107       if fld.internal then continue;
 108       if (fld.binOfs < 0) then continue;
 109       // HACK!
 110       if (fld.name = 'panelid') or (fld.name = 'monsterid') then
 111       begin
 112         writeln('skipping ', fld.pasname, ' <', fld.name, '>');
 113         continue;
 114       end;
 115       if (fld.baseType <> TDynField.TType.TPoint) and (fld.baseType <> TDynField.TType.TSize) then
 116       begin
 117         write(foimpl, 'function TDynRecordHelper.trig', fld.pasname, ' (): ');
 118         write(fohlp, 'function trig', fld.pasname, ' (): ');
 119       end;
 120       case fld.baseType of
 121         TDynField.TType.TBool:
 122           begin
 123             write(fohlp, 'Boolean; inline;'#10);
 124             write(foimpl, 'Boolean; inline; begin result := (getFieldWithType(''', fld.name, ''', TDynField.TType.TBool).ival ');
 125             if fld.negbool then write(foimpl, '=') else write(foimpl, '<>');
 126             write(foimpl, ' 0); end;'#10);
 127           end;
 128         TDynField.TType.TChar:
 129           begin
 130             write(fohlp, 'AnsiString; inline;'#10);
 131             write(foimpl, 'AnsiString; inline; begin result := utf2win(getFieldWithType(''', fld.name, ''', TDynField.TType.TChar).sval); end;'#10);
 132           end;
 133         TDynField.TType.TByte:
 134           begin
 135             write(fohlp, 'SmallInt; inline;'#10);
 136             write(foimpl, 'SmallInt; inline; begin result := ShortInt(getFieldWithType(''', fld.name, ''', TDynField.TType.TByte).ival); end;'#10);
 137           end;
 138         TDynField.TType.TUByte:
 139           begin
 140             write(fohlp, 'Byte; inline;'#10);
 141             write(foimpl, 'Byte; inline; begin result := Byte(getFieldWithType(''', fld.name, ''', TDynField.TType.TUByte).ival); end;'#10);
 142           end;
 143         TDynField.TType.TShort:
 144           begin
 145             write(fohlp, 'ShortInt; inline;'#10);
 146             write(foimpl, 'ShortInt; inline; begin result := SmallInt(getFieldWithType(''', fld.name, ''', TDynField.TType.TShort).ival); end;'#10);
 147           end;
 148         TDynField.TType.TUShort:
 149           begin
 150             write(fohlp, 'Word; inline;'#10);
 151             write(foimpl, 'Word; inline; begin result := Word(getFieldWithType(''', fld.name, ''', TDynField.TType.TUShort).ival); end;'#10);
 152           end;
 153         TDynField.TType.TInt:
 154           begin
 155             write(fohlp, 'LongInt; inline;'#10);
 156             write(foimpl, 'LongInt; inline; begin result := LongInt(getFieldWithType(''', fld.name, ''', TDynField.TType.TInt).ival); end;'#10);
 157           end;
 158         TDynField.TType.TUInt:
 159           begin
 160             write(fohlp, 'LongWord; inline;'#10);
 161             write(foimpl, 'LongWord; inline; begin result := LongWord(getFieldWithType(''', fld.name, ''', TDynField.TType.TUInt).ival); end;'#10);
 162           end;
 163         TDynField.TType.TString:
 164           begin
 165             write(fohlp, 'AnsiString; inline;'#10);
 166             write(foimpl, 'AnsiString; inline; begin result := utf2win(getFieldWithType(''', fld.name, ''', TDynField.TType.TChar).sval); end;'#10);
 167           end;
 168         TDynField.TType.TPoint:
 169           begin
 170             if fld.hasTPrefix or fld.separatePasFields then
 171             begin
 172               write(fohlp, 'function trig'); if fld.hasTPrefix then write(fohlp, 'T'); write(fohlp, 'X (): LongInt; inline;'#10);
 173               write(fohlp, 'function trig'); if fld.hasTPrefix then write(fohlp, 'T'); write(fohlp, 'Y (): LongInt; inline;'#10);
 174               // [T]X
 175               write(foimpl, 'function TDynRecordHelper.trig');
 176               if fld.hasTPrefix then write(foimpl, 'T');
 177               write(foimpl, 'X (): LongInt; inline; begin result := LongInt(getFieldWithType(''', fld.name, ''', TDynField.TType.TPoint).ival); end;'#10);
 178               // [T]Y
 179               write(foimpl, 'function TDynRecordHelper.trig');
 180               if fld.hasTPrefix then write(foimpl, 'T');
 181               write(foimpl, 'Y (): LongInt; inline; begin result := LongInt(getFieldWithType(''', fld.name, ''', TDynField.TType.TPoint).ival2); end;'#10);
 182             end
 183             else
 184             begin
 185               write(fohlp, 'function trig', fld.pasname, ' (): TDFPoint; inline;'#10);
 186               write(foimpl, 'function TDynRecordHelper.trig', fld.pasname, ' (): TDFPoint; inline; begin result := getPointField(''', fld.name, '''); end;'#10);
 187             end;
 188           end;
 189         TDynField.TType.TSize:
 190           begin
 191             if fld.hasTPrefix or fld.separatePasFields then
 192             begin
 193               write(fohlp, 'function trig'); if fld.hasTPrefix then write(fohlp, 'T'); write(fohlp, 'Width (): Word; inline;'#10);
 194               write(fohlp, 'function trig'); if fld.hasTPrefix then write(fohlp, 'T'); write(fohlp, 'Height (): Word; inline;'#10);
 195               // [T]X
 196               write(foimpl, 'function TDynRecordHelper.trig');
 197               if fld.hasTPrefix then write(foimpl, 'T');
 198               write(foimpl, 'Width (): Word; inline; begin result := Word(getFieldWithType(''', fld.name, ''', TDynField.TType.TSize).ival); end;'#10);
 199               // [T]Y
 200               write(foimpl, 'function TDynRecordHelper.trig');
 201               if fld.hasTPrefix then write(foimpl, 'T');
 202               write(foimpl, 'Height (): Word; inline; begin result := Word(getFieldWithType(''', fld.name, ''', TDynField.TType.TSize).ival2); end;'#10);
 203             end
 204             else
 205             begin
 206               raise Exception.Create('no non-separate sizes in triggers, pelase');
 207             end;
 208           end;
 209         TDynField.TType.TList:
 210           raise Exception.Create('no lists in triggers, pelase');
 211         TDynField.TType.TTrigData:
 212           raise Exception.Create('no triggers in triggers, pelase');
 213       end;
 214     end;
 215   end;
 216
 217
 218   //st := openDiskFileRO('mapdef.txt');
 219   st.position := 0;
 220   write(fo, #10#10'const defaultMapDef: AnsiString = ''''+'#10'  ');
 221   wdt := 2;
 222   while true do
 223   begin
 224     if (st.Read(ch, 1) <> 1) then break;
 225     s := formatstrf('#%d', [Byte(ch)]);
 226     if (wdt+Length(s) > 78) then begin wdt := 2; write(fo, '+'#10'  '); end;
 227     write(fo, s);
 228     Inc(wdt, Length(s));
 229   end;
 230   write(fo, #10';');
 231
 232   CloseFile(fo);
 233   CloseFile(fohlp);
 234   CloseFile(foimpl);
 235 end.