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