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, defint2: Integer;
 899   hasdefStr: Boolean;
 900   hasdefInt: Boolean;
 901   hasdefId: Boolean;
 902   lmaxdim: Integer;
 903   lebs: TDynField.TEBS;
 904   unique: Boolean;
 905   asmonid: Boolean;
 906   defech: AnsiChar;
 907 begin
 908   fldpasname := '';
 909   fldname := '';
 910   fldtype := '';
 911   fldofs := -1;
 912   fldrecname := '';
 913   asxy := false;
 914   aswh := false;
 915   ast := false;
 916   ainternal := false;
 917   omitdef := false;
 918   defstr := '';
 919   defint := 0;
 920   defint2 := 0;
 921   hasdefStr := false;
 922   hasdefInt := false;
 923   hasdefId := false;
 924   unique := false;
 925   asmonid := false;
 926   lmaxdim := -1;
 927   lebs := TDynField.TEBS.TNone;
 928
 929   fldpasname := pr.expectId(); // pascal field name
 930   // field name
 931   pr.expectId('is');
 932   fldname := pr.expectStr();
 933   // field type
 934   pr.expectId('type');
 935   fldtype := pr.expectId();
 936
 937   // fixed-size array?
 938   if pr.eatDelim('[') then
 939   begin
 940     lmaxdim := pr.expectInt();
 941     if (lmaxdim < 1) then raise Exception.Create(Format('invalid field ''%s'' array size', [fldname]));
 942     pr.expectDelim(']');
 943   end;
 944
 945   while (pr.tokType <> pr.TTSemi) do
 946   begin
 947     if pr.eatId('offset') then
 948     begin
 949       if (fldofs >= 0) then raise Exception.Create(Format('duplicate field ''%s'' offset', [fldname]));
 950       fldofs := pr.expectInt();
 951       if (fldofs < 0) then raise Exception.Create(Format('invalid field ''%s'' offset', [fldname]));
 952       continue;
 953     end;
 954
 955     if pr.eatId('as') then
 956     begin
 957            if pr.eatId('xy') then asxy := true
 958       else if pr.eatId('wh') then aswh := true
 959       else if pr.eatId('txy') then begin asxy := true; ast := true; end
 960       else if pr.eatId('twh') then begin aswh := true; ast := true; end
 961       else if pr.eatId('monsterid') then begin asmonid := true; end
 962       else raise Exception.Create(Format('invalid field ''%s'' as what?', [fldname]));
 963       continue;
 964     end;
 965
 966     if pr.eatId('enum') then
 967     begin
 968       lebs := TDynField.TEBS.TEnum;
 969       if (Length(fldrecname) <> 0) then raise Exception.Create(Format('field ''%s'' already typed as ''%s''', [fldname, fldrecname]));
 970       fldrecname := pr.expectId();
 971       continue;
 972     end;
 973
 974     if pr.eatId('bitset') then
 975     begin
 976       lebs := TDynField.TEBS.TBitSet;
 977       if (Length(fldrecname) <> 0) then raise Exception.Create(Format('field ''%s'' already typed as ''%s''', [fldname, fldrecname]));
 978       unique := pr.eatId('unique');
 979       fldrecname := pr.expectId();
 980       continue;
 981     end;
 982
 983     if pr.eatId('default') then
 984     begin
 985       if hasdefStr or hasdefInt or hasdefId then raise Exception.Create(Format('field ''%s'' has duplicate default', [fldname]));
 986       case pr.tokType of
 987         pr.TTStr:
 988           begin
 989             hasdefStr := true;
 990             defstr := pr.expectStr(true); // allow empty strings
 991           end;
 992         pr.TTId:
 993           begin
 994             hasdefId := true;
 995             defstr := pr.expectId();
 996           end;
 997         pr.TTInt:
 998           begin
 999             hasdefInt := true;
