src/shared/xdynrec.pas

   1 (* Copyright (C)  DooM 2D:Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, either version 3 of the License, or
   6  * (at your option) any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15  *)
  16 {$INCLUDE a_modes.inc}
  17 unit xdynrec;
  18
  19 interface
  20
  21 uses
  22   xparser;
  23
  24
  25 // ////////////////////////////////////////////////////////////////////////// //
  26 type
  27   TDynMapDef = class;
  28   TDynRecord = class;
  29
  30   // this is base type for all scalars (and arrays)
  31   TDynField = class
  32   public
  33     type
  34       TType = (TBool, TChar, TByte, TUByte, TShort, TUShort, TInt, TUInt, TString, TPoint, TSize, TList, TTrigData);
  35       // TPoint: pair of Shorts
  36       // TSize: pair of UShorts
  37       // TList: actually, array of records
  38       // TTrigData: array of bytes
  39       // arrays of chars are pascal shortstrings (with counter in the first byte)
  40
  41     type
  42       TDynFieldArray = array of TDynField;
  43       TDynRecordArray = array of TDynRecord;
  44
  45   private
  46     type
  47       TEBS = (TNone, TRec, TEnum, TBitSet);
  48
  49   private
  50     mOwner: TDynRecord;
  51     mPasName: AnsiString;
  52     mName: AnsiString;
  53     mType: TType;
  54     mIVal: Integer; // for all integer types
  55     mIVal2: Integer; // for point and size
  56     mSVal: AnsiString; // string; for byte and char arrays
  57     mRVal: TDynRecordArray; // for list
  58     mRecRef: TDynRecord; // for record
  59     mRecRefOwned: Boolean; // was mRecRef created from inline definition?
  60     mMaxDim: Integer; // for byte and char arrays; <0: not an array
  61     mBinOfs: Integer; // offset in binary; <0 - none
  62     mRecOfs: Integer; // offset in record; <0 - none
  63     mSepPosSize: Boolean; // for points and sizes, use separate fields
  64     mAsT: Boolean; // for points and sizes, use separate fields, names starts with `t`
  65     mDefined: Boolean;
  66     mHasDefault: Boolean;
  67     mDefaultValueSet: Boolean;
  68     mOmitDef: Boolean;
  69     mInternal: Boolean;
  70     // default values
  71     mDefSVal: AnsiString;
  72     mEBS: TEBS;
  73     mEBSName: AnsiString; // name of enum, bitset or record
  74     mBitSetUnique: Boolean; // bitset can contain only one value
  75     mNegBool: Boolean;
  76
  77     // temp
  78     mDefId: AnsiString;
  79
  80   private
  81     procedure cleanup ();
  82
  83     procedure parseDef (pr: TTextParser);
  84
  85     procedure setIVal (v: Integer); inline;
  86     procedure setSVal (const v: AnsiString); inline;
  87
  88     procedure fixDefaultValue ();
  89     function isDefaultValue (): Boolean;
  90
  91   public
  92     constructor Create (const aname: AnsiString; atype: TType);
  93     constructor Create (pr: TTextParser);
  94     destructor Destroy (); override;
  95
  96     class function getTypeName (t: TType): AnsiString;
  97
  98     function definition (): AnsiString;
  99
 100     function clone (): TDynField;
 101
 102     procedure parseValue (pr: TTextParser);
 103
 104     procedure writeTo (wr: TTextWriter);
 105
 106     // won't work for lists
 107     function isSimpleEqu (fld: TDynField): Boolean;
 108
 109   public
 110     property pasname: AnsiString read mPasName;
 111     property name: AnsiString read mName;
 112     property baseType: TType read mType;
 113     property defined: Boolean read mDefined write mDefined;
 114     property internal: Boolean read mInternal write mInternal;
 115     property ival: Integer read mIVal write setIVal;
 116     property sval: AnsiString read mSVal write setSVal;
 117     property list: TDynRecordArray read mRVal write mRVal;
 118     property maxdim: Integer read mMaxDim; // for fixed-size arrays
 119     property binOfs: Integer read mBinOfs; // offset in binary; <0 - none
 120     property recOfs: Integer read mRecOfs; // offset in record; <0 - none
 121     property hasDefault: Boolean read mHasDefault;
 122     property defsval: AnsiString read mDefSVal write mDefSVal;
 123     property ebs: TEBS read mEBS write mEBS;
 124     property ebsname: AnsiString read mEBSName write mEBSName; // enum/bitset name
 125
 126     property x: Integer read mIVal;
 127     property w: Integer read mIVal;
 128     property y: Integer read mIVal2;
 129     property h: Integer read mIVal2;
 130   end;
 131
 132
 133   TDynRecord = class
 134   private
 135     mOwner: TDynMapDef;
 136     mId: AnsiString;
 137     mPasName: AnsiString;
 138     mName: AnsiString;
 139     mSize: Integer;
 140     mFields: TDynField.TDynFieldArray;
 141     mTrigTypes: array of AnsiString; // if this is triggerdata, we'll hold list of triggers here
 142     mHeader: Boolean; // true for header record
 143     mBinBlock: Integer; // -1: none
 144
 145   private
 146     procedure parseDef (pr: TTextParser); // parse definition
 147
 148     function findByName (const aname: AnsiString): Integer; inline;
 149     function hasByName (const aname: AnsiString): Boolean; inline;
 150     function getFieldByName (const aname: AnsiString): TDynField; inline;
 151
 152     function getIsTrigData (): Boolean; inline;
 153     function getIsForTrig (const aname: AnsiString): Boolean; inline;
 154
 155   public
 156     constructor Create ();
 157     constructor Create (pr: TTextParser); // parse definition
 158     destructor Destroy (); override;
 159
 160     function definition (): AnsiString;
 161
 162     function clone (): TDynRecord;
 163
 164     procedure parseValue (pr: TTextParser; asheader: Boolean=false);
 165
 166     procedure writeTo (wr: TTextWriter; putHeader: Boolean=true);
 167
 168   public
 169     property id: AnsiString read mId; // for map parser
 170     property pasname: AnsiString read mPasName;
 171     property name: AnsiString read mName; // record name
 172     property size: Integer read mSize; // size in bytes
 173     property fields: TDynField.TDynFieldArray read mFields write mFields;
 174     property has[const aname: AnsiString]: Boolean read hasByName;
 175     property field[const aname: AnsiString]: TDynField read getFieldByName;
 176     property isTrigData: Boolean read getIsTrigData;
 177     property isForTrig[const aname: AnsiString]: Boolean read getIsForTrig;
 178   end;
 179
 180
 181   TDynEBS = class
 182   private
 183     mOwner: TDynMapDef;
 184     mIsEnum: Boolean;
 185     mName: AnsiString;
 186     mIds: array of AnsiString;
 187     mVals: array of Integer;
 188     mMaxName: AnsiString; // MAX field
 189     mMaxVal: Integer; // max value
 190
 191   private
 192     procedure cleanup ();
 193
 194     procedure parseDef (pr: TTextParser); // parse definition
 195
 196     function findByName (const aname: AnsiString): Integer; inline;
 197     function hasByName (const aname: AnsiString): Boolean; inline;
 198     function getFieldByName (const aname: AnsiString): Integer; inline;
 199
 200   public
 201     constructor Create (pr: TTextParser); // parse definition
 202     destructor Destroy (); override;
 203
 204     function definition (): AnsiString;
 205
 206   public
 207     property name: AnsiString read mName; // record name
 208     property isEnum: Boolean read mIsEnum;
 209     property has[const aname: AnsiString]: Boolean read hasByName;
 210     property field[const aname: AnsiString]: Integer read getFieldByName;
 211   end;
 212
 213
 214   TDynMapDef = class
 215   private
 216     curheader: TDynRecord; // for parser
 217
 218   private
 219     function findRecordById (const atypename, aid: AnsiString): TDynRecord;
 220
 221   public
 222     records: array of TDynRecord; // [0] is always header
 223     trigDatas: array of TDynRecord;
 224     ebs: array of TDynEBS;
 225
 226   private
 227     procedure parseDef (pr: TTextParser);
 228
 229     function getHeader (): TDynRecord; inline;
 230
 231   public
 232     constructor Create (pr: TTextParser);
 233     destructor Destroy (); override;
 234
 235     function findRec (const aname: AnsiString): TDynRecord;
 236     function findTrigDataFor (const aname: AnsiString): TDynRecord;
 237     function findEBS (const aname: AnsiString): TDynEBS;
 238
 239     function parseMap (pr: TTextParser): TDynRecord;
 240
 241   public
 242     property header: TDynRecord read getHeader;
 243   end;
 244
 245
 246 implementation
 247
 248 uses
 249   SysUtils;
 250
 251
 252 // ////////////////////////////////////////////////////////////////////////// //
 253 constructor TDynField.Create (const aname: AnsiString; atype: TType);
 254 begin
 255   mRVal := nil;
 256   mRecRef := nil;
 257   mRecRefOwned := false;
 258   cleanup();
 259   mName := aname;
 260   mType := atype;
 261 end;
 262
 263
 264 constructor TDynField.Create (pr: TTextParser);
 265 begin
 266   cleanup();
 267   parseDef(pr);
 268 end;
 269
 270
 271 destructor TDynField.Destroy ();
 272 begin
 273   cleanup();
 274   inherited;
 275 end;
 276
 277
 278 procedure TDynField.cleanup ();
 279 begin
 280   mName := '';
 281   mType := TType.TInt;
 282   mIVal := 0;
 283   mIVal2 := 0;
 284   mSVal := '';
 285   mRVal := nil;
 286   if mRecRefOwned then mRecRef.Free();
 287   mRecRef := nil;
 288   mRecRefOwned := false;
 289   mMaxDim := -1;
 290   mBinOfs := -1;
 291   mRecOfs := -1;
 292   mSepPosSize := false;
 293   mAsT := false;
 294   mHasDefault := false;
 295   mDefined := false;
 296   mOmitDef := false;
 297   mInternal := true;
 298   mDefSVal := '';
 299   mEBS := TEBS.TNone;
 300   mEBSName := '';
 301   mBitSetUnique := false;
 302   mNegBool := false;
 303   mDefId := '';
 304   mDefaultValueSet := false;
 305 end;
 306
 307
 308 function TDynField.clone (): TDynField;
 309 var
 310   f: Integer;
 311 begin
 312   result := TDynField.Create(mName, mType);
 313   result.mOwner := mOwner;
 314   result.mPasName := mPasName;
 315   result.mName := mName;
 316   result.mType := mType;
 317   result.mIVal := mIVal;
 318   result.mIVal2 := mIVal2;
 319   result.mSVal := mSVal;
 320   SetLength(result.mRVal, Length(mRVal));
 321   for f := 0 to High(mRVal) do result.mRVal[f] := mRVal[f].clone();
 322   result.mRecRefOwned := mRecRefOwned;
 323   if mRecRefOwned then
 324   begin
 325     if (mRecRef <> nil) then result.mRecRef := mRecRef.clone();
 326   end
 327   else
 328   begin
 329     result.mRecRef := mRecRef;
 330   end;
 331   result.mMaxDim := mMaxDim;
 332   result.mBinOfs := mBinOfs;
 333   result.mRecOfs := mRecOfs;
 334   result.mSepPosSize := mSepPosSize;
 335   result.mAsT := mAsT;
 336   result.mDefined := mDefined;
 337   result.mHasDefault := mHasDefault;
 338   result.mOmitDef := mOmitDef;
 339   result.mInternal := mInternal;
 340   result.mDefSVal := mDefSVal;
 341   result.mEBS := mEBS;
 342   result.mEBSName := mEBSName;
 343   result.mBitSetUnique := mBitSetUnique;
 344   result.mNegBool := mNegBool;
 345   result.mDefId := mDefId;
 346   result.mDefaultValueSet := mDefaultValueSet;
 347 end;
 348
 349
 350 procedure TDynField.setIVal (v: Integer); inline; begin mIVal := v; mDefined := true; end;
 351 procedure TDynField.setSVal (const v: AnsiString); inline; begin mSVal := v; mDefined := true; end;
 352
 353
 354 // won't work for lists
 355 function TDynField.isSimpleEqu (fld: TDynField): Boolean;
 356 begin
 357   if (fld = nil) or (mType <> fld.mType) then begin result := false; exit; end;
 358   case mType of
 359     TType.TBool: result := ((mIVal <> 0) = (fld.mIVal <> 0));
 360     TType.TChar: result := (mSVal = fld.mSVal);
 361     TType.TByte,
 362     TType.TUByte,
 363     TType.TShort,
 364     TType.TUShort,
 365     TType.TInt,
 366     TType.TUInt:
 367       result := (mIVal = fld.mIVal);
 368     TType.TString: result := (mSVal = fld.mSVal);
 369     TType.TPoint,
 370     TType.TSize:
 371       result := ((mIVal = fld.mIVal) and (mIVal2 = fld.mIVal2));
 372     TType.TList: result := false;
 373     TType.TTrigData: result := false;
 374     else raise Exception.Create('ketmar forgot to handle some field type');
 375   end;
 376 end;
 377
 378
 379 procedure TDynField.fixDefaultValue ();
 380 var
 381   stp: TTextParser;
 382   s: AnsiString;
 383 begin
 384   if not mDefined then
 385   begin
 386     if not mHasDefault then
 387     begin
 388       if mInternal then exit;
 389       raise Exception.Create(Format('field ''%s'' in record ''%s'' of record type ''%s'' is not set', [mName, mOwner.mId, mOwner.mName]));
 390     end;
 391     if (mEBS = TEBS.TRec) then
 392     begin
 393       if (CompareText(mDefSVal, 'null') <> 0) then raise Exception.Create(Format('field ''%s'' in record ''%s'' of record type ''%s'' has non-null default value ''%s''', [mName, mOwner.mId, mOwner.mName, mDefSVal]));
 394       mDefined := true;
 395       assert(mRecRef = nil);
 396       mDefaultValueSet := true;
 397       exit;
 398     end;
 399     s := '';
 400     case mType of
 401       TType.TChar, TType.TString: s := TTextParser.quote(mDefSVal)+';';
 402       TType.TPoint, TType.TSize: assert(false); // no default values for these types yet
 403       else s := mDefSVal+';';
 404     end;
 405     //mDefined := true;
 406     //writeln('DEFAULT for <', mName, '>: <', s, '>');
 407     stp := TStrTextParser.Create(s);
 408     try
 409       parseValue(stp);
 410     finally
 411       stp.Free();
 412     end;
 413     assert(mDefined);
 414     mDefaultValueSet := true;
 415   end;
 416 end;
 417
 418
 419 function TDynField.isDefaultValue (): Boolean;
 420 var
 421   fld: TDynField = nil;
 422   stp: TTextParser = nil;
 423   s: AnsiString;
 424 begin
 425   if not mHasDefault then begin result := false; exit; end;
 426   //result := mDefaultValueSet;
 427   if (mEBS = TEBS.TRec) then begin result := (mRecRef = nil); exit; end;
 428   s := '';
 429   case mType of
 430     TType.TChar, TType.TString: s := TTextParser.quote(mDefSVal)+';';
 431     TType.TPoint, TType.TSize: begin result := false; exit; end; // no default values for these types yet
 432     else s := mDefSVal+';';
 433   end;
 434   stp := TStrTextParser.Create(s);
 435   try
 436     fld := clone();
 437     fld.parseValue(stp);
 438     result := isSimpleEqu(fld);
 439   finally
 440     fld.Free();
 441     stp.Free();
 442   end;
 443 end;
 444
 445
 446 class function TDynField.getTypeName (t: TType): AnsiString;
 447 begin
 448   case t of
 449     TType.TBool: result := 'bool';
 450     TType.TChar: result := 'char';
 451     TType.TByte: result := 'byte';
 452     TType.TUByte: result := 'ubyte';
 453     TType.TShort: result := 'short';
 454     TType.TUShort: result := 'ushort';
 455     TType.TInt: result := 'int';
 456     TType.TUInt: result := 'uint';
 457     TType.TString: result := 'string';
 458     TType.TPoint: result := 'point';
 459     TType.TSize: result := 'size';
 460     TType.TList: result := 'array';
 461     TType.TTrigData: result := 'trigdata';
 462     else raise Exception.Create('ketmar forgot to handle some field type');
 463   end;
 464 end;
 465
 466
 467 function TDynField.definition (): AnsiString;
 468 begin
 469   result := mPasName+' is '+TTextParser.quote(mName)+' type ';
 470   result += getTypeName(mType);
 471   if (mMaxDim >= 0) then result += Format('[%d]', [mMaxDim]);
 472   if (mRecOfs >= 0) then result += Format(' offset %d', [mRecOfs]);
 473   case mEBS of
 474     TEBS.TNone: begin end;
 475     TEBS.TRec: result += ' '+mEBSName;
 476     TEBS.TEnum: result += ' enum '+mEBSName;
 477     TEBS.TBitSet: begin result += ' bitset '; if mBitSetUnique then result += 'unique '; result += mEBSName; end;
 478   end;
 479   if mHasDefault then
 480   begin
 481     if (mType = TType.TChar) or (mType = TType.TString) then result += ' default '+TTextParser.quote(mDefSVal)
 482     else if (Length(mDefSVal) > 0) then result += ' default '+mDefSVal;
 483     {
 484     else
 485     begin
 486       if (mType = TType.TBool) then
 487       begin
 488         result += ' default ';
 489         if (mDefIVal <> 0) then result += 'true' else result += 'false';
 490       end
 491       else
 492       begin
 493         result += Format(' default %d', [mDefIVal]);
 494       end;
 495     end;
 496     }
 497   end;
 498   if mSepPosSize then
 499   begin
 500          if (mType = TType.TPoint) then begin if (mAsT) then result += ' as txy' else result += ' as xy'; end
 501     else if (mType = TType.TSize) then begin if (mAsT) then result += ' as twh' else result += ' as wh'; end;
 502   end;
 503   if mOmitDef then result += ' omitdefault';
 504   if mInternal then result += ' internal';
 505 end;
 506
 507
 508 procedure TDynField.parseDef (pr: TTextParser);
 509 var
 510   fldname: AnsiString;
 511   fldtype: AnsiString;
 512   fldofs: Integer;
 513   fldrecname: AnsiString;
 514   fldpasname: AnsiString;
 515   asxy, aswh, ast: Boolean;
 516   ainternal: Boolean;
 517   omitdef: Boolean;
 518   defstr: AnsiString;
 519   defint: Integer;
 520   hasdefStr: Boolean;
 521   hasdefInt: Boolean;
 522   hasdefId: Boolean;
 523   lmaxdim: Integer;
 524   lebs: TDynField.TEBS;
 525   unique: Boolean;
 526 begin
 527   fldpasname := '';
 528   fldname := '';
 529   fldtype := '';
 530   fldofs := -1;
 531   fldrecname := '';
 532   asxy := false;
 533   aswh := false;
 534   ast := false;
 535   ainternal := false;
 536   omitdef := false;
 537   defstr := '';
 538   defint := 0;
 539   hasdefStr := false;
 540   hasdefInt := false;
 541   hasdefId := false;
 542   unique := false;
 543   lmaxdim := -1;
 544   lebs := TDynField.TEBS.TNone;
 545
 546   fldpasname := pr.expectId(); // pascal field name
 547   // field name
 548   pr.expectId('is');
 549   fldname := pr.expectStr();
 550   // field type
 551   pr.expectId('type');
 552   fldtype := pr.expectId();
 553
 554   // fixed-size array?
 555   if pr.eatDelim('[') then
 556   begin
 557     lmaxdim := pr.expectInt();
 558     if (lmaxdim < 1) then raise Exception.Create(Format('invali field ''%s'' array size', [fldname]));
 559     pr.expectDelim(']');
 560   end;
 561
 562   while (pr.tokType <> pr.TTSemi) do
 563   begin
 564     if pr.eatId('offset') then
 565     begin
 566       if (fldofs >= 0) then raise Exception.Create(Format('duplicate field ''%s'' offset', [fldname]));
 567       fldofs := pr.expectInt();
 568       if (fldofs < 0) then raise Exception.Create(Format('invalid field ''%s'' offset', [fldname]));
 569       continue;
 570     end;
 571
 572     if pr.eatId('as') then
 573     begin
 574            if pr.eatId('xy') then asxy := true
 575       else if pr.eatId('wh') then aswh := true
 576       else if pr.eatId('txy') then begin asxy := true; ast := true; end
 577       else if pr.eatId('twh') then begin aswh := true; ast := true; end
 578       else raise Exception.Create(Format('invalid field ''%s'' as what?', [fldname]));
 579       continue;
 580     end;
 581
 582     if pr.eatId('enum') then
 583     begin
 584       lebs := TDynField.TEBS.TEnum;
 585       if (Length(fldrecname) <> 0) then raise Exception.Create(Format('field ''%s'' already typed as ''%s''', [fldname, fldrecname]));
 586       fldrecname := pr.expectId();
 587       continue;
 588     end;
 589
 590     if pr.eatId('bitset') then
 591     begin
 592       lebs := TDynField.TEBS.TBitSet;
 593       if (Length(fldrecname) <> 0) then raise Exception.Create(Format('field ''%s'' already typed as ''%s''', [fldname, fldrecname]));
 594       unique := pr.eatId('unique');
 595       fldrecname := pr.expectId();
 596       continue;
 597     end;
 598
 599     if pr.eatId('default') then
 600     begin
 601       if hasdefStr or hasdefInt or hasdefId then raise Exception.Create(Format('field ''%s'' has duplicate default', [fldname]));
 602       case pr.tokType of
 603         pr.TTStr:
 604           begin
 605             hasdefStr := true;
 606             defstr := pr.expectStr(true); // allow empty strings
 607           end;
 608         pr.TTId:
 609           begin
 610             hasdefId := true;
 611             defstr := pr.expectId();
 612           end;
 613         pr.TTInt:
 614           begin
 615             hasdefInt := true;
 616             defint := pr.expectInt();
 617           end;
 618         else
 619           raise Exception.Create(Format('field ''%s'' has invalid default', [fldname]));
 620       end;
 621       continue;
 622     end;
 623
 624     if pr.eatId('omitdefault') then
 625     begin
 626       omitdef := true;
 627       continue;
 628     end;
 629
 630     if pr.eatId('internal') then
 631     begin
 632       ainternal := true;
 633       continue;
 634     end;
 635
 636     if (pr.tokType <> pr.TTId) then raise Exception.Create(Format('field ''%s'' has something unexpected in definition', [fldname]));
 637
 638     if (Length(fldrecname) <> 0) then raise Exception.Create(Format('field ''%s'' already typed as ''%s''', [fldname, fldrecname]));
 639     fldrecname := pr.expectId();
 640     lebs := TDynField.TEBS.TRec;
 641   end;
 642
 643   pr.expectTT(pr.TTSemi);
 644
 645   // create field
 646   mName := fldname;
 647        if (fldtype = 'bool') then mType := TType.TBool
 648   else if (fldtype = 'negbool') then begin mType := TType.TBool; mNegBool := true; end
 649   else if (fldtype = 'char') then mType := TType.TChar
 650   else if (fldtype = 'byte') then mType := TType.TByte
 651   else if (fldtype = 'ubyte') then mType := TType.TUByte
 652   else if (fldtype = 'short') then mType := TType.TShort
 653   else if (fldtype = 'ushort') then mType := TType.TUShort
 654   else if (fldtype = 'int') then mType := TType.TInt
 655   else if (fldtype = 'uint') then mType := TType.TUInt
 656   else if (fldtype = 'string') then mType := TType.TString
 657   else if (fldtype = 'point') then mType := TType.TPoint
 658   else if (fldtype = 'size') then mType := TType.TSize
 659   else if (fldtype = 'trigdata') then mType := TType.TTrigData
 660   else raise Exception.Create(Format('field ''%s'' has invalid type ''%s''', [fldname, fldtype]));
 661
 662   {if hasdefId and (self.baseType = self.TType.TBool) then
 663   begin
 664          if (defstr = 'true') or (defstr = 'tan') or (defstr = 'yes') then self.mDefIVal := 1
 665     else if (defstr = 'false') or (defstr = 'ona') or (defstr = 'no') then self.mDefIVal := 0
 666     else raise Exception.Create(Format('field ''%s'' has invalid boolean default ''%s''', [fldname, defstr]));
 667   end
 668   else}
 669   begin
 670          if hasdefStr then self.mDefSVal := defstr
 671     else if hasdefInt then self.mDefSVal := Format('%d', [defint])
 672     else if hasdefId then self.mDefSVal := defstr;
 673   end;
 674
 675   self.mHasDefault := (hasdefStr or hasdefId or hasdefInt);
 676   self.mPasName := fldpasname;
 677   self.mEBS := lebs;
 678   self.mEBSName := fldrecname;
 679   self.mBitSetUnique := unique;
 680   self.mMaxDim := lmaxdim;
 681   self.mBinOfs := fldofs;
 682   self.mRecOfs := fldofs;
 683   self.mSepPosSize := (asxy or aswh);
 684   self.mAsT := ast;
 685   self.mOmitDef := omitdef;
 686   self.mInternal := ainternal;
 687 end;
 688
 689
 690 procedure TDynField.writeTo (wr: TTextWriter);
 691 var
 692   def: TDynMapDef;
 693   es: TDynEBS = nil;
 694   f, mask: Integer;
 695   first, found: Boolean;
 696 begin
 697   wr.put(mName);
 698   wr.put(' ');
 699   // if this field should contain struct, convert type and parse struct
 700   case mEBS of
 701     TEBS.TNone: begin end;
 702     TEBS.TRec:
 703       begin
 704         if (mRecRef = nil) then
 705         begin
 706           wr.put('null;'#10);
 707         end
 708         else if mRecRefOwned then
 709         begin
 710           mRecRef.writeTo(wr, false); // only data, no header
 711         end
 712         else
 713         begin
 714           wr.put(mRecRef.mId);
 715           wr.put(';'#10);
 716         end;
 717         exit;
 718       end;
 719     TEBS.TEnum:
 720       begin
 721         def := mOwner.mOwner;
 722         es := def.findEBS(mEBSName);
 723         if (es = nil) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSName, mName]));
 724         for f := 0 to High(es.mVals) do
 725         begin
 726           if (es.mVals[f] = mIVal) then
 727           begin
 728             wr.put(es.mIds[f]);
 729             wr.put(';'#10);
 730             exit;
 731           end;
 732         end;
 733         raise Exception.Create(Format('value %d in record enum type ''%s'' for field ''%s'' not found', [mIVal, mEBSName, mName]));
 734       end;
 735     TEBS.TBitSet:
 736       begin
 737         def := mOwner.mOwner;
 738         es := def.findEBS(mEBSName);
 739         if (es = nil) then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' not found', [mEBSName, mName]));
 740         // none?
 741         if (mIVal = 0) then
 742         begin
 743           for f := 0 to High(es.mVals) do
 744           begin
 745             if (es.mVals[f] = 0) then
 746             begin
 747               wr.put(es.mIds[f]);
 748               wr.put(';'#10);
 749               exit;
 750             end;
 751           end;
 752           raise Exception.Create(Format('value %d in record bitset type ''%s'' for field ''%s'' not found', [0, mEBSName, mName]));
 753         end;
 754         // not none
 755         mask := 1;
 756         first := true;
 757         while (mask <> 0) do
 758         begin
 759           if ((mIVal and mask) <> 0) then
 760           begin
 761             found := false;
 762             for f := 0 to High(es.mVals) do
 763             begin
 764               if (es.mVals[f] = mask) then
 765               begin
 766                 if not first then wr.put('+') else first := false;
 767                 wr.put(es.mIds[f]);
 768                 found := true;
 769                 break;
 770               end;
 771             end;
 772             if not found then raise Exception.Create(Format('value %d in record bitset type ''%s'' for field ''%s'' not found', [mask, mEBSName, mName]));
 773           end;
 774           mask := mask shl 1;
 775         end;
 776         wr.put(';'#10);
 777         exit;
 778       end;
 779     else raise Exception.Create('ketmar forgot to handle some EBS type');
 780   end;
 781
 782   case mType of
 783     TType.TBool:
 784       begin
 785         if (mIVal = 0) then wr.put('false;'#10) else wr.put('true;'#10);
 786         exit;
 787       end;
 788     TType.TChar:
 789       begin
 790         if (mMaxDim = 0) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
 791         wr.put(TTextParser.quote(mSVal));
 792         wr.put(';'#10);
 793         exit;
 794       end;
 795     TType.TByte,
 796     TType.TUByte,
 797     TType.TShort,
 798     TType.TUShort,
 799     TType.TInt,
 800     TType.TUInt:
 801       begin
 802         wr.put('%d;'#10, [mIVal]);
 803         exit;
 804       end;
 805     TType.TString:
 806       begin
 807         wr.put(TTextParser.quote(mSVal));
 808         wr.put(';'#10);
 809         exit;
 810       end;
 811     TType.TPoint,
 812     TType.TSize:
 813       begin
 814         wr.put('(%d %d);'#10, [mIVal, mIVal2]);
 815         exit;
 816       end;
 817     TType.TList:
 818       begin
 819         assert(false);
 820         exit;
 821       end;
 822     TType.TTrigData:
 823       begin
 824         assert(false);
 825         exit;
 826       end;
 827     else raise Exception.Create('ketmar forgot to handle some field type');
 828   end;
 829   raise Exception.Create(Format('cannot parse field ''%s'' yet', [mName]));
 830 end;
 831
 832
 833 procedure TDynField.parseValue (pr: TTextParser);
 834
 835   procedure parseInt (min, max: Integer);
 836   begin
 837     mIVal := pr.expectInt();
 838     if (mIVal < min) or (mIVal > max) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
 839     mDefined := true;
 840   end;
 841
 842 var
 843   rec, rc: TDynRecord;
 844   def: TDynMapDef;
 845   es: TDynEBS = nil;
 846   tfld: TDynField;
 847   tk: AnsiString;
 848 begin
 849   // if this field should contain struct, convert type and parse struct
 850   case mEBS of
 851     TEBS.TNone: begin end;
 852     TEBS.TRec:
 853       begin
 854         def := mOwner.mOwner;
 855         // ugly hack. sorry.
 856         if (CompareText(mEBSName, 'triggerdata') = 0) then
 857         begin
 858           rec := mOwner;
 859           // find trigger definition
 860           tfld := rec.field['type'];
 861           if (tfld = nil) then raise Exception.Create(Format('triggerdata value for field ''%s'' in record ''%s'' without ''type'' field', [mName, rec.mName]));
 862           if (tfld.mEBS <> TEBS.TEnum) then raise Exception.Create(Format('triggerdata value for field ''%s'' in record ''%s'' with bad ''type'' field', [mName, rec.mName]));
 863           rc := def.findTrigDataFor(tfld.mSVal);
 864           if (rc = nil) then raise Exception.Create(Format('triggerdata definition for field ''%s'' in record ''%s'' with type ''%s'' not found', [mName, rec.mName, tfld.mSVal]));
 865           rc := rc.clone();
 866           rc.parseValue(pr);
 867           if mRecRefOwned then mRecRef.Free();
 868           mRecRefOwned := true;
 869           mRecRef := rc;
 870           mDefined := true;
 871           exit;
 872         end;
 873         // other record types
 874         if (pr.tokType = pr.TTId) then
 875         begin
 876           rec := def.findRecordById(mEBSName, pr.tokStr);
 877           if (rec = nil) then raise Exception.Create(Format('record ''%s'' (%s) value for field ''%s'' not found', [pr.tokStr, mEBSName, mName]));
 878           pr.expectId();
 879           if mRecRefOwned then mRecRef.Free();
 880           mRecRefOwned := false;
 881           mRecRef := rec;
 882           mDefined := true;
 883           pr.expectTT(pr.TTSemi);
 884           exit;
 885         end
 886         else if (pr.tokType = pr.TTBegin) then
 887         begin
 888           rec := def.findRec(mEBSName);
 889           if (rec = nil) then raise Exception.Create(Format('record type ''%s'' for field ''%s'' not found', [mEBSName, mName]));
 890           rc := rec.clone();
 891           rc.parseValue(pr);
 892           if mRecRefOwned then mRecRef.Free();
 893           mRecRefOwned := true;
 894           mRecRef := rc;
 895           mDefined := true;
 896           exit;
 897         end;
 898         pr.expectTT(pr.TTBegin);
 899       end;
 900     TEBS.TEnum:
 901       begin
 902         def := mOwner.mOwner;
 903         es := def.findEBS(mEBSName);
 904         if (es = nil) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSName, mName]));
 905         tk := pr.expectId();
 906         if not es.has[tk] then raise Exception.Create(Format('record enum value ''%s'' of type ''%s'' for field ''%s'' not found', [tk, mEBSName, mName]));
 907         mIVal := es.field[tk];
 908         mSVal := tk;
 909         //writeln('ENUM ', mEBSName, '; element <', mSVal, '> with value ', mIVal);
 910         mDefined := true;
 911         pr.expectTT(pr.TTSemi);
 912         exit;
 913       end;
 914     TEBS.TBitSet:
 915       begin
 916         def := mOwner.mOwner;
 917         es := def.findEBS(mEBSName);
 918         if (es = nil) then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' not found', [mEBSName, mName]));
 919         mIVal := 0;
 920         while true do
 921         begin
 922           tk := pr.expectId();
 923           if not es.has[tk] then raise Exception.Create(Format('record bitset value ''%s'' of type ''%s'' for field ''%s'' not found', [tk, mEBSName, mName]));
 924           mIVal := mIVal or es.field[tk];
 925           mSVal := tk;
 926           if (pr.tokType <> pr.TTDelim) or ((pr.tokChar <> '|') and (pr.tokChar <> '+')) then break;
 927           if mBitSetUnique then raise Exception.Create(Format('record bitset of type ''%s'' for field ''%s'' expects only one value', [tk, mEBSName, mName]));
 928           //pr.expectDelim('|');
 929           pr.skipToken(); // plus or pipe
 930         end;
 931         mDefined := true;
 932         pr.expectTT(pr.TTSemi);
 933         exit;
 934       end;
 935     else raise Exception.Create('ketmar forgot to handle some EBS type');
 936   end;
 937
 938   case mType of
 939     TType.TBool:
 940       begin
 941              if pr.eatId('true') or pr.eatId('tan') or pr.eatId('yes') then mIVal := 1
 942         else if pr.eatId('false') or pr.eatId('ona') or pr.eatId('no') then mIVal := 0
 943         else raise Exception.Create(Format('invalid bool value for field ''%s''', [mName]));
 944         mDefined := true;
 945         pr.expectTT(pr.TTSemi);
 946         exit;
 947       end;
 948     TType.TChar:
 949       begin
 950         if (mMaxDim = 0) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
 951         mSVal := pr.expectStr(true);
 952         if (mMaxDim < 0) then
 953         begin
 954           // single char
 955           if (Length(mSVal) <> 1) then raise Exception.Create(Format('invalid string size for field ''%s''', [mName]));
 956           mIVal := Integer(mSVal[1]);
 957           mSVal := '';
 958         end
 959         else
 960         begin
 961           // string
 962           if (Length(mSVal) > mMaxDim) then raise Exception.Create(Format('invalid string size for field ''%s''', [mName]));
 963         end;
 964         mDefined := true;
 965         pr.expectTT(pr.TTSemi);
 966         exit;
 967       end;
 968     TType.TByte:
 969       begin
 970         parseInt(-128, 127);
 971         pr.expectTT(pr.TTSemi);
 972         exit;
 973       end;
 974     TType.TUByte:
 975       begin
 976         parseInt(0, 255);
 977         pr.expectTT(pr.TTSemi);
 978         exit;
 979       end;
 980     TType.TShort:
 981       begin
 982         parseInt(-32768, 32768);
 983         pr.expectTT(pr.TTSemi);
 984         exit;
 985       end;
 986     TType.TUShort:
 987       begin
 988         parseInt(0, 65535);
 989         pr.expectTT(pr.TTSemi);
 990         exit;
 991       end;
 992     TType.TInt:
 993       begin
 994         parseInt(Integer($80000000), $7fffffff);
 995         pr.expectTT(pr.TTSemi);
 996         exit;
 997       end;
 998     TType.TUInt:
 999       begin
1000         parseInt(0, $7fffffff); //FIXME
1001         pr.expectTT(pr.TTSemi);
1002         exit;
1003       end;
1004     TType.TString:
1005       begin
1006         mSVal := pr.expectStr(true);
1007         mDefined := true;
1008         pr.expectTT(pr.TTSemi);
1009         exit;
1010       end;
1011     TType.TPoint,
1012     TType.TSize:
1013       begin
1014         pr.expectDelim('(');
1015         mIVal := pr.expectInt();
1016         if (mType = TType.TPoint) then
1017         begin
1018           if (mIVal < -32768) or (mIVal > 32767) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
1019         end
1020         else
1021         begin
1022           if (mIVal < 0) or (mIVal > 32767) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
1023         end;
1024         mIVal2 := pr.expectInt();
1025         if (mType = TType.TPoint) then
1026         begin
1027           if (mIVal2 < -32768) or (mIVal2 > 32767) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
1028         end
1029         else
1030         begin
1031           if (mIVal2 < 0) or (mIVal2 > 32767) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
1032         end;
1033         mDefined := true;
1034         pr.expectDelim(')');
1035         pr.expectTT(pr.TTSemi);
1036         exit;
1037       end;
1038     TType.TList:
1039       begin
1040         assert(false);
1041         exit;
1042       end;
1043     TType.TTrigData:
1044       begin
1045         assert(false);
1046         exit;
1047       end;
1048     else raise Exception.Create('ketmar forgot to handle some field type');
1049   end;
1050   raise Exception.Create(Format('cannot parse field ''%s'' yet', [mName]));
1051 end;
1052
1053
1054 // ////////////////////////////////////////////////////////////////////////// //
1055 constructor TDynRecord.Create (pr: TTextParser);
1056 begin
1057   if (pr = nil) then raise Exception.Create('cannot create record type without type definition');
1058   mId := '';
1059   mName := '';
1060   mSize := 0;
1061   mFields := nil;
1062   mTrigTypes := nil;
1063   mHeader := false;
1064   mBinBlock := -1;
1065   parseDef(pr);
1066 end;
1067
1068
1069 constructor TDynRecord.Create ();
1070 begin
1071   mName := '';
1072   mSize := 0;
1073   mFields := nil;
1074   mTrigTypes := nil;
1075   mHeader := false;
1076 end;
1077
1078
1079 destructor TDynRecord.Destroy ();
1080 begin
1081   mName := '';
1082   mFields := nil;
1083   mTrigTypes := nil;
1084   inherited;
1085 end;
1086
1087
1088 function TDynRecord.findByName (const aname: AnsiString): Integer; inline;
1089 begin
1090   result := 0;
1091   while (result < Length(mFields)) do
1092   begin
1093     if (CompareText(aname, mFields[result].mName) = 0) then exit;
1094     Inc(result);
1095   end;
1096   result := -1;
1097 end;
1098
1099
1100 function TDynRecord.hasByName (const aname: AnsiString): Boolean; inline;
1101 begin
1102   result := (findByName(aname) >= 0);
1103 end;
1104
1105
1106 function TDynRecord.getFieldByName (const aname: AnsiString): TDynField; inline;
1107 var
1108   f: Integer;
1109 begin
1110   f := findByName(aname);
1111   if (f >= 0) then result := mFields[f] else result := nil;
1112 end;
1113
1114
1115 function TDynRecord.getIsTrigData (): Boolean; inline;
1116 begin
1117   result := (Length(mTrigTypes) > 0);
1118 end;
1119
1120
1121 function TDynRecord.getIsForTrig (const aname: AnsiString): Boolean; inline;
1122 var
1123   f: Integer;
1124 begin
1125   result := true;
1126   for f := 0 to High(mTrigTypes) do if (CompareText(mTrigTypes[f], aname) = 0) then exit;
1127   result := false;
1128 end;
1129
1130
1131 function TDynRecord.clone (): TDynRecord;
1132 var
1133   f: Integer;
1134 begin
1135   result := TDynRecord.Create();
1136   result.mOwner := mOwner;
1137   result.mId := mId;
1138   result.mPasName := mPasName;
1139   result.mName := mName;
1140   result.mSize := mSize;
1141   result.mHeader := mHeader;
1142   SetLength(result.mFields, Length(mFields));
1143   for f := 0 to High(mFields) do
1144   begin
1145     result.mFields[f] := mFields[f].clone();
1146     result.mFields[f].mOwner := result;
1147   end;
1148   SetLength(result.mTrigTypes, Length(mTrigTypes));
1149   for f := 0 to High(mTrigTypes) do result.mTrigTypes[f] := mTrigTypes[f];
1150 end;
1151
1152
1153 procedure TDynRecord.parseDef (pr: TTextParser);
1154 var
1155   fld: TDynField;
1156   tdn: AnsiString;
1157 begin
1158   if pr.eatId('TriggerData') then
1159   begin
1160     pr.expectId('for');
1161     if pr.eatDelim('(') then
1162     begin
1163       while true do
1164       begin
1165         while pr.eatTT(pr.TTComma) do begin end;
1166         if pr.eatDelim(')') then break;
1167         tdn := pr.expectId();
1168         if isForTrig[tdn] then raise Exception.Create(Format('duplicate trigdata ''%s'' trigtype ''%s''', [mName, tdn]));
1169         SetLength(mTrigTypes, Length(mTrigTypes)+1);
1170         mTrigTypes[High(mTrigTypes)] := tdn;
1171       end;
1172     end
1173     else
1174     begin
1175       tdn := pr.expectId();
1176       SetLength(mTrigTypes, 1);
1177       mTrigTypes[0] := tdn;
1178     end;
1179   end
1180   else
1181   begin
1182     mPasName := pr.expectId(); // pascal record name
1183     pr.expectId('is');
1184     mName := pr.expectStr();
1185     while (pr.tokType <> pr.TTBegin) do
1186     begin
1187       if pr.eatId('header') then begin mHeader := true; continue; end;
1188       if pr.eatId('size') then
1189       begin
1190         if (mSize > 0) then raise Exception.Create(Format('duplicate `size` in record ''%s''', [mName]));
1191         mSize := pr.expectInt();
1192         if (mSize < 1) then raise Exception.Create(Format('invalid record ''%s'' size: %d', [mName, mSize]));
1193         pr.expectId('bytes');
1194         continue;
1195       end;
1196       if pr.eatId('binblock') then
1197       begin
1198         if (mBinBlock >= 0) then raise Exception.Create(Format('duplicate `binblock` in record ''%s''', [mName]));
1199         mBinBlock := pr.expectInt();
1200         if (mBinBlock < 1) then raise Exception.Create(Format('invalid record ''%s'' binblock: %d', [mName, mBinBlock]));
1201         continue;
1202       end;
1203     end;
1204   end;
1205
1206   pr.expectTT(pr.TTBegin);
1207   // load fields
1208   while (pr.tokType <> pr.TTEnd) do
1209   begin
1210     fld := TDynField.Create(pr);
1211     if hasByName(fld.name) then begin fld.Free(); raise Exception.Create(Format('duplicate field ''%s''', [fld.name])); end;
1212     // append
1213     fld.mOwner := self;
1214     SetLength(mFields, Length(mFields)+1);
1215     mFields[High(mFields)] := fld;
1216     // done with field
1217     //writeln('DEF: ', fld.definition);
1218   end;
1219   pr.expectTT(pr.TTEnd);
1220 end;
1221
1222
1223 function TDynRecord.definition (): AnsiString;
1224 var
1225   f: Integer;
1226 begin
1227   if isTrigData then
1228   begin
1229     // trigger data
1230     result := 'TriggerData for ';
1231     if (Length(mTrigTypes) > 1) then
1232     begin
1233       result += '(';
1234       for f := 0 to High(mTrigTypes) do
1235       begin
1236         if (f <> 0) then result += ', ';
1237         result += mTrigTypes[f];
1238       end;
1239       result += ')';
1240     end
1241     else
1242     begin
1243       result += mTrigTypes[0];
1244     end;
1245   end
1246   else
1247   begin
1248     // record
1249     result := mPasName+' is '+TTextParser.quote(mName);
1250     if (mSize >= 0) then result += Format(' size %d bytes', [mSize]);
1251     if mHeader then result += ' header';
1252   end;
1253   result += ' {'#10;
1254   for f := 0 to High(mFields) do
1255   begin
1256     result += '  ';
1257     result += mFields[f].definition;
1258     result += ';'#10;
1259   end;
1260   result += '}';
1261 end;
1262
1263
1264 procedure TDynRecord.writeTo (wr: TTextWriter; putHeader: Boolean=true);
1265 var
1266   f, c: Integer;
1267   fld: TDynField;
1268 begin
1269   if putHeader then
1270   begin
1271     wr.put(mName);
1272     if (Length(mId) > 0) then begin wr.put(' '); wr.put(mId); end;
1273     wr.put(' ');
1274   end;
1275   wr.put('{'#10);
1276   wr.indent();
1277   try
1278     for f := 0 to High(mFields) do
1279     begin
1280       fld := mFields[f];
1281       // record list?
1282       if (fld.mType = fld.TType.TList) then
1283       begin
1284         if not mHeader then raise Exception.Create('record list in non-header record');
1285         for c := 0 to High(fld.mRVal) do
1286         begin
1287           wr.putIndent();
1288           fld.mRVal[c].writeTo(wr, true);
1289         end;
1290         continue;
1291       end;
1292       if fld.mInternal then continue;
1293       if fld.mOmitDef and fld.isDefaultValue then continue;
1294       wr.putIndent();
1295       fld.writeTo(wr);
1296     end;
1297   finally
1298     wr.unindent();
1299   end;
1300   wr.putIndent();
1301   wr.put('}'#10);
1302 end;
1303
1304
1305 procedure TDynRecord.parseValue (pr: TTextParser; asheader: Boolean=false);
1306 var
1307   f, c: Integer;
1308   fld: TDynField;
1309   rec: TDynRecord;
1310   success: Boolean;
1311 begin
1312   if (mOwner = nil) then raise Exception.Create(Format('can''t parse record ''%s'' value without owner', [mName]));
1313
1314   if not asheader then
1315   begin
1316     // id?
1317     if (pr.tokType = pr.TTId) then mId := pr.expectId();
1318   end;
1319
1320   writeln('parsing record <', mName, '>');
1321   pr.expectTT(pr.TTBegin);
1322   while (pr.tokType <> pr.TTEnd) do
1323   begin
1324     if (pr.tokType <> pr.TTId) then raise Exception.Create('identifier expected');
1325
1326     writeln('<', pr.tokStr, ':', asheader, '>');
1327
1328     // records
1329     if (asheader) then
1330     begin
1331       assert(self = mOwner.curheader);
1332       success := false;
1333       for f := 0 to High(mOwner.records) do
1334       begin
1335         if (CompareText(mOwner.records[f].mName, pr.tokStr) = 0) then
1336         begin
1337           // find (or create) list of records with this type
1338           fld := field[pr.tokStr];
1339           if (fld = nil) then
1340           begin
1341             // first record
1342             fld := TDynField.Create(mOwner.records[f].mName, TDynField.TType.TList);
1343             fld.mOwner := self;
1344             SetLength(mFields, Length(mFields)+1);
1345             mFields[High(mFields)] := fld;
1346           end;
1347           if (fld.mType <> TDynField.TType.TList) then raise Exception.Create(Format('thing ''%s'' in record ''%s'' must be record', [fld.mName, mName]));
1348           rec := mOwner.records[f].clone();
1349           try
1350             pr.skipToken();
1351             rec.parseValue(pr);
1352             if (Length(rec.mId) > 0) then
1353             begin
1354               for c := 0 to High(fld.mRVal) do
1355               begin
1356                 if (Length(fld.mRVal[c].mId) > 0) and (CompareText(fld.mRVal[c].mId, rec.mId) = 0) then raise Exception.Create(Format('duplicate thing ''%s'' in record ''%s''', [fld.mName, mName]));
1357               end;
1358             end;
1359             SetLength(fld.mRVal, Length(fld.mRVal)+1);
1360             fld.mRVal[High(fld.mRVal)] := rec;
1361             writeln('added ''', mOwner.records[f].mName, ''' with id ''', rec.mId, ''' (total:', Length(fld.mRVal), ')');
1362             //assert(mOwner.findRecordById(mOwner.records[f].mName, rec.mId) <> nil);
1363             rec := nil;
1364           finally
1365             rec.Free();
1366           end;
1367           success := true;
1368           break;
1369         end;
1370       end;
1371       if success then continue;
1372     end;
1373
1374     // fields
1375     fld := field[pr.tokStr];
1376     if (fld <> nil) then
1377     begin
1378       if fld.defined then raise Exception.Create(Format('duplicate field ''%s'' in record ''%s''', [fld.mName, mName]));
1379       if fld.internal then raise Exception.Create(Format('internal field ''%s'' in record ''%s''', [fld.mName, mName]));
1380       pr.skipToken();
1381       fld.parseValue(pr);
1382       continue;
1383     end;
1384
1385     // something is wrong
1386     raise Exception.Create(Format('unknown field ''%s'' in record ''%s''', [pr.tokStr, mName]));
1387   end;
1388   pr.expectTT(pr.TTEnd);
1389   // fix field defaults
1390   for f := 0 to High(mFields) do mFields[f].fixDefaultValue();
1391   writeln('done parsing record <', mName, '>');
1392 end;
1393
1394
1395 // ////////////////////////////////////////////////////////////////////////// //
1396 constructor TDynEBS.Create (pr: TTextParser);
1397 begin
1398   cleanup();
1399   parseDef(pr);
1400 end;
1401
1402
1403 destructor TDynEBS.Destroy ();
1404 begin
1405   cleanup();
1406   inherited;
1407 end;
1408
1409
1410 procedure TDynEBS.cleanup ();
1411 begin
1412   mIsEnum := false;
1413   mName := '';
1414   mIds := nil;
1415   mVals := nil;
1416   mMaxName := '';
1417   mMaxVal := 0;
1418 end;
1419
1420
1421 function TDynEBS.findByName (const aname: AnsiString): Integer;
1422 begin
1423   result := 0;
1424   while (result < Length(mIds)) do
1425   begin
1426     if (CompareText(aname, mIds[result]) = 0) then exit;
1427     Inc(result);
1428   end;
1429   result := -1;
1430 end;
1431
1432
1433 function TDynEBS.hasByName (const aname: AnsiString): Boolean; inline;
1434 begin
1435   result := (findByName(aname) >= 0);
1436 end;
1437
1438
1439 function TDynEBS.getFieldByName (const aname: AnsiString): Integer; inline;
1440 var
1441   f: Integer;
1442 begin
1443   f := findByName(aname);
1444   if (f >= 0) then result := mVals[f] else result := 0;
1445 end;
1446
1447
1448 function TDynEBS.definition (): AnsiString;
1449 var
1450   f, cv: Integer;
1451 begin
1452   if mIsEnum then result :='enum ' else result := 'bitset ';
1453   result += mName;
1454   result += ' {'#10;
1455   // fields
1456   if mIsEnum then cv := 0 else cv := 1;
1457   for f := 0 to High(mIds) do
1458   begin
1459     if (mIds[f] = mMaxName) then continue;
1460     result += '  '+mIds[f];
1461     if (mVals[f] <> cv) then
1462     begin
1463       result += Format(' = %d', [mVals[f]]);
1464       if mIsEnum then cv := mVals[f];
1465       result += ','#10;
1466     end
1467     else
1468     begin
1469       result += Format(', // %d'#10, [mVals[f]]);
1470     end;
1471     if mIsEnum then Inc(cv) else if (mVals[f] = cv) then cv := cv shl 1;
1472   end;
1473   // max field
1474   if (Length(mMaxName) > 0) then result += '  '+mMaxName+' = MAX,'#10;
1475   result += '}';
1476 end;
1477
1478
1479 procedure TDynEBS.parseDef (pr: TTextParser);
1480 var
1481   idname: AnsiString;
1482   cv, v: Integer;
1483   f: Integer;
1484   skipAdd: Boolean;
1485   hasV: Boolean;
1486 begin
1487        if pr.eatId('enum') then mIsEnum := true
1488   else if pr.eatId('bitset') then mIsEnum := false
1489   else pr.expectId('enum');
1490   mName := pr.expectId();
1491   mMaxVal := Integer($80000000);
1492   if mIsEnum then cv := 0 else cv := 1;
1493   pr.expectTT(pr.TTBegin);
1494   while (pr.tokType <> pr.TTEnd) do
1495   begin
1496     idname := pr.expectId();
1497     for f := 0 to High(mIds) do
1498     begin
1499       if (CompareText(mIds[f], idname) = 0) then raise Exception.Create(Format('duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName]));
1500     end;
1501     if (CompareText(mMaxName, idname) = 0) then raise Exception.Create(Format('duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName]));
1502     skipAdd := false;
1503     hasV := false;
1504     v := cv;
1505     // has value?
1506     if pr.eatDelim('=') then
1507     begin
1508       if pr.eatId('MAX') then
1509       begin
1510         if (Length(mMaxName) > 0) then raise Exception.Create(Format('duplicate max field ''%s'' in enum/bitset ''%s''', [idname, mName]));
1511         mMaxName := idname;
1512         skipAdd := true;
1513       end
1514       else
1515       begin
1516         v := pr.expectInt();
1517           if mIsEnum then cv := v;
1518         hasV := true;
1519       end;
1520     end;
1521     // append it?
1522     if not skipAdd then
1523     begin
1524       // fix maxvalue
1525       if mIsEnum or (not hasV) then
1526       begin
1527         if (mMaxVal < v) then mMaxVal := v;
1528       end;
1529       SetLength(mIds, Length(mIds)+1);
1530       mIds[High(mIds)] := idname;
1531       SetLength(mVals, Length(mIds));
1532       mVals[High(mVals)] := v;
1533       // next cv
1534       if mIsEnum or (not hasV) then
1535       begin
1536         if mIsEnum then Inc(cv) else cv := cv shl 1;
1537       end;
1538     end;
1539     if (pr.tokType = pr.TTEnd) then break;
1540     pr.expectTT(pr.TTComma);
1541     while pr.eatTT(pr.TTComma) do begin end;
1542   end;
1543   pr.expectTT(pr.TTEnd);
1544   // add max field
1545   if (Length(mMaxName) > 0) then
1546   begin
1547     SetLength(mIds, Length(mIds)+1);
1548     mIds[High(mIds)] := mMaxName;
1549     SetLength(mVals, Length(mIds));
1550     mVals[High(mVals)] := mMaxVal;
1551   end;
1552 end;
1553
1554
1555 // ////////////////////////////////////////////////////////////////////////// //
1556 constructor TDynMapDef.Create (pr: TTextParser);
1557 begin
1558   records := nil;
1559   trigDatas := nil;
1560   ebs := nil;
1561   curheader := nil;
1562   parseDef(pr);
1563 end;
1564
1565
1566 destructor TDynMapDef.Destroy ();
1567 var
1568   f: Integer;
1569 begin
1570   for f := 0 to High(records) do records[f].Free();
1571   for f := 0 to High(trigDatas) do trigDatas[f].Free();
1572   for f := 0 to High(ebs) do ebs[f].Free();
1573   records := nil;
1574   trigDatas := nil;
1575   ebs := nil;
1576   inherited;
1577 end;
1578
1579
1580 function TDynMapDef.getHeader (): TDynRecord; inline;
1581 begin
1582   if (Length(records) = 0) then raise Exception.Create('no header in empty mapdef');
1583   result := records[0];
1584 end;
1585
1586
1587 function TDynMapDef.findRec (const aname: AnsiString): TDynRecord;
1588 var
1589   f: Integer;
1590 begin
1591   for f := 0 to High(records) do
1592   begin
1593     if (CompareText(records[f].name, aname) = 0) then begin result := records[f]; exit; end;
1594   end;
1595   result := nil;
1596 end;
1597
1598
1599 function TDynMapDef.findTrigDataFor (const aname: AnsiString): TDynRecord;
1600 var
1601   f: Integer;
1602 begin
1603   for f := 0 to High(trigDatas) do
1604   begin
1605     if (trigDatas[f].isForTrig[aname]) then begin result := trigDatas[f]; exit; end;
1606   end;
1607   result := nil;
1608 end;
1609
1610
1611 function TDynMapDef.findEBS (const aname: AnsiString): TDynEBS;
1612 var
1613   f: Integer;
1614 begin
1615   for f := 0 to High(ebs) do
1616   begin
1617     if (CompareText(ebs[f].name, aname) = 0) then begin result := ebs[f]; exit; end;
1618   end;
1619   result := nil;
1620 end;
1621
1622
1623 function TDynMapDef.findRecordById (const atypename, aid: AnsiString): TDynRecord;
1624 var
1625   rec: TDynRecord;
1626   fld: TDynField;
1627   f: Integer;
1628 begin
1629   result := nil;
1630   if (curheader = nil) then exit;
1631   // find record type
1632   //writeln('searching for type <', atypename, '>');
1633   rec := findRec(atypename);
1634   if (rec = nil) then exit;
1635   // find record data
1636   //writeln('searching for data of type <', atypename, '>');
1637   fld := curheader.field[atypename];
1638   if (fld = nil) then exit;
1639   if (fld.mType <> fld.TType.TList) then exit;
1640   // find by id
1641   //writeln('searching for data of type <', atypename, '> with id <', aid, '> (', Length(fld.mRVal), ')');
1642   for f := 0 to High(fld.mRVal) do
1643   begin
1644     if (CompareText(fld.mRVal[f].mId, aid) = 0) then
1645     begin
1646       //writeln('  FOUND!');
1647       result := fld.mRVal[f];
1648       exit;
1649     end;
1650   end;
1651   // alas
1652 end;
1653
1654
1655 procedure TDynMapDef.parseDef (pr: TTextParser);
1656 var
1657   dr, hdr: TDynRecord;
1658   eb: TDynEBS;
1659   f: Integer;
1660 begin
1661   hdr := nil;
1662   while true do
1663   begin
1664     if not pr.skipBlanks() then break;
1665     if (pr.tokType <> pr.TTId) then raise Exception.Create('identifier expected');
1666
1667     if (pr.tokStr = 'enum') or (pr.tokStr = 'bitset') then
1668     begin
1669       eb := TDynEBS.Create(pr);
1670       if (findEBS(eb.name) <> nil) then
1671       begin
1672         eb.Free();
1673         raise Exception.Create(Format('duplicate enum/bitset ''%s''', [eb.name]));
1674       end;
1675       eb.mOwner := self;
1676       SetLength(ebs, Length(ebs)+1);
1677       ebs[High(ebs)] := eb;
1678       //writeln(eb.definition); writeln;
1679       continue;
1680     end;
1681
1682     if (pr.tokStr = 'TriggerData') then
1683     begin
1684       dr := TDynRecord.Create(pr);
1685       for f := 0 to High(dr.mTrigTypes) do
1686       begin
1687         if (findTrigDataFor(dr.mTrigTypes[f]) <> nil) then
1688         begin
1689           dr.Free();
1690           raise Exception.Create(Format('duplicate trigdata ''%s''', [dr.mTrigTypes[f]]));
1691         end;
1692       end;
1693       dr.mOwner := self;
1694       SetLength(trigDatas, Length(trigDatas)+1);
1695       trigDatas[High(trigDatas)] := dr;
1696       //writeln(dr.definition); writeln;
1697       continue;
1698     end;
1699
1700     dr := TDynRecord.Create(pr);
1701     //writeln(dr.definition); writeln;
1702     if (findRec(dr.name) <> nil) then begin dr.Free(); raise Exception.Create(Format('duplicate record ''%s''', [dr.name])); end;
1703     if (hdr <> nil) and (CompareText(dr.name, hdr.name) = 0) then begin dr.Free(); raise Exception.Create(Format('duplicate record ''%s''', [dr.name])); end;
1704     dr.mOwner := self;
1705     if dr.mHeader then
1706     begin
1707       if (hdr <> nil) then begin dr.Free(); raise Exception.Create(Format('duplicate header record ''%s'' (previous is ''%s'')', [dr.name, hdr.name])); end;
1708       hdr := dr;
1709     end
1710     else
1711     begin
1712       SetLength(records, Length(records)+1);
1713       records[High(records)] := dr;
1714     end;
1715   end;
1716
1717   if (hdr = nil) then raise Exception.Create('header definition not found in mapdef');
1718   SetLength(records, Length(records)+1);
1719   for f := High(records) downto 1 do records[f] := records[f-1];
1720   records[0] := hdr;
1721 end;
1722
1723
1724 // ////////////////////////////////////////////////////////////////////////// //
1725 function TDynMapDef.parseMap (pr: TTextParser): TDynRecord;
1726 var
1727   res: TDynRecord = nil;
1728 begin
1729   if (curheader <> nil) then raise Exception.Create('cannot call `parseMap()` recursively, sorry');
1730   result := nil;
1731   try
1732     pr.expectId(header.name);
1733     res := header.clone();
1734     curheader := res;
1735     res.parseValue(pr, true); // as header
1736     result := res;
1737     res := nil;
1738   finally
1739     curheader := nil;
1740     res.Free();
1741   end;
1742 end;
1743
1744
1745 end.