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