1000             defint := pr.expectInt();
1001           end;
1002         pr.TTDelim:
1003           begin
1004             hasdefInt := true;
1005             if pr.eatDelim('[') then defech := ']' else begin pr.expectDelim('('); defech := ')'; end;
1006             defint := pr.expectInt();
1007             defint2 := pr.expectInt();
1008             pr.expectDelim(defech);
1009           end;
1010         else
1011           raise Exception.Create(Format('field ''%s'' has invalid default', [fldname]));
1012       end;
1013       continue;
1014     end;
1015
1016     if pr.eatId('omitdefault') then
1017     begin
1018       omitdef := true;
1019       continue;
1020     end;
1021
1022     if pr.eatId('internal') then
1023     begin
1024       ainternal := true;
1025       continue;
1026     end;
1027
1028     if (pr.tokType <> pr.TTId) then raise Exception.Create(Format('field ''%s'' has something unexpected in definition', [fldname]));
1029
1030     if (Length(fldrecname) <> 0) then raise Exception.Create(Format('field ''%s'' already typed as ''%s''', [fldname, fldrecname]));
1031     fldrecname := pr.expectId();
1032     lebs := TDynField.TEBS.TRec;
1033   end;
1034
1035   pr.expectTT(pr.TTSemi);
1036
1037   // create field
1038   mName := fldname;
1039        if (fldtype = 'bool') then mType := TType.TBool
1040   else if (fldtype = 'negbool') then begin mType := TType.TBool; mNegBool := true; end
1041   else if (fldtype = 'char') then mType := TType.TChar
1042   else if (fldtype = 'byte') then mType := TType.TByte
1043   else if (fldtype = 'ubyte') then mType := TType.TUByte
1044   else if (fldtype = 'short') then mType := TType.TShort
1045   else if (fldtype = 'ushort') then mType := TType.TUShort
1046   else if (fldtype = 'int') then mType := TType.TInt
1047   else if (fldtype = 'uint') then mType := TType.TUInt
1048   else if (fldtype = 'string') then mType := TType.TString
1049   else if (fldtype = 'point') then mType := TType.TPoint
1050   else if (fldtype = 'size') then mType := TType.TSize
1051   else if (fldtype = 'trigdata') then mType := TType.TTrigData
1052   else raise Exception.Create(Format('field ''%s'' has invalid type ''%s''', [fldname, fldtype]));
1053
1054   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]));
1055   if (mType = TType.TTrigData) then
1056   begin
1057     if (lmaxdim < 1) then raise Exception.Create(Format('field ''%s'' of type ''%s'' cannot be array', [fldname, fldtype]));
1058     if (Length(fldrecname) > 0) then raise Exception.Create(Format('field ''%s'' of type ''%s'' cannot have another type', [fldname, fldtype]));
1059     lebs := TDynField.TEBS.TRec;
1060   end;
1061
1062        if hasdefStr then self.mDefUnparsed := quoteStr(defstr)
1063   else if hasdefId then self.mDefUnparsed := defstr
1064   else if hasdefInt then
1065   begin
1066          if (mType = TType.TPoint) then self.mDefUnparsed := Format('(%d %d)', [defint, defint2])
1067     else if (mType = TType.TSize) then self.mDefUnparsed := Format('[%d %d]', [defint, defint2])
1068     else self.mDefUnparsed := Format('%d', [defint]);
1069   end;
1070
1071   self.mHasDefault := (hasdefStr or hasdefId or hasdefInt);
1072   self.mPasName := fldpasname;
1073   self.mEBS := lebs;
1074   self.mEBSTypeName := fldrecname;
1075   self.mBitSetUnique := unique;
1076   self.mAsMonsterId := asmonid;
1077   self.mMaxDim := lmaxdim;
1078   self.mBinOfs := fldofs;
1079   self.mSepPosSize := (asxy or aswh);
1080   self.mAsT := ast;
1081   self.mOmitDef := omitdef;
1082   self.mInternal := ainternal;
1083 end;
1084
1085
1086 function TDynField.getRecRefIndex (): Integer;
1087 begin
1088   if (mRecRef = nil) then begin result := -1; exit; end;
1089   result := mOwner.findRecordNumByType(mEBSTypeName, mRecRef);
1090 end;
1091
1092
1093 procedure TDynField.writeBinTo (st: TStream);
1094 var
1095   s: AnsiString;
1096   f: Integer;
1097   maxv: Integer;
1098   buf: PByte;
1099   ws: TStream = nil;
1100 begin
1101   case mEBS of
1102     TEBS.TNone: begin end;
1103     TEBS.TRec:
1104       begin
1105         if (mMaxDim >= 0) then
1106         begin
1107           // this must be triggerdata
1108           if (mType <> TType.TTrigData) then
1109           begin
1110             raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
1111           end;
1112           // write triggerdata
1113           GetMem(buf, mMaxDim);
1114           if (buf = nil) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
1115           try
1116             FillChar(buf^, mMaxDim, 0);
1117             if (mRecRef <> nil) then
1118             begin
1119               ws := TSFSMemoryChunkStream.Create(buf, mMaxDim);
1120               mRecRef.writeBinTo(ws, mMaxDim); // as trigdata
1121             end;
1122             st.WriteBuffer(buf^, mMaxDim);
1123           finally
1124             ws.Free();
1125             if (buf <> nil) then FreeMem(buf);
1126           end;
1127           exit;
1128         end;
1129         // record reference
1130         case mType of
1131           TType.TByte: maxv := 127;
1132           TType.TUByte: maxv := 254;
1133           TType.TShort: maxv := 32767;
1134           TType.TUShort: maxv := 65534;
1135           TType.TInt: maxv := $7fffffff;
1136           TType.TUInt: maxv := $7fffffff;
1137           else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
1138         end;
1139         // find record number
1140         if (mRecRef <> nil) then
1141         begin
1142           f := mOwner.findRecordNumByType(mEBSTypeName, mRecRef);
1143           if (f < 0) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' not found in record list', [mEBSTypeName, mName]));
1144           if mAsMonsterId then Inc(f);
1145           if (f > maxv) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' has too big index', [mEBSTypeName, mName]));
1146         end
1147         else
1148         begin
1149           if mAsMonsterId then f := 0 else f := -1;
1150         end;
1151         case mType of
1152           TType.TByte, TType.TUByte: writeInt(st, Byte(f));
1153           TType.TShort, TType.TUShort: writeInt(st, SmallInt(f));
1154           TType.TInt, TType.TUInt: writeInt(st, LongWord(f));
1155           else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
1156         end;
1157         exit;
1158       end;
1159     TEBS.TEnum: begin end;
1160     TEBS.TBitSet: begin end;
1161     else raise Exception.Create('ketmar forgot to handle some EBS type');
1162   end;
1163
1164   case mType of
1165     TType.TBool:
1166       begin
1167         if not mNegBool then
1168         begin
1169           if (mIVal <> 0) then writeInt(st, Byte(1)) else writeInt(st, Byte(0));
1170         end
1171         else
1172         begin
1173           if (mIVal = 0) then writeInt(st, Byte(1)) else writeInt(st, Byte(0));
1174         end;
1175         exit;
1176       end;
1177     TType.TChar:
1178       begin
1179         if (mMaxDim = 0) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
1180         if (mMaxDim < 0) then
1181         begin
1182           if (Length(mSVal) <> 1) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
1183           writeInt(st, Byte(mSVal[1]));
1184         end
1185         else
1186         begin
1187           if (Length(mSVal) > mMaxDim) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
1188           s := utf2win(mSVal);
1189           if (Length(s) > 0) then st.WriteBuffer(PChar(s)^, Length(s));
1190           for f := Length(s) to mMaxDim do writeInt(st, Byte(0));
1191         end;
1192         exit;
1193       end;
1194     TType.TByte,
1195     TType.TUByte:
1196       begin
1197         // triggerdata array was processed earlier
1198         if (mMaxDim >= 0) then Exception.Create(Format('byte array in field ''%s'' cannot be written', [mName]));
1199         writeInt(st, Byte(mIVal));
1200         exit;
1201       end;
1202     TType.TShort,
1203     TType.TUShort:
1204       begin
1205         if (mMaxDim >= 0) then raise Exception.Create(Format('short array in field ''%s'' cannot be written', [mName]));
1206         writeInt(st, Word(mIVal));
1207         exit;
1208       end;
1209     TType.TInt,
1210     TType.TUInt:
1211       begin
1212         if (mMaxDim >= 0) then raise Exception.Create(Format('int array in field ''%s'' cannot be written', [mName]));
1213         writeInt(st, LongWord(mIVal));
1214         exit;
1215       end;
1216     TType.TString:
1217       begin
1218         raise Exception.Create(Format('cannot write string field ''%s''', [mName]));
1219       end;
1220     TType.TPoint:
1221       begin
1222         if (mMaxDim >= 0) then raise Exception.Create(Format('pos/size array in field ''%s'' cannot be written', [mName]));
1223         writeInt(st, LongInt(mIVal));
1224         writeInt(st, LongInt(mIVal2));
1225         exit;
1226       end;
1227     TType.TSize:
1228       begin
1229         if (mMaxDim >= 0) then raise Exception.Create(Format('pos/size array in field ''%s'' cannot be written', [mName]));
1230         writeInt(st, Word(mIVal));
1231         writeInt(st, Word(mIVal2));
1232         exit;
1233       end;
1234     TType.TList:
1235       begin
1236         assert(false);
1237         exit;
1238       end;
1239     TType.TTrigData:
1240       begin
1241         assert(false);
1242         exit;
1243       end;
1244     else raise Exception.Create('ketmar forgot to handle some field type');
1245   end;
1246 end;
1247
1248
1249 procedure TDynField.writeTo (wr: TTextWriter);
1250 var
1251   es: TDynEBS = nil;
1252   f, mask: Integer;
1253   first, found: Boolean;
1254 begin
1255   wr.put(mName);
1256   wr.put(' ');
1257   case mEBS of
1258     TEBS.TNone: begin end;
1259     TEBS.TRec:
1260       begin
1261         if (mRecRef = nil) then
1262         begin
1263           if (mType = TType.TTrigData) then wr.put('{}'#10) else wr.put('null;'#10);
1264         end
1265         else if (Length(mRecRef.mId) = 0) then
1266         begin
1267           mRecRef.writeTo(wr, false); // only data, no header
1268         end
1269         else
1270         begin
1271           wr.put(mRecRef.mId);
1272           wr.put(';'#10);
1273         end;
1274         exit;
1275       end;
1276     TEBS.TEnum:
1277       begin
1278         //def := mOwner.mOwner;
1279         //es := def.findEBSType(mEBSTypeName);
1280         es := nil;
1281         if (mEBSType <> nil) and (mEBSType is TDynEBS) then es := (mEBSType as TDynEBS);
1282         if (es = nil) or (not es.mIsEnum) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1283         for f := 0 to High(es.mVals) do
1284         begin
1285           if (es.mVals[f] = mIVal) then
1286           begin
1287             wr.put(es.mIds[f]);
1288             wr.put(';'#10);
1289             exit;
1290           end;
1291         end;
1292         raise Exception.Create(Format('value %d in record enum type ''%s'' for field ''%s'' not found', [mIVal, mEBSTypeName, mName]));
1293       end;
1294     TEBS.TBitSet:
1295       begin
1296         //def := mOwner.mOwner;
1297         //es := def.findEBSType(mEBSTypeName);
1298         es := nil;
1299         if (mEBSType <> nil) and (mEBSType is TDynEBS) then es := (mEBSType as TDynEBS);
1300         if (es = nil) or es.mIsEnum then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1301         // none?
1302         if (mIVal = 0) then
1303         begin
1304           for f := 0 to High(es.mVals) do
1305           begin
1306             if (es.mVals[f] = 0) then
1307             begin
1308               wr.put(es.mIds[f]);
1309               wr.put(';'#10);
1310               exit;
1311             end;
1312           end;
1313           raise Exception.Create(Format('value %d in record bitset type ''%s'' for field ''%s'' not found', [0, mEBSTypeName, mName]));
1314         end;
1315         // not none
1316         mask := 1;
1317         first := true;
1318         while (mask <> 0) do
1319         begin
1320           if ((mIVal and mask) <> 0) then
1321           begin
1322             found := false;
1323             for f := 0 to High(es.mVals) do
1324             begin
1325               if (es.mVals[f] = mask) then
1326               begin
1327                 if not first then wr.put('+') else first := false;
1328                 wr.put(es.mIds[f]);
1329                 found := true;
1330                 break;
1331               end;
1332             end;
1333             if not found then raise Exception.Create(Format('value %d in record bitset type ''%s'' for field ''%s'' not found', [mask, mEBSTypeName, mName]));
1334           end;
1335           mask := mask shl 1;
1336         end;
1337         wr.put(';'#10);
1338         exit;
1339       end;
1340     else raise Exception.Create('ketmar forgot to handle some EBS type');
1341   end;
1342
1343   case mType of
1344     TType.TBool:
1345       begin
1346         if (mIVal = 0) then wr.put('false;'#10) else wr.put('true;'#10);
1347         exit;
1348       end;
1349     TType.TChar:
1350       begin
1351         if (mMaxDim = 0) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
1352         wr.put(quoteStr(mSVal));
1353         wr.put(';'#10);
1354         exit;
1355       end;
1356     TType.TByte,
1357     TType.TUByte,
1358     TType.TShort,
1359     TType.TUShort,
1360     TType.TInt,
1361     TType.TUInt:
1362       begin
1363         wr.put('%d;'#10, [mIVal]);
1364         exit;
1365       end;
1366     TType.TString:
1367       begin
1368         wr.put(quoteStr(mSVal));
1369         wr.put(';'#10);
1370         exit;
1371       end;
1372     TType.TPoint,
1373     TType.TSize:
1374       begin
1375         wr.put('(%d %d);'#10, [mIVal, mIVal2]);
1376         exit;
1377       end;
1378     TType.TList:
1379       begin
1380         assert(false);
1381         exit;
1382       end;
1383     TType.TTrigData:
1384       begin
1385         assert(false);
1386         exit;
1387       end;
1388     else raise Exception.Create('ketmar forgot to handle some field type');
1389   end;
1390   raise Exception.Create(Format('cannot parse field ''%s'' yet', [mName]));
1391 end;
1392
1393
1394 procedure TDynField.parseBinValue (st: TStream);
1395 var
1396   rec, rc: TDynRecord;
1397   tfld: TDynField;
1398   es: TDynEBS = nil;
1399   tdata: PByte = nil;
1400   f, mask: Integer;
1401   s: AnsiString;
1402 begin
1403   case mEBS of
1404     TEBS.TNone: begin end;
1405     TEBS.TRec:
1406       begin
1407         // this must be triggerdata
1408         if (mType = TType.TTrigData) then
1409         begin
1410           assert(mMaxDim > 0);
1411           rec := mOwner;
1412           // find trigger definition
1413           tfld := rec.trigTypeField();
1414           if (tfld = nil) then raise Exception.Create(Format('triggerdata value for field ''%s'' in record ''%s'' without TriggerType field', [mName, rec.mName]));
1415           rc := mOwner.mOwner.findTrigFor(tfld.mSVal); // find in mapdef
1416           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]));
1417           rc := rc.clone();
1418           rc.mHeaderRec := mOwner.mHeaderRec;
1419           try
1420             rc.parseBinValue(st, true);
1421             mRecRef := rc;
1422             rc := nil;
1423           finally
1424             rc.Free();
1425           end;
1426           mDefined := true;
1427           exit;
1428         end
1429         else
1430         begin
1431           // not a trigger data
1432           case mType of
1433             TType.TByte: f := readShortInt(st);
1434             TType.TUByte: f := readByte(st);
1435             TType.TShort: f := readSmallInt(st);
1436             TType.TUShort: f := readWord(st);
1437             TType.TInt: f := readLongInt(st);
1438             TType.TUInt: f := readLongWord(st);
1439             else raise Exception.Create(Format('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName]));
1440           end;
1441           if mAsMonsterId then Dec(f);
1442           if (f < 0) then mRecRefId := '' else mRecRefId := Format('%s%d', [mEBSTypeName, f]);
1443         end;
1444         mDefined := true;
1445         exit;
1446       end;
1447     TEBS.TEnum,
1448     TEBS.TBitSet:
1449       begin
1450         assert(mMaxDim < 0);
1451         case mType of
1452           TType.TByte: f := readShortInt(st);
1453           TType.TUByte: f := readByte(st);
1454           TType.TShort: f := readSmallInt(st);
1455           TType.TUShort: f := readWord(st);
1456           TType.TInt: f := readLongInt(st);
1457           TType.TUInt: f := readLongWord(st);
1458           else raise Exception.Create(Format('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName]));
1459         end;
1460         es := nil;
1461         if (mEBSType <> nil) and (mEBSType is TDynEBS) then es := (mEBSType as TDynEBS);
1462         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]));
1463         mIVal := f;
1464         // build enum/bitfield values
1465         if (mEBS = TEBS.TEnum) then
1466         begin
1467           mSVal := es.nameByValue(mIVal);
1468           if (Length(mSVal) = 0) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mIVal]));
1469         end
1470         else
1471         begin
1472           // special for 'none'
1473           if (mIVal = 0) then
1474           begin
1475             mSVal := es.nameByValue(mIVal);
1476             if (Length(mSVal) = 0) then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mIVal]));
1477           end
1478           else
1479           begin
1480             mSVal := '';
1481             mask := 1;
1482             while (mask <> 0) do
1483             begin
1484               if ((mIVal and mask) <> 0) then
1485               begin
1486                 s := es.nameByValue(mask);
1487                 if (Length(s) = 0) then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mask]));
1488                 if (Length(mSVal) <> 0) then mSVal += '+';
1489                 mSVal += s;
1490               end;
1491               mask := mask shl 1;
1492             end;
1493           end;
1494         end;
1495         //writeln('ebs <', es.mName, '>: ', mSVal);
1496         mDefined := true;
1497         exit;
1498       end;
1499     else raise Exception.Create('ketmar forgot to handle some EBS type');
1500   end;
1501
1502   case mType of
1503     TType.TBool:
1504       begin
1505         f := readByte(st);
1506         if (f <> 0) then f := 1;
1507         if mNegBool then f := 1-f;
1508         mIVal := f;
1509         mDefined := true;
1510         exit;
1511       end;
1512     TType.TChar:
1513       begin
1514         if (mMaxDim < 0) then
1515         begin
1516           mIVal := readByte(st);
1517         end
1518         else
1519         begin
1520           mSVal := '';
1521           GetMem(tdata, mMaxDim);
1522           try
1523             st.ReadBuffer(tdata^, mMaxDim);
1524             f := 0;
1525             while (f < mMaxDim) and (tdata[f] <> 0) do Inc(f);
1526             if (f > 0) then
1527             begin
1528               SetLength(mSVal, f);
1529               Move(tdata^, PChar(mSVal)^, f);
1530               mSVal := win2utf(mSVal);
1531             end;
1532           finally
1533             FreeMem(tdata);
1534           end;
1535         end;
1536         mDefined := true;
1537         exit;
1538       end;
1539     TType.TByte: begin mIVal := readShortInt(st); mDefined := true; exit; end;
1540     TType.TUByte: begin mIVal := readByte(st); mDefined := true; exit; end;
1541     TType.TShort: begin mIVal := readSmallInt(st); mDefined := true; exit; end;
1542     TType.TUShort: begin mIVal := readWord(st); mDefined := true; exit; end;
1543     TType.TInt: begin mIVal := readLongInt(st); mDefined := true; exit; end;
1544     TType.TUInt: begin mIVal := readLongWord(st); mDefined := true; exit; end;
1545     TType.TString:
1546       begin
1547         raise Exception.Create('cannot read strings from binaries yet');
1548         exit;
1549       end;
1550     TType.TPoint:
1551       begin
1552         mIVal := readLongInt(st);
1553         mIVal2 := readLongInt(st);
1554         mDefined := true;
1555         exit;
1556       end;
1557     TType.TSize:
1558       begin
1559         mIVal := readWord(st);
1560         mIVal2 := readWord(st);
1561         mDefined := true;
1562         exit;
1563       end;
1564     TType.TList:
1565       begin
1566         assert(false);
1567         exit;
1568       end;
1569     TType.TTrigData:
1570       begin
1571         assert(false);
1572         exit;
1573       end;
1574     else raise Exception.Create('ketmar forgot to handle some field type');
1575   end;
1576   raise Exception.Create(Format('cannot parse field ''%s'' yet', [mName]));
1577 end;
1578
1579
1580 procedure TDynField.parseValue (pr: TTextParser);
1581
1582   procedure parseInt (min, max: Integer);
1583   begin
1584     mIVal := pr.expectInt();
1585     if (mIVal < min) or (mIVal > max) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
1586     mDefined := true;
1587   end;
1588
1589 var
1590   rec, rc: TDynRecord;
1591   es: TDynEBS = nil;
1592   tfld: TDynField;
1593   tk: AnsiString;
1594   edim: AnsiChar;
1595 begin
1596   // if this field should contain struct, convert type and parse struct
1597   case mEBS of
1598     TEBS.TNone: begin end;
1599     TEBS.TRec:
1600       begin
1601         // ugly hack. sorry.
1602         if (mType = TType.TTrigData) then
1603         begin
1604           pr.expectTT(pr.TTBegin);
1605           if (pr.tokType = pr.TTEnd) then
1606           begin
1607             // '{}'
1608             mRecRef := nil;
1609             pr.expectTT(pr.TTEnd);
1610           end
1611           else
1612           begin
1613             rec := mOwner;
1614             // find trigger definition
1615             tfld := rec.trigTypeField();
1616             if (tfld = nil) then raise Exception.Create(Format('triggerdata value for field ''%s'' in record ''%s'' without ''type'' field', [mName, rec.mName]));
1617             rc := mOwner.mOwner.findTrigFor(tfld.mSVal); // find in mapdef
1618             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]));
1619             rc := rc.clone();
1620             rc.mHeaderRec := mOwner.mHeaderRec;
1621             //writeln(rc.definition);
1622             try
1623               rc.parseValue(pr, true);
1624               mRecRef := rc;
1625               rc := nil;
1626             finally
1627               rc.Free();
1628             end;
1629           end;
1630           mDefined := true;
1631           pr.eatTT(pr.TTSemi); // hack: allow (but don't require) semicolon after inline records
1632           exit;
1633         end;
1634         // other record types
1635         if (pr.tokType = pr.TTId) then
1636         begin
1637           if pr.eatId('null') then
1638           begin
1639             mRecRef := nil;
1640           end
1641           else
1642           begin
1643             rec := mOwner.findRecordByTypeId(mEBSTypeName, pr.tokStr);
1644             if (rec = nil) then raise Exception.Create(Format('record ''%s'' (%s) value for field ''%s'' not found', [pr.tokStr, mEBSTypeName, mName]));
1645             pr.expectId();
1646             mRecRef := rec;
1647           end;
1648           mDefined := true;
1649           pr.expectTT(pr.TTSemi);
1650           exit;
1651         end
1652         else if (pr.tokType = pr.TTBegin) then
1653         begin
1654           //rec := mOwner.mOwner.findRecType(mEBSTypeName); // find in mapdef
1655           rec := nil;
1656           if (mEBSType <> nil) and (mEBSType is TDynRecord) then rec := (mEBSType as TDynRecord);
1657           if (rec = nil) then raise Exception.Create(Format('record type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1658           rc := rec.clone();
1659           rc.mHeaderRec := mOwner.mHeaderRec;
1660           rc.parseValue(pr);
1661           mRecRef := rc;
1662           mDefined := true;
1663           if mOwner.addRecordByType(mEBSTypeName, rc) then
1664           begin
1665             //raise Exception.Create(Format('record type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1666             e_LogWritefln('duplicate record with id ''%s'' for field ''%s'' in record ''%s''', [rc.mId, mName, mOwner.mName]);
1667           end;
1668           pr.eatTT(pr.TTSemi); // hack: allow (but don't require) semicolon after inline records
1669           exit;
1670         end;
1671         pr.expectTT(pr.TTBegin);
1672       end;
1673     TEBS.TEnum:
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 (not es.mIsEnum) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1679         tk := pr.expectId();
1680         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]));
1681         mIVal := es.field[tk];
1682         mSVal := tk;
1683         //writeln('ENUM ', mEBSName, '; element <', mSVal, '> with value ', mIVal);
1684         mDefined := true;
1685         pr.expectTT(pr.TTSemi);
1686         exit;
1687       end;
1688     TEBS.TBitSet:
1689       begin
1690         //es := mOwner.mOwner.findEBSType(mEBSTypeName); // find in mapdef
1691         es := nil;
1692         if (mEBSType <> nil) and (mEBSType is TDynEBS) then es := (mEBSType as TDynEBS);
1693         if (es = nil) or es.mIsEnum then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1694         mIVal := 0;
1695         while true do
1696         begin
1697           tk := pr.expectId();
1698           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]));
1699           mIVal := mIVal or es.field[tk];
1700           mSVal := tk;
1701           if (pr.tokType <> pr.TTDelim) or ((pr.tokChar <> '|') and (pr.tokChar <> '+')) then break;
1702           if mBitSetUnique then raise Exception.Create(Format('record bitset of type ''%s'' for field ''%s'' expects only one value', [tk, mEBSTypeName, mName]));
1703           //pr.expectDelim('|');
1704           pr.skipToken(); // plus or pipe
1705         end;
1706         mDefined := true;
1707         pr.expectTT(pr.TTSemi);
1708         exit;
1709       end;
1710     else raise Exception.Create('ketmar forgot to handle some EBS type');
1711   end;
1712
1713   case mType of
1714     TType.TBool:
1715       begin
1716              if pr.eatId('true') or pr.eatId('tan') or pr.eatId('yes') then mIVal := 1
1717         else if pr.eatId('false') or pr.eatId('ona') or pr.eatId('no') then mIVal := 0
1718         else raise Exception.Create(Format('invalid bool value for field ''%s''', [mName]));
1719         mDefined := true;
1720         pr.expectTT(pr.TTSemi);
1721         exit;
1722       end;
1723     TType.TChar:
1724       begin
1725         if (mMaxDim = 0) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
1726         mSVal := pr.expectStr(true);
1727         if (mMaxDim < 0) then
1728         begin
1729           // single char
1730           if (Length(mSVal) <> 1) then raise Exception.Create(Format('invalid string size for field ''%s''', [mName]));
1731           mIVal := Integer(mSVal[1]);
1732           mSVal := '';
1733         end
1734         else
1735         begin
1736           // string
1737           if (Length(mSVal) > mMaxDim) then raise Exception.Create(Format('invalid string size for field ''%s''', [mName]));
1738         end;
1739         mDefined := true;
1740         pr.expectTT(pr.TTSemi);
1741         exit;
1742       end;
1743     TType.TByte:
1744       begin
1745         parseInt(-128, 127);
1746         pr.expectTT(pr.TTSemi);
1747         exit;
1748       end;
1749     TType.TUByte:
1750       begin
1751         parseInt(0, 255);
1752         pr.expectTT(pr.TTSemi);
1753         exit;
1754       end;
1755     TType.TShort:
1756       begin
1757         parseInt(-32768, 32768);
1758         pr.expectTT(pr.TTSemi);
1759         exit;
1760       end;
1761     TType.TUShort:
1762       begin
1763         parseInt(0, 65535);
1764         pr.expectTT(pr.TTSemi);
1765         exit;
1766       end;
1767     TType.TInt:
1768       begin
1769         parseInt(Integer($80000000), $7fffffff);
1770         pr.expectTT(pr.TTSemi);
1771         exit;
1772       end;
1773     TType.TUInt:
1774       begin
1775         parseInt(0, $7fffffff); //FIXME
1776         pr.expectTT(pr.TTSemi);
1777         exit;
1778       end;
1779     TType.TString:
1780       begin
1781         mSVal := pr.expectStr(true);
1782         mDefined := true;
1783         pr.expectTT(pr.TTSemi);
1784         exit;
1785       end;
1786     TType.TPoint,
1787     TType.TSize:
1788       begin
1789         if pr.eatDelim('[') then edim := ']' else begin pr.expectDelim('('); edim := ')'; end;
1790         mIVal := pr.expectInt();
1791         if (mType = TType.TSize) then
1792         begin
1793           if (mIVal < 0) or (mIVal > 32767) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
1794         end;
1795         mIVal2 := pr.expectInt();
1796         if (mType = TType.TSize) then
1797         begin
1798           if (mIVal2 < 0) or (mIVal2 > 32767) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
1799         end;
1800         mDefined := true;
1801         pr.expectDelim(edim);
1802         pr.expectTT(pr.TTSemi);
1803         exit;
1804       end;
1805     TType.TList:
1806       begin
1807         assert(false);
1808         exit;
1809       end;
1810     TType.TTrigData:
1811       begin
1812         assert(false);
1813         exit;
1814       end;
1815     else raise Exception.Create('ketmar forgot to handle some field type');
1816   end;
1817   raise Exception.Create(Format('cannot parse field ''%s'' yet', [mName]));
1818 end;
1819
1820
1821 // ////////////////////////////////////////////////////////////////////////// //
1822 constructor TDynRecord.Create (pr: TTextParser);
1823 begin
1824   if (pr = nil) then raise Exception.Create('cannot create record type without type definition');
1825   mId := '';
1826   mName := '';
1827   mSize := 0;
1828   mFields := TDynFieldList.Create();
1829   {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1830   mFieldsHash := hashNewStrInt();
1831   {$ENDIF}
1832   mTrigTypes := nil;
1833   mHeader := false;
1834   mHeaderRec := nil;
1835   mBinBlock := -1;
1836   mTagInt := 0;
1837   mTagPtr := nil;
1838   parseDef(pr);
1839 end;
1840
1841
1842 constructor TDynRecord.Create ();
1843 begin
1844   mName := '';
1845   mSize := 0;
1846   mFields := TDynFieldList.Create();
1847   {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1848   mFieldsHash := hashNewStrInt();
1849   {$ENDIF}
1850   mTrigTypes := nil;
1851   mHeader := false;
1852   mHeaderRec := nil;
1853   mTagInt := 0;
1854   mTagPtr := nil;
1855 end;
1856
1857
1858 destructor TDynRecord.Destroy ();
1859 begin
1860   mName := '';
1861   mFields.Free();
1862   mFields := nil;
1863   {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1864   mFieldsHash.Free();
1865   mFieldsHash := nil;
1866   {$ENDIF}
1867   mTrigTypes := nil;
1868   mHeaderRec := nil;
1869   mTagInt := 0;
1870   mTagPtr := nil;
1871   inherited;
1872 end;
1873
1874
1875 procedure TDynRecord.addField (fld: TDynField); inline;
1876 begin
1877   if (fld = nil) then raise Exception.Create('cannot append nil field to record');
1878   mFields.append(fld);
1879   {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1880   if (Length(fld.mName) > 0) then mFieldsHash.put(fld.mName, mFields.count-1);
1881   {$ENDIF}
1882 end;
1883
1884
1885 function TDynRecord.addFieldChecked (fld: TDynField): Boolean; inline; // `true`: duplicate name
1886 begin
1887   result := false;
1888   if (fld = nil) then raise Exception.Create('cannot append nil field to record');
1889   {$IF not DEFINED(XDYNREC_USE_FIELDHASH)}
1890   if (Length(fld.mName) > 0) then result := hasByName(fld.mName);
1891   {$ENDIF}
1892   mFields.append(fld);
1893   {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1894   if (Length(fld.mName) > 0) then result := mFieldsHash.put(fld.mName, mFields.count-1);
1895   {$ENDIF}
1896 end;
1897
1898
1899 function TDynRecord.findByName (const aname: AnsiString): Integer; inline;
1900 begin
1901   {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1902   if not mFieldsHash.get(aname, result) then result := -1;
1903   {$ELSE}
1904   result := 0;
1905   while (result < mFields.count) do
1906   begin
1907     if StrEqu(aname, mFields[result].mName) then exit;
1908     Inc(result);
1909   end;
1910   result := -1;
1911   {$ENDIF}
1912 end;
1913
1914
1915 function TDynRecord.hasByName (const aname: AnsiString): Boolean; inline;
1916 begin
1917   result := (findByName(aname) >= 0);
1918 end;
1919
1920
1921 function TDynRecord.getFieldByName (const aname: AnsiString): TDynField; inline;
1922 var
1923   f: Integer;
1924 begin
1925   f := findByName(aname);
1926   if (f >= 0) then result := mFields[f] else result := nil;
1927 end;
1928
1929
1930 function TDynRecord.getFieldAt (idx: Integer): TDynField; inline;
1931 begin
1932   if (idx >= 0) and (idx < mFields.count) then result := mFields[idx] else result := nil;
1933 end;
1934
1935
1936 function TDynRecord.getCount (): Integer; inline;
1937 begin
1938   result := mFields.count;
1939 end;
1940
1941
1942 function TDynRecord.getIsTrigData (): Boolean; inline;
1943 begin
1944   result := (Length(mTrigTypes) > 0);
1945 end;
1946
1947
1948 function TDynRecord.getIsForTrig (const aname: AnsiString): Boolean; inline;
1949 var
1950   f: Integer;
1951 begin
1952   result := true;
1953   for f := 0 to High(mTrigTypes) do if StrEqu(mTrigTypes[f], aname) then exit;
1954   result := false;
1955 end;
1956
1957
1958 function TDynRecord.getForTrigCount (): Integer; inline;
1959 begin
1960   result := Length(mTrigTypes);
1961 end;
1962
1963
1964 function TDynRecord.getForTrigAt (idx: Integer): AnsiString; inline;
1965 begin
1966   if (idx >= 0) and (idx < Length(mTrigTypes)) then result := mTrigTypes[idx] else result := '';
1967 end;
1968
1969
1970 function TDynRecord.clone (): TDynRecord;
1971 var
1972   fld: TDynField;
1973   f: Integer;
1974 begin
1975   result := TDynRecord.Create();
1976   result.mOwner := mOwner;
1977   result.mId := mId;
1978   result.mPasName := mPasName;
1979   result.mName := mName;
1980   result.mSize := mSize;
1981   if (mFields.count > 0) then
1982   begin
1983     result.mFields.capacity := mFields.count;
1984     for fld in mFields do result.addField(fld.clone(result));
1985   end;
1986   SetLength(result.mTrigTypes, Length(mTrigTypes));
1987   for f := 0 to High(mTrigTypes) do result.mTrigTypes[f] := mTrigTypes[f];
1988   result.mHeader := mHeader;
1989   result.mBinBlock := mBinBlock;
1990   result.mHeaderRec := mHeaderRec;
1991   result.mTagInt := mTagInt;
1992   result.mTagPtr := mTagPtr;
1993 end;
1994
1995
1996 function TDynRecord.findRecordByTypeId (const atypename, aid: AnsiString): TDynRecord;
1997 var
1998   fld: TDynField;
1999   idx: Integer;
2000 begin
2001   result := nil;
2002   if (Length(aid) = 0) then exit;
2003   // find record data
2004   fld := mHeaderRec.field[atypename];
2005   if (fld = nil) then exit;
2006   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]));
2007   // find by id
2008   if (fld.mRVal <> nil) then
2009   begin
2010     if fld.mRHash.get(aid, idx) then begin result := fld.mRVal[idx]; exit; end;
2011   end;
2012   // alas
2013 end;
2014
2015
2016 function TDynRecord.findRecordNumByType (const atypename: AnsiString; rc: TDynRecord): Integer;
2017 var
2018   fld: TDynField;
2019   idx: Integer;
2020 begin
2021   result := -1;
2022   // find record data
2023   fld := mHeaderRec.field[atypename];
2024   if (fld = nil) then exit;
2025   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]));
2026   // find by ref
2027   if (fld.mRVal <> nil) then
2028   begin
2029     for idx := 0 to fld.mRVal.count-1 do
2030     begin
2031       if (fld.mRVal[idx] = rc) then begin result := idx; exit; end;
2032     end;
2033   end;
2034   // alas
2035 end;
2036
2037
2038 function TDynRecord.addRecordByType (const atypename: AnsiString; rc: TDynRecord): Boolean;
2039 var
2040   fld: TDynField;
2041 begin
2042   // find record data
2043   fld := mHeaderRec.field[atypename];
2044   if (fld = nil) then
2045   begin
2046     // first record
2047     fld := TDynField.Create(atypename, TDynField.TType.TList);
2048     fld.mOwner := mHeaderRec;
2049     mHeaderRec.addField(fld);
2050   end;
2051   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]));
2052   // append
2053   if (fld.mRVal = nil) then
2054   begin
2055     fld.mRVal := TDynRecList.Create();
2056     fld.mRHash := hashNewStrInt();
2057   end;
2058   result := fld.addListItem(rc);
2059 end;
2060
2061
2062 function TDynRecord.isSimpleEqu (rec: TDynRecord): Boolean;
2063 var
2064   f: Integer;
2065 begin
2066   if (rec = nil) then begin result := false; exit; end; // self.mRecRef can't be `nil` here
2067   if (rec = self) then begin result := true; exit; end;
2068   if (mFields.count <> rec.mFields.count) then begin result := false; exit; end;
2069   result := false;
2070   for f := 0 to mFields.count-1 do
2071   begin
2072     if not mFields[f].isSimpleEqu(rec.mFields[f]) then exit;
2073   end;
2074   result := true;
2075 end;
2076
2077
2078 function TDynRecord.trigTypeField (): TDynField;
2079 var
2080   fld: TDynField;
2081   es: TDynEBS = nil;
2082 begin
2083   for fld in mFields do
2084   begin
2085     if (fld.mEBS <> TDynField.TEBS.TEnum) then continue;
2086     if not (fld.mEBSType is TDynEBS) then continue;
2087     es := (fld.mEBSType as TDynEBS);
2088     assert(es <> nil);
2089     if StrEqu(es.mName, 'TriggerType') then begin result := fld; exit; end;
2090   end;
2091   result := nil;
2092 end;
2093
2094
2095 // number of records of the given instance
2096 function TDynRecord.instanceCount (const typename: AnsiString): Integer;
2097 var
2098   fld: TDynField;
2099 begin
2100   result := 0;
2101   fld := field[typename];
2102   if (fld <> nil) and (fld.mType = fld.TType.TList) then result := fld.mRVal.count;
2103 end;
2104
2105
2106 function TDynRecord.getUserVar (const aname: AnsiString): Variant;
2107 var
2108   fld: TDynField;
2109 begin
2110   fld := getFieldByName(aname);
2111   if (fld = nil) then result := Unassigned else result := fld.varvalue;
2112 end;
2113
2114
2115 procedure TDynRecord.setUserVar (const aname: AnsiString; val: Variant);
2116 var
2117   fld: TDynField;
2118 begin
2119   fld := getFieldByName(aname);
2120   if (fld = nil) then
2121   begin
2122     if (Length(aname) = 0) then raise Exception.Create('cannot create nameless user field');
2123     fld := TDynField.Create(aname, val);
2124     fld.mOwner := self;
2125     fld.mInternal := true;
2126     addField(fld);
2127   end
2128   else
2129   begin
2130     fld.varvalue := val;
2131   end;
2132 end;
2133
2134
2135 {
2136 procedure TDynRecord.setUserField (const fldname: AnsiString; v: LongInt);
2137 var
2138   fld: TDynField;
2139 begin
2140   if (Length(fldname) = 0) then exit;
2141   fld := field[fldname];
2142   if (fld <> nil) then
2143   begin
2144     if (fld.mType <> fld.TType.TInt) or (fld.mEBS <> fld.TEBS.TNone) then
2145     begin
2146       raise Exception.Create(Format('invalid user field ''%s'' type', [fld.name]));
2147     end;
2148   end
2149   else
2150   begin
2151     fld := TDynField.Create(fldname, fld.TType.TInt);
2152     fld.mOwner := self;
2153     fld.mIVal := v;
2154     fld.mInternal := true;
2155     fld.mDefined := true;
2156     addField(fld);
2157   end;
2158 end;
2159
2160
2161 procedure TDynRecord.setUserField (const fldname: AnsiString; v: AnsiString);
2162 var
2163   fld: TDynField;
2164 begin
2165   if (Length(fldname) = 0) then exit;
2166   fld := field[fldname];
2167   if (fld <> nil) then
2168   begin
2169     if (fld.mType <> fld.TType.TString) or (fld.mEBS <> fld.TEBS.TNone) then
2170     begin
2171       raise Exception.Create(Format('invalid user field ''%s'' type', [fld.name]));
2172     end;
2173   end
2174   else
2175   begin
2176     fld := TDynField.Create(fldname, fld.TType.TString);
2177     fld.mOwner := self;
2178     fld.mSVal := v;
2179     fld.mInternal := true;
2180     fld.mDefined := true;
2181     addField(fld);
2182   end;
2183 end;
2184
2185
2186 procedure TDynRecord.setUserField (const fldname: AnsiString; v: Boolean);
2187 var
2188   fld: TDynField;
2189 begin
2190   if (Length(fldname) = 0) then exit;
2191   fld := field[fldname];
2192   if (fld <> nil) then
2193   begin
2194     if (fld.mType <> fld.TType.TBool) or (fld.mEBS <> fld.TEBS.TNone) then
2195     begin
2196       raise Exception.Create(Format('invalid user field ''%s'' type', [fld.name]));
2197     end;
2198   end
2199   else
2200   begin
2201     fld := TDynField.Create(fldname, fld.TType.TBool);
2202     fld.mOwner := self;
2203     fld.mIVal := Integer(v);
2204     fld.mInternal := true;
2205     fld.mDefined := true;
2206     addField(fld);
2207   end;
2208 end;
2209 }
2210
2211
2212 procedure TDynRecord.parseDef (pr: TTextParser);
2213 var
2214   fld: TDynField;
2215   tdn: AnsiString;
2216 begin
2217   if pr.eatId('TriggerData') then
2218   begin
2219     pr.expectId('for');
2220     if pr.eatDelim('(') then
2221     begin
2222       while true do
2223       begin
2224         while pr.eatTT(pr.TTComma) do begin end;
2225         if pr.eatDelim(')') then break;
2226         tdn := pr.expectId();
2227         if isForTrig[tdn] then raise Exception.Create(Format('duplicate trigdata ''%s'' trigtype ''%s''', [mName, tdn]));
2228         SetLength(mTrigTypes, Length(mTrigTypes)+1);
2229         mTrigTypes[High(mTrigTypes)] := tdn;
2230       end;
2231     end
2232     else
2233     begin
2234       tdn := pr.expectId();
2235       SetLength(mTrigTypes, 1);
2236       mTrigTypes[0] := tdn;
2237     end;
2238     mName := 'TriggerData';
2239   end
2240   else
2241   begin
2242     mPasName := pr.expectId(); // pascal record name
2243     pr.expectId('is');
2244     mName := pr.expectStr();
2245     while (pr.tokType <> pr.TTBegin) do
2246     begin
2247       if pr.eatId('header') then begin mHeader := true; continue; end;
2248       if pr.eatId('size') then
2249       begin
2250         if (mSize > 0) then raise Exception.Create(Format('duplicate `size` in record ''%s''', [mName]));
2251         mSize := pr.expectInt();
2252         if (mSize < 1) then raise Exception.Create(Format('invalid record ''%s'' size: %d', [mName, mSize]));
2253         pr.expectId('bytes');
2254         continue;
2255       end;
2256       if pr.eatId('binblock') then
2257       begin
2258         if (mBinBlock >= 0) then raise Exception.Create(Format('duplicate `binblock` in record ''%s''', [mName]));
2259         mBinBlock := pr.expectInt();
2260         if (mBinBlock < 1) then raise Exception.Create(Format('invalid record ''%s'' binblock: %d', [mName, mBinBlock]));
2261         continue;
2262       end;
2263     end;
2264   end;
2265
2266   pr.expectTT(pr.TTBegin);
2267   // load fields
2268   while (pr.tokType <> pr.TTEnd) do
2269   begin
2270     fld := TDynField.Create(pr);
2271     //if hasByName(fld.name) then begin fld.Free(); raise Exception.Create(Format('duplicate field ''%s''', [fld.name])); end;
2272     // append
2273     fld.mOwner := self;
2274     if addFieldChecked(fld) then
2275     begin
2276       fld.Free();
2277       raise Exception.Create(Format('duplicate field ''%s''', [fld.name]));
2278     end;
2279     // done with field
2280   end;
2281   pr.expectTT(pr.TTEnd);
2282 end;
2283
2284
2285 function TDynRecord.pasdef (): AnsiString;
2286 var
2287   fld: TDynField;
2288 begin
2289   if isTrigData then
2290   begin
2291     assert(false);
2292     result := '';
2293   end
2294   else
2295   begin
2296     // record
2297     result := '  '+mPasName+' = packed record'#10;
2298   end;
2299   for fld in mFields do
2300   begin
2301     if fld.mInternal then continue;
2302     if (fld.mBinOfs < 0) then continue;
2303     result += '    '+fld.pasdef+#10;
2304   end;
2305   result += '  end;'#10;
2306 end;
2307
2308
2309 function TDynRecord.definition (): AnsiString;
2310 var
2311   f: Integer;
2312 begin
2313   if isTrigData then
2314   begin
2315     // trigger data
2316     result := 'TriggerData for ';
2317     if (Length(mTrigTypes) > 1) then
2318     begin
2319       result += '(';
2320       for f := 0 to High(mTrigTypes) do
2321       begin
2322         if (f <> 0) then result += ', ';
2323         result += mTrigTypes[f];
2324       end;
2325       result += ')';
2326     end
2327     else
2328     begin
2329       result += mTrigTypes[0];
2330     end;
2331   end
2332   else
2333   begin
2334     // record
2335     result := mPasName+' is '+quoteStr(mName);
2336     if (mSize >= 0) then result += Format(' size %d bytes', [mSize]);
2337     if mHeader then result += ' header';
2338   end;
2339   result += ' {'#10;
2340   for f := 0 to mFields.count-1 do
2341   begin
2342     result += '  ';
2343     result += mFields[f].definition;
2344     result += ';'#10;
2345   end;
2346   result += '}';
2347 end;
2348
2349
2350 procedure TDynRecord.parseBinValue (st: TStream; forceData: Boolean=false);
2351 var
2352   sign: string[4];
2353   btype: Integer;
2354   bsize: Integer;
2355   buf: PByte = nil;
2356   loaded: array[0..255] of Boolean;
2357   rec, rect: TDynRecord;
2358   fld: TDynField;
2359   f: Integer;
2360   mst: TSFSMemoryChunkStream = nil;
2361
2362   procedure linkNames (rec: TDynRecord);
2363   var
2364     fld: TDynField;
2365     rt: TDynRecord;
2366   begin
2367     //writeln('*** rec: ', rec.mName, '.', rec.mId, ' (', rec.mFields.count, ')');
2368     for fld in rec.mFields do
2369     begin
2370       if (fld.mType = TDynField.TType.TTrigData) then
2371       begin
2372         if (fld.mRecRef <> nil) then linkNames(fld.mRecRef);
2373         continue;
2374       end;
2375       if (Length(fld.mRecRefId) = 0) then continue;
2376       assert(fld.mEBSType <> nil);
2377       rt := findRecordByTypeId(fld.mEBSTypeName, fld.mRecRefId);
2378       if (rt = nil) then
2379       begin
2380         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);
2381         //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]));
2382       end;
2383       //writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')');
2384       fld.mRecRefId := '';
2385       fld.mRecRef := rt;
2386       fld.mDefined := true;
2387     end;
2388     for fld in rec.mFields do
2389     begin
2390       //writeln('  ', fld.mName);
2391       fld.fixDefaultValue(); // just in case
2392     end;
2393   end;
2394
2395 begin
2396   for f := 0 to High(loaded) do loaded[f] := false;
2397   mst := TSFSMemoryChunkStream.Create(nil, 0);
2398   try
2399     if mHeader and not forceData then
2400     begin
2401       // parse map file as sequence of blocks
2402       sign[0] := #4;
2403       st.ReadBuffer(sign[1], 4);
2404       if (sign <> 'MAP'#1) then raise Exception.Create('invalid binary map signature');
2405       // parse blocks
2406       while (st.position < st.size) do
2407       begin
2408         btype := readByte(st);
2409         if (btype = 0) then break; // no more blocks
2410         readLongWord(st); // reserved
2411         bsize := readLongInt(st);
2412         {$IF DEFINED(D2D_XDYN_DEBUG)}writeln('btype=', btype, '; bsize=', bsize);{$ENDIF}
2413         if (bsize < 0) or (bsize > $1fffffff) then raise Exception.Create(Format('block of type %d has invalid size %d', [btype, bsize]));
2414         if loaded[btype] then raise Exception.Create(Format('block of type %d already loaded', [btype]));
2415         loaded[btype] := true;
2416         // find record type for this block
2417         rect := nil;
2418         for rec in mOwner.recTypes do if (rec.mBinBlock = btype) then begin rect := rec; break; end;
2419         if (rect = nil) then raise Exception.Create(Format('block of type %d has no corresponding record', [btype]));
2420         //writeln('found type ''', rec.mName, ''' for block type ', btype);
2421         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]));
2422         // header?
2423         if (rect.mHeader) then
2424         begin
2425           if (bsize <> mSize) then raise Exception.Create(Format('header block of type %d has invalid number of records', [btype]));
2426           GetMem(buf, bsize);
2427           st.ReadBuffer(buf^, bsize);
2428           mst.setup(buf, mSize);
2429           parseBinValue(mst, true); // force parsing data
2430         end
2431         else
2432         begin
2433           // create list for this type
2434           fld := TDynField.Create(rec.mName, TDynField.TType.TList);
2435           fld.mOwner := self;
2436           addField(fld);
2437           if (bsize > 0) then
2438           begin
2439             GetMem(buf, bsize);
2440             st.ReadBuffer(buf^, bsize);
2441             for f := 0 to (bsize div rec.mSize)-1 do
2442             begin
2443               mst.setup(buf+f*rec.mSize, rec.mSize);
2444               rec := rect.clone();
2445               rec.mHeaderRec := self;
2446               rec.parseBinValue(mst);
2447               rec.mId := Format('%s%d', [rec.mName, f]);
2448               fld.addListItem(rec);
2449               //writeln('parsed ''', rec.mId, '''...');
2450             end;
2451           end;
2452         end;
2453         FreeMem(buf);
2454         buf := nil;
2455         //st.position := st.position+bsize;
2456       end;
2457       // link fields
2458       for fld in mFields do
2459       begin
2460         if (fld.mType <> TDynField.TType.TList) then continue;
2461         for rec in fld.mRVal do linkNames(rec);
2462       end;
2463       exit;
2464     end;
2465
2466     // read fields
2467     if StrEqu(mName, 'TriggerData') then mSize := Integer(st.size-st.position);
2468     if (mSize < 1) then raise Exception.Create(Format('cannot read record of type ''%s'' with unknown size', [mName]));
2469     GetMem(buf, mSize);
2470     st.ReadBuffer(buf^, mSize);
2471     for fld in mFields do
2472     begin
2473       if fld.mInternal then continue;
2474       if (fld.mBinOfs < 0) then continue;
2475       if (fld.mBinOfs >= st.size) then raise Exception.Create(Format('record of type ''%s'' has invalid field ''%s''', [fld.mName]));
2476       mst.setup(buf+fld.mBinOfs, mSize-fld.mBinOfs);
2477       //writeln('parsing ''', mName, '.', fld.mName, '''...');
2478       fld.parseBinValue(mst);
2479     end;
2480   finally
2481     mst.Free();
2482     if (buf <> nil) then FreeMem(buf);
2483   end;
2484 end;
2485
2486
2487 procedure TDynRecord.writeBinTo (st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false);
2488 var
2489   fld: TDynField;
2490   rec, rv: TDynRecord;
2491   buf: PByte = nil;
2492   ws: TStream = nil;
2493   blk, blkmax: Integer;
2494   //f, c: Integer;
2495   bufsz: Integer = 0;
2496   blksz: Integer;
2497 begin
2498   if (trigbufsz < 0) then
2499   begin
2500     if (mBinBlock < 1) then raise Exception.Create('cannot write binary record without block number');
2501     if (mSize < 1) then raise Exception.Create('cannot write binary record without size');
2502     bufsz := mSize;
2503   end
2504   else
2505   begin
2506     bufsz := trigbufsz;
2507   end;
2508   try
2509     GetMem(buf, bufsz);
2510     FillChar(buf^, bufsz, 0);
2511     ws := TSFSMemoryChunkStream.Create(buf, bufsz);
2512
2513     // write normal fields
2514     for fld in mFields do
2515     begin
2516       // record list?
2517       if (fld.mType = fld.TType.TList) then continue; // later
2518       if fld.mInternal then continue;
2519       if (fld.mBinOfs < 0) then continue;
2520       if (fld.mBinOfs >= bufsz) then raise Exception.Create('binary value offset is outside of the buffer');
2521       TSFSMemoryChunkStream(ws).setup(buf+fld.mBinOfs, bufsz-fld.mBinOfs);
2522       //writeln('writing field <', fld.mName, '>');
2523       fld.writeBinTo(ws);
2524     end;
2525
2526     // write block with normal fields
2527     if mHeader and not onlyFields then
2528     begin
2529       //writeln('writing header...');
2530       // signature and version
2531       writeIntBE(st, LongWord($4D415001));
2532       writeInt(st, Byte(mBinBlock)); // type
2533       writeInt(st, LongWord(0)); // reserved
2534       writeInt(st, LongWord(bufsz)); // size
2535     end;
2536     st.WriteBuffer(buf^, bufsz);
2537
2538     ws.Free(); ws := nil;
2539     FreeMem(buf); buf := nil;
2540
2541     // write other blocks, if any
2542     if mHeader and not onlyFields then
2543     begin
2544       // calculate blkmax
2545       blkmax := 0;
2546       for fld in mFields do
2547       begin
2548         // record list?
2549         if (fld.mType = fld.TType.TList) then
2550         begin
2551           if (fld.mRVal = nil) or (fld.mRVal.count = 0) then continue;
2552           rec := mOwner.findRecType(fld.mName);
2553           if (rec = nil) then continue;
2554           if (rec.mBinBlock <= 0) then continue;
2555           if (blkmax < rec.mBinBlock) then blkmax := rec.mBinBlock;
2556         end;
2557       end;
2558       // write blocks
2559       for blk := 1 to blkmax do
2560       begin
2561         if (blk = mBinBlock) then continue;
2562         ws := nil;
2563         for fld in mFields do
2564         begin
2565           // record list?
2566           if (fld.mType = fld.TType.TList) then
2567           begin
2568             if (fld.mRVal = nil) or (fld.mRVal.count = 0) then continue;
2569             rec := mOwner.findRecType(fld.mName);
2570             if (rec = nil) then continue;
2571             if (rec.mBinBlock <> blk) then continue;
2572             if (ws = nil) then ws := TMemoryStream.Create();
2573             for rv in fld.mRVal do rv.writeBinTo(ws);
2574           end;
2575         end;
2576         // flush block
2577         if (ws <> nil) then
2578         begin
2579           blksz := Integer(ws.position);
2580           ws.position := 0;
2581           writeInt(st, Byte(blk)); // type
2582           writeInt(st, LongWord(0)); // reserved
2583           writeInt(st, LongWord(blksz)); // size
2584           st.CopyFrom(ws, blksz);
2585           ws.Free();
2586           ws := nil;
2587         end;
2588       end;
2589       // write end marker
2590       writeInt(st, Byte(0));
2591       writeInt(st, LongWord(0));
2592       writeInt(st, LongWord(0));
2593     end;
2594   finally
2595     ws.Free();
2596     if (buf <> nil) then FreeMem(buf);
2597   end;
2598 end;
2599
2600
2601 procedure TDynRecord.writeTo (wr: TTextWriter; putHeader: Boolean=true);
2602 var
2603   fld: TDynField;
2604   rec: TDynRecord;
2605 begin
2606   if putHeader then
2607   begin
2608     wr.put(mName);
2609     if (Length(mId) > 0) then begin wr.put(' '); wr.put(mId); end;
2610     wr.put(' ');
2611   end;
2612   wr.put('{'#10);
2613   wr.indent();
2614   try
2615     for fld in mFields do
2616     begin
2617       // record list?
2618       if (fld.mType = fld.TType.TList) then
2619       begin
2620         if not mHeader then raise Exception.Create('record list in non-header record');
2621         if (fld.mRVal <> nil) then
2622         begin
2623           for rec in fld.mRVal do
2624           begin
2625             if (Length(rec.mId) = 0) then continue;
2626             wr.putIndent();
2627             rec.writeTo(wr, true);
2628           end;
2629         end;
2630         continue;
2631       end;
2632       if fld.mInternal then continue;
2633       if fld.mOmitDef and fld.isDefaultValue then continue;
2634       wr.putIndent();
2635       fld.writeTo(wr);
2636     end;
2637   finally
2638     wr.unindent();
2639   end;
2640   wr.putIndent();
2641   wr.put('}'#10);
2642 end;
2643
2644
2645 {$IF DEFINED(D2D_DYNREC_PROFILER)}
2646 var
2647   profCloneRec: UInt64 = 0;
2648   profFindRecType: UInt64 = 0;
2649   profFieldSearching: UInt64 = 0;
2650   profListDupChecking: UInt64 = 0;
2651   profAddRecByType: UInt64 = 0;
2652   profFieldValParsing: UInt64 = 0;
2653   profFixDefaults: UInt64 = 0;
2654   profRecValParse: UInt64 = 0;
2655
2656 procedure xdynDumpProfiles ();
2657 begin
2658   writeln('=== XDYNREC PROFILES ===');
2659   writeln('record cloning: ', profCloneRec div 1000, '.', profCloneRec mod 1000, ' milliseconds');
2660   writeln('findRecType   : ', profFindRecType div 1000, '.', profFindRecType mod 1000, ' milliseconds');
2661   writeln('field[]       : ', profFieldSearching div 1000, '.', profFieldSearching mod 1000, ' milliseconds');
2662   writeln('list dup check: ', profListDupChecking div 1000, '.', profListDupChecking mod 1000, ' milliseconds');
2663   writeln('addRecByType  : ', profAddRecByType div 1000, '.', profAddRecByType mod 1000, ' milliseconds');
2664   writeln('field valparse: ', profFieldValParsing div 1000, '.', profFieldValParsing mod 1000, ' milliseconds');
2665   writeln('fix defaults  : ', profFixDefaults div 1000, '.', profFixDefaults mod 1000, ' milliseconds');
2666   writeln('recvalparse   : ', profRecValParse div 1000, '.', profRecValParse mod 1000, ' milliseconds');
2667 end;
2668 {$ENDIF}
2669
2670
2671 procedure TDynRecord.parseValue (pr: TTextParser; beginEaten: Boolean=false);
2672 var
2673   fld: TDynField;
2674   rec: TDynRecord = nil;
2675   trc{, rv}: TDynRecord;
2676   {$IF DEFINED(D2D_DYNREC_PROFILER)}
2677   stt, stall: UInt64;
2678   {$ENDIF}
2679 begin
2680   if (mOwner = nil) then raise Exception.Create(Format('can''t parse record ''%s'' value without owner', [mName]));
2681
2682   {$IF DEFINED(D2D_DYNREC_PROFILER)}stall := curTimeMicro();{$ENDIF}
2683
2684   // not a header?
2685   if not mHeader then
2686   begin
2687     // id?
2688     if (not beginEaten) and (pr.tokType = pr.TTId) then mId := pr.expectId();
2689   end
2690   else
2691   begin
2692     assert(mHeaderRec = self);
2693   end;
2694
2695   //writeln('parsing record <', mName, '>');
2696   if not beginEaten then pr.expectTT(pr.TTBegin);
2697   while (pr.tokType <> pr.TTEnd) do
2698   begin
2699     if (pr.tokType <> pr.TTId) then raise Exception.Create('identifier expected');
2700     //writeln('<', mName, '.', pr.tokStr, '>');
2701
2702     // records
2703     if mHeader then
2704     begin
2705       // add records with this type (if any)
2706       {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2707       trc := mOwner.findRecType(pr.tokStr);
2708       {$IF DEFINED(D2D_DYNREC_PROFILER)}profFindRecType := curTimeMicro()-stt;{$ENDIF}
2709       if (trc <> nil) then
2710       begin
2711         {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2712         rec := trc.clone();
2713         {$IF DEFINED(D2D_DYNREC_PROFILER)}profCloneRec := curTimeMicro()-stt;{$ENDIF}
2714         rec.mHeaderRec := mHeaderRec;
2715         try
2716           pr.skipToken();
2717           rec.parseValue(pr);
2718           (*
2719           if (Length(rec.mId) > 0) then
2720           begin
2721             {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2722             fld := field[pr.tokStr];
2723             {$IF DEFINED(D2D_DYNREC_PROFILER)}profFieldSearching := curTimeMicro()-stt;{$ENDIF}
2724             (*
2725             if (fld <> nil) and (fld.mRVal <> nil) then
2726             begin
2727               {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2728               //idtmp := trc.mName+':'+rec.mId;
2729               //if ids.put(idtmp, 1) then raise Exception.Create(Format('duplicate thing ''%s'' in record ''%s''', [fld.mName, mName]));
2730               if fld.mRHash.has(rec.mId) then raise Exception.Create(Format('duplicate thing ''%s'' in record ''%s''', [fld.mName, mName]));
2731               {$IF DEFINED(D2D_DYNREC_PROFILER)}profListDupChecking := curTimeMicro()-stt;{$ENDIF}
2732             end;
2733           end;
2734           *)
2735           {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2736           addRecordByType(rec.mName, rec);
2737           {$IF DEFINED(D2D_DYNREC_PROFILER)}profAddRecByType := curTimeMicro()-stt;{$ENDIF}
2738           rec := nil;
2739         finally
2740           rec.Free();
2741         end;
2742         continue;
2743       end;
2744     end;
2745
2746     // fields
2747     {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2748     fld := field[pr.tokStr];
2749     {$IF DEFINED(D2D_DYNREC_PROFILER)}profFieldSearching := curTimeMicro()-stt;{$ENDIF}
2750     if (fld <> nil) then
2751     begin
2752       if fld.defined then raise Exception.Create(Format('duplicate field ''%s'' in record ''%s''', [fld.mName, mName]));
2753       if fld.internal then raise Exception.Create(Format('internal field ''%s'' in record ''%s''', [fld.mName, mName]));
2754       pr.skipToken();
2755       {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2756       fld.parseValue(pr);
2757       {$IF DEFINED(D2D_DYNREC_PROFILER)}profFieldValParsing := curTimeMicro()-stt;{$ENDIF}
2758       continue;
2759     end;
2760
2761     // something is wrong
2762     raise Exception.Create(Format('unknown field ''%s'' in record ''%s''', [pr.tokStr, mName]));
2763   end;
2764   pr.expectTT(pr.TTEnd);
2765   // fix field defaults
2766   {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2767   for fld in mFields do fld.fixDefaultValue();
2768   {$IF DEFINED(D2D_DYNREC_PROFILER)}profFixDefaults := curTimeMicro()-stt;{$ENDIF}
2769   //writeln('done parsing record <', mName, '>');
2770   //{$IF DEFINED(D2D_DYNREC_PROFILER)}writeln('stall: ', curTimeMicro()-stall);{$ENDIF}
2771   {$IF DEFINED(D2D_DYNREC_PROFILER)}profRecValParse := curTimeMicro()-stall;{$ENDIF}
2772 end;
2773
2774
2775 // ////////////////////////////////////////////////////////////////////////// //
2776 constructor TDynEBS.Create (pr: TTextParser);
2777 begin
2778   cleanup();
2779   parseDef(pr);
2780 end;
2781
2782
2783 destructor TDynEBS.Destroy ();
2784 begin
2785   cleanup();
2786   inherited;
2787 end;
2788
2789
2790 procedure TDynEBS.cleanup ();
2791 begin
2792   mIsEnum := false;
2793   mName := '';
2794   mIds := nil;
2795   mVals := nil;
2796   mMaxName := '';
2797   mMaxVal := 0;
2798 end;
2799
2800
2801 function TDynEBS.findByName (const aname: AnsiString): Integer;
2802 begin
2803   result := 0;
2804   while (result < Length(mIds)) do
2805   begin
2806     if StrEqu(aname, mIds[result]) then exit;
2807     Inc(result);
2808   end;
2809   result := -1;
2810 end;
2811
2812
2813 function TDynEBS.hasByName (const aname: AnsiString): Boolean; inline;
2814 begin
2815   result := (findByName(aname) >= 0);
2816 end;
2817
2818
2819 function TDynEBS.getFieldByName (const aname: AnsiString): Integer; inline;
2820 var
2821   f: Integer;
2822 begin
2823   f := findByName(aname);
2824   if (f >= 0) then result := mVals[f] else result := 0;
2825 end;
2826
2827
2828 function TDynEBS.definition (): AnsiString;
2829 var
2830   f, cv: Integer;
2831 begin
2832   if mIsEnum then result :='enum ' else result := 'bitset ';
2833   result += mName;
2834   result += ' {'#10;
2835   // fields
2836   if mIsEnum then cv := 0 else cv := 1;
2837   for f := 0 to High(mIds) do
2838   begin
2839     if (mIds[f] = mMaxName) then continue;
2840     result += '  '+mIds[f];
2841     if (mVals[f] <> cv) then
2842     begin
2843       result += Format(' = %d', [mVals[f]]);
2844       if mIsEnum then cv := mVals[f];
2845       result += ','#10;
2846     end
2847     else
2848     begin
2849       result += Format(', // %d'#10, [mVals[f]]);
2850     end;
2851     if mIsEnum then Inc(cv) else if (mVals[f] = cv) then cv := cv shl 1;
2852   end;
2853   // max field
2854   if (Length(mMaxName) > 0) then result += '  '+mMaxName+' = MAX,'#10;
2855   result += '}';
2856 end;
2857
2858
2859 function TDynEBS.pasdef (): AnsiString;
2860 var
2861   f: Integer;
2862 begin
2863   result := '// '+mName+#10'const'#10;
2864   // fields
2865   for f := 0 to High(mIds) do
2866   begin
2867     result += formatstrf('  %s = %d;'#10, [mIds[f], mVals[f]]);
2868   end;
2869 end;
2870
2871
2872 function TDynEBS.nameByValue (v: Integer): AnsiString;
2873 var
2874   f: Integer;
2875 begin
2876   for f := 0 to High(mVals) do
2877   begin
2878     if (mVals[f] = v) then begin result := mIds[f]; exit; end;
2879   end;
2880   result := '';
2881 end;
2882
2883
2884 procedure TDynEBS.parseDef (pr: TTextParser);
2885 var
2886   idname: AnsiString;
2887   cv, v: Integer;
2888   f: Integer;
2889   skipAdd: Boolean;
2890   hasV: Boolean;
2891 begin
2892        if pr.eatId('enum') then mIsEnum := true
2893   else if pr.eatId('bitset') then mIsEnum := false
2894   else pr.expectId('enum');
2895   mName := pr.expectId();
2896   mMaxVal := Integer($80000000);
2897   if mIsEnum then cv := 0 else cv := 1;
2898   pr.expectTT(pr.TTBegin);
2899   while (pr.tokType <> pr.TTEnd) do
2900   begin
2901     idname := pr.expectId();
2902     for f := 0 to High(mIds) do
2903     begin
2904       if StrEqu(mIds[f], idname) then raise Exception.Create(Format('duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName]));
2905     end;
2906     if StrEqu(mMaxName, idname) then raise Exception.Create(Format('duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName]));
2907     skipAdd := false;
2908     hasV := false;
2909     v := cv;
2910     // has value?
2911     if pr.eatDelim('=') then
2912     begin
2913       if pr.eatId('MAX') then
2914       begin
2915         if (Length(mMaxName) > 0) then raise Exception.Create(Format('duplicate max field ''%s'' in enum/bitset ''%s''', [idname, mName]));
2916         mMaxName := idname;
2917         skipAdd := true;
2918       end
2919       else
2920       begin
2921         v := pr.expectInt();
2922           if mIsEnum then cv := v;
2923         hasV := true;
2924       end;
2925     end;
2926     // append it?
2927     if not skipAdd then
2928     begin
2929       // fix maxvalue
2930       if mIsEnum or (not hasV) then
2931       begin
2932         if (mMaxVal < v) then mMaxVal := v;
2933       end;
2934       SetLength(mIds, Length(mIds)+1);
2935       mIds[High(mIds)] := idname;
2936       SetLength(mVals, Length(mIds));
2937       mVals[High(mVals)] := v;
2938       // next cv
2939       if mIsEnum or (not hasV) then
2940       begin
2941         if mIsEnum then Inc(cv) else cv := cv shl 1;
2942       end;
2943     end;
2944     if (pr.tokType = pr.TTEnd) then break;
2945     pr.expectTT(pr.TTComma);
2946     while pr.eatTT(pr.TTComma) do begin end;
2947   end;
2948   pr.expectTT(pr.TTEnd);
2949   // add max field
2950   if (Length(mMaxName) > 0) then
2951   begin
2952     SetLength(mIds, Length(mIds)+1);
2953     mIds[High(mIds)] := mMaxName;
2954     SetLength(mVals, Length(mIds));
2955     mVals[High(mVals)] := mMaxVal;
2956   end;
2957 end;
2958
2959
2960 // ////////////////////////////////////////////////////////////////////////// //
2961 constructor TDynMapDef.Create (pr: TTextParser);
2962 begin
2963   recTypes := TDynRecList.Create();
2964   trigTypes := TDynRecList.Create();
2965   ebsTypes := TDynEBSList.Create();
2966   parseDef(pr);
2967 end;
2968
2969
2970 destructor TDynMapDef.Destroy ();
2971 var
2972   rec: TDynRecord;
2973   ebs: TDynEBS;
2974 begin
2975   for rec in recTypes do rec.Free();
2976   for rec in trigTypes do rec.Free();
2977   for ebs in ebsTypes do ebs.Free();
2978   recTypes.Free();
2979   trigTypes.Free();
2980   ebsTypes.Free();
2981   recTypes := nil;
2982   trigTypes := nil;
2983   ebsTypes := nil;
2984   inherited;
2985 end;
2986
2987
2988 function TDynMapDef.getHeaderRecType (): TDynRecord; inline;
2989 begin
2990   if (recTypes.count = 0) then raise Exception.Create('no header in empty mapdef');
2991   result := recTypes[0];
2992 end;
2993
2994
2995 function TDynMapDef.findRecType (const aname: AnsiString): TDynRecord;
2996 var
2997   rec: TDynRecord;
2998 begin
2999   for rec in recTypes do
3000   begin
3001     if StrEqu(rec.name, aname) then begin result := rec; exit; end;
3002   end;
3003   result := nil;
3004 end;
3005
3006
3007 function TDynMapDef.findTrigFor (const aname: AnsiString): TDynRecord;
3008 var
3009   rec: TDynRecord;
3010 begin
3011   for rec in trigTypes do
3012   begin
3013     if (rec.isForTrig[aname]) then begin result := rec; exit; end;
3014   end;
3015   result := nil;
3016 end;
3017
3018
3019 function TDynMapDef.findEBSType (const aname: AnsiString): TDynEBS;
3020 var
3021   ebs: TDynEBS;
3022 begin
3023   for ebs in ebsTypes do
3024   begin
3025     if StrEqu(ebs.name, aname) then begin result := ebs; exit; end;
3026   end;
3027   result := nil;
3028 end;
3029
3030
3031 procedure TDynMapDef.parseDef (pr: TTextParser);
3032 var
3033   rec, hdr: TDynRecord;
3034   eb: TDynEBS;
3035   f: Integer;
3036
3037   // setup header links and type links
3038   procedure linkRecord (rec: TDynRecord);
3039   var
3040     fld: TDynField;
3041   begin
3042     rec.mHeaderRec := recTypes[0];
3043     for fld in rec.mFields do
3044     begin
3045       if (fld.mType = fld.TType.TTrigData) then continue;
3046       case fld.mEBS of
3047         TDynField.TEBS.TNone: begin end;
3048         TDynField.TEBS.TRec:
3049           begin
3050             fld.mEBSType := findRecType(fld.mEBSTypeName);
3051             if (fld.mEBSType = nil) then raise Exception.Create(Format('field ''%s'' of type ''%s'' has no correcponding record definition', [fld.mName, fld.mEBSTypeName]));
3052           end;
3053         TDynField.TEBS.TEnum,
3054         TDynField.TEBS.TBitSet:
3055           begin
3056             fld.mEBSType := findEBSType(fld.mEBSTypeName);
3057             if (fld.mEBSType = nil) then raise Exception.Create(Format('field ''%s'' of type ''%s'' has no correcponding enum/bitset', [fld.mName, fld.mEBSTypeName]));
3058             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]));
3059           end;
3060       end;
3061     end;
3062   end;
3063
3064   // setup default values
3065   procedure fixRecordDefaults (rec: TDynRecord);
3066   var
3067     fld: TDynField;
3068   begin
3069     for fld in rec.mFields do if fld.mHasDefault then fld.parseDefaultValue();
3070   end;
3071
3072 begin
3073   hdr := nil;
3074   while true do
3075   begin
3076     if not pr.skipBlanks() then break;
3077     if (pr.tokType <> pr.TTId) then raise Exception.Create('identifier expected');
3078
3079     if (pr.tokStr = 'enum') or (pr.tokStr = 'bitset') then
3080     begin
3081       eb := TDynEBS.Create(pr);
3082       if (findEBSType(eb.name) <> nil) then
3083       begin
3084         eb.Free();
3085         raise Exception.Create(Format('duplicate enum/bitset ''%s''', [eb.name]));
3086       end;
3087       eb.mOwner := self;
3088       ebsTypes.append(eb);
3089       //writeln(eb.definition); writeln;
3090       continue;
3091     end;
3092
3093     if (pr.tokStr = 'TriggerData') then
3094     begin
3095       rec := TDynRecord.Create(pr);
3096       for f := 0 to High(rec.mTrigTypes) do
3097       begin
3098         if (findTrigFor(rec.mTrigTypes[f]) <> nil) then
3099         begin
3100           rec.Free();
3101           raise Exception.Create(Format('duplicate trigdata ''%s''', [rec.mTrigTypes[f]]));
3102         end;
3103       end;
3104       rec.mOwner := self;
3105       trigTypes.append(rec);
3106       //writeln(dr.definition); writeln;
3107       continue;
3108     end;
3109
3110     rec := TDynRecord.Create(pr);
3111     //writeln(dr.definition); writeln;
3112     if (findRecType(rec.name) <> nil) then begin rec.Free(); raise Exception.Create(Format('duplicate record ''%s''', [rec.name])); end;
3113     if (hdr <> nil) and StrEqu(rec.name, hdr.name) then begin rec.Free(); raise Exception.Create(Format('duplicate record ''%s''', [rec.name])); end;
3114     rec.mOwner := self;
3115     if rec.mHeader then
3116     begin
3117       if (hdr <> nil) then begin rec.Free(); raise Exception.Create(Format('duplicate header record ''%s'' (previous is ''%s'')', [rec.name, hdr.name])); end;
3118       hdr := rec;
3119     end
3120     else
3121     begin
3122       recTypes.append(rec);
3123     end;
3124   end;
3125
3126   // put header record to top
3127   if (hdr = nil) then raise Exception.Create('header definition not found in mapdef');
3128   recTypes.append(nil);
3129   for f := recTypes.count-1 downto 1 do recTypes[f] := recTypes[f-1];
3130   recTypes[0] := hdr;
3131
3132   // setup header links and type links
3133   for rec in recTypes do linkRecord(rec);
3134   for rec in trigTypes do linkRecord(rec);
3135
3136   // setup default values
3137   for rec in recTypes do fixRecordDefaults(rec);
3138   for rec in trigTypes do fixRecordDefaults(rec);
3139 end;
3140
3141
3142 // ////////////////////////////////////////////////////////////////////////// //
3143 function TDynMapDef.parseMap (pr: TTextParser): TDynRecord;
3144 var
3145   res: TDynRecord = nil;
3146 begin
3147   result := nil;
3148   try
3149     pr.expectId(headerType.name);
3150     res := headerType.clone();
3151     res.mHeaderRec := res;
3152     res.parseValue(pr);
3153     result := res;
3154     res := nil;
3155   finally
3156     res.Free();
3157   end;
3158 end;
3159
3160
3161 function TDynMapDef.parseBinMap (st: TStream): TDynRecord;
3162 var
3163   res: TDynRecord = nil;
3164 begin
3165   result := nil;
3166   try
3167     res := headerType.clone();
3168     res.mHeaderRec := res;
3169     res.parseBinValue(st);
3170     result := res;
3171     res := nil;
3172   finally
3173     res.Free();
3174   end;
3175 end;
3176
3177
3178 function TDynMapDef.pasdef (): AnsiString;
3179 var
3180   ebs: TDynEBS;
3181   rec: TDynRecord;
3182   fld: TDynField;
3183   needComma: Boolean;
3184   tn: AnsiString;
3185 begin
3186   result := '';
3187   result += '// ////////////////////////////////////////////////////////////////////////// //'#10;
3188   result += '// enums and bitsets'#10;
3189   for ebs in ebsTypes do result += #10+ebs.pasdef();
3190   result += #10#10'// ////////////////////////////////////////////////////////////////////////// //'#10;
3191   result += '// records'#10'type'#10;
3192   for rec in recTypes do
3193   begin
3194     if (rec.mSize < 1) then continue;
3195     result += rec.pasdef();
3196     result += #10;
3197   end;
3198   result += #10#10'// ////////////////////////////////////////////////////////////////////////// //'#10;
3199   result += '// triggerdata'#10'type'#10;
3200   result += '  TTriggerData = record'#10;
3201   result += '    case Byte of'#10;
3202   result += '      0: (Default: Byte128);'#10;
3203   for rec in trigTypes do
3204   begin
3205     result += '      ';
3206     needComma := false;
3207     for tn in rec.mTrigTypes do
3208     begin
3209       if needComma then result += ', ' else needComma := true;
3210       result += tn;
3211     end;
3212     result += ': ('#10;
3213     for fld in rec.mFields do
3214     begin
3215       if fld.mInternal then continue;
3216       if (fld.mBinOfs < 0) then continue;
3217       result += '        '+fld.pasdef+#10;
3218     end;
3219     result += '      );'#10;
3220   end;
3221   result += '  end;'#10;
3222 end;
3223
3224
3225 function TDynMapDef.pasdefconst (): AnsiString;
3226 var
3227   ebs: TDynEBS;
3228 begin
3229   result := '';
3230   result += '// ////////////////////////////////////////////////////////////////////////// //'#10;
3231   result += '// enums and bitsets'#10;
3232   for ebs in ebsTypes do result += #10+ebs.pasdef();
3233 end;
3234
3235
3236 function TDynMapDef.getTrigTypeCount (): Integer; inline; begin result := trigTypes.count; end;
3237 function TDynMapDef.getTrigTypeAt (idx: Integer): TDynRecord; inline; begin if (idx >= 0) and (idx < trigTypes.count) then result := trigTypes[idx] else result := nil; end;
3238
3239
3240 end.