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