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