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