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 {.$DEFINE XDYNREC_USE_FIELDHASH} // actually, it is SLOWER with this
  18 unit xdynrec;
  19
  20 interface
  21
  22 uses
  23   Classes,
  24   xparser, xstreams, utils, hashtable;
  25
  26
  27 // ////////////////////////////////////////////////////////////////////////// //
  28 type
  29   TDynMapDef = class;
  30   TDynRecord = class;
  31   TDynField = class;
  32   TDynEBS = class;
  33
  34   TDynFieldList = specialize TSimpleList<TDynField>;
  35   TDynRecList = specialize TSimpleList<TDynRecord>;
  36   TDynEBSList = specialize TSimpleList<TDynEBS>;
  37
  38   // this is base type for all scalars (and arrays)
  39   TDynField = class
  40   public
  41     type
  42       TType = (TBool, TChar, TByte, TUByte, TShort, TUShort, TInt, TUInt, TString, TPoint, TSize, TList, TTrigData);
  43       // TPoint: pair of Integers
  44       // TSize: pair of UShorts
  45       // TList: actually, array of records
  46       // TTrigData: array of mMaxDim bytes, but internally a record (mRecRef)
  47       // arrays of chars are pascal shortstrings (with counter in the first byte)
  48
  49   private
  50     type
  51       TEBS = (TNone, TRec, TEnum, TBitSet);
  52
  53   private
  54     mOwner: TDynRecord;
  55     mPasName: AnsiString;
  56     mName: AnsiString;
  57     mType: TType;
  58     mIVal: Integer; // for all integer types
  59     mIVal2: Integer; // for point and size
  60     mSVal: AnsiString; // string; for byte and char arrays
  61     mRVal: TDynRecList; // for list
  62     mRHash: THashStrInt; // id -> index in mRVal
  63     mRecRef: TDynRecord; // for TEBS.TRec
  64     mMaxDim: Integer; // for byte and char arrays; <0: not an array; 0: impossible value
  65     mBinOfs: Integer; // offset in binary; <0 - none
  66     mSepPosSize: Boolean; // for points and sizes, use separate fields
  67     mAsT: Boolean; // for points and sizes, use separate fields, names starts with `t`
  68     mDefined: Boolean;
  69     mHasDefault: Boolean;
  70     mOmitDef: Boolean;
  71     mInternal: Boolean;
  72     mNegBool: Boolean;
  73     mBitSetUnique: Boolean; // bitset can contain only one value
  74     mAsMonsterId: Boolean; // special hack for triggers: monster record number+1 in binary (so 0 means "none")
  75     // default value
  76     mDefUnparsed: AnsiString;
  77     mDefSVal: AnsiString; // default string value
  78     mDefIVal, mDefIVal2: Integer; // default integer values
  79     mDefRecRef: TDynRecord;
  80     mEBS: TEBS; // complex type type
  81     mEBSTypeName: AnsiString; // name of enum, bitset or record
  82     mEBSType: TObject; // either TDynRecord or TDynEBS; nil means "simple type"; nil for `TTrigData` too
  83
  84     // for binary parser
  85     mRecRefId: AnsiString;
  86
  87     // for userdata
  88     mTagInt: Integer;
  89     mTagPtr: Pointer;
  90
  91   private
  92     procedure cleanup ();
  93
  94     procedure parseDef (pr: TTextParser);
  95
  96     procedure parseDefaultValue (); // parse `mDefUnparsed` to `mDefSVal`, `mDefIVal`, `mDefIVal2`, `mDefRecRef`
  97     procedure fixDefaultValue (); // this will NOT clone `mDefRecRef`
  98     function isDefaultValue (): Boolean;
  99
 100     function getListCount (): Integer; inline;
 101     function getListItem (idx: Integer): TDynRecord; inline; overload;
 102     function getListItem (const aname: AnsiString): TDynRecord; inline; overload;
 103
 104     function getRecRefIndex (): Integer;
 105
 106     procedure setIVal (v: Integer); inline;
 107
 108   protected
 109     // returns `true` for duplicate record id
 110     function addListItem (rec: TDynRecord): Boolean; inline;
 111
 112   public
 113     {
 114     type
 115       TListEnumerator = record
 116       private
 117         mList: TDynRecList;
 118         mCurIdx: Integer;
 119       public
 120         constructor Create (alist: TDynRecList);
 121         function MoveNext (): Boolean; inline;
 122         function getCurrent (): TDynRecord; inline;
 123         property Current: TDynRecord read getCurrent;
 124       end;
 125     }
 126
 127   public
 128     constructor Create (const aname: AnsiString; atype: TType);
 129     constructor Create (pr: TTextParser);
 130     destructor Destroy (); override;
 131
 132     class function getTypeName (t: TType): AnsiString;
 133
 134     function definition (): AnsiString;
 135     function pasdef (): AnsiString;
 136
 137     function clone (newOwner: TDynRecord=nil): TDynField;
 138
 139     procedure parseValue (pr: TTextParser);
 140     procedure parseBinValue (st: TStream);
 141
 142     procedure writeTo (wr: TTextWriter);
 143     procedure writeBinTo (st: TStream);
 144
 145     // won't work for lists
 146     function isSimpleEqu (fld: TDynField): Boolean;
 147
 148     procedure setValue (const s: AnsiString);
 149
 150     function GetEnumerator (): TDynRecList.TEnumerator; inline;
 151
 152   public
 153     property pasname: AnsiString read mPasName;
 154     property name: AnsiString read mName;
 155     property baseType: TType read mType;
 156     property negbool: Boolean read mNegBool;
 157     property defined: Boolean read mDefined write mDefined;
 158     property internal: Boolean read mInternal write mInternal;
 159     property hasTPrefix: Boolean read mAsT;
 160     property separatePasFields: Boolean read mSepPosSize;
 161     property binOfs: Integer read mBinOfs;
 162     property ival: Integer read mIVal write setIVal;
 163     property ival2: Integer read mIVal2;
 164     property sval: AnsiString read mSVal;
 165     property hasDefault: Boolean read mHasDefault;
 166     property defsval: AnsiString read mDefSVal;
 167     property ebs: TEBS read mEBS;
 168     property ebstype: TObject read mEBSType;
 169     property ebstypename: AnsiString read mEBSTypeName; // enum/bitset name
 170     property recref: TDynRecord read mRecRef write mRecRef; //FIXME: writing is a hack!
 171     property recrefIndex: Integer read getRecRefIndex; // search for this record in header; -1: not found
 172     // for lists
 173     property count: Integer read getListCount;
 174     property item[idx: Integer]: TDynRecord read getListItem;
 175     property items[const aname: AnsiString]: TDynRecord read getListItem; default; // alas, FPC 3+ lost property overloading feature
 176     // userdata
 177     property tagInt: Integer read mTagInt write mTagInt;
 178     property tagPtr: Pointer read mTagPtr write mTagPtr;
 179   end;
 180
 181
 182   // "value" header record contains TList fields, with name equal to record type
 183   TDynRecord = class
 184   private
 185     mOwner: TDynMapDef;
 186     mId: AnsiString;
 187     mPasName: AnsiString;
 188     mName: AnsiString;
 189     mSize: Integer;
 190     mFields: TDynFieldList;
 191     {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
 192     mFieldsHash: THashStrInt; // id -> index in mRVal
 193     {$ENDIF}
 194     mTrigTypes: array of AnsiString; // if this is triggerdata, we'll hold list of triggers here
 195     mHeader: Boolean; // true for header record
 196     mBinBlock: Integer; // -1: none
 197     mHeaderRec: TDynRecord; // for "value" records this is header record with data, for "type" records this is header type record
 198
 199     // for userdata
 200     mTagInt: Integer;
 201     mTagPtr: Pointer;
 202
 203   private
 204     procedure parseDef (pr: TTextParser); // parse definition
 205
 206     function findByName (const aname: AnsiString): Integer; inline;
 207     function hasByName (const aname: AnsiString): Boolean; inline;
 208     function getFieldByName (const aname: AnsiString): TDynField; inline;
 209     function getFieldAt (idx: Integer): TDynField; inline;
 210     function getCount (): Integer; inline;
 211
 212     function getIsTrigData (): Boolean; inline;
 213     function getIsForTrig (const aname: AnsiString): Boolean; inline;
 214
 215     function getForTrigCount (): Integer; inline;
 216     function getForTrigAt (idx: Integer): AnsiString; inline;
 217
 218   protected
 219     function findRecordByTypeId (const atypename, aid: AnsiString): TDynRecord;
 220     function findRecordNumByType (const atypename: AnsiString; rc: TDynRecord): Integer;
 221     function addRecordByType (const atypename: AnsiString; rc: TDynRecord): Boolean; // `true`: duplicate record id
 222
 223     procedure addField (fld: TDynField); inline;
 224     function addFieldChecked (fld: TDynField): Boolean; inline; // `true`: duplicate name
 225
 226   public
 227     constructor Create ();
 228     constructor Create (pr: TTextParser); // parse definition
 229     destructor Destroy (); override;
 230
 231     function definition (): AnsiString;
 232     function pasdef (): AnsiString;
 233
 234     function clone (): TDynRecord;
 235
 236     function isSimpleEqu (rec: TDynRecord): Boolean;
 237
 238     procedure parseValue (pr: TTextParser; beginEaten: Boolean=false);
 239     procedure parseBinValue (st: TStream; forceData: Boolean=false);
 240
 241     procedure writeTo (wr: TTextWriter; putHeader: Boolean=true);
 242     procedure writeBinTo (st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false);
 243
 244     // find field with `TriggerType` type
 245     function trigTypeField (): TDynField;
 246
 247     // number of records of the given instance
 248     function instanceCount (const typename: AnsiString): Integer;
 249
 250     procedure setUserField (const fldname: AnsiString; v: LongInt);
 251     procedure setUserField (const fldname: AnsiString; v: AnsiString);
 252
 253   public
 254     property id: AnsiString read mId; // for map parser
 255     property pasname: AnsiString read mPasName;
 256     property name: AnsiString read mName; // record name
 257     property size: Integer read mSize; // size in bytes
 258     //property fields: TDynFieldList read mFields;
 259     property has[const aname: AnsiString]: Boolean read hasByName;
 260     property count: Integer read getCount;
 261     property field[const aname: AnsiString]: TDynField read getFieldByName; default;
 262     property fieldAt[idx: Integer]: TDynField read getFieldAt;
 263     property isTrigData: Boolean read getIsTrigData;
 264     property isForTrig[const aname: AnsiString]: Boolean read getIsForTrig;
 265     property forTrigCount: Integer read getForTrigCount;
 266     property forTrigAt[idx: Integer]: AnsiString read getForTrigAt;
 267     property headerRec: TDynRecord read mHeaderRec;
 268     property isHeader: Boolean read mHeader;
 269     // userdata
 270     property tagInt: Integer read mTagInt write mTagInt;
 271     property tagPtr: Pointer read mTagPtr write mTagPtr;
 272   end;
 273
 274   TDynEBS = class
 275   private
 276     mOwner: TDynMapDef;
 277     mIsEnum: Boolean;
 278     mName: AnsiString;
 279     mIds: array of AnsiString;
 280     mVals: array of Integer;
 281     mMaxName: AnsiString; // MAX field
 282     mMaxVal: Integer; // max value
 283
 284   private
 285     procedure cleanup ();
 286
 287     procedure parseDef (pr: TTextParser); // parse definition
 288
 289     function findByName (const aname: AnsiString): Integer; inline;
 290     function hasByName (const aname: AnsiString): Boolean; inline;
 291     function getFieldByName (const aname: AnsiString): Integer; inline;
 292
 293   public
 294     constructor Create (pr: TTextParser); // parse definition
 295     destructor Destroy (); override;
 296
 297     function definition (): AnsiString;
 298     function pasdef (): AnsiString;
 299
 300     // return empty string if not found
 301     function nameByValue (v: Integer): AnsiString;
 302
 303   public
 304     property name: AnsiString read mName; // record name
 305     property isEnum: Boolean read mIsEnum;
 306     property has[const aname: AnsiString]: Boolean read hasByName;
 307     property field[const aname: AnsiString]: Integer read getFieldByName;
 308   end;
 309
 310
 311   TDynMapDef = class
 312   public
 313     recTypes: TDynRecList; // [0] is always header
 314     trigTypes: TDynRecList; // trigdata
 315     ebsTypes: TDynEBSList; // enums, bitsets
 316
 317   private
 318     procedure parseDef (pr: TTextParser);
 319
 320     function getHeaderRecType (): TDynRecord; inline;
 321
 322     function getTrigTypeCount (): Integer; inline;
 323     function getTrigTypeAt (idx: Integer): TDynRecord; inline;
 324
 325   public
 326     constructor Create (pr: TTextParser); // parses data definition
 327     destructor Destroy (); override;
 328
 329     function findRecType (const aname: AnsiString): TDynRecord;
 330     function findTrigFor (const aname: AnsiString): TDynRecord;
 331     function findEBSType (const aname: AnsiString): TDynEBS;
 332
 333     function pasdef (): AnsiString;
 334     function pasdefconst (): AnsiString;
 335
 336     // creates new header record
 337     function parseMap (pr: TTextParser): TDynRecord;
 338
 339     // creates new header record
 340     function parseBinMap (st: TStream): TDynRecord;
 341
 342   public
 343     property headerType: TDynRecord read getHeaderRecType;
 344     property trigTypeCount: Integer read getTrigTypeCount;
 345     property trigType[idx: Integer]: TDynRecord read getTrigTypeAt;
 346   end;
 347
 348
 349 {$IF DEFINED(D2D_DYNREC_PROFILER)}
 350 procedure xdynDumpProfiles ();
 351 {$ENDIF}
 352
 353
 354 implementation
 355
 356 uses
 357   SysUtils, e_log
 358   {$IF DEFINED(D2D_DYNREC_PROFILER)},xprofiler{$ENDIF};
 359
 360
 361 // ////////////////////////////////////////////////////////////////////////// //
 362 function StrEqu (const a, b: AnsiString): Boolean; inline; begin result := (a = b); end;
 363
 364
 365 // ////////////////////////////////////////////////////////////////////////// //
 366 {
 367 constructor TDynField.TListEnumerator.Create (alist: TDynRecList);
 368 begin
 369   mList := alist;
 370   mCurIdx := -1;
 371 end;
 372
 373
 374 function TDynField.TListEnumerator.MoveNext (): Boolean; inline;
 375 begin
 376   Inc(mCurIdx);
 377   result := (mList <> nil) and (mCurIdx < mList.count);
 378 end;
 379
 380
 381 function TDynField.TListEnumerator.getCurrent (): TDynRecord; inline;
 382 begin
 383   result := mList[mCurIdx];
 384 end;
 385 }
 386
 387
 388 function TDynField.GetEnumerator (): TDynRecList.TEnumerator; inline;
 389 begin
 390   //result := TListEnumerator.Create(mRVal);
 391   if (mRVal <> nil) then result := mRVal.GetEnumerator else result := TDynRecList.TEnumerator.Create(nil, 0);
 392 end;
 393
 394
 395 // ////////////////////////////////////////////////////////////////////////// //
 396 constructor TDynField.Create (const aname: AnsiString; atype: TType);
 397 begin
 398   mRVal := nil;
 399   mRecRef := nil;
 400   mRHash := nil;
 401   cleanup();
 402   mName := aname;
 403   mType := atype;
 404   if (mType = TType.TList) then
 405   begin
 406     mRVal := TDynRecList.Create();
 407     mRHash := hashNewStrInt();
 408   end;
 409 end;
 410
 411
 412 constructor TDynField.Create (pr: TTextParser);
 413 begin
 414   cleanup();
 415   parseDef(pr);
 416 end;
 417
 418
 419 destructor TDynField.Destroy ();
 420 begin
 421   cleanup();
 422   inherited;
 423 end;
 424
 425
 426 procedure TDynField.cleanup ();
 427 begin
 428   mName := '';
 429   mType := TType.TInt;
 430   mIVal := 0;
 431   mIVal2 := 0;
 432   mSVal := '';
 433   mRVal.Free();
 434   mRVal := nil;
 435   mRHash.Free();
 436   mRHash := nil;
 437   mRecRef := nil;
 438   mMaxDim := -1;
 439   mBinOfs := -1;
 440   mSepPosSize := false;
 441   mAsT := false;
 442   mHasDefault := false;
 443   mDefined := false;
 444   mOmitDef := false;
 445   mInternal := true;
 446   mDefUnparsed := '';
 447   mDefSVal := '';
 448   mDefIVal := 0;
 449   mDefIVal2 := 0;
 450   mDefRecRef := nil;
 451   mEBS := TEBS.TNone;
 452   mEBSTypeName := '';
 453   mEBSType := nil;
 454   mBitSetUnique := false;
 455   mAsMonsterId := false;
 456   mNegBool := false;
 457   mRecRefId := '';
 458   mTagInt := 0;
 459   mTagPtr := nil;
 460 end;
 461
 462
 463 function TDynField.clone (newOwner: TDynRecord=nil): TDynField;
 464 var
 465   rec: TDynRecord;
 466 begin
 467   result := TDynField.Create(mName, mType);
 468   result.mOwner := mOwner;
 469   if (newOwner <> nil) then result.mOwner := newOwner else result.mOwner := mOwner;
 470   result.mPasName := mPasName;
 471   result.mName := mName;
 472   result.mType := mType;
 473   result.mIVal := mIVal;
 474   result.mIVal2 := mIVal2;
 475   result.mSVal := mSVal;
 476   if (mRVal <> nil) then
 477   begin
 478     if (result.mRVal = nil) then result.mRVal := TDynRecList.Create(mRVal.count);
 479     if (result.mRHash = nil) then result.mRHash := hashNewStrInt();
 480     for rec in mRVal do result.addListItem(rec.clone());
 481   end;
 482   result.mRecRef := mRecRef;
 483   result.mMaxDim := mMaxDim;
 484   result.mBinOfs := mBinOfs;
 485   result.mSepPosSize := mSepPosSize;
 486   result.mAsT := mAsT;
 487   result.mDefined := mDefined;
 488   result.mHasDefault := mHasDefault;
 489   result.mOmitDef := mOmitDef;
 490   result.mInternal := mInternal;
 491   result.mNegBool := mNegBool;
 492   result.mBitSetUnique := mBitSetUnique;
 493   result.mAsMonsterId := mAsMonsterId;
 494   result.mDefUnparsed := mDefUnparsed;
 495   result.mDefSVal := mDefSVal;
 496   result.mDefIVal := mDefIVal;
 497   result.mDefIVal2 := mDefIVal2;
 498   result.mDefRecRef := mDefRecRef;
 499   result.mEBS := mEBS;
 500   result.mEBSTypeName := mEBSTypeName;
 501   result.mEBSType := mEBSType;
 502   result.mRecRefId := mRecRefId;
 503   result.mTagInt := mTagInt;
 504   result.mTagPtr := mTagPtr;
 505 end;
 506
 507
 508 procedure TDynField.setIVal (v: Integer); inline;
 509 begin
 510   //FIXME: check type
 511   mIVal := v;
 512   mDefined := true;
 513 end;
 514
 515
 516 // won't work for lists
 517 function TDynField.isSimpleEqu (fld: TDynField): Boolean;
 518 begin
 519   if (fld = nil) or (mType <> fld.mType) then begin result := false; exit; end;
 520   case mType of
 521     TType.TBool: result := ((mIVal <> 0) = (fld.mIVal <> 0));
 522     TType.TChar: result := (mSVal = fld.mSVal);
 523     TType.TByte,
 524     TType.TUByte,
 525     TType.TShort,
 526     TType.TUShort,
 527     TType.TInt,
 528     TType.TUInt:
 529       result := (mIVal = fld.mIVal);
 530     TType.TString: result := (mSVal = fld.mSVal);
 531     TType.TPoint,
 532     TType.TSize:
 533       result := ((mIVal = fld.mIVal) and (mIVal2 = fld.mIVal2));
 534     TType.TList: result := false;
 535     TType.TTrigData:
 536       begin
 537         if (mRecRef = nil) then begin result := (fld.mRecRef = nil); exit; end;
 538         result := mRecRef.isSimpleEqu(fld.mRecRef);
 539       end;
 540     else raise Exception.Create('ketmar forgot to handle some field type');
 541   end;
 542 end;
 543
 544
 545 procedure TDynField.setValue (const s: AnsiString);
 546 var
 547   stp: TTextParser;
 548 begin
 549   stp := TStrTextParser.Create(s+';');
 550   try
 551     parseValue(stp);
 552   finally
 553     stp.Free();
 554   end;
 555 end;
 556
 557
 558 procedure TDynField.parseDefaultValue ();
 559 var
 560   stp: TTextParser = nil;
 561   oSVal: AnsiString;
 562   oIVal, oIVal2: Integer;
 563   oRRef: TDynRecord;
 564   oDef: Boolean;
 565 begin
 566   if not mHasDefault then
 567   begin
 568     mDefSVal := '';
 569     mDefIVal := 0;
 570     mDefIVal2 := 0;
 571     mDefRecRef := nil;
 572   end
 573   else
 574   begin
 575     oSVal := mSVal;
 576     oIVal := mIVal;
 577     oIVal2 := mIVal2;
 578     oRRef := mRecRef;
 579     oDef := mDefined;
 580     try
 581       stp := TStrTextParser.Create(mDefUnparsed+';');
 582       parseValue(stp);
 583       mDefSVal := mSVal;
 584       mDefIVal := mIVal;
 585       mDefIVal2 := mIVal2;
 586       mDefRecRef := mRecRef;
 587     finally
 588       mSVal := oSVal;
 589       mIVal := oIVal;
 590       mIVal2 := oIVal2;
 591       mRecRef := oRRef;
 592       mDefined := oDef;
 593       stp.Free();
 594     end;
 595   end;
 596 end;
 597
 598
 599 // default value should be parsed
 600 procedure TDynField.fixDefaultValue ();
 601 begin
 602   if mDefined then exit;
 603   if not mHasDefault then
 604   begin
 605     if mInternal then exit;
 606     raise Exception.Create(Format('field ''%s'' in record ''%s'' of record type ''%s'' is not set', [mName, mOwner.mId, mOwner.mName]));
 607   end;
 608   if (mEBS = TEBS.TRec) then mRecRef := mDefRecRef;
 609   mSVal := mDefSVal;
 610   mIVal := mDefIVal;
 611   mIVal2 := mDefIVal2;
 612   mDefined := true;
 613 end;
 614
 615
 616 // default value should be parsed
 617 function TDynField.isDefaultValue (): Boolean;
 618 begin
 619   if not mHasDefault then begin result := false; exit; end;
 620   if (mEBS = TEBS.TRec) then begin result := (mRecRef = mDefRecRef); exit; end;
 621   case mType of
 622     TType.TChar, TType.TString: result := (mSVal = mDefSVal);
 623     TType.TPoint, TType.TSize: result := (mIVal = mDefIVal2) and (mIVal2 = mDefIVal2);
 624     TType.TList, TType.TTrigData: result := false; // no default values for those types
 625     else result := (mIVal = mDefIVal);
 626   end;
 627 end;
 628
 629
 630 function TDynField.getListCount (): Integer; inline;
 631 begin
 632   if (mRVal <> nil) then result := mRVal.count else result := 0;
 633 end;
 634
 635
 636 function TDynField.getListItem (idx: Integer): TDynRecord; inline; overload;
 637 begin
 638   if (mRVal <> nil) and (idx >= 0) and (idx < mRVal.count) then result := mRVal[idx] else result := nil;
 639 end;
 640
 641
 642 function TDynField.getListItem (const aname: AnsiString): TDynRecord; inline; overload;
 643 var
 644   idx: Integer;
 645 begin
 646   if (mRVal <> nil) and mRHash.get(aname, idx) then result := mRVal[idx] else result := nil;
 647 end;
 648
 649
 650 function TDynField.addListItem (rec: TDynRecord): Boolean; inline;
 651 begin
 652   result := false;
 653   if (mRVal <> nil) then
 654   begin
 655     mRVal.append(rec);
 656     if (Length(rec.mId) > 0) then result := mRHash.put(rec.mId, mRVal.count-1);
 657   end;
 658 end;
 659
 660
 661 class function TDynField.getTypeName (t: TType): AnsiString;
 662 begin
 663   case t of
 664     TType.TBool: result := 'bool';
 665     TType.TChar: result := 'char';
 666     TType.TByte: result := 'byte';
 667     TType.TUByte: result := 'ubyte';
 668     TType.TShort: result := 'short';
 669     TType.TUShort: result := 'ushort';
 670     TType.TInt: result := 'int';
 671     TType.TUInt: result := 'uint';
 672     TType.TString: result := 'string';
 673     TType.TPoint: result := 'point';
 674     TType.TSize: result := 'size';
 675     TType.TList: result := 'array';
 676     TType.TTrigData: result := 'trigdata';
 677     else raise Exception.Create('ketmar forgot to handle some field type');
 678   end;
 679 end;
 680
 681
 682 function TDynField.definition (): AnsiString;
 683 begin
 684   result := mPasName+' is '+quoteStr(mName)+' type ';
 685   result += getTypeName(mType);
 686   if (mMaxDim >= 0) then result += Format('[%d]', [mMaxDim]);
 687   if (mBinOfs >= 0) then result += Format(' offset %d', [mBinOfs]);
 688   case mEBS of
 689     TEBS.TNone: begin end;
 690     TEBS.TRec: result += ' '+mEBSTypeName;
 691     TEBS.TEnum: result += ' enum '+mEBSTypeName;
 692     TEBS.TBitSet: begin result += ' bitset '; if mBitSetUnique then result += 'unique '; result += mEBSTypeName; end;
 693   end;
 694   if mAsMonsterId then result += ' as monsterid';
 695   if mHasDefault and (Length(mDefUnparsed) > 0) then result += ' default '+mDefUnparsed;
 696   if mSepPosSize then
 697   begin
 698          if (mType = TType.TPoint) then begin if (mAsT) then result += ' as txy' else result += ' as xy'; end
 699     else if (mType = TType.TSize) then begin if (mAsT) then result += ' as twh' else result += ' as wh'; end;
 700   end;
 701   if mOmitDef then result += ' omitdefault';
 702   if mInternal then result += ' internal';
 703 end;
 704
 705
 706 function TDynField.pasdef (): AnsiString;
 707 begin
 708   result := mPasName+': ';
 709   case mType of
 710     TType.TBool: result += 'Boolean;';
 711     TType.TChar: if (mMaxDim > 0) then result += formatstrf('Char%d;', [mMaxDim]) else result += 'Char;';
 712     TType.TByte: result += 'ShortInt;';
 713     TType.TUByte: result += 'Byte;';
 714     TType.TShort: result += 'SmallInt;';
 715     TType.TUShort: result += 'Word;';
 716     TType.TInt: result += 'LongInt;';
 717     TType.TUInt: result += 'LongWord;';
 718     TType.TString: result += 'AnsiString;';
 719     TType.TPoint:
 720            if mAsT then result := 'tX, tY: Integer;'
 721       else if mSepPosSize then result := 'X, Y: Integer;'
 722       else result += 'TDFPoint;';
 723     TType.TSize:
 724            if mAsT then result := 'tWidth, tHeight: Word;'
 725       else if mSepPosSize then result := 'Width, Height: Word;'
 726       else result += 'TSize;';
 727     TType.TList: assert(false);
 728     TType.TTrigData: result += formatstrf('Byte%d;', [mMaxDim]);
 729     else raise Exception.Create('ketmar forgot to handle some field type');
 730   end;
 731 end;
 732
 733
 734 procedure TDynField.parseDef (pr: TTextParser);
 735 var
 736   fldname: AnsiString;
 737   fldtype: AnsiString;
 738   fldofs: Integer;
 739   fldrecname: AnsiString;
 740   fldpasname: AnsiString;
 741   asxy, aswh, ast: Boolean;
 742   ainternal: Boolean;
 743   omitdef: Boolean;
 744   defstr: AnsiString;
 745   defint: Integer;
 746   hasdefStr: Boolean;
 747   hasdefInt: Boolean;
 748   hasdefId: Boolean;
 749   lmaxdim: Integer;
 750   lebs: TDynField.TEBS;
 751   unique: Boolean;
 752   asmonid: Boolean;
 753 begin
 754   fldpasname := '';
 755   fldname := '';
 756   fldtype := '';
 757   fldofs := -1;
 758   fldrecname := '';
 759   asxy := false;
 760   aswh := false;
 761   ast := false;
 762   ainternal := false;
 763   omitdef := false;
 764   defstr := '';
 765   defint := 0;
 766   hasdefStr := false;
 767   hasdefInt := false;
 768   hasdefId := false;
 769   unique := false;
 770   asmonid := false;
 771   lmaxdim := -1;
 772   lebs := TDynField.TEBS.TNone;
 773
 774   fldpasname := pr.expectId(); // pascal field name
 775   // field name
 776   pr.expectId('is');
 777   fldname := pr.expectStr();
 778   // field type
 779   pr.expectId('type');
 780   fldtype := pr.expectId();
 781
 782   // fixed-size array?
 783   if pr.eatDelim('[') then
 784   begin
 785     lmaxdim := pr.expectInt();
 786     if (lmaxdim < 1) then raise Exception.Create(Format('invalid field ''%s'' array size', [fldname]));
 787     pr.expectDelim(']');
 788   end;
 789
 790   while (pr.tokType <> pr.TTSemi) do
 791   begin
 792     if pr.eatId('offset') then
 793     begin
 794       if (fldofs >= 0) then raise Exception.Create(Format('duplicate field ''%s'' offset', [fldname]));
 795       fldofs := pr.expectInt();
 796       if (fldofs < 0) then raise Exception.Create(Format('invalid field ''%s'' offset', [fldname]));
 797       continue;
 798     end;
 799
 800     if pr.eatId('as') then
 801     begin
 802            if pr.eatId('xy') then asxy := true
 803       else if pr.eatId('wh') then aswh := true
 804       else if pr.eatId('txy') then begin asxy := true; ast := true; end
 805       else if pr.eatId('twh') then begin aswh := true; ast := true; end
 806       else if pr.eatId('monsterid') then begin asmonid := true; end
 807       else raise Exception.Create(Format('invalid field ''%s'' as what?', [fldname]));
 808       continue;
 809     end;
 810
 811     if pr.eatId('enum') then
 812     begin
 813       lebs := TDynField.TEBS.TEnum;
 814       if (Length(fldrecname) <> 0) then raise Exception.Create(Format('field ''%s'' already typed as ''%s''', [fldname, fldrecname]));
 815       fldrecname := pr.expectId();
 816       continue;
 817     end;
 818
 819     if pr.eatId('bitset') then
 820     begin
 821       lebs := TDynField.TEBS.TBitSet;
 822       if (Length(fldrecname) <> 0) then raise Exception.Create(Format('field ''%s'' already typed as ''%s''', [fldname, fldrecname]));
 823       unique := pr.eatId('unique');
 824       fldrecname := pr.expectId();
 825       continue;
 826     end;
 827
 828     if pr.eatId('default') then
 829     begin
 830       if hasdefStr or hasdefInt or hasdefId then raise Exception.Create(Format('field ''%s'' has duplicate default', [fldname]));
 831       case pr.tokType of
 832         pr.TTStr:
 833           begin
 834             hasdefStr := true;
 835             defstr := pr.expectStr(true); // allow empty strings
 836           end;
 837         pr.TTId:
 838           begin
 839             hasdefId := true;
 840             defstr := pr.expectId();
 841           end;
 842         pr.TTInt:
 843           begin
 844             hasdefInt := true;
 845             defint := pr.expectInt();
 846           end;
 847         else
 848           raise Exception.Create(Format('field ''%s'' has invalid default', [fldname]));
 849       end;
 850       continue;
 851     end;
 852
 853     if pr.eatId('omitdefault') then
 854     begin
 855       omitdef := true;
 856       continue;
 857     end;
 858
 859     if pr.eatId('internal') then
 860     begin
 861       ainternal := true;
 862       continue;
 863     end;
 864
 865     if (pr.tokType <> pr.TTId) then raise Exception.Create(Format('field ''%s'' has something unexpected in definition', [fldname]));
 866
 867     if (Length(fldrecname) <> 0) then raise Exception.Create(Format('field ''%s'' already typed as ''%s''', [fldname, fldrecname]));
 868     fldrecname := pr.expectId();
 869     lebs := TDynField.TEBS.TRec;
 870   end;
 871
 872   pr.expectTT(pr.TTSemi);
 873
 874   // create field
 875   mName := fldname;
 876        if (fldtype = 'bool') then mType := TType.TBool
 877   else if (fldtype = 'negbool') then begin mType := TType.TBool; mNegBool := true; end
 878   else if (fldtype = 'char') then mType := TType.TChar
 879   else if (fldtype = 'byte') then mType := TType.TByte
 880   else if (fldtype = 'ubyte') then mType := TType.TUByte
 881   else if (fldtype = 'short') then mType := TType.TShort
 882   else if (fldtype = 'ushort') then mType := TType.TUShort
 883   else if (fldtype = 'int') then mType := TType.TInt
 884   else if (fldtype = 'uint') then mType := TType.TUInt
 885   else if (fldtype = 'string') then mType := TType.TString
 886   else if (fldtype = 'point') then mType := TType.TPoint
 887   else if (fldtype = 'size') then mType := TType.TSize
 888   else if (fldtype = 'trigdata') then mType := TType.TTrigData
 889   else raise Exception.Create(Format('field ''%s'' has invalid type ''%s''', [fldname, fldtype]));
 890
 891   if (lmaxdim > 0) and (mType <> TType.TChar) and (mType <> TType.TTrigData) then raise Exception.Create(Format('field ''%s'' of type ''%s'' cannot be array', [fldname, fldtype]));
 892   if (mType = TType.TTrigData) then
 893   begin
 894     if (lmaxdim < 1) then raise Exception.Create(Format('field ''%s'' of type ''%s'' cannot be array', [fldname, fldtype]));
 895     if (Length(fldrecname) > 0) then raise Exception.Create(Format('field ''%s'' of type ''%s'' cannot have another type', [fldname, fldtype]));
 896     lebs := TDynField.TEBS.TRec;
 897   end;
 898
 899        if hasdefStr then self.mDefUnparsed := quoteStr(defstr)
 900   else if hasdefInt then self.mDefUnparsed := Format('%d', [defint])
 901   else if hasdefId then self.mDefUnparsed := defstr;
 902
 903   self.mHasDefault := (hasdefStr or hasdefId or hasdefInt);
 904   self.mPasName := fldpasname;
 905   self.mEBS := lebs;
 906   self.mEBSTypeName := fldrecname;
 907   self.mBitSetUnique := unique;
 908   self.mAsMonsterId := asmonid;
 909   self.mMaxDim := lmaxdim;
 910   self.mBinOfs := fldofs;
 911   self.mSepPosSize := (asxy or aswh);
 912   self.mAsT := ast;
 913   self.mOmitDef := omitdef;
 914   self.mInternal := ainternal;
 915 end;
 916
 917
 918 function TDynField.getRecRefIndex (): Integer;
 919 begin
 920   if (mRecRef = nil) then begin result := -1; exit; end;
 921   result := mOwner.findRecordNumByType(mEBSTypeName, mRecRef);
 922 end;
 923
 924
 925 procedure TDynField.writeBinTo (st: TStream);
 926 var
 927   s: AnsiString;
 928   f: Integer;
 929   maxv: Integer;
 930   buf: PByte;
 931   ws: TStream = nil;
 932 begin
 933   case mEBS of
 934     TEBS.TNone: begin end;
 935     TEBS.TRec:
 936       begin
 937         if (mMaxDim >= 0) then
 938         begin
 939           // this must be triggerdata
 940           if (mType <> TType.TTrigData) then
 941           begin
 942             raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
 943           end;
 944           // write triggerdata
 945           GetMem(buf, mMaxDim);
 946           if (buf = nil) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
 947           try
 948             FillChar(buf^, mMaxDim, 0);
 949             if (mRecRef <> nil) then
 950             begin
 951               ws := TSFSMemoryChunkStream.Create(buf, mMaxDim);
 952               mRecRef.writeBinTo(ws, mMaxDim); // as trigdata
 953             end;
 954             st.WriteBuffer(buf^, mMaxDim);
 955           finally
 956             ws.Free();
 957             if (buf <> nil) then FreeMem(buf);
 958           end;
 959           exit;
 960         end;
 961         // record reference
 962         case mType of
 963           TType.TByte: maxv := 127;
 964           TType.TUByte: maxv := 254;
 965           TType.TShort: maxv := 32767;
 966           TType.TUShort: maxv := 65534;
 967           TType.TInt: maxv := $7fffffff;
 968           TType.TUInt: maxv := $7fffffff;
 969           else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
 970         end;
 971         // find record number
 972         if (mRecRef <> nil) then
 973         begin
 974           f := mOwner.findRecordNumByType(mEBSTypeName, mRecRef);
 975           if (f < 0) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' not found in record list', [mEBSTypeName, mName]));
 976           if mAsMonsterId then Inc(f);
 977           if (f > maxv) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' has too big index', [mEBSTypeName, mName]));
 978         end
 979         else
 980         begin
 981           if mAsMonsterId then f := 0 else f := -1;
 982         end;
 983         case mType of
 984           TType.TByte, TType.TUByte: writeInt(st, Byte(f));
 985           TType.TShort, TType.TUShort: writeInt(st, SmallInt(f));
 986           TType.TInt, TType.TUInt: writeInt(st, LongWord(f));
 987           else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
 988         end;
 989         exit;
 990       end;
 991     TEBS.TEnum: begin end;
 992     TEBS.TBitSet: begin end;
 993     else raise Exception.Create('ketmar forgot to handle some EBS type');
 994   end;
 995
 996   case mType of
 997     TType.TBool:
 998       begin
 999         if not mNegBool then
