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