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