1000         begin
1001           if (mIVal <> 0) then writeInt(st, Byte(1)) else writeInt(st, Byte(0));
1002         end
1003         else
1004         begin
1005           if (mIVal = 0) then writeInt(st, Byte(1)) else writeInt(st, Byte(0));
1006         end;
1007         exit;
1008       end;
1009     TType.TChar:
1010       begin
1011         if (mMaxDim = 0) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
1012         if (mMaxDim < 0) then
1013         begin
1014           if (Length(mSVal) <> 1) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
1015           writeInt(st, Byte(mSVal[1]));
1016         end
1017         else
1018         begin
1019           if (Length(mSVal) > mMaxDim) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
1020           s := utf2win(mSVal);
1021           if (Length(s) > 0) then st.WriteBuffer(PChar(s)^, Length(s));
1022           for f := Length(s) to mMaxDim do writeInt(st, Byte(0));
1023         end;
1024         exit;
1025       end;
1026     TType.TByte,
1027     TType.TUByte:
1028       begin
1029         // triggerdata array was processed earlier
1030         if (mMaxDim >= 0) then Exception.Create(Format('byte array in field ''%s'' cannot be written', [mName]));
1031         writeInt(st, Byte(mIVal));
1032         exit;
1033       end;
1034     TType.TShort,
1035     TType.TUShort:
1036       begin
1037         if (mMaxDim >= 0) then raise Exception.Create(Format('short array in field ''%s'' cannot be written', [mName]));
1038         writeInt(st, Word(mIVal));
1039         exit;
1040       end;
1041     TType.TInt,
1042     TType.TUInt:
1043       begin
1044         if (mMaxDim >= 0) then raise Exception.Create(Format('int array in field ''%s'' cannot be written', [mName]));
1045         writeInt(st, LongWord(mIVal));
1046         exit;
1047       end;
1048     TType.TString:
1049       begin
1050         raise Exception.Create(Format('cannot write string field ''%s''', [mName]));
1051       end;
1052     TType.TPoint:
1053       begin
1054         if (mMaxDim >= 0) then raise Exception.Create(Format('pos/size array in field ''%s'' cannot be written', [mName]));
1055         writeInt(st, LongInt(mIVal));
1056         writeInt(st, LongInt(mIVal2));
1057         exit;
1058       end;
1059     TType.TSize:
1060       begin
1061         if (mMaxDim >= 0) then raise Exception.Create(Format('pos/size array in field ''%s'' cannot be written', [mName]));
1062         writeInt(st, Word(mIVal));
1063         writeInt(st, Word(mIVal2));
1064         exit;
1065       end;
1066     TType.TList:
1067       begin
1068         assert(false);
1069         exit;
1070       end;
1071     TType.TTrigData:
1072       begin
1073         assert(false);
1074         exit;
1075       end;
1076     else raise Exception.Create('ketmar forgot to handle some field type');
1077   end;
1078 end;
1079
1080
1081 procedure TDynField.writeTo (wr: TTextWriter);
1082 var
1083   es: TDynEBS = nil;
1084   f, mask: Integer;
1085   first, found: Boolean;
1086 begin
1087   wr.put(mName);
1088   wr.put(' ');
1089   case mEBS of
1090     TEBS.TNone: begin end;
1091     TEBS.TRec:
1092       begin
1093         if (mRecRef = nil) then
1094         begin
1095           if (mType = TType.TTrigData) then wr.put('{}'#10) else wr.put('null;'#10);
1096         end
1097         else if (Length(mRecRef.mId) = 0) then
1098         begin
1099           mRecRef.writeTo(wr, false); // only data, no header
1100         end
1101         else
1102         begin
1103           wr.put(mRecRef.mId);
1104           wr.put(';'#10);
1105         end;
1106         exit;
1107       end;
1108     TEBS.TEnum:
1109       begin
1110         //def := mOwner.mOwner;
1111         //es := def.findEBSType(mEBSTypeName);
1112         es := nil;
1113         if (mEBSType <> nil) and (mEBSType is TDynEBS) then es := (mEBSType as TDynEBS);
1114         if (es = nil) or (not es.mIsEnum) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1115         for f := 0 to High(es.mVals) do
1116         begin
1117           if (es.mVals[f] = mIVal) then
1118           begin
1119             wr.put(es.mIds[f]);
1120             wr.put(';'#10);
1121             exit;
1122           end;
1123         end;
1124         raise Exception.Create(Format('value %d in record enum type ''%s'' for field ''%s'' not found', [mIVal, mEBSTypeName, mName]));
1125       end;
1126     TEBS.TBitSet:
1127       begin
1128         //def := mOwner.mOwner;
1129         //es := def.findEBSType(mEBSTypeName);
1130         es := nil;
1131         if (mEBSType <> nil) and (mEBSType is TDynEBS) then es := (mEBSType as TDynEBS);
1132         if (es = nil) or es.mIsEnum then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1133         // none?
1134         if (mIVal = 0) then
1135         begin
1136           for f := 0 to High(es.mVals) do
1137           begin
1138             if (es.mVals[f] = 0) then
1139             begin
1140               wr.put(es.mIds[f]);
1141               wr.put(';'#10);
1142               exit;
1143             end;
1144           end;
1145           raise Exception.Create(Format('value %d in record bitset type ''%s'' for field ''%s'' not found', [0, mEBSTypeName, mName]));
1146         end;
1147         // not none
1148         mask := 1;
1149         first := true;
1150         while (mask <> 0) do
1151         begin
1152           if ((mIVal and mask) <> 0) then
1153           begin
1154             found := false;
1155             for f := 0 to High(es.mVals) do
1156             begin
1157               if (es.mVals[f] = mask) then
1158               begin
1159                 if not first then wr.put('+') else first := false;
1160                 wr.put(es.mIds[f]);
1161                 found := true;
1162                 break;
1163               end;
1164             end;
1165             if not found then raise Exception.Create(Format('value %d in record bitset type ''%s'' for field ''%s'' not found', [mask, mEBSTypeName, mName]));
1166           end;
1167           mask := mask shl 1;
1168         end;
1169         wr.put(';'#10);
1170         exit;
1171       end;
1172     else raise Exception.Create('ketmar forgot to handle some EBS type');
1173   end;
1174
1175   case mType of
1176     TType.TBool:
1177       begin
1178         if (mIVal = 0) then wr.put('false;'#10) else wr.put('true;'#10);
1179         exit;
1180       end;
1181     TType.TChar:
1182       begin
1183         if (mMaxDim = 0) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
1184         wr.put(quoteStr(mSVal));
1185         wr.put(';'#10);
1186         exit;
1187       end;
1188     TType.TByte,
1189     TType.TUByte,
1190     TType.TShort,
1191     TType.TUShort,
1192     TType.TInt,
1193     TType.TUInt:
1194       begin
1195         wr.put('%d;'#10, [mIVal]);
1196         exit;
1197       end;
1198     TType.TString:
1199       begin
1200         wr.put(quoteStr(mSVal));
1201         wr.put(';'#10);
1202         exit;
1203       end;
1204     TType.TPoint,
1205     TType.TSize:
1206       begin
1207         wr.put('(%d %d);'#10, [mIVal, mIVal2]);
1208         exit;
1209       end;
1210     TType.TList:
1211       begin
1212         assert(false);
1213         exit;
1214       end;
1215     TType.TTrigData:
1216       begin
1217         assert(false);
1218         exit;
1219       end;
1220     else raise Exception.Create('ketmar forgot to handle some field type');
1221   end;
1222   raise Exception.Create(Format('cannot parse field ''%s'' yet', [mName]));
1223 end;
1224
1225
1226 procedure TDynField.parseBinValue (st: TStream);
1227 var
1228   rec, rc: TDynRecord;
1229   tfld: TDynField;
1230   es: TDynEBS = nil;
1231   tdata: PByte = nil;
1232   f, mask: Integer;
1233   s: AnsiString;
1234 begin
1235   case mEBS of
1236     TEBS.TNone: begin end;
1237     TEBS.TRec:
1238       begin
1239         // this must be triggerdata
1240         if (mType = TType.TTrigData) then
1241         begin
1242           assert(mMaxDim > 0);
1243           rec := mOwner;
1244           // find trigger definition
1245           tfld := rec.trigTypeField();
1246           if (tfld = nil) then raise Exception.Create(Format('triggerdata value for field ''%s'' in record ''%s'' without TriggerType field', [mName, rec.mName]));
1247           rc := mOwner.mOwner.findTrigFor(tfld.mSVal); // find in mapdef
1248           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]));
1249           rc := rc.clone();
1250           rc.mHeaderRec := mOwner.mHeaderRec;
1251           try
1252             rc.parseBinValue(st, true);
1253             mRecRef := rc;
1254             rc := nil;
1255           finally
1256             rc.Free();
1257           end;
1258           mDefined := true;
1259           exit;
1260         end
1261         else
1262         begin
1263           // not a trigger data
1264           case mType of
1265             TType.TByte: f := readShortInt(st);
1266             TType.TUByte: f := readByte(st);
1267             TType.TShort: f := readSmallInt(st);
1268             TType.TUShort: f := readWord(st);
1269             TType.TInt: f := readLongInt(st);
1270             TType.TUInt: f := readLongWord(st);
1271             else raise Exception.Create(Format('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName]));
1272           end;
1273           if mAsMonsterId then Dec(f);
1274           if (f < 0) then mRecRefId := '' else mRecRefId := Format('%s%d', [mEBSTypeName, f]);
1275         end;
1276         mDefined := true;
1277         exit;
1278       end;
1279     TEBS.TEnum,
1280     TEBS.TBitSet:
1281       begin
1282         assert(mMaxDim < 0);
1283         case mType of
1284           TType.TByte: f := readShortInt(st);
1285           TType.TUByte: f := readByte(st);
1286           TType.TShort: f := readSmallInt(st);
1287           TType.TUShort: f := readWord(st);
1288           TType.TInt: f := readLongInt(st);
1289           TType.TUInt: f := readLongWord(st);
1290           else raise Exception.Create(Format('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName]));
1291         end;
1292         es := nil;
1293         if (mEBSType <> nil) and (mEBSType is TDynEBS) then es := (mEBSType as TDynEBS);
1294         if (es = nil) or (es.mIsEnum <> (mEBS = TEBS.TEnum)) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1295         mIVal := f;
1296         // build enum/bitfield values
1297         if (mEBS = TEBS.TEnum) then
1298         begin
1299           mSVal := es.nameByValue(mIVal);
1300           if (Length(mSVal) = 0) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mIVal]));
1301         end
1302         else
1303         begin
1304           // special for 'none'
1305           if (mIVal = 0) then
1306           begin
1307             mSVal := es.nameByValue(mIVal);
1308             if (Length(mSVal) = 0) then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mIVal]));
1309           end
1310           else
1311           begin
1312             mSVal := '';
1313             mask := 1;
1314             while (mask <> 0) do
1315             begin
1316               if ((mIVal and mask) <> 0) then
1317               begin
1318                 s := es.nameByValue(mask);
1319                 if (Length(s) = 0) then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mask]));
1320                 if (Length(mSVal) <> 0) then mSVal += '+';
1321                 mSVal += s;
1322               end;
1323               mask := mask shl 1;
1324             end;
1325           end;
1326         end;
1327         //writeln('ebs <', es.mName, '>: ', mSVal);
1328         mDefined := true;
1329         exit;
1330       end;
1331     else raise Exception.Create('ketmar forgot to handle some EBS type');
1332   end;
1333
1334   case mType of
1335     TType.TBool:
1336       begin
1337         f := readByte(st);
1338         if (f <> 0) then f := 1;
1339         if mNegBool then f := 1-f;
1340         mIVal := f;
1341         mDefined := true;
1342         exit;
1343       end;
1344     TType.TChar:
1345       begin
1346         if (mMaxDim < 0) then
1347         begin
1348           mIVal := readByte(st);
1349         end
1350         else
1351         begin
1352           mSVal := '';
1353           GetMem(tdata, mMaxDim);
1354           try
1355             st.ReadBuffer(tdata^, mMaxDim);
1356             f := 0;
1357             while (f < mMaxDim) and (tdata[f] <> 0) do Inc(f);
1358             if (f > 0) then
1359             begin
1360               SetLength(mSVal, f);
1361               Move(tdata^, PChar(mSVal)^, f);
1362               mSVal := win2utf(mSVal);
1363             end;
1364           finally
1365             FreeMem(tdata);
1366           end;
1367         end;
1368         mDefined := true;
1369         exit;
1370       end;
1371     TType.TByte: begin mIVal := readShortInt(st); mDefined := true; exit; end;
1372     TType.TUByte: begin mIVal := readByte(st); mDefined := true; exit; end;
1373     TType.TShort: begin mIVal := readSmallInt(st); mDefined := true; exit; end;
1374     TType.TUShort: begin mIVal := readWord(st); mDefined := true; exit; end;
1375     TType.TInt: begin mIVal := readLongInt(st); mDefined := true; exit; end;
1376     TType.TUInt: begin mIVal := readLongWord(st); mDefined := true; exit; end;
1377     TType.TString:
1378       begin
1379         raise Exception.Create('cannot read strings from binaries yet');
1380         exit;
1381       end;
1382     TType.TPoint:
1383       begin
1384         mIVal := readLongInt(st);
1385         mIVal2 := readLongInt(st);
1386         mDefined := true;
1387         exit;
1388       end;
1389     TType.TSize:
1390       begin
1391         mIVal := readWord(st);
1392         mIVal2 := readWord(st);
1393         mDefined := true;
1394         exit;
1395       end;
1396     TType.TList:
1397       begin
1398         assert(false);
1399         exit;
1400       end;
1401     TType.TTrigData:
1402       begin
1403         assert(false);
1404         exit;
1405       end;
1406     else raise Exception.Create('ketmar forgot to handle some field type');
1407   end;
1408   raise Exception.Create(Format('cannot parse field ''%s'' yet', [mName]));
1409 end;
1410
1411
1412 procedure TDynField.parseValue (pr: TTextParser);
1413
1414   procedure parseInt (min, max: Integer);
1415   begin
1416     mIVal := pr.expectInt();
1417     if (mIVal < min) or (mIVal > max) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
1418     mDefined := true;
1419   end;
1420
1421 var
1422   rec, rc: TDynRecord;
1423   es: TDynEBS = nil;
1424   tfld: TDynField;
1425   tk: AnsiString;
1426   edim: AnsiChar;
1427 begin
1428   // if this field should contain struct, convert type and parse struct
1429   case mEBS of
1430     TEBS.TNone: begin end;
1431     TEBS.TRec:
1432       begin
1433         // ugly hack. sorry.
1434         if (mType = TType.TTrigData) then
1435         begin
1436           pr.expectTT(pr.TTBegin);
1437           if (pr.tokType = pr.TTEnd) then
1438           begin
1439             // '{}'
1440             mRecRef := nil;
1441             pr.expectTT(pr.TTEnd);
1442           end
1443           else
1444           begin
1445             rec := mOwner;
1446             // find trigger definition
1447             tfld := rec.trigTypeField();
1448             if (tfld = nil) then raise Exception.Create(Format('triggerdata value for field ''%s'' in record ''%s'' without ''type'' field', [mName, rec.mName]));
1449             rc := mOwner.mOwner.findTrigFor(tfld.mSVal); // find in mapdef
1450             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]));
1451             rc := rc.clone();
1452             rc.mHeaderRec := mOwner.mHeaderRec;
1453             //writeln(rc.definition);
1454             try
1455               rc.parseValue(pr, true);
1456               mRecRef := rc;
1457               rc := nil;
1458             finally
1459               rc.Free();
1460             end;
1461           end;
1462           mDefined := true;
1463           pr.eatTT(pr.TTSemi); // hack: allow (but don't require) semicolon after inline records
1464           exit;
1465         end;
1466         // other record types
1467         if (pr.tokType = pr.TTId) then
1468         begin
1469           if pr.eatId('null') then
1470           begin
1471             mRecRef := nil;
1472           end
1473           else
1474           begin
1475             rec := mOwner.findRecordByTypeId(mEBSTypeName, pr.tokStr);
1476             if (rec = nil) then raise Exception.Create(Format('record ''%s'' (%s) value for field ''%s'' not found', [pr.tokStr, mEBSTypeName, mName]));
1477             pr.expectId();
1478             mRecRef := rec;
1479           end;
1480           mDefined := true;
1481           pr.expectTT(pr.TTSemi);
1482           exit;
1483         end
1484         else if (pr.tokType = pr.TTBegin) then
1485         begin
1486           //rec := mOwner.mOwner.findRecType(mEBSTypeName); // find in mapdef
1487           rec := nil;
1488           if (mEBSType <> nil) and (mEBSType is TDynRecord) then rec := (mEBSType as TDynRecord);
1489           if (rec = nil) then raise Exception.Create(Format('record type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1490           rc := rec.clone();
1491           rc.mHeaderRec := mOwner.mHeaderRec;
1492           rc.parseValue(pr);
1493           mRecRef := rc;
1494           mDefined := true;
1495           if mOwner.addRecordByType(mEBSTypeName, rc) then
1496           begin
1497             //raise Exception.Create(Format('record type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1498             e_LogWritefln('duplicate record with id ''%s'' for field ''%s'' in record ''%s''', [rc.mId, mName, mOwner.mName]);
1499           end;
1500           pr.eatTT(pr.TTSemi); // hack: allow (but don't require) semicolon after inline records
1501           exit;
1502         end;
1503         pr.expectTT(pr.TTBegin);
1504       end;
1505     TEBS.TEnum:
1506       begin
1507         //es := mOwner.mOwner.findEBSType(mEBSTypeName); // find in mapdef
1508         es := nil;
1509         if (mEBSType <> nil) and (mEBSType is TDynEBS) then es := (mEBSType as TDynEBS);
1510         if (es = nil) or (not es.mIsEnum) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1511         tk := pr.expectId();
1512         if not es.has[tk] then raise Exception.Create(Format('record enum value ''%s'' of type ''%s'' for field ''%s'' not found', [tk, mEBSTypeName, mName]));
1513         mIVal := es.field[tk];
1514         mSVal := tk;
1515         //writeln('ENUM ', mEBSName, '; element <', mSVal, '> with value ', mIVal);
1516         mDefined := true;
1517         pr.expectTT(pr.TTSemi);
1518         exit;
1519       end;
1520     TEBS.TBitSet:
1521       begin
1522         //es := mOwner.mOwner.findEBSType(mEBSTypeName); // find in mapdef
1523         es := nil;
1524         if (mEBSType <> nil) and (mEBSType is TDynEBS) then es := (mEBSType as TDynEBS);
1525         if (es = nil) or es.mIsEnum then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1526         mIVal := 0;
1527         while true do
1528         begin
1529           tk := pr.expectId();
1530           if not es.has[tk] then raise Exception.Create(Format('record bitset value ''%s'' of type ''%s'' for field ''%s'' not found', [tk, mEBSTypeName, mName]));
1531           mIVal := mIVal or es.field[tk];
1532           mSVal := tk;
1533           if (pr.tokType <> pr.TTDelim) or ((pr.tokChar <> '|') and (pr.tokChar <> '+')) then break;
1534           if mBitSetUnique then raise Exception.Create(Format('record bitset of type ''%s'' for field ''%s'' expects only one value', [tk, mEBSTypeName, mName]));
1535           //pr.expectDelim('|');
1536           pr.skipToken(); // plus or pipe
1537         end;
1538         mDefined := true;
1539         pr.expectTT(pr.TTSemi);
1540         exit;
1541       end;
1542     else raise Exception.Create('ketmar forgot to handle some EBS type');
1543   end;
1544
1545   case mType of
1546     TType.TBool:
1547       begin
1548              if pr.eatId('true') or pr.eatId('tan') or pr.eatId('yes') then mIVal := 1
1549         else if pr.eatId('false') or pr.eatId('ona') or pr.eatId('no') then mIVal := 0
1550         else raise Exception.Create(Format('invalid bool value for field ''%s''', [mName]));
1551         mDefined := true;
1552         pr.expectTT(pr.TTSemi);
1553         exit;
1554       end;
1555     TType.TChar:
1556       begin
1557         if (mMaxDim = 0) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
1558         mSVal := pr.expectStr(true);
1559         if (mMaxDim < 0) then
1560         begin
1561           // single char
1562           if (Length(mSVal) <> 1) then raise Exception.Create(Format('invalid string size for field ''%s''', [mName]));
1563           mIVal := Integer(mSVal[1]);
1564           mSVal := '';
1565         end
1566         else
1567         begin
1568           // string
1569           if (Length(mSVal) > mMaxDim) then raise Exception.Create(Format('invalid string size for field ''%s''', [mName]));
1570         end;
1571         mDefined := true;
1572         pr.expectTT(pr.TTSemi);
1573         exit;
1574       end;
1575     TType.TByte:
1576       begin
1577         parseInt(-128, 127);
1578         pr.expectTT(pr.TTSemi);
1579         exit;
1580       end;
1581     TType.TUByte:
1582       begin
1583         parseInt(0, 255);
1584         pr.expectTT(pr.TTSemi);
1585         exit;
1586       end;
1587     TType.TShort:
1588       begin
1589         parseInt(-32768, 32768);
1590         pr.expectTT(pr.TTSemi);
1591         exit;
1592       end;
1593     TType.TUShort:
1594       begin
1595         parseInt(0, 65535);
1596         pr.expectTT(pr.TTSemi);
1597         exit;
1598       end;
1599     TType.TInt:
1600       begin
1601         parseInt(Integer($80000000), $7fffffff);
1602         pr.expectTT(pr.TTSemi);
1603         exit;
1604       end;
1605     TType.TUInt:
1606       begin
1607         parseInt(0, $7fffffff); //FIXME
1608         pr.expectTT(pr.TTSemi);
1609         exit;
1610       end;
1611     TType.TString:
1612       begin
1613         mSVal := pr.expectStr(true);
1614         mDefined := true;
1615         pr.expectTT(pr.TTSemi);
1616         exit;
1617       end;
1618     TType.TPoint,
1619     TType.TSize:
1620       begin
1621         if pr.eatDelim('[') then edim := ']' else begin pr.expectDelim('('); edim := ')'; end;
1622         mIVal := pr.expectInt();
1623         if (mType = TType.TSize) then
1624         begin
1625           if (mIVal < 0) or (mIVal > 32767) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
1626         end;
1627         mIVal2 := pr.expectInt();
1628         if (mType = TType.TSize) then
1629         begin
1630           if (mIVal2 < 0) or (mIVal2 > 32767) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
1631         end;
1632         mDefined := true;
1633         pr.expectDelim(edim);
1634         pr.expectTT(pr.TTSemi);
1635         exit;
1636       end;
1637     TType.TList:
1638       begin
1639         assert(false);
1640         exit;
1641       end;
1642     TType.TTrigData:
1643       begin
1644         assert(false);
1645         exit;
1646       end;
1647     else raise Exception.Create('ketmar forgot to handle some field type');
1648   end;
1649   raise Exception.Create(Format('cannot parse field ''%s'' yet', [mName]));
1650 end;
1651
1652
1653 // ////////////////////////////////////////////////////////////////////////// //
1654 constructor TDynRecord.Create (pr: TTextParser);
1655 begin
1656   if (pr = nil) then raise Exception.Create('cannot create record type without type definition');
1657   mId := '';
1658   mName := '';
1659   mSize := 0;
1660   mFields := TDynFieldList.Create();
1661   {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1662   mFieldsHash := hashNewStrInt();
1663   {$ENDIF}
1664   mTrigTypes := nil;
1665   mHeader := false;
1666   mHeaderRec := nil;
1667   mBinBlock := -1;
1668   mTagInt := 0;
1669   mTagPtr := nil;
1670   parseDef(pr);
1671 end;
1672
1673
1674 constructor TDynRecord.Create ();
1675 begin
1676   mName := '';
1677   mSize := 0;
1678   mFields := TDynFieldList.Create();
1679   {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1680   mFieldsHash := hashNewStrInt();
1681   {$ENDIF}
1682   mTrigTypes := nil;
1683   mHeader := false;
1684   mHeaderRec := nil;
1685   mTagInt := 0;
1686   mTagPtr := nil;
1687 end;
1688
1689
1690 destructor TDynRecord.Destroy ();
1691 begin
1692   mName := '';
1693   mFields.Free();
1694   mFields := nil;
1695   {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1696   mFieldsHash.Free();
1697   mFieldsHash := nil;
1698   {$ENDIF}
1699   mTrigTypes := nil;
1700   mHeaderRec := nil;
1701   mTagInt := 0;
1702   mTagPtr := nil;
1703   inherited;
1704 end;
1705
1706
1707 procedure TDynRecord.addField (fld: TDynField); inline;
1708 begin
1709   if (fld = nil) then raise Exception.Create('cannot append nil field to record');
1710   mFields.append(fld);
1711   {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1712   if (Length(fld.mName) > 0) then mFieldsHash.put(fld.mName, mFields.count-1);
1713   {$ENDIF}
1714 end;
1715
1716
1717 function TDynRecord.addFieldChecked (fld: TDynField): Boolean; inline; // `true`: duplicate name
1718 begin
1719   result := false;
1720   if (fld = nil) then raise Exception.Create('cannot append nil field to record');
1721   {$IF not DEFINED(XDYNREC_USE_FIELDHASH)}
1722   if (Length(fld.mName) > 0) then result := hasByName(fld.mName);
1723   {$ENDIF}
1724   mFields.append(fld);
1725   {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1726   if (Length(fld.mName) > 0) then result := mFieldsHash.put(fld.mName, mFields.count-1);
1727   {$ENDIF}
1728 end;
1729
1730
1731 function TDynRecord.findByName (const aname: AnsiString): Integer; inline;
1732 begin
1733   {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1734   if not mFieldsHash.get(aname, result) then result := -1;
1735   {$ELSE}
1736   result := 0;
1737   while (result < mFields.count) do
1738   begin
1739     if StrEqu(aname, mFields[result].mName) then exit;
1740     Inc(result);
1741   end;
1742   result := -1;
1743   {$ENDIF}
1744 end;
1745
1746
1747 function TDynRecord.hasByName (const aname: AnsiString): Boolean; inline;
1748 begin
1749   result := (findByName(aname) >= 0);
1750 end;
1751
1752
1753 function TDynRecord.getFieldByName (const aname: AnsiString): TDynField; inline;
1754 var
1755   f: Integer;
1756 begin
1757   f := findByName(aname);
1758   if (f >= 0) then result := mFields[f] else result := nil;
1759 end;
1760
1761
1762 function TDynRecord.getFieldAt (idx: Integer): TDynField; inline;
1763 begin
1764   if (idx >= 0) and (idx < mFields.count) then result := mFields[idx] else result := nil;
1765 end;
1766
1767
1768 function TDynRecord.getCount (): Integer; inline;
1769 begin
1770   result := mFields.count;
1771 end;
1772
1773
1774 function TDynRecord.getIsTrigData (): Boolean; inline;
1775 begin
1776   result := (Length(mTrigTypes) > 0);
1777 end;
1778
1779
1780 function TDynRecord.getIsForTrig (const aname: AnsiString): Boolean; inline;
1781 var
1782   f: Integer;
1783 begin
1784   result := true;
1785   for f := 0 to High(mTrigTypes) do if StrEqu(mTrigTypes[f], aname) then exit;
1786   result := false;
1787 end;
1788
1789
1790 function TDynRecord.getForTrigCount (): Integer; inline;
1791 begin
1792   result := Length(mTrigTypes);
1793 end;
1794
1795
1796 function TDynRecord.getForTrigAt (idx: Integer): AnsiString; inline;
1797 begin
1798   if (idx >= 0) and (idx < Length(mTrigTypes)) then result := mTrigTypes[idx] else result := '';
1799 end;
1800
1801
1802 function TDynRecord.clone (): TDynRecord;
1803 var
1804   fld: TDynField;
1805   f: Integer;
1806 begin
1807   result := TDynRecord.Create();
1808   result.mOwner := mOwner;
1809   result.mId := mId;
1810   result.mPasName := mPasName;
1811   result.mName := mName;
1812   result.mSize := mSize;
1813   if (mFields.count > 0) then
1814   begin
1815     result.mFields.capacity := mFields.count;
1816     for fld in mFields do result.addField(fld.clone(result));
1817   end;
1818   SetLength(result.mTrigTypes, Length(mTrigTypes));
1819   for f := 0 to High(mTrigTypes) do result.mTrigTypes[f] := mTrigTypes[f];
1820   result.mHeader := mHeader;
1821   result.mBinBlock := mBinBlock;
1822   result.mHeaderRec := mHeaderRec;
1823   result.mTagInt := mTagInt;
1824   result.mTagPtr := mTagPtr;
1825 end;
1826
1827
1828 function TDynRecord.findRecordByTypeId (const atypename, aid: AnsiString): TDynRecord;
1829 var
1830   fld: TDynField;
1831   idx: Integer;
1832 begin
1833   result := nil;
1834   if (Length(aid) = 0) then exit;
1835   // find record data
1836   fld := mHeaderRec.field[atypename];
1837   if (fld = nil) then exit;
1838   if (fld.mType <> fld.TType.TList) then raise Exception.Create(Format('cannot get record of type ''%s'' due to name conflict with ordinary field', [atypename]));
1839   // find by id
1840   if (fld.mRVal <> nil) then
1841   begin
1842     if fld.mRHash.get(aid, idx) then begin result := fld.mRVal[idx]; exit; end;
1843   end;
1844   // alas
1845 end;
1846
1847
1848 function TDynRecord.findRecordNumByType (const atypename: AnsiString; rc: TDynRecord): Integer;
1849 var
1850   fld: TDynField;
1851   idx: Integer;
1852 begin
1853   result := -1;
1854   // find record data
1855   fld := mHeaderRec.field[atypename];
1856   if (fld = nil) then exit;
1857   if (fld.mType <> fld.TType.TList) then raise Exception.Create(Format('cannot get record of type ''%s'' due to name conflict with ordinary field', [atypename]));
1858   // find by ref
1859   if (fld.mRVal <> nil) then
1860   begin
1861     for idx := 0 to fld.mRVal.count-1 do
1862     begin
1863       if (fld.mRVal[idx] = rc) then begin result := idx; exit; end;
1864     end;
1865   end;
1866   // alas
1867 end;
1868
1869
1870 function TDynRecord.addRecordByType (const atypename: AnsiString; rc: TDynRecord): Boolean;
1871 var
1872   fld: TDynField;
1873 begin
1874   // find record data
1875   fld := mHeaderRec.field[atypename];
1876   if (fld = nil) then
1877   begin
1878     // first record
1879     fld := TDynField.Create(atypename, TDynField.TType.TList);
1880     fld.mOwner := mHeaderRec;
1881     mHeaderRec.addField(fld);
1882   end;
1883   if (fld.mType <> fld.TType.TList) then raise Exception.Create(Format('cannot append record of type ''%s'' due to name conflict with ordinary field', [atypename]));
1884   // append
1885   if (fld.mRVal = nil) then
1886   begin
1887     fld.mRVal := TDynRecList.Create();
1888     fld.mRHash := hashNewStrInt();
1889   end;
1890   result := fld.addListItem(rc);
1891 end;
1892
1893
1894 function TDynRecord.isSimpleEqu (rec: TDynRecord): Boolean;
1895 var
1896   f: Integer;
1897 begin
1898   if (rec = nil) then begin result := false; exit; end; // self.mRecRef can't be `nil` here
1899   if (rec = self) then begin result := true; exit; end;
1900   if (mFields.count <> rec.mFields.count) then begin result := false; exit; end;
1901   result := false;
1902   for f := 0 to mFields.count-1 do
1903   begin
1904     if not mFields[f].isSimpleEqu(rec.mFields[f]) then exit;
1905   end;
1906   result := true;
1907 end;
1908
1909
1910 function TDynRecord.trigTypeField (): TDynField;
1911 var
1912   fld: TDynField;
1913   es: TDynEBS = nil;
1914 begin
1915   for fld in mFields do
1916   begin
1917     if (fld.mEBS <> TDynField.TEBS.TEnum) then continue;
1918     if not (fld.mEBSType is TDynEBS) then continue;
1919     es := (fld.mEBSType as TDynEBS);
1920     assert(es <> nil);
1921     if StrEqu(es.mName, 'TriggerType') then begin result := fld; exit; end;
1922   end;
1923   result := nil;
1924 end;
1925
1926
1927 // number of records of the given instance
1928 function TDynRecord.instanceCount (const typename: AnsiString): Integer;
1929 var
1930   fld: TDynField;
1931 begin
1932   result := 0;
1933   fld := field[typename];
1934   if (fld <> nil) and (fld.mType = fld.TType.TList) then result := fld.mRVal.count;
1935 end;
1936
1937
1938 procedure TDynRecord.setUserField (const fldname: AnsiString; v: LongInt);
1939 var
1940   fld: TDynField;
1941 begin
1942   if (Length(fldname) = 0) then exit;
1943   fld := field[fldname];
1944   if (fld <> nil) then
1945   begin
1946     if (fld.mType <> fld.TType.TInt) or (fld.mEBS <> fld.TEBS.TNone) then
1947     begin
1948       raise Exception.Create(Format('invalid user field ''%s'' type', [fld.name]));
1949     end;
1950   end
1951   else
1952   begin
1953     fld := TDynField.Create(fldname, fld.TType.TInt);
1954     fld.mOwner := self;
1955     fld.mIVal := v;
1956     fld.mInternal := true;
1957     fld.mDefined := true;
1958     addField(fld);
1959   end;
1960 end;
1961
1962
1963 procedure TDynRecord.setUserField (const fldname: AnsiString; v: AnsiString);
1964 var
1965   fld: TDynField;
1966 begin
1967   if (Length(fldname) = 0) then exit;
1968   fld := field[fldname];
1969   if (fld <> nil) then
1970   begin
1971     if (fld.mType <> fld.TType.TString) or (fld.mEBS <> fld.TEBS.TNone) then
1972     begin
1973       raise Exception.Create(Format('invalid user field ''%s'' type', [fld.name]));
1974     end;
1975   end
1976   else
1977   begin
1978     fld := TDynField.Create(fldname, fld.TType.TString);
1979     fld.mOwner := self;
1980     fld.mSVal := v;
1981     fld.mInternal := true;
1982     fld.mDefined := true;
1983     addField(fld);
1984   end;
1985 end;
1986
1987
1988 procedure TDynRecord.parseDef (pr: TTextParser);
1989 var
1990   fld: TDynField;
1991   tdn: AnsiString;
1992 begin
1993   if pr.eatId('TriggerData') then
1994   begin
1995     pr.expectId('for');
1996     if pr.eatDelim('(') then
1997     begin
1998       while true do
1999       begin
2000         while pr.eatTT(pr.TTComma) do begin end;
2001         if pr.eatDelim(')') then break;
2002         tdn := pr.expectId();
2003         if isForTrig[tdn] then raise Exception.Create(Format('duplicate trigdata ''%s'' trigtype ''%s''', [mName, tdn]));
2004         SetLength(mTrigTypes, Length(mTrigTypes)+1);
2005         mTrigTypes[High(mTrigTypes)] := tdn;
2006       end;
2007     end
2008     else
2009     begin
2010       tdn := pr.expectId();
2011       SetLength(mTrigTypes, 1);
2012       mTrigTypes[0] := tdn;
2013     end;
2014     mName := 'TriggerData';
2015   end
2016   else
2017   begin
2018     mPasName := pr.expectId(); // pascal record name
2019     pr.expectId('is');
2020     mName := pr.expectStr();
2021     while (pr.tokType <> pr.TTBegin) do
2022     begin
2023       if pr.eatId('header') then begin mHeader := true; continue; end;
2024       if pr.eatId('size') then
2025       begin
2026         if (mSize > 0) then raise Exception.Create(Format('duplicate `size` in record ''%s''', [mName]));
2027         mSize := pr.expectInt();
2028         if (mSize < 1) then raise Exception.Create(Format('invalid record ''%s'' size: %d', [mName, mSize]));
2029         pr.expectId('bytes');
2030         continue;
2031       end;
2032       if pr.eatId('binblock') then
2033       begin
2034         if (mBinBlock >= 0) then raise Exception.Create(Format('duplicate `binblock` in record ''%s''', [mName]));
2035         mBinBlock := pr.expectInt();
2036         if (mBinBlock < 1) then raise Exception.Create(Format('invalid record ''%s'' binblock: %d', [mName, mBinBlock]));
2037         continue;
2038       end;
2039     end;
2040   end;
2041
2042   pr.expectTT(pr.TTBegin);
2043   // load fields
2044   while (pr.tokType <> pr.TTEnd) do
2045   begin
2046     fld := TDynField.Create(pr);
2047     //if hasByName(fld.name) then begin fld.Free(); raise Exception.Create(Format('duplicate field ''%s''', [fld.name])); end;
2048     // append
2049     fld.mOwner := self;
2050     if addFieldChecked(fld) then
2051     begin
2052       fld.Free();
2053       raise Exception.Create(Format('duplicate field ''%s''', [fld.name]));
2054     end;
2055     // done with field
2056   end;
2057   pr.expectTT(pr.TTEnd);
2058 end;
2059
2060
2061 function TDynRecord.pasdef (): AnsiString;
2062 var
2063   fld: TDynField;
2064 begin
2065   if isTrigData then
2066   begin
2067     assert(false);
2068     result := '';
2069   end
2070   else
2071   begin
2072     // record
2073     result := '  '+mPasName+' = packed record'#10;
2074   end;
2075   for fld in mFields do
2076   begin
2077     if fld.mInternal then continue;
2078     if (fld.mBinOfs < 0) then continue;
2079     result += '    '+fld.pasdef+#10;
2080   end;
2081   result += '  end;'#10;
2082 end;
2083
2084
2085 function TDynRecord.definition (): AnsiString;
2086 var
2087   f: Integer;
2088 begin
2089   if isTrigData then
2090   begin
2091     // trigger data
2092     result := 'TriggerData for ';
2093     if (Length(mTrigTypes) > 1) then
2094     begin
2095       result += '(';
2096       for f := 0 to High(mTrigTypes) do
2097       begin
2098         if (f <> 0) then result += ', ';
2099         result += mTrigTypes[f];
2100       end;
2101       result += ')';
2102     end
2103     else
2104     begin
2105       result += mTrigTypes[0];
2106     end;
2107   end
2108   else
2109   begin
2110     // record
2111     result := mPasName+' is '+quoteStr(mName);
2112     if (mSize >= 0) then result += Format(' size %d bytes', [mSize]);
2113     if mHeader then result += ' header';
2114   end;
2115   result += ' {'#10;
2116   for f := 0 to mFields.count-1 do
2117   begin
2118     result += '  ';
2119     result += mFields[f].definition;
2120     result += ';'#10;
2121   end;
2122   result += '}';
2123 end;
2124
2125
2126 procedure TDynRecord.parseBinValue (st: TStream; forceData: Boolean=false);
2127 var
2128   sign: string[4];
2129   btype: Integer;
2130   bsize: Integer;
2131   buf: PByte = nil;
2132   loaded: array[0..255] of Boolean;
2133   rec, rect: TDynRecord;
2134   fld: TDynField;
2135   f: Integer;
2136   mst: TSFSMemoryChunkStream = nil;
2137
2138   procedure linkNames (rec: TDynRecord);
2139   var
2140     fld: TDynField;
2141     rt: TDynRecord;
2142   begin
2143     //writeln('*** rec: ', rec.mName, '.', rec.mId, ' (', rec.mFields.count, ')');
2144     for fld in rec.mFields do
2145     begin
2146       if (fld.mType = TDynField.TType.TTrigData) then
2147       begin
2148         if (fld.mRecRef <> nil) then linkNames(fld.mRecRef);
2149         continue;
2150       end;
2151       if (Length(fld.mRecRefId) = 0) then continue;
2152       assert(fld.mEBSType <> nil);
2153       rt := findRecordByTypeId(fld.mEBSTypeName, fld.mRecRefId);
2154       if (rt = nil) then
2155       begin
2156         e_LogWritefln('record of type ''%s'' with id ''%s'' links to inexistant record of type ''%s'' with id ''%s''', [rec.mName, rec.mId, fld.mEBSTypeName, fld.mRecRefId], MSG_WARNING);
2157         //raise Exception.Create(Format('record of type ''%s'' with id ''%s'' links to inexistant record of type ''%s'' with id ''%s''', [rec.mName, rec.mId, fld.mEBSTypeName, fld.mRecRefId]));
2158       end;
2159       //writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')');
2160       fld.mRecRefId := '';
2161       fld.mRecRef := rt;
2162       fld.mDefined := true;
2163     end;
2164     for fld in rec.mFields do
2165     begin
2166       //writeln('  ', fld.mName);
2167       fld.fixDefaultValue(); // just in case
2168     end;
2169   end;
2170
2171 begin
2172   for f := 0 to High(loaded) do loaded[f] := false;
2173   mst := TSFSMemoryChunkStream.Create(nil, 0);
2174   try
2175     if mHeader and not forceData then
2176     begin
2177       // parse map file as sequence of blocks
2178       sign[0] := #4;
2179       st.ReadBuffer(sign[1], 4);
2180       if (sign <> 'MAP'#1) then raise Exception.Create('invalid binary map signature');
2181       // parse blocks
2182       while (st.position < st.size) do
2183       begin
2184         btype := readByte(st);
2185         if (btype = 0) then break; // no more blocks
2186         readLongWord(st); // reserved
2187         bsize := readLongInt(st);
2188         {$IF DEFINED(D2D_XDYN_DEBUG)}writeln('btype=', btype, '; bsize=', bsize);{$ENDIF}
2189         if (bsize < 0) or (bsize > $1fffffff) then raise Exception.Create(Format('block of type %d has invalid size %d', [btype, bsize]));
2190         if loaded[btype] then raise Exception.Create(Format('block of type %d already loaded', [btype]));
2191         loaded[btype] := true;
2192         // find record type for this block
2193         rect := nil;
2194         for rec in mOwner.recTypes do if (rec.mBinBlock = btype) then begin rect := rec; break; end;
2195         if (rect = nil) then raise Exception.Create(Format('block of type %d has no corresponding record', [btype]));
2196         //writeln('found type ''', rec.mName, ''' for block type ', btype);
2197         if (rec.mSize = 0) or ((bsize mod rec.mSize) <> 0) then raise Exception.Create(Format('block of type %d has invalid number of records', [btype]));
2198         // header?
2199         if (rect.mHeader) then
2200         begin
2201           if (bsize <> mSize) then raise Exception.Create(Format('header block of type %d has invalid number of records', [btype]));
2202           GetMem(buf, bsize);
2203           st.ReadBuffer(buf^, bsize);
2204           mst.setup(buf, mSize);
2205           parseBinValue(mst, true); // force parsing data
2206         end
2207         else
2208         begin
2209           // create list for this type
2210           fld := TDynField.Create(rec.mName, TDynField.TType.TList);
2211           fld.mOwner := self;
2212           addField(fld);
2213           if (bsize > 0) then
2214           begin
2215             GetMem(buf, bsize);
2216             st.ReadBuffer(buf^, bsize);
2217             for f := 0 to (bsize div rec.mSize)-1 do
2218             begin
2219               mst.setup(buf+f*rec.mSize, rec.mSize);
2220               rec := rect.clone();
2221               rec.mHeaderRec := self;
2222               rec.parseBinValue(mst);
2223               rec.mId := Format('%s%d', [rec.mName, f]);
2224               fld.addListItem(rec);
2225               //writeln('parsed ''', rec.mId, '''...');
2226             end;
2227           end;
2228         end;
2229         FreeMem(buf);
2230         buf := nil;
2231         //st.position := st.position+bsize;
2232       end;
2233       // link fields
2234       for fld in mFields do
2235       begin
2236         if (fld.mType <> TDynField.TType.TList) then continue;
2237         for rec in fld.mRVal do linkNames(rec);
2238       end;
2239       exit;
2240     end;
2241
2242     // read fields
2243     if StrEqu(mName, 'TriggerData') then mSize := Integer(st.size-st.position);
2244     if (mSize < 1) then raise Exception.Create(Format('cannot read record of type ''%s'' with unknown size', [mName]));
2245     GetMem(buf, mSize);
2246     st.ReadBuffer(buf^, mSize);
2247     for fld in mFields do
2248     begin
2249       if fld.mInternal then continue;
2250       if (fld.mBinOfs < 0) then continue;
2251       if (fld.mBinOfs >= st.size) then raise Exception.Create(Format('record of type ''%s'' has invalid field ''%s''', [fld.mName]));
2252       mst.setup(buf+fld.mBinOfs, mSize-fld.mBinOfs);
2253       //writeln('parsing ''', mName, '.', fld.mName, '''...');
2254       fld.parseBinValue(mst);
2255     end;
2256   finally
2257     mst.Free();
2258     if (buf <> nil) then FreeMem(buf);
2259   end;
2260 end;
2261
2262
2263 procedure TDynRecord.writeBinTo (st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false);
2264 var
2265   fld: TDynField;
2266   rec, rv: TDynRecord;
2267   buf: PByte = nil;
2268   ws: TStream = nil;
2269   blk, blkmax: Integer;
2270   //f, c: Integer;
2271   bufsz: Integer = 0;
2272   blksz: Integer;
2273 begin
2274   if (trigbufsz < 0) then
2275   begin
2276     if (mBinBlock < 1) then raise Exception.Create('cannot write binary record without block number');
2277     if (mSize < 1) then raise Exception.Create('cannot write binary record without size');
2278     bufsz := mSize;
2279   end
2280   else
2281   begin
2282     bufsz := trigbufsz;
2283   end;
2284   try
2285     GetMem(buf, bufsz);
2286     FillChar(buf^, bufsz, 0);
2287     ws := TSFSMemoryChunkStream.Create(buf, bufsz);
2288
2289     // write normal fields
2290     for fld in mFields do
2291     begin
2292       // record list?
2293       if (fld.mType = fld.TType.TList) then continue; // later
2294       if fld.mInternal then continue;
2295       if (fld.mBinOfs < 0) then continue;
2296       if (fld.mBinOfs >= bufsz) then raise Exception.Create('binary value offset is outside of the buffer');
2297       TSFSMemoryChunkStream(ws).setup(buf+fld.mBinOfs, bufsz-fld.mBinOfs);
2298       //writeln('writing field <', fld.mName, '>');
2299       fld.writeBinTo(ws);
2300     end;
2301
2302     // write block with normal fields
2303     if mHeader and not onlyFields then
2304     begin
2305       //writeln('writing header...');
2306       // signature and version
2307       writeIntBE(st, LongWord($4D415001));
2308       writeInt(st, Byte(mBinBlock)); // type
2309       writeInt(st, LongWord(0)); // reserved
2310       writeInt(st, LongWord(bufsz)); // size
2311     end;
2312     st.WriteBuffer(buf^, bufsz);
2313
2314     ws.Free(); ws := nil;
2315     FreeMem(buf); buf := nil;
2316
2317     // write other blocks, if any
2318     if mHeader and not onlyFields then
2319     begin
2320       // calculate blkmax
2321       blkmax := 0;
2322       for fld in mFields do
2323       begin
2324         // record list?
2325         if (fld.mType = fld.TType.TList) then
2326         begin
2327           if (fld.mRVal = nil) or (fld.mRVal.count = 0) then continue;
2328           rec := mOwner.findRecType(fld.mName);
2329           if (rec = nil) then continue;
2330           if (rec.mBinBlock <= 0) then continue;
2331           if (blkmax < rec.mBinBlock) then blkmax := rec.mBinBlock;
2332         end;
2333       end;
2334       // write blocks
2335       for blk := 1 to blkmax do
2336       begin
2337         if (blk = mBinBlock) then continue;
2338         ws := nil;
2339         for fld in mFields do
2340         begin
2341           // record list?
2342           if (fld.mType = fld.TType.TList) then
2343           begin
2344             if (fld.mRVal = nil) or (fld.mRVal.count = 0) then continue;
2345             rec := mOwner.findRecType(fld.mName);
2346             if (rec = nil) then continue;
2347             if (rec.mBinBlock <> blk) then continue;
2348             if (ws = nil) then ws := TMemoryStream.Create();
2349             for rv in fld.mRVal do rv.writeBinTo(ws);
2350           end;
2351         end;
2352         // flush block
2353         if (ws <> nil) then
2354         begin
2355           blksz := Integer(ws.position);
2356           ws.position := 0;
2357           writeInt(st, Byte(blk)); // type
2358           writeInt(st, LongWord(0)); // reserved
2359           writeInt(st, LongWord(blksz)); // size
2360           st.CopyFrom(ws, blksz);
2361           ws.Free();
2362           ws := nil;
2363         end;
2364       end;
2365       // write end marker
2366       writeInt(st, Byte(0));
2367       writeInt(st, LongWord(0));
2368       writeInt(st, LongWord(0));
2369     end;
2370   finally
2371     ws.Free();
2372     if (buf <> nil) then FreeMem(buf);
2373   end;
2374 end;
2375
2376
2377 procedure TDynRecord.writeTo (wr: TTextWriter; putHeader: Boolean=true);
2378 var
2379   fld: TDynField;
2380   rec: TDynRecord;
2381 begin
2382   if putHeader then
2383   begin
2384     wr.put(mName);
2385     if (Length(mId) > 0) then begin wr.put(' '); wr.put(mId); end;
2386     wr.put(' ');
2387   end;
2388   wr.put('{'#10);
2389   wr.indent();
2390   try
2391     for fld in mFields do
2392     begin
2393       // record list?
2394       if (fld.mType = fld.TType.TList) then
2395       begin
2396         if not mHeader then raise Exception.Create('record list in non-header record');
2397         if (fld.mRVal <> nil) then
2398         begin
2399           for rec in fld.mRVal do
2400           begin
2401             if (Length(rec.mId) = 0) then continue;
2402             wr.putIndent();
2403             rec.writeTo(wr, true);
2404           end;
2405         end;
2406         continue;
2407       end;
2408       if fld.mInternal then continue;
2409       if fld.mOmitDef and fld.isDefaultValue then continue;
2410       wr.putIndent();
2411       fld.writeTo(wr);
2412     end;
2413   finally
2414     wr.unindent();
2415   end;
2416   wr.putIndent();
2417   wr.put('}'#10);
2418 end;
2419
2420
2421 {$IF DEFINED(D2D_DYNREC_PROFILER)}
2422 var
2423   profCloneRec: UInt64 = 0;
2424   profFindRecType: UInt64 = 0;
2425   profFieldSearching: UInt64 = 0;
2426   profListDupChecking: UInt64 = 0;
2427   profAddRecByType: UInt64 = 0;
2428   profFieldValParsing: UInt64 = 0;
2429   profFixDefaults: UInt64 = 0;
2430   profRecValParse: UInt64 = 0;
2431
2432 procedure xdynDumpProfiles ();
2433 begin
2434   writeln('=== XDYNREC PROFILES ===');
2435   writeln('record cloning: ', profCloneRec div 1000, '.', profCloneRec mod 1000, ' milliseconds');
2436   writeln('findRecType   : ', profFindRecType div 1000, '.', profFindRecType mod 1000, ' milliseconds');
2437   writeln('field[]       : ', profFieldSearching div 1000, '.', profFieldSearching mod 1000, ' milliseconds');
2438   writeln('list dup check: ', profListDupChecking div 1000, '.', profListDupChecking mod 1000, ' milliseconds');
2439   writeln('addRecByType  : ', profAddRecByType div 1000, '.', profAddRecByType mod 1000, ' milliseconds');
2440   writeln('field valparse: ', profFieldValParsing div 1000, '.', profFieldValParsing mod 1000, ' milliseconds');
2441   writeln('fix defaults  : ', profFixDefaults div 1000, '.', profFixDefaults mod 1000, ' milliseconds');
2442   writeln('recvalparse   : ', profRecValParse div 1000, '.', profRecValParse mod 1000, ' milliseconds');
2443 end;
2444 {$ENDIF}
2445
2446
2447 procedure TDynRecord.parseValue (pr: TTextParser; beginEaten: Boolean=false);
2448 var
2449   fld: TDynField;
2450   rec: TDynRecord = nil;
2451   trc{, rv}: TDynRecord;
2452   {$IF DEFINED(D2D_DYNREC_PROFILER)}
2453   stt, stall: UInt64;
2454   {$ENDIF}
2455 begin
2456   if (mOwner = nil) then raise Exception.Create(Format('can''t parse record ''%s'' value without owner', [mName]));
2457
2458   {$IF DEFINED(D2D_DYNREC_PROFILER)}stall := curTimeMicro();{$ENDIF}
2459
2460   // not a header?
2461   if not mHeader then
2462   begin
2463     // id?
2464     if (not beginEaten) and (pr.tokType = pr.TTId) then mId := pr.expectId();
2465   end
2466   else
2467   begin
2468     assert(mHeaderRec = self);
2469   end;
2470
2471   //writeln('parsing record <', mName, '>');
2472   if not beginEaten then pr.expectTT(pr.TTBegin);
2473   while (pr.tokType <> pr.TTEnd) do
2474   begin
2475     if (pr.tokType <> pr.TTId) then raise Exception.Create('identifier expected');
2476     //writeln('<', mName, '.', pr.tokStr, '>');
2477
2478     // records
2479     if mHeader then
2480     begin
2481       // add records with this type (if any)
2482       {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2483       trc := mOwner.findRecType(pr.tokStr);
2484       {$IF DEFINED(D2D_DYNREC_PROFILER)}profFindRecType := curTimeMicro()-stt;{$ENDIF}
2485       if (trc <> nil) then
2486       begin
2487         {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2488         rec := trc.clone();
2489         {$IF DEFINED(D2D_DYNREC_PROFILER)}profCloneRec := curTimeMicro()-stt;{$ENDIF}
2490         rec.mHeaderRec := mHeaderRec;
2491         try
2492           pr.skipToken();
2493           rec.parseValue(pr);
2494           (*
2495           if (Length(rec.mId) > 0) then
2496           begin
2497             {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2498             fld := field[pr.tokStr];
2499             {$IF DEFINED(D2D_DYNREC_PROFILER)}profFieldSearching := curTimeMicro()-stt;{$ENDIF}
2500             (*
2501             if (fld <> nil) and (fld.mRVal <> nil) then
2502             begin
2503               {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2504               //idtmp := trc.mName+':'+rec.mId;
2505               //if ids.put(idtmp, 1) then raise Exception.Create(Format('duplicate thing ''%s'' in record ''%s''', [fld.mName, mName]));
2506               if fld.mRHash.has(rec.mId) then raise Exception.Create(Format('duplicate thing ''%s'' in record ''%s''', [fld.mName, mName]));
2507               {$IF DEFINED(D2D_DYNREC_PROFILER)}profListDupChecking := curTimeMicro()-stt;{$ENDIF}
2508             end;
2509           end;
2510           *)
2511           {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2512           addRecordByType(rec.mName, rec);
2513           {$IF DEFINED(D2D_DYNREC_PROFILER)}profAddRecByType := curTimeMicro()-stt;{$ENDIF}
2514           rec := nil;
2515         finally
2516           rec.Free();
2517         end;
2518         continue;
2519       end;
2520     end;
2521
2522     // fields
2523     {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2524     fld := field[pr.tokStr];
2525     {$IF DEFINED(D2D_DYNREC_PROFILER)}profFieldSearching := curTimeMicro()-stt;{$ENDIF}
2526     if (fld <> nil) then
2527     begin
2528       if fld.defined then raise Exception.Create(Format('duplicate field ''%s'' in record ''%s''', [fld.mName, mName]));
2529       if fld.internal then raise Exception.Create(Format('internal field ''%s'' in record ''%s''', [fld.mName, mName]));
2530       pr.skipToken();
2531       {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2532       fld.parseValue(pr);
2533       {$IF DEFINED(D2D_DYNREC_PROFILER)}profFieldValParsing := curTimeMicro()-stt;{$ENDIF}
2534       continue;
2535     end;
2536
2537     // something is wrong
2538     raise Exception.Create(Format('unknown field ''%s'' in record ''%s''', [pr.tokStr, mName]));
2539   end;
2540   pr.expectTT(pr.TTEnd);
2541   // fix field defaults
2542   {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2543   for fld in mFields do fld.fixDefaultValue();
2544   {$IF DEFINED(D2D_DYNREC_PROFILER)}profFixDefaults := curTimeMicro()-stt;{$ENDIF}
2545   //writeln('done parsing record <', mName, '>');
2546   //{$IF DEFINED(D2D_DYNREC_PROFILER)}writeln('stall: ', curTimeMicro()-stall);{$ENDIF}
2547   {$IF DEFINED(D2D_DYNREC_PROFILER)}profRecValParse := curTimeMicro()-stall;{$ENDIF}
2548 end;
2549
2550
2551 // ////////////////////////////////////////////////////////////////////////// //
2552 constructor TDynEBS.Create (pr: TTextParser);
2553 begin
2554   cleanup();
2555   parseDef(pr);
2556 end;
2557
2558
2559 destructor TDynEBS.Destroy ();
2560 begin
2561   cleanup();
2562   inherited;
2563 end;
2564
2565
2566 procedure TDynEBS.cleanup ();
2567 begin
2568   mIsEnum := false;
2569   mName := '';
2570   mIds := nil;
2571   mVals := nil;
2572   mMaxName := '';
2573   mMaxVal := 0;
2574 end;
2575
2576
2577 function TDynEBS.findByName (const aname: AnsiString): Integer;
2578 begin
2579   result := 0;
2580   while (result < Length(mIds)) do
2581   begin
2582     if StrEqu(aname, mIds[result]) then exit;
2583     Inc(result);
2584   end;
2585   result := -1;
2586 end;
2587
2588
2589 function TDynEBS.hasByName (const aname: AnsiString): Boolean; inline;
2590 begin
2591   result := (findByName(aname) >= 0);
2592 end;
2593
2594
2595 function TDynEBS.getFieldByName (const aname: AnsiString): Integer; inline;
2596 var
2597   f: Integer;
2598 begin
2599   f := findByName(aname);
2600   if (f >= 0) then result := mVals[f] else result := 0;
2601 end;
2602
2603
2604 function TDynEBS.definition (): AnsiString;
2605 var
2606   f, cv: Integer;
2607 begin
2608   if mIsEnum then result :='enum ' else result := 'bitset ';
2609   result += mName;
2610   result += ' {'#10;
2611   // fields
2612   if mIsEnum then cv := 0 else cv := 1;
2613   for f := 0 to High(mIds) do
2614   begin
2615     if (mIds[f] = mMaxName) then continue;
2616     result += '  '+mIds[f];
2617     if (mVals[f] <> cv) then
2618     begin
2619       result += Format(' = %d', [mVals[f]]);
2620       if mIsEnum then cv := mVals[f];
2621       result += ','#10;
2622     end
2623     else
2624     begin
2625       result += Format(', // %d'#10, [mVals[f]]);
2626     end;
2627     if mIsEnum then Inc(cv) else if (mVals[f] = cv) then cv := cv shl 1;
2628   end;
2629   // max field
2630   if (Length(mMaxName) > 0) then result += '  '+mMaxName+' = MAX,'#10;
2631   result += '}';
2632 end;
2633
2634
2635 function TDynEBS.pasdef (): AnsiString;
2636 var
2637   f: Integer;
2638 begin
2639   result := '// '+mName+#10'const'#10;
2640   // fields
2641   for f := 0 to High(mIds) do
2642   begin
2643     result += formatstrf('  %s = %d;'#10, [mIds[f], mVals[f]]);
2644   end;
2645 end;
2646
2647
2648 function TDynEBS.nameByValue (v: Integer): AnsiString;
2649 var
2650   f: Integer;
2651 begin
2652   for f := 0 to High(mVals) do
2653   begin
2654     if (mVals[f] = v) then begin result := mIds[f]; exit; end;
2655   end;
2656   result := '';
2657 end;
2658
2659
2660 procedure TDynEBS.parseDef (pr: TTextParser);
2661 var
2662   idname: AnsiString;
2663   cv, v: Integer;
2664   f: Integer;
2665   skipAdd: Boolean;
2666   hasV: Boolean;
2667 begin
2668        if pr.eatId('enum') then mIsEnum := true
2669   else if pr.eatId('bitset') then mIsEnum := false
2670   else pr.expectId('enum');
2671   mName := pr.expectId();
2672   mMaxVal := Integer($80000000);
2673   if mIsEnum then cv := 0 else cv := 1;
2674   pr.expectTT(pr.TTBegin);
2675   while (pr.tokType <> pr.TTEnd) do
2676   begin
2677     idname := pr.expectId();
2678     for f := 0 to High(mIds) do
2679     begin
2680       if StrEqu(mIds[f], idname) then raise Exception.Create(Format('duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName]));
2681     end;
2682     if StrEqu(mMaxName, idname) then raise Exception.Create(Format('duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName]));
2683     skipAdd := false;
2684     hasV := false;
2685     v := cv;
2686     // has value?
2687     if pr.eatDelim('=') then
2688     begin
2689       if pr.eatId('MAX') then
2690       begin
2691         if (Length(mMaxName) > 0) then raise Exception.Create(Format('duplicate max field ''%s'' in enum/bitset ''%s''', [idname, mName]));
2692         mMaxName := idname;
2693         skipAdd := true;
2694       end
2695       else
2696       begin
2697         v := pr.expectInt();
2698           if mIsEnum then cv := v;
2699         hasV := true;
2700       end;
2701     end;
2702     // append it?
2703     if not skipAdd then
2704     begin
2705       // fix maxvalue
2706       if mIsEnum or (not hasV) then
2707       begin
2708         if (mMaxVal < v) then mMaxVal := v;
2709       end;
2710       SetLength(mIds, Length(mIds)+1);
2711       mIds[High(mIds)] := idname;
2712       SetLength(mVals, Length(mIds));
2713       mVals[High(mVals)] := v;
2714       // next cv
2715       if mIsEnum or (not hasV) then
2716       begin
2717         if mIsEnum then Inc(cv) else cv := cv shl 1;
2718       end;
2719     end;
2720     if (pr.tokType = pr.TTEnd) then break;
2721     pr.expectTT(pr.TTComma);
2722     while pr.eatTT(pr.TTComma) do begin end;
2723   end;
2724   pr.expectTT(pr.TTEnd);
2725   // add max field
2726   if (Length(mMaxName) > 0) then
2727   begin
2728     SetLength(mIds, Length(mIds)+1);
2729     mIds[High(mIds)] := mMaxName;
2730     SetLength(mVals, Length(mIds));
2731     mVals[High(mVals)] := mMaxVal;
2732   end;
2733 end;
2734
2735
2736 // ////////////////////////////////////////////////////////////////////////// //
2737 constructor TDynMapDef.Create (pr: TTextParser);
2738 begin
2739   recTypes := TDynRecList.Create();
2740   trigTypes := TDynRecList.Create();
2741   ebsTypes := TDynEBSList.Create();
2742   parseDef(pr);
2743 end;
2744
2745
2746 destructor TDynMapDef.Destroy ();
2747 var
2748   rec: TDynRecord;
2749   ebs: TDynEBS;
2750 begin
2751   for rec in recTypes do rec.Free();
2752   for rec in trigTypes do rec.Free();
2753   for ebs in ebsTypes do ebs.Free();
2754   recTypes.Free();
2755   trigTypes.Free();
2756   ebsTypes.Free();
2757   recTypes := nil;
2758   trigTypes := nil;
2759   ebsTypes := nil;
2760   inherited;
2761 end;
2762
2763
2764 function TDynMapDef.getHeaderRecType (): TDynRecord; inline;
2765 begin
2766   if (recTypes.count = 0) then raise Exception.Create('no header in empty mapdef');
2767   result := recTypes[0];
2768 end;
2769
2770
2771 function TDynMapDef.findRecType (const aname: AnsiString): TDynRecord;
2772 var
2773   rec: TDynRecord;
2774 begin
2775   for rec in recTypes do
2776   begin
2777     if StrEqu(rec.name, aname) then begin result := rec; exit; end;
2778   end;
2779   result := nil;
2780 end;
2781
2782
2783 function TDynMapDef.findTrigFor (const aname: AnsiString): TDynRecord;
2784 var
2785   rec: TDynRecord;
2786 begin
2787   for rec in trigTypes do
2788   begin
2789     if (rec.isForTrig[aname]) then begin result := rec; exit; end;
2790   end;
2791   result := nil;
2792 end;
2793
2794
2795 function TDynMapDef.findEBSType (const aname: AnsiString): TDynEBS;
2796 var
2797   ebs: TDynEBS;
2798 begin
2799   for ebs in ebsTypes do
2800   begin
2801     if StrEqu(ebs.name, aname) then begin result := ebs; exit; end;
2802   end;
2803   result := nil;
2804 end;
2805
2806
2807 procedure TDynMapDef.parseDef (pr: TTextParser);
2808 var
2809   rec, hdr: TDynRecord;
2810   eb: TDynEBS;
2811   f: Integer;
2812
2813   // setup header links and type links
2814   procedure linkRecord (rec: TDynRecord);
2815   var
2816     fld: TDynField;
2817   begin
2818     rec.mHeaderRec := recTypes[0];
2819     for fld in rec.mFields do
2820     begin
2821       if (fld.mType = fld.TType.TTrigData) then continue;
2822       case fld.mEBS of
2823         TDynField.TEBS.TNone: begin end;
2824         TDynField.TEBS.TRec:
2825           begin
2826             fld.mEBSType := findRecType(fld.mEBSTypeName);
2827             if (fld.mEBSType = nil) then raise Exception.Create(Format('field ''%s'' of type ''%s'' has no correcponding record definition', [fld.mName, fld.mEBSTypeName]));
2828           end;
2829         TDynField.TEBS.TEnum,
2830         TDynField.TEBS.TBitSet:
2831           begin
2832             fld.mEBSType := findEBSType(fld.mEBSTypeName);
2833             if (fld.mEBSType = nil) then raise Exception.Create(Format('field ''%s'' of type ''%s'' has no correcponding enum/bitset', [fld.mName, fld.mEBSTypeName]));
2834             if ((fld.mEBS = TDynField.TEBS.TEnum) <> (fld.mEBSType as TDynEBS).mIsEnum) then raise Exception.Create(Format('field ''%s'' of type ''%s'' enum/bitset type conflict', [fld.mName, fld.mEBSTypeName]));
2835           end;
2836       end;
2837     end;
2838   end;
2839
2840   // setup default values
2841   procedure fixRecordDefaults (rec: TDynRecord);
2842   var
2843     fld: TDynField;
2844   begin
2845     for fld in rec.mFields do if fld.mHasDefault then fld.parseDefaultValue();
2846   end;
2847
2848 begin
2849   hdr := nil;
2850   while true do
2851   begin
2852     if not pr.skipBlanks() then break;
2853     if (pr.tokType <> pr.TTId) then raise Exception.Create('identifier expected');
2854
2855     if (pr.tokStr = 'enum') or (pr.tokStr = 'bitset') then
2856     begin
2857       eb := TDynEBS.Create(pr);
2858       if (findEBSType(eb.name) <> nil) then
2859       begin
2860         eb.Free();
2861         raise Exception.Create(Format('duplicate enum/bitset ''%s''', [eb.name]));
2862       end;
2863       eb.mOwner := self;
2864       ebsTypes.append(eb);
2865       //writeln(eb.definition); writeln;
2866       continue;
2867     end;
2868
2869     if (pr.tokStr = 'TriggerData') then
2870     begin
2871       rec := TDynRecord.Create(pr);
2872       for f := 0 to High(rec.mTrigTypes) do
2873       begin
2874         if (findTrigFor(rec.mTrigTypes[f]) <> nil) then
2875         begin
2876           rec.Free();
2877           raise Exception.Create(Format('duplicate trigdata ''%s''', [rec.mTrigTypes[f]]));
2878         end;
2879       end;
2880       rec.mOwner := self;
2881       trigTypes.append(rec);
2882       //writeln(dr.definition); writeln;
2883       continue;
2884     end;
2885
2886     rec := TDynRecord.Create(pr);
2887     //writeln(dr.definition); writeln;
2888     if (findRecType(rec.name) <> nil) then begin rec.Free(); raise Exception.Create(Format('duplicate record ''%s''', [rec.name])); end;
2889     if (hdr <> nil) and StrEqu(rec.name, hdr.name) then begin rec.Free(); raise Exception.Create(Format('duplicate record ''%s''', [rec.name])); end;
2890     rec.mOwner := self;
2891     if rec.mHeader then
2892     begin
2893       if (hdr <> nil) then begin rec.Free(); raise Exception.Create(Format('duplicate header record ''%s'' (previous is ''%s'')', [rec.name, hdr.name])); end;
2894       hdr := rec;
2895     end
2896     else
2897     begin
2898       recTypes.append(rec);
2899     end;
2900   end;
2901
2902   // put header record to top
2903   if (hdr = nil) then raise Exception.Create('header definition not found in mapdef');
2904   recTypes.append(nil);
2905   for f := recTypes.count-1 downto 1 do recTypes[f] := recTypes[f-1];
2906   recTypes[0] := hdr;
2907
2908   // setup header links and type links
2909   for rec in recTypes do linkRecord(rec);
2910   for rec in trigTypes do linkRecord(rec);
2911
2912   // setup default values
2913   for rec in recTypes do fixRecordDefaults(rec);
2914   for rec in trigTypes do fixRecordDefaults(rec);
2915 end;
2916
2917
2918 // ////////////////////////////////////////////////////////////////////////// //
2919 function TDynMapDef.parseMap (pr: TTextParser): TDynRecord;
2920 var
2921   res: TDynRecord = nil;
2922 begin
2923   result := nil;
2924   try
2925     pr.expectId(headerType.name);
2926     res := headerType.clone();
2927     res.mHeaderRec := res;
2928     res.parseValue(pr);
2929     result := res;
2930     res := nil;
2931   finally
2932     res.Free();
2933   end;
2934 end;
2935
2936
2937 function TDynMapDef.parseBinMap (st: TStream): TDynRecord;
2938 var
2939   res: TDynRecord = nil;
2940 begin
2941   result := nil;
2942   try
2943     res := headerType.clone();
2944     res.mHeaderRec := res;
2945     res.parseBinValue(st);
2946     result := res;
2947     res := nil;
2948   finally
2949     res.Free();
2950   end;
2951 end;
2952
2953
2954 function TDynMapDef.pasdef (): AnsiString;
2955 var
2956   ebs: TDynEBS;
2957   rec: TDynRecord;
2958   fld: TDynField;
2959   needComma: Boolean;
2960   tn: AnsiString;
2961 begin
2962   result := '';
2963   result += '// ////////////////////////////////////////////////////////////////////////// //'#10;
2964   result += '// enums and bitsets'#10;
2965   for ebs in ebsTypes do result += #10+ebs.pasdef();
2966   result += #10#10'// ////////////////////////////////////////////////////////////////////////// //'#10;
2967   result += '// records'#10'type'#10;
2968   for rec in recTypes do
2969   begin
2970     if (rec.mSize < 1) then continue;
2971     result += rec.pasdef();
2972     result += #10;
2973   end;
2974   result += #10#10'// ////////////////////////////////////////////////////////////////////////// //'#10;
2975   result += '// triggerdata'#10'type'#10;
2976   result += '  TTriggerData = record'#10;
2977   result += '    case Byte of'#10;
2978   result += '      0: (Default: Byte128);'#10;
2979   for rec in trigTypes do
2980   begin
2981     result += '      ';
2982     needComma := false;
2983     for tn in rec.mTrigTypes do
2984     begin
2985       if needComma then result += ', ' else needComma := true;
2986       result += tn;
2987     end;
2988     result += ': ('#10;
2989     for fld in rec.mFields do
2990     begin
2991       if fld.mInternal then continue;
2992       if (fld.mBinOfs < 0) then continue;
2993       result += '        '+fld.pasdef+#10;
2994     end;
2995     result += '      );'#10;
2996   end;
2997   result += '  end;'#10;
2998 end;
2999
3000
3001 function TDynMapDef.pasdefconst (): AnsiString;
3002 var
3003   ebs: TDynEBS;
3004 begin
3005   result := '';
3006   result += '// ////////////////////////////////////////////////////////////////////////// //'#10;
3007   result += '// enums and bitsets'#10;
3008   for ebs in ebsTypes do result += #10+ebs.pasdef();
3009 end;
3010
3011
3012 function TDynMapDef.getTrigTypeCount (): Integer; inline; begin result := trigTypes.count; end;
3013 function TDynMapDef.getTrigTypeAt (idx: Integer): TDynRecord; inline; begin if (idx >= 0) and (idx < trigTypes.count) then result := trigTypes[idx] else result := nil; end;
3014
3015
3016 end.