src/shared/xdynrec.pas

   1 (* Copyright (C)  DooM 2D:Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, either version 3 of the License, or
   6  * (at your option) any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15  *)
  16 {$INCLUDE a_modes.inc}
  17 {.$DEFINE XDYNREC_USE_FIELDHASH} // actually, it is SLOWER with this
  18 unit xdynrec;
  19
  20 interface
  21
  22 uses
  23   Classes,
  24   xparser, xstreams, utils, hashtable;
  25
  26
  27 // ////////////////////////////////////////////////////////////////////////// //
  28 type
  29   TDynMapDef = class;
  30   TDynRecord = class;
  31   TDynField = class;
  32   TDynEBS = class;
  33
  34   TDynFieldList = specialize TSimpleList<TDynField>;
  35   TDynRecList = specialize TSimpleList<TDynRecord>;
  36   TDynEBSList = specialize TSimpleList<TDynEBS>;
  37
  38   // this is base type for all scalars (and arrays)
  39   TDynField = class
  40   public
  41     type
  42       TType = (TBool, TChar, TByte, TUByte, TShort, TUShort, TInt, TUInt, TString, TPoint, TSize, TList, TTrigData);
  43       // TPoint: pair of Integers
  44       // TSize: pair of UShorts
  45       // TList: actually, array of records
  46       // TTrigData: array of mMaxDim bytes, but internally a record (mRecRef)
  47       // arrays of chars are pascal shortstrings (with counter in the first byte)
  48
  49   private
  50     type
  51       TEBS = (TNone, TRec, TEnum, TBitSet);
  52
  53   private
  54     mOwner: TDynRecord;
  55     mPasName: AnsiString;
  56     mName: AnsiString;
  57     mType: TType;
  58     mIVal: Integer; // for all integer types
  59     mIVal2: Integer; // for point and size
  60     mSVal: AnsiString; // string; for byte and char arrays
  61     mRVal: TDynRecList; // for list
  62     mRHash: THashStrInt; // id -> index in mRVal
  63     mRecRef: TDynRecord; // for TEBS.TRec
  64     mMaxDim: Integer; // for byte and char arrays; <0: not an array; 0: impossible value
  65     mBinOfs: Integer; // offset in binary; <0 - none
  66     mRecOfs: Integer; // offset in record; <0 - none
  67     mSepPosSize: Boolean; // for points and sizes, use separate fields
  68     mAsT: Boolean; // for points and sizes, use separate fields, names starts with `t`
  69     mDefined: Boolean;
  70     mHasDefault: Boolean;
  71     mOmitDef: Boolean;
  72     mInternal: Boolean;
  73     mNegBool: Boolean;
  74     mBitSetUnique: Boolean; // bitset can contain only one value
  75     mAsMonsterId: Boolean; // special hack for triggers: monster record number+1 in binary (so 0 means "none")
  76     // default value
  77     mDefUnparsed: AnsiString;
  78     mDefSVal: AnsiString; // default string value
  79     mDefIVal, mDefIVal2: Integer; // default integer values
  80     mDefRecRef: TDynRecord;
  81     mEBS: TEBS; // complex type type
  82     mEBSTypeName: AnsiString; // name of enum, bitset or record
  83     mEBSType: TObject; // either TDynRecord or TDynEBS; nil means "simple type"; nil for `TTrigData` too
  84
  85     // for binary parser
  86     mRecRefId: AnsiString;
  87
  88   private
  89     procedure cleanup ();
  90
  91     procedure parseDef (pr: TTextParser);
  92
  93     procedure parseDefaultValue (); // parse `mDefUnparsed` to `mDefSVal`, `mDefIVal`, `mDefIVal2`, `mDefRecRef`
  94     procedure fixDefaultValue (); // this will NOT clone `mDefRecRef`
  95     function isDefaultValue (): Boolean;
  96
  97     function getListCount (): Integer; inline;
  98     function getListItem (idx: Integer): TDynRecord; inline; overload;
  99     function getListItem (const aname: AnsiString): TDynRecord; inline; overload;
 100
 101   protected
 102     // returns `true` for duplicate record id
 103     function addListItem (rec: TDynRecord): Boolean; inline;
 104
 105   public
 106     constructor Create (const aname: AnsiString; atype: TType);
 107     constructor Create (pr: TTextParser);
 108     destructor Destroy (); override;
 109
 110     class function getTypeName (t: TType): AnsiString;
 111
 112     function definition (): AnsiString;
 113     function pasdef (): AnsiString;
 114
 115     function clone (newOwner: TDynRecord=nil): TDynField;
 116
 117     procedure parseValue (pr: TTextParser);
 118     procedure parseBinValue (st: TStream);
 119
 120     procedure writeTo (wr: TTextWriter);
 121     procedure writeBinTo (st: TStream);
 122
 123     // won't work for lists
 124     function isSimpleEqu (fld: TDynField): Boolean;
 125
 126     procedure setValue (const s: AnsiString);
 127
 128   public
 129     property pasname: AnsiString read mPasName;
 130     property name: AnsiString read mName;
 131     property baseType: TType read mType;
 132     property defined: Boolean read mDefined write mDefined;
 133     property internal: Boolean read mInternal write mInternal;
 134     property ival: Integer read mIVal;
 135     property sval: AnsiString read mSVal;
 136     property hasDefault: Boolean read mHasDefault;
 137     property defsval: AnsiString read mDefSVal;
 138     property ebs: TEBS read mEBS;
 139     property ebstype: TObject read mEBSType;
 140     property ebstypename: AnsiString read mEBSTypeName; // enum/bitset name
 141     // for lists
 142     property count: Integer read getListCount;
 143     property item[idx: Integer]: TDynRecord read getListItem;
 144     property items[const aname: AnsiString]: TDynRecord read getListItem; default; // alas, FPC 3+ lost property overloading feature
 145
 146     property x: Integer read mIVal;
 147     property w: Integer read mIVal;
 148     property y: Integer read mIVal2;
 149     property h: Integer read mIVal2;
 150   end;
 151
 152
 153   // "value" header record contains TList fields, with name equal to record type
 154   TDynRecord = class
 155   private
 156     mOwner: TDynMapDef;
 157     mId: AnsiString;
 158     mPasName: AnsiString;
 159     mName: AnsiString;
 160     mSize: Integer;
 161     mFields: TDynFieldList;
 162     {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
 163     mFieldsHash: THashStrInt; // id -> index in mRVal
 164     {$ENDIF}
 165     mTrigTypes: array of AnsiString; // if this is triggerdata, we'll hold list of triggers here
 166     mHeader: Boolean; // true for header record
 167     mBinBlock: Integer; // -1: none
 168     mHeaderRec: TDynRecord; // for "value" records this is header record with data, for "type" records this is header type record
 169
 170   private
 171     procedure parseDef (pr: TTextParser); // parse definition
 172
 173     function findByName (const aname: AnsiString): Integer; inline;
 174     function hasByName (const aname: AnsiString): Boolean; inline;
 175     function getFieldByName (const aname: AnsiString): TDynField; inline;
 176
 177     function getIsTrigData (): Boolean; inline;
 178     function getIsForTrig (const aname: AnsiString): Boolean; inline;
 179
 180   protected
 181     function findRecordByTypeId (const atypename, aid: AnsiString): TDynRecord;
 182     function findRecordNumByType (const atypename: AnsiString; rc: TDynRecord): Integer;
 183     function addRecordByType (const atypename: AnsiString; rc: TDynRecord): Boolean; // `true`: duplicate record id
 184
 185     procedure addField (fld: TDynField); inline;
 186     function addFieldChecked (fld: TDynField): Boolean; inline; // `true`: duplicate name
 187
 188   public
 189     constructor Create ();
 190     constructor Create (pr: TTextParser); // parse definition
 191     destructor Destroy (); override;
 192
 193     function definition (): AnsiString;
 194     function pasdef (): AnsiString;
 195
 196     function clone (): TDynRecord;
 197
 198     function isSimpleEqu (rec: TDynRecord): Boolean;
 199
 200     procedure parseValue (pr: TTextParser; beginEaten: Boolean=false);
 201     procedure parseBinValue (st: TStream; forceData: Boolean=false);
 202
 203     procedure writeTo (wr: TTextWriter; putHeader: Boolean=true);
 204     procedure writeBinTo (st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false);
 205
 206     // find field with `TriggerType` type
 207     function trigTypeField (): TDynField;
 208
 209     // number of records of the given instance
 210     function instanceCount (const typename: AnsiString): Integer;
 211
 212   public
 213     property id: AnsiString read mId; // for map parser
 214     property pasname: AnsiString read mPasName;
 215     property name: AnsiString read mName; // record name
 216     property size: Integer read mSize; // size in bytes
 217     //property fields: TDynFieldList read mFields;
 218     property has[const aname: AnsiString]: Boolean read hasByName;
 219     property field[const aname: AnsiString]: TDynField read getFieldByName;
 220     property isTrigData: Boolean read getIsTrigData;
 221     property isForTrig[const aname: AnsiString]: Boolean read getIsForTrig;
 222     property headerType: TDynRecord read mHeaderRec;
 223     property isHeader: Boolean read mHeader;
 224   end;
 225
 226   TDynEBS = class
 227   private
 228     mOwner: TDynMapDef;
 229     mIsEnum: Boolean;
 230     mName: AnsiString;
 231     mIds: array of AnsiString;
 232     mVals: array of Integer;
 233     mMaxName: AnsiString; // MAX field
 234     mMaxVal: Integer; // max value
 235
 236   private
 237     procedure cleanup ();
 238
 239     procedure parseDef (pr: TTextParser); // parse definition
 240
 241     function findByName (const aname: AnsiString): Integer; inline;
 242     function hasByName (const aname: AnsiString): Boolean; inline;
 243     function getFieldByName (const aname: AnsiString): Integer; inline;
 244
 245   public
 246     constructor Create (pr: TTextParser); // parse definition
 247     destructor Destroy (); override;
 248
 249     function definition (): AnsiString;
 250     function pasdef (): AnsiString;
 251
 252     // return empty string if not found
 253     function nameByValue (v: Integer): AnsiString;
 254
 255   public
 256     property name: AnsiString read mName; // record name
 257     property isEnum: Boolean read mIsEnum;
 258     property has[const aname: AnsiString]: Boolean read hasByName;
 259     property field[const aname: AnsiString]: Integer read getFieldByName;
 260   end;
 261
 262
 263   TDynMapDef = class
 264   public
 265     recTypes: TDynRecList; // [0] is always header
 266     trigTypes: TDynRecList; // trigdata
 267     ebsTypes: TDynEBSList; // enums, bitsets
 268
 269   private
 270     procedure parseDef (pr: TTextParser);
 271
 272     function getHeaderRecType (): TDynRecord; inline;
 273
 274   public
 275     constructor Create (pr: TTextParser); // parses data definition
 276     destructor Destroy (); override;
 277
 278     function findRecType (const aname: AnsiString): TDynRecord;
 279     function findTrigFor (const aname: AnsiString): TDynRecord;
 280     function findEBSType (const aname: AnsiString): TDynEBS;
 281
 282     function pasdef (): AnsiString;
 283
 284     // creates new header record
 285     function parseMap (pr: TTextParser): TDynRecord;
 286
 287     // creates new header record
 288     function parseBinMap (st: TStream): TDynRecord;
 289
 290   public
 291     property headerType: TDynRecord read getHeaderRecType;
 292   end;
 293
 294
 295 {$IF DEFINED(D2D_DYNREC_PROFILER)}
 296 procedure xdynDumpProfiles ();
 297 {$ENDIF}
 298
 299
 300 implementation
 301
 302 uses
 303   SysUtils, e_log
 304   {$IF DEFINED(D2D_DYNREC_PROFILER)},xprofiler{$ENDIF};
 305
 306
 307 // ////////////////////////////////////////////////////////////////////////// //
 308 function StrEqu (const a, b: AnsiString): Boolean; inline; begin result := (a = b); end;
 309
 310
 311 // ////////////////////////////////////////////////////////////////////////// //
 312 constructor TDynField.Create (const aname: AnsiString; atype: TType);
 313 begin
 314   mRVal := nil;
 315   mRecRef := nil;
 316   mRHash := nil;
 317   cleanup();
 318   mName := aname;
 319   mType := atype;
 320   if (mType = TType.TList) then
 321   begin
 322     mRVal := TDynRecList.Create();
 323     mRHash := hashNewStrInt();
 324   end;
 325 end;
 326
 327
 328 constructor TDynField.Create (pr: TTextParser);
 329 begin
 330   cleanup();
 331   parseDef(pr);
 332 end;
 333
 334
 335 destructor TDynField.Destroy ();
 336 begin
 337   cleanup();
 338   inherited;
 339 end;
 340
 341
 342 procedure TDynField.cleanup ();
 343 begin
 344   mName := '';
 345   mType := TType.TInt;
 346   mIVal := 0;
 347   mIVal2 := 0;
 348   mSVal := '';
 349   mRVal.Free();
 350   mRVal := nil;
 351   mRHash.Free();
 352   mRHash := nil;
 353   mRecRef := nil;
 354   mMaxDim := -1;
 355   mBinOfs := -1;
 356   mRecOfs := -1;
 357   mSepPosSize := false;
 358   mAsT := false;
 359   mHasDefault := false;
 360   mDefined := false;
 361   mOmitDef := false;
 362   mInternal := true;
 363   mDefUnparsed := '';
 364   mDefSVal := '';
 365   mDefIVal := 0;
 366   mDefIVal2 := 0;
 367   mDefRecRef := nil;
 368   mEBS := TEBS.TNone;
 369   mEBSTypeName := '';
 370   mEBSType := nil;
 371   mBitSetUnique := false;
 372   mAsMonsterId := false;
 373   mNegBool := false;
 374   mRecRefId := '';
 375 end;
 376
 377
 378 function TDynField.clone (newOwner: TDynRecord=nil): TDynField;
 379 var
 380   rec: TDynRecord;
 381 begin
 382   result := TDynField.Create(mName, mType);
 383   result.mOwner := mOwner;
 384   if (newOwner <> nil) then result.mOwner := newOwner else result.mOwner := mOwner;
 385   result.mPasName := mPasName;
 386   result.mName := mName;
 387   result.mType := mType;
 388   result.mIVal := mIVal;
 389   result.mIVal2 := mIVal2;
 390   result.mSVal := mSVal;
 391   if (mRVal <> nil) then
 392   begin
 393     if (result.mRVal = nil) then result.mRVal := TDynRecList.Create(mRVal.count);
 394     if (result.mRHash = nil) then result.mRHash := hashNewStrInt();
 395     for rec in mRVal do result.addListItem(rec.clone());
 396   end;
 397   result.mRecRef := mRecRef;
 398   result.mMaxDim := mMaxDim;
 399   result.mBinOfs := mBinOfs;
 400   result.mRecOfs := mRecOfs;
 401   result.mSepPosSize := mSepPosSize;
 402   result.mAsT := mAsT;
 403   result.mDefined := mDefined;
 404   result.mHasDefault := mHasDefault;
 405   result.mOmitDef := mOmitDef;
 406   result.mInternal := mInternal;
 407   result.mNegBool := mNegBool;
 408   result.mBitSetUnique := mBitSetUnique;
 409   result.mAsMonsterId := mAsMonsterId;
 410   result.mDefUnparsed := mDefUnparsed;
 411   result.mDefSVal := mDefSVal;
 412   result.mDefIVal := mDefIVal;
 413   result.mDefIVal2 := mDefIVal2;
 414   result.mDefRecRef := mDefRecRef;
 415   result.mEBS := mEBS;
 416   result.mEBSTypeName := mEBSTypeName;
 417   result.mEBSType := mEBSType;
 418   result.mRecRefId := mRecRefId;
 419 end;
 420
 421
 422 // won't work for lists
 423 function TDynField.isSimpleEqu (fld: TDynField): Boolean;
 424 begin
 425   if (fld = nil) or (mType <> fld.mType) then begin result := false; exit; end;
 426   case mType of
 427     TType.TBool: result := ((mIVal <> 0) = (fld.mIVal <> 0));
 428     TType.TChar: result := (mSVal = fld.mSVal);
 429     TType.TByte,
 430     TType.TUByte,
 431     TType.TShort,
 432     TType.TUShort,
 433     TType.TInt,
 434     TType.TUInt:
 435       result := (mIVal = fld.mIVal);
 436     TType.TString: result := (mSVal = fld.mSVal);
 437     TType.TPoint,
 438     TType.TSize:
 439       result := ((mIVal = fld.mIVal) and (mIVal2 = fld.mIVal2));
 440     TType.TList: result := false;
 441     TType.TTrigData:
 442       begin
 443         if (mRecRef = nil) then begin result := (fld.mRecRef = nil); exit; end;
 444         result := mRecRef.isSimpleEqu(fld.mRecRef);
 445       end;
 446     else raise Exception.Create('ketmar forgot to handle some field type');
 447   end;
 448 end;
 449
 450
 451 procedure TDynField.setValue (const s: AnsiString);
 452 var
 453   stp: TTextParser;
 454 begin
 455   stp := TStrTextParser.Create(s+';');
 456   try
 457     parseValue(stp);
 458   finally
 459     stp.Free();
 460   end;
 461 end;
 462
 463
 464 procedure TDynField.parseDefaultValue ();
 465 var
 466   stp: TTextParser = nil;
 467   oSVal: AnsiString;
 468   oIVal, oIVal2: Integer;
 469   oRRef: TDynRecord;
 470   oDef: Boolean;
 471 begin
 472   if not mHasDefault then
 473   begin
 474     mDefSVal := '';
 475     mDefIVal := 0;
 476     mDefIVal2 := 0;
 477     mDefRecRef := nil;
 478   end
 479   else
 480   begin
 481     oSVal := mSVal;
 482     oIVal := mIVal;
 483     oIVal2 := mIVal2;
 484     oRRef := mRecRef;
 485     oDef := mDefined;
 486     try
 487       stp := TStrTextParser.Create(mDefUnparsed+';');
 488       parseValue(stp);
 489       mDefSVal := mSVal;
 490       mDefIVal := mIVal;
 491       mDefIVal2 := mIVal2;
 492       mDefRecRef := mRecRef;
 493     finally
 494       mSVal := oSVal;
 495       mIVal := oIVal;
 496       mIVal2 := oIVal2;
 497       mRecRef := oRRef;
 498       mDefined := oDef;
 499       stp.Free();
 500     end;
 501   end;
 502 end;
 503
 504
 505 // default value should be parsed
 506 procedure TDynField.fixDefaultValue ();
 507 begin
 508   if mDefined then exit;
 509   if not mHasDefault then
 510   begin
 511     if mInternal then exit;
 512     raise Exception.Create(Format('field ''%s'' in record ''%s'' of record type ''%s'' is not set', [mName, mOwner.mId, mOwner.mName]));
 513   end;
 514   if (mEBS = TEBS.TRec) then mRecRef := mDefRecRef;
 515   mSVal := mDefSVal;
 516   mIVal := mDefIVal;
 517   mIVal2 := mDefIVal2;
 518   mDefined := true;
 519 end;
 520
 521
 522 // default value should be parsed
 523 function TDynField.isDefaultValue (): Boolean;
 524 begin
 525   if not mHasDefault then begin result := false; exit; end;
 526   if (mEBS = TEBS.TRec) then begin result := (mRecRef = mDefRecRef); exit; end;
 527   case mType of
 528     TType.TChar, TType.TString: result := (mSVal = mDefSVal);
 529     TType.TPoint, TType.TSize: result := (mIVal = mDefIVal2) and (mIVal2 = mDefIVal2);
 530     TType.TList, TType.TTrigData: result := false; // no default values for those types
 531     else result := (mIVal = mDefIVal);
 532   end;
 533 end;
 534
 535
 536 function TDynField.getListCount (): Integer; inline;
 537 begin
 538   if (mRVal <> nil) then result := mRVal.count else result := 0;
 539 end;
 540
 541
 542 function TDynField.getListItem (idx: Integer): TDynRecord; inline; overload;
 543 begin
 544   if (mRVal <> nil) and (idx >= 0) and (idx < mRVal.count) then result := mRVal[idx] else result := nil;
 545 end;
 546
 547
 548 function TDynField.getListItem (const aname: AnsiString): TDynRecord; inline; overload;
 549 var
 550   idx: Integer;
 551 begin
 552   if (mRVal <> nil) and mRHash.get(aname, idx) then result := mRVal[idx] else result := nil;
 553 end;
 554
 555
 556 function TDynField.addListItem (rec: TDynRecord): Boolean; inline;
 557 begin
 558   result := false;
 559   if (mRVal <> nil) then
 560   begin
 561     mRVal.append(rec);
 562     if (Length(rec.mId) > 0) then result := mRHash.put(rec.mId, mRVal.count-1);
 563   end;
 564 end;
 565
 566
 567 class function TDynField.getTypeName (t: TType): AnsiString;
 568 begin
 569   case t of
 570     TType.TBool: result := 'bool';
 571     TType.TChar: result := 'char';
 572     TType.TByte: result := 'byte';
 573     TType.TUByte: result := 'ubyte';
 574     TType.TShort: result := 'short';
 575     TType.TUShort: result := 'ushort';
 576     TType.TInt: result := 'int';
 577     TType.TUInt: result := 'uint';
 578     TType.TString: result := 'string';
 579     TType.TPoint: result := 'point';
 580     TType.TSize: result := 'size';
 581     TType.TList: result := 'array';
 582     TType.TTrigData: result := 'trigdata';
 583     else raise Exception.Create('ketmar forgot to handle some field type');
 584   end;
 585 end;
 586
 587
 588 function TDynField.definition (): AnsiString;
 589 begin
 590   result := mPasName+' is '+quoteStr(mName)+' type ';
 591   result += getTypeName(mType);
 592   if (mMaxDim >= 0) then result += Format('[%d]', [mMaxDim]);
 593   if (mRecOfs >= 0) then result += Format(' offset %d', [mRecOfs]);
 594   case mEBS of
 595     TEBS.TNone: begin end;
 596     TEBS.TRec: result += ' '+mEBSTypeName;
 597     TEBS.TEnum: result += ' enum '+mEBSTypeName;
 598     TEBS.TBitSet: begin result += ' bitset '; if mBitSetUnique then result += 'unique '; result += mEBSTypeName; end;
 599   end;
 600   if mAsMonsterId then result += ' as monsterid';
 601   if mHasDefault and (Length(mDefUnparsed) > 0) then result += ' default '+mDefUnparsed;
 602   if mSepPosSize then
 603   begin
 604          if (mType = TType.TPoint) then begin if (mAsT) then result += ' as txy' else result += ' as xy'; end
 605     else if (mType = TType.TSize) then begin if (mAsT) then result += ' as twh' else result += ' as wh'; end;
 606   end;
 607   if mOmitDef then result += ' omitdefault';
 608   if mInternal then result += ' internal';
 609 end;
 610
 611
 612 function TDynField.pasdef (): AnsiString;
 613 begin
 614   result := mPasName+': ';
 615   case mType of
 616     TType.TBool: result += 'Boolean;';
 617     TType.TChar: if (mMaxDim > 0) then result += formatstrf('Char%d;', [mMaxDim]) else result += 'Char;';
 618     TType.TByte: result += 'ShortInt;';
 619     TType.TUByte: result += 'Byte;';
 620     TType.TShort: result += 'SmallInt;';
 621     TType.TUShort: result += 'Word;';
 622     TType.TInt: result += 'LongInt;';
 623     TType.TUInt: result += 'LongWord;';
 624     TType.TString: result += 'AnsiString;';
 625     TType.TPoint:
 626            if mAsT then result := 'tX, tY: Integer;'
 627       else if mSepPosSize then result := 'X, Y: Integer;'
 628       else result += 'TDFPoint;';
 629     TType.TSize:
 630            if mAsT then result := 'tWidth, tHeight: Word;'
 631       else if mSepPosSize then result := 'Width, Height: Word;'
 632       else result += 'TSize;';
 633     TType.TList: assert(false);
 634     TType.TTrigData: result += formatstrf('Byte%d;', [mMaxDim]);
 635     else raise Exception.Create('ketmar forgot to handle some field type');
 636   end;
 637 end;
 638
 639
 640 procedure TDynField.parseDef (pr: TTextParser);
 641 var
 642   fldname: AnsiString;
 643   fldtype: AnsiString;
 644   fldofs: Integer;
 645   fldrecname: AnsiString;
 646   fldpasname: AnsiString;
 647   asxy, aswh, ast: Boolean;
 648   ainternal: Boolean;
 649   omitdef: Boolean;
 650   defstr: AnsiString;
 651   defint: Integer;
 652   hasdefStr: Boolean;
 653   hasdefInt: Boolean;
 654   hasdefId: Boolean;
 655   lmaxdim: Integer;
 656   lebs: TDynField.TEBS;
 657   unique: Boolean;
 658   asmonid: Boolean;
 659 begin
 660   fldpasname := '';
 661   fldname := '';
 662   fldtype := '';
 663   fldofs := -1;
 664   fldrecname := '';
 665   asxy := false;
 666   aswh := false;
 667   ast := false;
 668   ainternal := false;
 669   omitdef := false;
 670   defstr := '';
 671   defint := 0;
 672   hasdefStr := false;
 673   hasdefInt := false;
 674   hasdefId := false;
 675   unique := false;
 676   asmonid := false;
 677   lmaxdim := -1;
 678   lebs := TDynField.TEBS.TNone;
 679
 680   fldpasname := pr.expectId(); // pascal field name
 681   // field name
 682   pr.expectId('is');
 683   fldname := pr.expectStr();
 684   // field type
 685   pr.expectId('type');
 686   fldtype := pr.expectId();
 687
 688   // fixed-size array?
 689   if pr.eatDelim('[') then
 690   begin
 691     lmaxdim := pr.expectInt();
 692     if (lmaxdim < 1) then raise Exception.Create(Format('invalid field ''%s'' array size', [fldname]));
 693     pr.expectDelim(']');
 694   end;
 695
 696   while (pr.tokType <> pr.TTSemi) do
 697   begin
 698     if pr.eatId('offset') then
 699     begin
 700       if (fldofs >= 0) then raise Exception.Create(Format('duplicate field ''%s'' offset', [fldname]));
 701       fldofs := pr.expectInt();
 702       if (fldofs < 0) then raise Exception.Create(Format('invalid field ''%s'' offset', [fldname]));
 703       continue;
 704     end;
 705
 706     if pr.eatId('as') then
 707     begin
 708            if pr.eatId('xy') then asxy := true
 709       else if pr.eatId('wh') then aswh := true
 710       else if pr.eatId('txy') then begin asxy := true; ast := true; end
 711       else if pr.eatId('twh') then begin aswh := true; ast := true; end
 712       else if pr.eatId('monsterid') then begin asmonid := true; end
 713       else raise Exception.Create(Format('invalid field ''%s'' as what?', [fldname]));
 714       continue;
 715     end;
 716
 717     if pr.eatId('enum') then
 718     begin
 719       lebs := TDynField.TEBS.TEnum;
 720       if (Length(fldrecname) <> 0) then raise Exception.Create(Format('field ''%s'' already typed as ''%s''', [fldname, fldrecname]));
 721       fldrecname := pr.expectId();
 722       continue;
 723     end;
 724
 725     if pr.eatId('bitset') then
 726     begin
 727       lebs := TDynField.TEBS.TBitSet;
 728       if (Length(fldrecname) <> 0) then raise Exception.Create(Format('field ''%s'' already typed as ''%s''', [fldname, fldrecname]));
 729       unique := pr.eatId('unique');
 730       fldrecname := pr.expectId();
 731       continue;
 732     end;
 733
 734     if pr.eatId('default') then
 735     begin
 736       if hasdefStr or hasdefInt or hasdefId then raise Exception.Create(Format('field ''%s'' has duplicate default', [fldname]));
 737       case pr.tokType of
 738         pr.TTStr:
 739           begin
 740             hasdefStr := true;
 741             defstr := pr.expectStr(true); // allow empty strings
 742           end;
 743         pr.TTId:
 744           begin
 745             hasdefId := true;
 746             defstr := pr.expectId();
 747           end;
 748         pr.TTInt:
 749           begin
 750             hasdefInt := true;
 751             defint := pr.expectInt();
 752           end;
 753         else
 754           raise Exception.Create(Format('field ''%s'' has invalid default', [fldname]));
 755       end;
 756       continue;
 757     end;
 758
 759     if pr.eatId('omitdefault') then
 760     begin
 761       omitdef := true;
 762       continue;
 763     end;
 764
 765     if pr.eatId('internal') then
 766     begin
 767       ainternal := true;
 768       continue;
 769     end;
 770
 771     if (pr.tokType <> pr.TTId) then raise Exception.Create(Format('field ''%s'' has something unexpected in definition', [fldname]));
 772
 773     if (Length(fldrecname) <> 0) then raise Exception.Create(Format('field ''%s'' already typed as ''%s''', [fldname, fldrecname]));
 774     fldrecname := pr.expectId();
 775     lebs := TDynField.TEBS.TRec;
 776   end;
 777
 778   pr.expectTT(pr.TTSemi);
 779
 780   // create field
 781   mName := fldname;
 782        if (fldtype = 'bool') then mType := TType.TBool
 783   else if (fldtype = 'negbool') then begin mType := TType.TBool; mNegBool := true; end
 784   else if (fldtype = 'char') then mType := TType.TChar
 785   else if (fldtype = 'byte') then mType := TType.TByte
 786   else if (fldtype = 'ubyte') then mType := TType.TUByte
 787   else if (fldtype = 'short') then mType := TType.TShort
 788   else if (fldtype = 'ushort') then mType := TType.TUShort
 789   else if (fldtype = 'int') then mType := TType.TInt
 790   else if (fldtype = 'uint') then mType := TType.TUInt
 791   else if (fldtype = 'string') then mType := TType.TString
 792   else if (fldtype = 'point') then mType := TType.TPoint
 793   else if (fldtype = 'size') then mType := TType.TSize
 794   else if (fldtype = 'trigdata') then mType := TType.TTrigData
 795   else raise Exception.Create(Format('field ''%s'' has invalid type ''%s''', [fldname, fldtype]));
 796
 797   if (lmaxdim > 0) and (mType <> TType.TChar) and (mType <> TType.TTrigData) then raise Exception.Create(Format('field ''%s'' of type ''%s'' cannot be array', [fldname, fldtype]));
 798   if (mType = TType.TTrigData) then
 799   begin
 800     if (lmaxdim < 1) then raise Exception.Create(Format('field ''%s'' of type ''%s'' cannot be array', [fldname, fldtype]));
 801     if (Length(fldrecname) > 0) then raise Exception.Create(Format('field ''%s'' of type ''%s'' cannot have another type', [fldname, fldtype]));
 802     lebs := TDynField.TEBS.TRec;
 803   end;
 804
 805        if hasdefStr then self.mDefUnparsed := quoteStr(defstr)
 806   else if hasdefInt then self.mDefUnparsed := Format('%d', [defint])
 807   else if hasdefId then self.mDefUnparsed := defstr;
 808
 809   self.mHasDefault := (hasdefStr or hasdefId or hasdefInt);
 810   self.mPasName := fldpasname;
 811   self.mEBS := lebs;
 812   self.mEBSTypeName := fldrecname;
 813   self.mBitSetUnique := unique;
 814   self.mAsMonsterId := asmonid;
 815   self.mMaxDim := lmaxdim;
 816   self.mBinOfs := fldofs;
 817   self.mRecOfs := fldofs;
 818   self.mSepPosSize := (asxy or aswh);
 819   self.mAsT := ast;
 820   self.mOmitDef := omitdef;
 821   self.mInternal := ainternal;
 822 end;
 823
 824
 825 procedure TDynField.writeBinTo (st: TStream);
 826 var
 827   s: AnsiString;
 828   f: Integer;
 829   maxv: Integer;
 830   buf: PByte;
 831   ws: TStream = nil;
 832 begin
 833   case mEBS of
 834     TEBS.TNone: begin end;
 835     TEBS.TRec:
 836       begin
 837         if (mMaxDim >= 0) then
 838         begin
 839           // this must be triggerdata
 840           if (mType <> TType.TTrigData) then
 841           begin
 842             raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
 843           end;
 844           // write triggerdata
 845           GetMem(buf, mMaxDim);
 846           if (buf = nil) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
 847           try
 848             FillChar(buf^, mMaxDim, 0);
 849             if (mRecRef <> nil) then
 850             begin
 851               ws := TSFSMemoryChunkStream.Create(buf, mMaxDim);
 852               mRecRef.writeBinTo(ws, mMaxDim); // as trigdata
 853             end;
 854             st.WriteBuffer(buf^, mMaxDim);
 855           finally
 856             ws.Free();
 857             if (buf <> nil) then FreeMem(buf);
 858           end;
 859           exit;
 860         end;
 861         // record reference
 862         case mType of
 863           TType.TByte: maxv := 127;
 864           TType.TUByte: maxv := 254;
 865           TType.TShort: maxv := 32767;
 866           TType.TUShort: maxv := 65534;
 867           TType.TInt: maxv := $7fffffff;
 868           TType.TUInt: maxv := $7fffffff;
 869           else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
 870         end;
 871         // find record number
 872         if (mRecRef <> nil) then
 873         begin
 874           f := mOwner.findRecordNumByType(mEBSTypeName, mRecRef);
 875           if (f < 0) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' not found in record list', [mEBSTypeName, mName]));
 876           if mAsMonsterId then Inc(f);
 877           if (f > maxv) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' has too big index', [mEBSTypeName, mName]));
 878         end
 879         else
 880         begin
 881           if mAsMonsterId then f := 0 else f := -1;
 882         end;
 883         case mType of
 884           TType.TByte, TType.TUByte: writeInt(st, Byte(f));
 885           TType.TShort, TType.TUShort: writeInt(st, SmallInt(f));
 886           TType.TInt, TType.TUInt: writeInt(st, LongWord(f));
 887           else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
 888         end;
 889         exit;
 890       end;
 891     TEBS.TEnum: begin end;
 892     TEBS.TBitSet: begin end;
 893     else raise Exception.Create('ketmar forgot to handle some EBS type');
 894   end;
 895
 896   case mType of
 897     TType.TBool:
 898       begin
 899         if not mNegBool then
 900         begin
 901           if (mIVal <> 0) then writeInt(st, Byte(1)) else writeInt(st, Byte(0));
 902         end
 903         else
 904         begin
 905           if (mIVal = 0) then writeInt(st, Byte(1)) else writeInt(st, Byte(0));
 906         end;
 907         exit;
 908       end;
 909     TType.TChar:
 910       begin
 911         if (mMaxDim = 0) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
 912         if (mMaxDim < 0) then
 913         begin
 914           if (Length(mSVal) <> 1) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
 915           writeInt(st, Byte(mSVal[1]));
 916         end
 917         else
 918         begin
 919           if (Length(mSVal) > mMaxDim) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
 920           s := utf2win(mSVal);
 921           if (Length(s) > 0) then st.WriteBuffer(PChar(s)^, Length(s));
 922           for f := Length(s) to mMaxDim do writeInt(st, Byte(0));
 923         end;
 924         exit;
 925       end;
 926     TType.TByte,
 927     TType.TUByte:
 928       begin
 929         // triggerdata array was processed earlier
 930         if (mMaxDim >= 0) then Exception.Create(Format('byte array in field ''%s'' cannot be written', [mName]));
 931         writeInt(st, Byte(mIVal));
 932         exit;
 933       end;
 934     TType.TShort,
 935     TType.TUShort:
 936       begin
 937         if (mMaxDim >= 0) then raise Exception.Create(Format('short array in field ''%s'' cannot be written', [mName]));
 938         writeInt(st, Word(mIVal));
 939         exit;
 940       end;
 941     TType.TInt,
 942     TType.TUInt:
 943       begin
 944         if (mMaxDim >= 0) then raise Exception.Create(Format('int array in field ''%s'' cannot be written', [mName]));
 945         writeInt(st, LongWord(mIVal));
 946         exit;
 947       end;
 948     TType.TString:
 949       begin
 950         raise Exception.Create(Format('cannot write string field ''%s''', [mName]));
 951       end;
 952     TType.TPoint:
 953       begin
 954         if (mMaxDim >= 0) then raise Exception.Create(Format('pos/size array in field ''%s'' cannot be written', [mName]));
 955         writeInt(st, LongInt(mIVal));
 956         writeInt(st, LongInt(mIVal2));
 957         exit;
 958       end;
 959     TType.TSize:
 960       begin
 961         if (mMaxDim >= 0) then raise Exception.Create(Format('pos/size array in field ''%s'' cannot be written', [mName]));
 962         writeInt(st, Word(mIVal));
 963         writeInt(st, Word(mIVal2));
 964         exit;
 965       end;
 966     TType.TList:
 967       begin
 968         assert(false);
 969         exit;
 970       end;
 971     TType.TTrigData:
 972       begin
 973         assert(false);
 974         exit;
 975       end;
 976     else raise Exception.Create('ketmar forgot to handle some field type');
 977   end;
 978 end;
 979
 980
 981 procedure TDynField.writeTo (wr: TTextWriter);
 982 var
 983   es: TDynEBS = nil;
 984   f, mask: Integer;
 985   first, found: Boolean;
 986 begin
 987   wr.put(mName);
 988   wr.put(' ');
 989   case mEBS of
 990     TEBS.TNone: begin end;
 991     TEBS.TRec:
 992       begin
 993         if (mRecRef = nil) then
 994         begin
 995           if (mType = TType.TTrigData) then wr.put('{}'#10) else wr.put('null;'#10);
 996         end
 997         else if (Length(mRecRef.mId) = 0) then
 998         begin
 999           mRecRef.writeTo(wr, false); // only data, no header
1000         end
1001         else
1002         begin
1003           wr.put(mRecRef.mId);
1004           wr.put(';'#10);
1005         end;
1006         exit;
1007       end;
1008     TEBS.TEnum:
1009       begin
1010         //def := mOwner.mOwner;
1011         //es := def.findEBSType(mEBSTypeName);
1012         es := nil;
1013         if (mEBSType <> nil) and (mEBSType is TDynEBS) then es := (mEBSType as TDynEBS);
1014         if (es = nil) or (not es.mIsEnum) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1015         for f := 0 to High(es.mVals) do
1016         begin
1017           if (es.mVals[f] = mIVal) then
1018           begin
1019             wr.put(es.mIds[f]);
1020             wr.put(';'#10);
1021             exit;
1022           end;
1023         end;
1024         raise Exception.Create(Format('value %d in record enum type ''%s'' for field ''%s'' not found', [mIVal, mEBSTypeName, mName]));
1025       end;
1026     TEBS.TBitSet:
1027       begin
1028         //def := mOwner.mOwner;
1029         //es := def.findEBSType(mEBSTypeName);
1030         es := nil;
1031         if (mEBSType <> nil) and (mEBSType is TDynEBS) then es := (mEBSType as TDynEBS);
1032         if (es = nil) or es.mIsEnum then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1033         // none?
1034         if (mIVal = 0) then
1035         begin
1036           for f := 0 to High(es.mVals) do
1037           begin
1038             if (es.mVals[f] = 0) then
1039             begin
1040               wr.put(es.mIds[f]);
1041               wr.put(';'#10);
1042               exit;
1043             end;
1044           end;
1045           raise Exception.Create(Format('value %d in record bitset type ''%s'' for field ''%s'' not found', [0, mEBSTypeName, mName]));
1046         end;
1047         // not none
1048         mask := 1;
1049         first := true;
1050         while (mask <> 0) do
1051         begin
1052           if ((mIVal and mask) <> 0) then
1053           begin
1054             found := false;
1055             for f := 0 to High(es.mVals) do
1056             begin
1057               if (es.mVals[f] = mask) then
1058               begin
1059                 if not first then wr.put('+') else first := false;
1060                 wr.put(es.mIds[f]);
1061                 found := true;
1062                 break;
1063               end;
1064             end;
1065             if not found then raise Exception.Create(Format('value %d in record bitset type ''%s'' for field ''%s'' not found', [mask, mEBSTypeName, mName]));
1066           end;
1067           mask := mask shl 1;
1068         end;
1069         wr.put(';'#10);
1070         exit;
1071       end;
1072     else raise Exception.Create('ketmar forgot to handle some EBS type');
1073   end;
1074
1075   case mType of
1076     TType.TBool:
1077       begin
1078         if (mIVal = 0) then wr.put('false;'#10) else wr.put('true;'#10);
1079         exit;
1080       end;
1081     TType.TChar:
1082       begin
1083         if (mMaxDim = 0) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
1084         wr.put(quoteStr(mSVal));
1085         wr.put(';'#10);
1086         exit;
1087       end;
1088     TType.TByte,
1089     TType.TUByte,
1090     TType.TShort,
1091     TType.TUShort,
1092     TType.TInt,
1093     TType.TUInt:
1094       begin
1095         wr.put('%d;'#10, [mIVal]);
1096         exit;
1097       end;
1098     TType.TString:
1099       begin
1100         wr.put(quoteStr(mSVal));
1101         wr.put(';'#10);
1102         exit;
1103       end;
1104     TType.TPoint,
1105     TType.TSize:
1106       begin
1107         wr.put('(%d %d);'#10, [mIVal, mIVal2]);
1108         exit;
1109       end;
1110     TType.TList:
1111       begin
1112         assert(false);
1113         exit;
1114       end;
1115     TType.TTrigData:
1116       begin
1117         assert(false);
1118         exit;
1119       end;
1120     else raise Exception.Create('ketmar forgot to handle some field type');
1121   end;
1122   raise Exception.Create(Format('cannot parse field ''%s'' yet', [mName]));
1123 end;
1124
1125 procedure TDynField.parseBinValue (st: TStream);
1126 var
1127   rec, rc: TDynRecord;
1128   tfld: TDynField;
1129   es: TDynEBS = nil;
1130   tdata: PByte = nil;
1131   f, mask: Integer;
1132   s: AnsiString;
1133 begin
1134   case mEBS of
1135     TEBS.TNone: begin end;
1136     TEBS.TRec:
1137       begin
1138         // this must be triggerdata
1139         if (mType = TType.TTrigData) then
1140         begin
1141           assert(mMaxDim > 0);
1142           rec := mOwner;
1143           // find trigger definition
1144           tfld := rec.trigTypeField();
1145           if (tfld = nil) then raise Exception.Create(Format('triggerdata value for field ''%s'' in record ''%s'' without TriggerType field', [mName, rec.mName]));
1146           rc := mOwner.mOwner.findTrigFor(tfld.mSVal); // find in mapdef
1147           if (rc = nil) then raise Exception.Create(Format('triggerdata definition for field ''%s'' in record ''%s'' with type ''%s'' not found', [mName, rec.mName, tfld.mSVal]));
1148           rc := rc.clone();
1149           rc.mHeaderRec := mOwner.mHeaderRec;
1150           try
1151             rc.parseBinValue(st, true);
1152             mRecRef := rc;
1153             rc := nil;
1154           finally
1155             rc.Free();
1156           end;
1157           mDefined := true;
1158           exit;
1159         end
1160         else
1161         begin
1162           // not a trigger data
1163           case mType of
1164             TType.TByte: f := readShortInt(st);
1165             TType.TUByte: f := readByte(st);
1166             TType.TShort: f := readSmallInt(st);
1167             TType.TUShort: f := readWord(st);
1168             TType.TInt: f := readLongInt(st);
1169             TType.TUInt: f := readLongWord(st);
1170             else raise Exception.Create(Format('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName]));
1171           end;
1172           if mAsMonsterId then Dec(f);
1173           if (f < 0) then mRecRefId := '' else mRecRefId := Format('%s%d', [mEBSTypeName, f]);
1174         end;
1175         mDefined := true;
1176         exit;
1177       end;
1178     TEBS.TEnum,
1179     TEBS.TBitSet:
1180       begin
1181         assert(mMaxDim < 0);
1182         case mType of
1183           TType.TByte: f := readShortInt(st);
1184           TType.TUByte: f := readByte(st);
1185           TType.TShort: f := readSmallInt(st);
1186           TType.TUShort: f := readWord(st);
1187           TType.TInt: f := readLongInt(st);
1188           TType.TUInt: f := readLongWord(st);
1189           else raise Exception.Create(Format('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName]));
1190         end;
1191         es := nil;
1192         if (mEBSType <> nil) and (mEBSType is TDynEBS) then es := (mEBSType as TDynEBS);
1193         if (es = nil) or (es.mIsEnum <> (mEBS = TEBS.TEnum)) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1194         mIVal := f;
1195         // build enum/bitfield values
1196         if (mEBS = TEBS.TEnum) then
1197         begin
1198           mSVal := es.nameByValue(mIVal);
1199           if (Length(mSVal) = 0) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mIVal]));
1200         end
1201         else
1202         begin
1203           // special for 'none'
1204           if (mIVal = 0) then
1205           begin
1206             mSVal := es.nameByValue(mIVal);
1207             if (Length(mSVal) = 0) then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mIVal]));
1208           end
1209           else
1210           begin
1211             mSVal := '';
1212             mask := 1;
1213             while (mask <> 0) do
1214             begin
1215               if ((mIVal and mask) <> 0) then
1216               begin
1217                 s := es.nameByValue(mask);
1218                 if (Length(s) = 0) then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mask]));
1219                 if (Length(mSVal) <> 0) then mSVal += '+';
1220                 mSVal += s;
1221               end;
1222               mask := mask shl 1;
1223             end;
1224           end;
1225         end;
1226         //writeln('ebs <', es.mName, '>: ', mSVal);
1227         mDefined := true;
1228         exit;
1229       end;
1230     else raise Exception.Create('ketmar forgot to handle some EBS type');
1231   end;
1232
1233   case mType of
1234     TType.TBool:
1235       begin
1236         f := readByte(st);
1237         if (f <> 0) then f := 1;
1238         if mNegBool then f := 1-f;
1239         mIVal := f;
1240         mDefined := true;
1241         exit;
1242       end;
1243     TType.TChar:
1244       begin
1245         if (mMaxDim < 0) then
1246         begin
1247           mIVal := readByte(st);
1248         end
1249         else
1250         begin
1251           mSVal := '';
1252           GetMem(tdata, mMaxDim);
1253           try
1254             st.ReadBuffer(tdata^, mMaxDim);
1255             f := 0;
1256             while (f < mMaxDim) and (tdata[f] <> 0) do Inc(f);
1257             if (f > 0) then
1258             begin
1259               SetLength(mSVal, f);
1260               Move(tdata^, PChar(mSVal)^, f);
1261               mSVal := win2utf(mSVal);
1262             end;
1263           finally
1264             FreeMem(tdata);
1265           end;
1266         end;
1267         mDefined := true;
1268         exit;
1269       end;
1270     TType.TByte: begin mIVal := readShortInt(st); mDefined := true; exit; end;
1271     TType.TUByte: begin mIVal := readByte(st); mDefined := true; exit; end;
1272     TType.TShort: begin mIVal := readSmallInt(st); mDefined := true; exit; end;
1273     TType.TUShort: begin mIVal := readWord(st); mDefined := true; exit; end;
1274     TType.TInt: begin mIVal := readLongInt(st); mDefined := true; exit; end;
1275     TType.TUInt: begin mIVal := readLongWord(st); mDefined := true; exit; end;
1276     TType.TString:
1277       begin
1278         raise Exception.Create('cannot read strings from binaries yet');
1279         exit;
1280       end;
1281     TType.TPoint:
1282       begin
1283         mIVal := readLongInt(st);
1284         mIVal2 := readLongInt(st);
1285         mDefined := true;
1286         exit;
1287       end;
1288     TType.TSize:
1289       begin
1290         mIVal := readWord(st);
1291         mIVal2 := readWord(st);
1292         mDefined := true;
1293         exit;
1294       end;
1295     TType.TList:
1296       begin
1297         assert(false);
1298         exit;
1299       end;
1300     TType.TTrigData:
1301       begin
1302         assert(false);
1303         exit;
1304       end;
1305     else raise Exception.Create('ketmar forgot to handle some field type');
1306   end;
1307   raise Exception.Create(Format('cannot parse field ''%s'' yet', [mName]));
1308 end;
1309
1310
1311 procedure TDynField.parseValue (pr: TTextParser);
1312
1313   procedure parseInt (min, max: Integer);
1314   begin
1315     mIVal := pr.expectInt();
1316     if (mIVal < min) or (mIVal > max) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
1317     mDefined := true;
1318   end;
1319
1320 var
1321   rec, rc: TDynRecord;
1322   es: TDynEBS = nil;
1323   tfld: TDynField;
1324   tk: AnsiString;
1325   edim: AnsiChar;
1326 begin
1327   // if this field should contain struct, convert type and parse struct
1328   case mEBS of
1329     TEBS.TNone: begin end;
1330     TEBS.TRec:
1331       begin
1332         // ugly hack. sorry.
1333         if (mType = TType.TTrigData) then
1334         begin
1335           pr.expectTT(pr.TTBegin);
1336           if (pr.tokType = pr.TTEnd) then
1337           begin
1338             // '{}'
1339             mRecRef := nil;
1340             pr.expectTT(pr.TTEnd);
1341           end
1342           else
1343           begin
1344             rec := mOwner;
1345             // find trigger definition
1346             tfld := rec.trigTypeField();
1347             if (tfld = nil) then raise Exception.Create(Format('triggerdata value for field ''%s'' in record ''%s'' without ''type'' field', [mName, rec.mName]));
1348             rc := mOwner.mOwner.findTrigFor(tfld.mSVal); // find in mapdef
1349             if (rc = nil) then raise Exception.Create(Format('triggerdata definition for field ''%s'' in record ''%s'' with type ''%s'' not found', [mName, rec.mName, tfld.mSVal]));
1350             rc := rc.clone();
1351             rc.mHeaderRec := mOwner.mHeaderRec;
1352             //writeln(rc.definition);
1353             try
1354               rc.parseValue(pr, true);
1355               mRecRef := rc;
1356               rc := nil;
1357             finally
1358               rc.Free();
1359             end;
1360           end;
1361           mDefined := true;
1362           pr.eatTT(pr.TTSemi); // hack: allow (but don't require) semicolon after inline records
1363           exit;
1364         end;
1365         // other record types
1366         if (pr.tokType = pr.TTId) then
1367         begin
1368           if pr.eatId('null') then
1369           begin
1370             mRecRef := nil;
1371           end
1372           else
1373           begin
1374             rec := mOwner.findRecordByTypeId(mEBSTypeName, pr.tokStr);
1375             if (rec = nil) then raise Exception.Create(Format('record ''%s'' (%s) value for field ''%s'' not found', [pr.tokStr, mEBSTypeName, mName]));
1376             pr.expectId();
1377             mRecRef := rec;
1378           end;
1379           mDefined := true;
1380           pr.expectTT(pr.TTSemi);
1381           exit;
1382         end
1383         else if (pr.tokType = pr.TTBegin) then
1384         begin
1385           //rec := mOwner.mOwner.findRecType(mEBSTypeName); // find in mapdef
1386           rec := nil;
1387           if (mEBSType <> nil) and (mEBSType is TDynRecord) then rec := (mEBSType as TDynRecord);
1388           if (rec = nil) then raise Exception.Create(Format('record type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1389           rc := rec.clone();
1390           rc.mHeaderRec := mOwner.mHeaderRec;
1391           rc.parseValue(pr);
1392           mRecRef := rc;
1393           mDefined := true;
1394           if mOwner.addRecordByType(mEBSTypeName, rc) then
1395           begin
1396             //raise Exception.Create(Format('record type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1397             e_LogWritefln('duplicate record with id ''%s'' for field ''%s'' in record ''%s''', [rc.mId, mName, mOwner.mName]);
1398           end;
1399           pr.eatTT(pr.TTSemi); // hack: allow (but don't require) semicolon after inline records
1400           exit;
1401         end;
1402         pr.expectTT(pr.TTBegin);
1403       end;
1404     TEBS.TEnum:
1405       begin
1406         //es := mOwner.mOwner.findEBSType(mEBSTypeName); // find in mapdef
1407         es := nil;
1408         if (mEBSType <> nil) and (mEBSType is TDynEBS) then es := (mEBSType as TDynEBS);
1409         if (es = nil) or (not es.mIsEnum) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1410         tk := pr.expectId();
1411         if not es.has[tk] then raise Exception.Create(Format('record enum value ''%s'' of type ''%s'' for field ''%s'' not found', [tk, mEBSTypeName, mName]));
1412         mIVal := es.field[tk];
1413         mSVal := tk;
1414         //writeln('ENUM ', mEBSName, '; element <', mSVal, '> with value ', mIVal);
1415         mDefined := true;
1416         pr.expectTT(pr.TTSemi);
1417         exit;
1418       end;
1419     TEBS.TBitSet:
1420       begin
1421         //es := mOwner.mOwner.findEBSType(mEBSTypeName); // find in mapdef
1422         es := nil;
1423         if (mEBSType <> nil) and (mEBSType is TDynEBS) then es := (mEBSType as TDynEBS);
1424         if (es = nil) or es.mIsEnum then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1425         mIVal := 0;
1426         while true do
1427         begin
1428           tk := pr.expectId();
1429           if not es.has[tk] then raise Exception.Create(Format('record bitset value ''%s'' of type ''%s'' for field ''%s'' not found', [tk, mEBSTypeName, mName]));
1430           mIVal := mIVal or es.field[tk];
1431           mSVal := tk;
1432           if (pr.tokType <> pr.TTDelim) or ((pr.tokChar <> '|') and (pr.tokChar <> '+')) then break;
1433           if mBitSetUnique then raise Exception.Create(Format('record bitset of type ''%s'' for field ''%s'' expects only one value', [tk, mEBSTypeName, mName]));
1434           //pr.expectDelim('|');
1435           pr.skipToken(); // plus or pipe
1436         end;
1437         mDefined := true;
1438         pr.expectTT(pr.TTSemi);
1439         exit;
1440       end;
1441     else raise Exception.Create('ketmar forgot to handle some EBS type');
1442   end;
1443
1444   case mType of
1445     TType.TBool:
1446       begin
1447              if pr.eatId('true') or pr.eatId('tan') or pr.eatId('yes') then mIVal := 1
1448         else if pr.eatId('false') or pr.eatId('ona') or pr.eatId('no') then mIVal := 0
1449         else raise Exception.Create(Format('invalid bool value for field ''%s''', [mName]));
1450         mDefined := true;
1451         pr.expectTT(pr.TTSemi);
1452         exit;
1453       end;
1454     TType.TChar:
1455       begin
1456         if (mMaxDim = 0) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
1457         mSVal := pr.expectStr(true);
1458         if (mMaxDim < 0) then
1459         begin
1460           // single char
1461           if (Length(mSVal) <> 1) then raise Exception.Create(Format('invalid string size for field ''%s''', [mName]));
1462           mIVal := Integer(mSVal[1]);
1463           mSVal := '';
1464         end
1465         else
1466         begin
1467           // string
1468           if (Length(mSVal) > mMaxDim) then raise Exception.Create(Format('invalid string size for field ''%s''', [mName]));
1469         end;
1470         mDefined := true;
1471         pr.expectTT(pr.TTSemi);
1472         exit;
1473       end;
1474     TType.TByte:
1475       begin
1476         parseInt(-128, 127);
1477         pr.expectTT(pr.TTSemi);
1478         exit;
1479       end;
1480     TType.TUByte:
1481       begin
1482         parseInt(0, 255);
1483         pr.expectTT(pr.TTSemi);
1484         exit;
1485       end;
1486     TType.TShort:
1487       begin
1488         parseInt(-32768, 32768);
1489         pr.expectTT(pr.TTSemi);
1490         exit;
1491       end;
1492     TType.TUShort:
1493       begin
1494         parseInt(0, 65535);
1495         pr.expectTT(pr.TTSemi);
1496         exit;
1497       end;
1498     TType.TInt:
1499       begin
1500         parseInt(Integer($80000000), $7fffffff);
1501         pr.expectTT(pr.TTSemi);
1502         exit;
1503       end;
1504     TType.TUInt:
1505       begin
1506         parseInt(0, $7fffffff); //FIXME
1507         pr.expectTT(pr.TTSemi);
1508         exit;
1509       end;
1510     TType.TString:
1511       begin
1512         mSVal := pr.expectStr(true);
1513         mDefined := true;
1514         pr.expectTT(pr.TTSemi);
1515         exit;
1516       end;
1517     TType.TPoint,
1518     TType.TSize:
1519       begin
1520         if pr.eatDelim('[') then edim := ']' else begin pr.expectDelim('('); edim := ')'; end;
1521         mIVal := pr.expectInt();
1522         if (mType = TType.TSize) then
1523         begin
1524           if (mIVal < 0) or (mIVal > 32767) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
1525         end;
1526         mIVal2 := pr.expectInt();
1527         if (mType = TType.TSize) then
1528         begin
1529           if (mIVal2 < 0) or (mIVal2 > 32767) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
1530         end;
1531         mDefined := true;
1532         pr.expectDelim(edim);
1533         pr.expectTT(pr.TTSemi);
1534         exit;
1535       end;
1536     TType.TList:
1537       begin
1538         assert(false);
1539         exit;
1540       end;
1541     TType.TTrigData:
1542       begin
1543         assert(false);
1544         exit;
1545       end;
1546     else raise Exception.Create('ketmar forgot to handle some field type');
1547   end;
1548   raise Exception.Create(Format('cannot parse field ''%s'' yet', [mName]));
1549 end;
1550
1551
1552 // ////////////////////////////////////////////////////////////////////////// //
1553 constructor TDynRecord.Create (pr: TTextParser);
1554 begin
1555   if (pr = nil) then raise Exception.Create('cannot create record type without type definition');
1556   mId := '';
1557   mName := '';
1558   mSize := 0;
1559   mFields := TDynFieldList.Create();
1560   {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1561   mFieldsHash := hashNewStrInt();
1562   {$ENDIF}
1563   mTrigTypes := nil;
1564   mHeader := false;
1565   mHeaderRec := nil;
1566   mBinBlock := -1;
1567   parseDef(pr);
1568 end;
1569
1570
1571 constructor TDynRecord.Create ();
1572 begin
1573   mName := '';
1574   mSize := 0;
1575   mFields := TDynFieldList.Create();
1576   {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1577   mFieldsHash := hashNewStrInt();
1578   {$ENDIF}
1579   mTrigTypes := nil;
1580   mHeader := false;
1581   mHeaderRec := nil;
1582 end;
1583
1584
1585 destructor TDynRecord.Destroy ();
1586 begin
1587   mName := '';
1588   mFields.Free();
1589   mFields := nil;
1590   {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1591   mFieldsHash.Free();
1592   mFieldsHash := nil;
1593   {$ENDIF}
1594   mTrigTypes := nil;
1595   mHeaderRec := nil;
1596   inherited;
1597 end;
1598
1599
1600 procedure TDynRecord.addField (fld: TDynField); inline;
1601 begin
1602   if (fld = nil) then raise Exception.Create('cannot append nil field to record');
1603   mFields.append(fld);
1604   {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1605   if (Length(fld.mName) > 0) then mFieldsHash.put(fld.mName, mFields.count-1);
1606   {$ENDIF}
1607 end;
1608
1609
1610 function TDynRecord.addFieldChecked (fld: TDynField): Boolean; inline; // `true`: duplicate name
1611 begin
1612   result := false;
1613   if (fld = nil) then raise Exception.Create('cannot append nil field to record');
1614   {$IF not DEFINED(XDYNREC_USE_FIELDHASH)}
1615   if (Length(fld.mName) > 0) then result := hasByName(fld.mName);
1616   {$ENDIF}
1617   mFields.append(fld);
1618   {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1619   if (Length(fld.mName) > 0) then result := mFieldsHash.put(fld.mName, mFields.count-1);
1620   {$ENDIF}
1621 end;
1622
1623
1624 function TDynRecord.findByName (const aname: AnsiString): Integer; inline;
1625 begin
1626   {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1627   if not mFieldsHash.get(aname, result) then result := -1;
1628   {$ELSE}
1629   result := 0;
1630   while (result < mFields.count) do
1631   begin
1632     if StrEqu(aname, mFields[result].mName) then exit;
1633     Inc(result);
1634   end;
1635   result := -1;
1636   {$ENDIF}
1637 end;
1638
1639
1640 function TDynRecord.hasByName (const aname: AnsiString): Boolean; inline;
1641 begin
1642   result := (findByName(aname) >= 0);
1643 end;
1644
1645
1646 function TDynRecord.getFieldByName (const aname: AnsiString): TDynField; inline;
1647 var
1648   f: Integer;
1649 begin
1650   f := findByName(aname);
1651   if (f >= 0) then result := mFields[f] else result := nil;
1652 end;
1653
1654
1655 function TDynRecord.getIsTrigData (): Boolean; inline;
1656 begin
1657   result := (Length(mTrigTypes) > 0);
1658 end;
1659
1660
1661 function TDynRecord.getIsForTrig (const aname: AnsiString): Boolean; inline;
1662 var
1663   f: Integer;
1664 begin
1665   result := true;
1666   for f := 0 to High(mTrigTypes) do if StrEqu(mTrigTypes[f], aname) then exit;
1667   result := false;
1668 end;
1669
1670
1671 function TDynRecord.clone (): TDynRecord;
1672 var
1673   fld: TDynField;
1674   f: Integer;
1675 begin
1676   result := TDynRecord.Create();
1677   result.mOwner := mOwner;
1678   result.mId := mId;
1679   result.mPasName := mPasName;
1680   result.mName := mName;
1681   result.mSize := mSize;
1682   if (mFields.count > 0) then
1683   begin
1684     result.mFields.capacity := mFields.count;
1685     for fld in mFields do result.addField(fld.clone(result));
1686   end;
1687   SetLength(result.mTrigTypes, Length(mTrigTypes));
1688   for f := 0 to High(mTrigTypes) do result.mTrigTypes[f] := mTrigTypes[f];
1689   result.mHeader := mHeader;
1690   result.mBinBlock := mBinBlock;
1691   result.mHeaderRec := mHeaderRec;
1692 end;
1693
1694
1695 function TDynRecord.findRecordByTypeId (const atypename, aid: AnsiString): TDynRecord;
1696 var
1697   fld: TDynField;
1698   idx: Integer;
1699 begin
1700   result := nil;
1701   if (Length(aid) = 0) then exit;
1702   // find record data
1703   fld := mHeaderRec.field[atypename];
1704   if (fld = nil) then exit;
1705   if (fld.mType <> fld.TType.TList) then raise Exception.Create(Format('cannot get record of type ''%s'' due to name conflict with ordinary field', [atypename]));
1706   // find by id
1707   if (fld.mRVal <> nil) then
1708   begin
1709     if fld.mRHash.get(aid, idx) then begin result := fld.mRVal[idx]; exit; end;
1710   end;
1711   // alas
1712 end;
1713
1714
1715 function TDynRecord.findRecordNumByType (const atypename: AnsiString; rc: TDynRecord): Integer;
1716 var
1717   fld: TDynField;
1718   idx: Integer;
1719 begin
1720   result := -1;
1721   // find record data
1722   fld := mHeaderRec.field[atypename];
1723   if (fld = nil) then exit;
1724   if (fld.mType <> fld.TType.TList) then raise Exception.Create(Format('cannot get record of type ''%s'' due to name conflict with ordinary field', [atypename]));
1725   // find by ref
1726   if (fld.mRVal <> nil) then
1727   begin
1728     for idx := 0 to fld.mRVal.count-1 do
1729     begin
1730       if (fld.mRVal[idx] = rc) then begin result := idx; exit; end;
1731     end;
1732   end;
1733   // alas
1734 end;
1735
1736
1737 function TDynRecord.addRecordByType (const atypename: AnsiString; rc: TDynRecord): Boolean;
1738 var
1739   fld: TDynField;
1740 begin
1741   // find record data
1742   fld := mHeaderRec.field[atypename];
1743   if (fld = nil) then
1744   begin
1745     // first record
1746     fld := TDynField.Create(atypename, TDynField.TType.TList);
1747     fld.mOwner := mHeaderRec;
1748     mHeaderRec.addField(fld);
1749   end;
1750   if (fld.mType <> fld.TType.TList) then raise Exception.Create(Format('cannot append record of type ''%s'' due to name conflict with ordinary field', [atypename]));
1751   // append
1752   if (fld.mRVal = nil) then
1753   begin
1754     fld.mRVal := TDynRecList.Create();
1755     fld.mRHash := hashNewStrInt();
1756   end;
1757   result := fld.addListItem(rc);
1758 end;
1759
1760
1761 function TDynRecord.isSimpleEqu (rec: TDynRecord): Boolean;
1762 var
1763   f: Integer;
1764 begin
1765   if (rec = nil) then begin result := false; exit; end; // self.mRecRef can't be `nil` here
1766   if (rec = self) then begin result := true; exit; end;
1767   if (mFields.count <> rec.mFields.count) then begin result := false; exit; end;
1768   result := false;
1769   for f := 0 to mFields.count-1 do
1770   begin
1771     if not mFields[f].isSimpleEqu(rec.mFields[f]) then exit;
1772   end;
1773   result := true;
1774 end;
1775
1776
1777 function TDynRecord.trigTypeField (): TDynField;
1778 var
1779   fld: TDynField;
1780   es: TDynEBS = nil;
1781 begin
1782   for fld in mFields do
1783   begin
1784     if (fld.mEBS <> TDynField.TEBS.TEnum) then continue;
1785     if not (fld.mEBSType is TDynEBS) then continue;
1786     es := (fld.mEBSType as TDynEBS);
1787     assert(es <> nil);
1788     if StrEqu(es.mName, 'TriggerType') then begin result := fld; exit; end;
1789   end;
1790   result := nil;
1791 end;
1792
1793
1794 // number of records of the given instance
1795 function TDynRecord.instanceCount (const typename: AnsiString): Integer;
1796 var
1797   fld: TDynField;
1798 begin
1799   result := 0;
1800   fld := field[typename];
1801   if (fld <> nil) and (fld.mType = fld.TType.TList) then result := fld.mRVal.count;
1802 end;
1803
1804
1805 procedure TDynRecord.parseDef (pr: TTextParser);
1806 var
1807   fld: TDynField;
1808   tdn: AnsiString;
1809 begin
1810   if pr.eatId('TriggerData') then
1811   begin
1812     pr.expectId('for');
1813     if pr.eatDelim('(') then
1814     begin
1815       while true do
1816       begin
1817         while pr.eatTT(pr.TTComma) do begin end;
1818         if pr.eatDelim(')') then break;
1819         tdn := pr.expectId();
1820         if isForTrig[tdn] then raise Exception.Create(Format('duplicate trigdata ''%s'' trigtype ''%s''', [mName, tdn]));
1821         SetLength(mTrigTypes, Length(mTrigTypes)+1);
1822         mTrigTypes[High(mTrigTypes)] := tdn;
1823       end;
1824     end
1825     else
1826     begin
1827       tdn := pr.expectId();
1828       SetLength(mTrigTypes, 1);
1829       mTrigTypes[0] := tdn;
1830     end;
1831     mName := 'TriggerData';
1832   end
1833   else
1834   begin
1835     mPasName := pr.expectId(); // pascal record name
1836     pr.expectId('is');
1837     mName := pr.expectStr();
1838     while (pr.tokType <> pr.TTBegin) do
1839     begin
1840       if pr.eatId('header') then begin mHeader := true; continue; end;
1841       if pr.eatId('size') then
1842       begin
1843         if (mSize > 0) then raise Exception.Create(Format('duplicate `size` in record ''%s''', [mName]));
1844         mSize := pr.expectInt();
1845         if (mSize < 1) then raise Exception.Create(Format('invalid record ''%s'' size: %d', [mName, mSize]));
1846         pr.expectId('bytes');
1847         continue;
1848       end;
1849       if pr.eatId('binblock') then
1850       begin
1851         if (mBinBlock >= 0) then raise Exception.Create(Format('duplicate `binblock` in record ''%s''', [mName]));
1852         mBinBlock := pr.expectInt();
1853         if (mBinBlock < 1) then raise Exception.Create(Format('invalid record ''%s'' binblock: %d', [mName, mBinBlock]));
1854         continue;
1855       end;
1856     end;
1857   end;
1858
1859   pr.expectTT(pr.TTBegin);
1860   // load fields
1861   while (pr.tokType <> pr.TTEnd) do
1862   begin
1863     fld := TDynField.Create(pr);
1864     //if hasByName(fld.name) then begin fld.Free(); raise Exception.Create(Format('duplicate field ''%s''', [fld.name])); end;
1865     // append
1866     fld.mOwner := self;
1867     if addFieldChecked(fld) then
1868     begin
1869       fld.Free();
1870       raise Exception.Create(Format('duplicate field ''%s''', [fld.name]));
1871     end;
1872     // done with field
1873   end;
1874   pr.expectTT(pr.TTEnd);
1875 end;
1876
1877
1878 function TDynRecord.pasdef (): AnsiString;
1879 var
1880   fld: TDynField;
1881 begin
1882   if isTrigData then
1883   begin
1884     assert(false);
1885     result := '';
1886   end
1887   else
1888   begin
1889     // record
1890     result := '  '+mPasName+' = packed record'#10;
1891   end;
1892   for fld in mFields do
1893   begin
1894     if fld.mInternal then continue;
1895     if (fld.mBinOfs < 0) then continue;
1896     result += '    '+fld.pasdef+#10;
1897   end;
1898   result += '  end;'#10;
1899 end;
1900
1901
1902 function TDynRecord.definition (): AnsiString;
1903 var
1904   f: Integer;
1905 begin
1906   if isTrigData then
1907   begin
1908     // trigger data
1909     result := 'TriggerData for ';
1910     if (Length(mTrigTypes) > 1) then
1911     begin
1912       result += '(';
1913       for f := 0 to High(mTrigTypes) do
1914       begin
1915         if (f <> 0) then result += ', ';
1916         result += mTrigTypes[f];
1917       end;
1918       result += ')';
1919     end
1920     else
1921     begin
1922       result += mTrigTypes[0];
1923     end;
1924   end
1925   else
1926   begin
1927     // record
1928     result := mPasName+' is '+quoteStr(mName);
1929     if (mSize >= 0) then result += Format(' size %d bytes', [mSize]);
1930     if mHeader then result += ' header';
1931   end;
1932   result += ' {'#10;
1933   for f := 0 to mFields.count-1 do
1934   begin
1935     result += '  ';
1936     result += mFields[f].definition;
1937     result += ';'#10;
1938   end;
1939   result += '}';
1940 end;
1941
1942
1943 procedure TDynRecord.parseBinValue (st: TStream; forceData: Boolean=false);
1944 var
1945   sign: string[4];
1946   btype: Integer;
1947   bsize: Integer;
1948   buf: PByte = nil;
1949   loaded: array[0..255] of Boolean;
1950   rec, rect: TDynRecord;
1951   fld: TDynField;
1952   f: Integer;
1953   mst: TSFSMemoryChunkStream = nil;
1954
1955   procedure linkNames (rec: TDynRecord);
1956   var
1957     fld: TDynField;
1958     rt: TDynRecord;
1959   begin
1960     //writeln('*** rec: ', rec.mName, '.', rec.mId, ' (', rec.mFields.count, ')');
1961     for fld in rec.mFields do
1962     begin
1963       if (fld.mType = TDynField.TType.TTrigData) then
1964       begin
1965         if (fld.mRecRef <> nil) then linkNames(fld.mRecRef);
1966         continue;
1967       end;
1968       if (Length(fld.mRecRefId) = 0) then continue;
1969       assert(fld.mEBSType <> nil);
1970       rt := findRecordByTypeId(fld.mEBSTypeName, fld.mRecRefId);
1971       if (rt = nil) then
1972       begin
1973         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);
1974         //raise Exception.Create(Format('record of type ''%s'' with id ''%s'' links to inexistant record of type ''%s'' with id ''%s''', [rec.mName, rec.mId, fld.mEBSTypeName, fld.mRecRefId]));
1975       end;
1976       //writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')');
1977       fld.mRecRefId := '';
1978       fld.mRecRef := rt;
1979       fld.mDefined := true;
1980     end;
1981     for fld in rec.mFields do
1982     begin
1983       //writeln('  ', fld.mName);
1984       fld.fixDefaultValue(); // just in case
1985     end;
1986   end;
1987
1988 begin
1989   for f := 0 to High(loaded) do loaded[f] := false;
1990   mst := TSFSMemoryChunkStream.Create(nil, 0);
1991   try
1992     if mHeader and not forceData then
1993     begin
1994       // parse map file as sequence of blocks
1995       sign[0] := #4;
1996       st.ReadBuffer(sign[1], 4);
1997       if (sign <> 'MAP'#1) then raise Exception.Create('invalid binary map signature');
1998       // parse blocks
1999       while (st.position < st.size) do
2000       begin
2001         btype := readByte(st);
2002         if (btype = 0) then break; // no more blocks
2003         readLongWord(st); // reserved
2004         bsize := readLongInt(st);
2005         {$IF DEFINED(D2D_XDYN_DEBUG)}writeln('btype=', btype, '; bsize=', bsize);{$ENDIF}
2006         if (bsize < 0) or (bsize > $1fffffff) then raise Exception.Create(Format('block of type %d has invalid size %d', [btype, bsize]));
2007         if loaded[btype] then raise Exception.Create(Format('block of type %d already loaded', [btype]));
2008         loaded[btype] := true;
2009         // find record type for this block
2010         rect := nil;
2011         for rec in mOwner.recTypes do if (rec.mBinBlock = btype) then begin rect := rec; break; end;
2012         if (rect = nil) then raise Exception.Create(Format('block of type %d has no corresponding record', [btype]));
2013         //writeln('found type ''', rec.mName, ''' for block type ', btype);
2014         if (rec.mSize = 0) or ((bsize mod rec.mSize) <> 0) then raise Exception.Create(Format('block of type %d has invalid number of records', [btype]));
2015         // header?
2016         if (rect.mHeader) then
2017         begin
2018           if (bsize <> mSize) then raise Exception.Create(Format('header block of type %d has invalid number of records', [btype]));
2019           GetMem(buf, bsize);
2020           st.ReadBuffer(buf^, bsize);
2021           mst.setup(buf, mSize);
2022           parseBinValue(mst, true); // force parsing data
2023         end
2024         else
2025         begin
2026           // create list for this type
2027           fld := TDynField.Create(rec.mName, TDynField.TType.TList);
2028           fld.mOwner := self;
2029           addField(fld);
2030           if (bsize > 0) then
2031           begin
2032             GetMem(buf, bsize);
2033             st.ReadBuffer(buf^, bsize);
2034             for f := 0 to (bsize div rec.mSize)-1 do
2035             begin
2036               mst.setup(buf+f*rec.mSize, rec.mSize);
2037               rec := rect.clone();
2038               rec.mHeaderRec := self;
2039               rec.parseBinValue(mst);
2040               rec.mId := Format('%s%d', [rec.mName, f]);
2041               fld.addListItem(rec);
2042               //writeln('parsed ''', rec.mId, '''...');
2043             end;
2044           end;
2045         end;
2046         FreeMem(buf);
2047         buf := nil;
2048         //st.position := st.position+bsize;
2049       end;
2050       // link fields
2051       for fld in mFields do
2052       begin
2053         if (fld.mType <> TDynField.TType.TList) then continue;
2054         for rec in fld.mRVal do linkNames(rec);
2055       end;
2056       exit;
2057     end;
2058
2059     // read fields
2060     if StrEqu(mName, 'TriggerData') then mSize := Integer(st.size-st.position);
2061     if (mSize < 1) then raise Exception.Create(Format('cannot read record of type ''%s'' with unknown size', [mName]));
2062     GetMem(buf, mSize);
2063     st.ReadBuffer(buf^, mSize);
2064     for fld in mFields do
2065     begin
2066       if fld.mInternal then continue;
2067       if (fld.mBinOfs < 0) then continue;
2068       if (fld.mBinOfs >= st.size) then raise Exception.Create(Format('record of type ''%s'' has invalid field ''%s''', [fld.mName]));
2069       mst.setup(buf+fld.mBinOfs, mSize-fld.mBinOfs);
2070       //writeln('parsing ''', mName, '.', fld.mName, '''...');
2071       fld.parseBinValue(mst);
2072     end;
2073   finally
2074     mst.Free();
2075     if (buf <> nil) then FreeMem(buf);
2076   end;
2077 end;
2078
2079
2080 procedure TDynRecord.writeBinTo (st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false);
2081 var
2082   fld: TDynField;
2083   rec, rv: TDynRecord;
2084   buf: PByte = nil;
2085   ws: TStream = nil;
2086   blk, blkmax: Integer;
2087   //f, c: Integer;
2088   bufsz: Integer = 0;
2089   blksz: Integer;
2090 begin
2091   if (trigbufsz < 0) then
2092   begin
2093     if (mBinBlock < 1) then raise Exception.Create('cannot write binary record without block number');
2094     if (mSize < 1) then raise Exception.Create('cannot write binary record without size');
2095     bufsz := mSize;
2096   end
2097   else
2098   begin
2099     bufsz := trigbufsz;
2100   end;
2101   try
2102     GetMem(buf, bufsz);
2103     FillChar(buf^, bufsz, 0);
2104     ws := TSFSMemoryChunkStream.Create(buf, bufsz);
2105
2106     // write normal fields
2107     for fld in mFields do
2108     begin
2109       // record list?
2110       if (fld.mType = fld.TType.TList) then continue; // later
2111       if fld.mInternal then continue;
2112       if (fld.mBinOfs < 0) then continue;
2113       if (fld.mBinOfs >= bufsz) then raise Exception.Create('binary value offset is outside of the buffer');
2114       TSFSMemoryChunkStream(ws).setup(buf+fld.mBinOfs, bufsz-fld.mBinOfs);
2115       //writeln('writing field <', fld.mName, '>');
2116       fld.writeBinTo(ws);
2117     end;
2118
2119     // write block with normal fields
2120     if mHeader and not onlyFields then
2121     begin
2122       //writeln('writing header...');
2123       // signature and version
2124       writeIntBE(st, LongWord($4D415001));
2125       writeInt(st, Byte(mBinBlock)); // type
2126       writeInt(st, LongWord(0)); // reserved
2127       writeInt(st, LongWord(bufsz)); // size
2128     end;
2129     st.WriteBuffer(buf^, bufsz);
2130
2131     ws.Free(); ws := nil;
2132     FreeMem(buf); buf := nil;
2133
2134     // write other blocks, if any
2135     if mHeader and not onlyFields then
2136     begin
2137       // calculate blkmax
2138       blkmax := 0;
2139       for fld in mFields do
2140       begin
2141         // record list?
2142         if (fld.mType = fld.TType.TList) then
2143         begin
2144           if (fld.mRVal = nil) or (fld.mRVal.count = 0) then continue;
2145           rec := mOwner.findRecType(fld.mName);
2146           if (rec = nil) then continue;
2147           if (rec.mBinBlock <= 0) then continue;
2148           if (blkmax < rec.mBinBlock) then blkmax := rec.mBinBlock;
2149         end;
2150       end;
2151       // write blocks
2152       for blk := 1 to blkmax do
2153       begin
2154         if (blk = mBinBlock) then continue;
2155         ws := nil;
2156         for fld in mFields do
2157         begin
2158           // record list?
2159           if (fld.mType = fld.TType.TList) then
2160           begin
2161             if (fld.mRVal = nil) or (fld.mRVal.count = 0) then continue;
2162             rec := mOwner.findRecType(fld.mName);
2163             if (rec = nil) then continue;
2164             if (rec.mBinBlock <> blk) then continue;
2165             if (ws = nil) then ws := TMemoryStream.Create();
2166             for rv in fld.mRVal do rv.writeBinTo(ws);
2167           end;
2168         end;
2169         // flush block
2170         if (ws <> nil) then
2171         begin
2172           blksz := Integer(ws.position);
2173           ws.position := 0;
2174           writeInt(st, Byte(blk)); // type
2175           writeInt(st, LongWord(0)); // reserved
2176           writeInt(st, LongWord(blksz)); // size
2177           st.CopyFrom(ws, blksz);
2178           ws.Free();
2179           ws := nil;
2180         end;
2181       end;
2182       // write end marker
2183       writeInt(st, Byte(0));
2184       writeInt(st, LongWord(0));
2185       writeInt(st, LongWord(0));
2186     end;
2187   finally
2188     ws.Free();
2189     if (buf <> nil) then FreeMem(buf);
2190   end;
2191 end;
2192
2193
2194 procedure TDynRecord.writeTo (wr: TTextWriter; putHeader: Boolean=true);
2195 var
2196   fld: TDynField;
2197   rec: TDynRecord;
2198 begin
2199   if putHeader then
2200   begin
2201     wr.put(mName);
2202     if (Length(mId) > 0) then begin wr.put(' '); wr.put(mId); end;
2203     wr.put(' ');
2204   end;
2205   wr.put('{'#10);
2206   wr.indent();
2207   try
2208     for fld in mFields do
2209     begin
2210       // record list?
2211       if (fld.mType = fld.TType.TList) then
2212       begin
2213         if not mHeader then raise Exception.Create('record list in non-header record');
2214         if (fld.mRVal <> nil) then
2215         begin
2216           for rec in fld.mRVal do
2217           begin
2218             if (Length(rec.mId) = 0) then continue;
2219             wr.putIndent();
2220             rec.writeTo(wr, true);
2221           end;
2222         end;
2223         continue;
2224       end;
2225       if fld.mInternal then continue;
2226       if fld.mOmitDef and fld.isDefaultValue then continue;
2227       wr.putIndent();
2228       fld.writeTo(wr);
2229     end;
2230   finally
2231     wr.unindent();
2232   end;
2233   wr.putIndent();
2234   wr.put('}'#10);
2235 end;
2236
2237
2238 {$IF DEFINED(D2D_DYNREC_PROFILER)}
2239 var
2240   profCloneRec: UInt64 = 0;
2241   profFindRecType: UInt64 = 0;
2242   profFieldSearching: UInt64 = 0;
2243   profListDupChecking: UInt64 = 0;
2244   profAddRecByType: UInt64 = 0;
2245   profFieldValParsing: UInt64 = 0;
2246   profFixDefaults: UInt64 = 0;
2247   profRecValParse: UInt64 = 0;
2248
2249 procedure xdynDumpProfiles ();
2250 begin
2251   writeln('=== XDYNREC PROFILES ===');
2252   writeln('record cloning: ', profCloneRec div 1000, '.', profCloneRec mod 1000, ' milliseconds');
2253   writeln('findRecType   : ', profFindRecType div 1000, '.', profFindRecType mod 1000, ' milliseconds');
2254   writeln('field[]       : ', profFieldSearching div 1000, '.', profFieldSearching mod 1000, ' milliseconds');
2255   writeln('list dup check: ', profListDupChecking div 1000, '.', profListDupChecking mod 1000, ' milliseconds');
2256   writeln('addRecByType  : ', profAddRecByType div 1000, '.', profAddRecByType mod 1000, ' milliseconds');
2257   writeln('field valparse: ', profFieldValParsing div 1000, '.', profFieldValParsing mod 1000, ' milliseconds');
2258   writeln('fix defaults  : ', profFixDefaults div 1000, '.', profFixDefaults mod 1000, ' milliseconds');
2259   writeln('recvalparse   : ', profRecValParse div 1000, '.', profRecValParse mod 1000, ' milliseconds');
2260 end;
2261 {$ENDIF}
2262
2263
2264 procedure TDynRecord.parseValue (pr: TTextParser; beginEaten: Boolean=false);
2265 var
2266   fld: TDynField;
2267   rec: TDynRecord = nil;
2268   trc{, rv}: TDynRecord;
2269   {$IF DEFINED(D2D_DYNREC_PROFILER)}
2270   stt, stall: UInt64;
2271   {$ENDIF}
2272 begin
2273   if (mOwner = nil) then raise Exception.Create(Format('can''t parse record ''%s'' value without owner', [mName]));
2274
2275   {$IF DEFINED(D2D_DYNREC_PROFILER)}stall := curTimeMicro();{$ENDIF}
2276
2277   // not a header?
2278   if not mHeader then
2279   begin
2280     // id?
2281     if (not beginEaten) and (pr.tokType = pr.TTId) then mId := pr.expectId();
2282   end
2283   else
2284   begin
2285     assert(mHeaderRec = self);
2286   end;
2287
2288   //writeln('parsing record <', mName, '>');
2289   if not beginEaten then pr.expectTT(pr.TTBegin);
2290   while (pr.tokType <> pr.TTEnd) do
2291   begin
2292     if (pr.tokType <> pr.TTId) then raise Exception.Create('identifier expected');
2293     //writeln('<', mName, '.', pr.tokStr, '>');
2294
2295     // records
2296     if mHeader then
2297     begin
2298       // add records with this type (if any)
2299       {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2300       trc := mOwner.findRecType(pr.tokStr);
2301       {$IF DEFINED(D2D_DYNREC_PROFILER)}profFindRecType := curTimeMicro()-stt;{$ENDIF}
2302       if (trc <> nil) then
2303       begin
2304         {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2305         rec := trc.clone();
2306         {$IF DEFINED(D2D_DYNREC_PROFILER)}profCloneRec := curTimeMicro()-stt;{$ENDIF}
2307         rec.mHeaderRec := mHeaderRec;
2308         try
2309           pr.skipToken();
2310           rec.parseValue(pr);
2311           (*
2312           if (Length(rec.mId) > 0) then
2313           begin
2314             {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2315             fld := field[pr.tokStr];
2316             {$IF DEFINED(D2D_DYNREC_PROFILER)}profFieldSearching := curTimeMicro()-stt;{$ENDIF}
2317             (*
2318             if (fld <> nil) and (fld.mRVal <> nil) then
2319             begin
2320               {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2321               //idtmp := trc.mName+':'+rec.mId;
2322               //if ids.put(idtmp, 1) then raise Exception.Create(Format('duplicate thing ''%s'' in record ''%s''', [fld.mName, mName]));
2323               if fld.mRHash.has(rec.mId) then raise Exception.Create(Format('duplicate thing ''%s'' in record ''%s''', [fld.mName, mName]));
2324               {$IF DEFINED(D2D_DYNREC_PROFILER)}profListDupChecking := curTimeMicro()-stt;{$ENDIF}
2325             end;
2326           end;
2327           *)
2328           {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2329           addRecordByType(rec.mName, rec);
2330           {$IF DEFINED(D2D_DYNREC_PROFILER)}profAddRecByType := curTimeMicro()-stt;{$ENDIF}
2331           rec := nil;
2332         finally
2333           rec.Free();
2334         end;
2335         continue;
2336       end;
2337     end;
2338
2339     // fields
2340     {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2341     fld := field[pr.tokStr];
2342     {$IF DEFINED(D2D_DYNREC_PROFILER)}profFieldSearching := curTimeMicro()-stt;{$ENDIF}
2343     if (fld <> nil) then
2344     begin
2345       if fld.defined then raise Exception.Create(Format('duplicate field ''%s'' in record ''%s''', [fld.mName, mName]));
2346       if fld.internal then raise Exception.Create(Format('internal field ''%s'' in record ''%s''', [fld.mName, mName]));
2347       pr.skipToken();
2348       {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2349       fld.parseValue(pr);
2350       {$IF DEFINED(D2D_DYNREC_PROFILER)}profFieldValParsing := curTimeMicro()-stt;{$ENDIF}
2351       continue;
2352     end;
2353
2354     // something is wrong
2355     raise Exception.Create(Format('unknown field ''%s'' in record ''%s''', [pr.tokStr, mName]));
2356   end;
2357   pr.expectTT(pr.TTEnd);
2358   // fix field defaults
2359   {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2360   for fld in mFields do fld.fixDefaultValue();
2361   {$IF DEFINED(D2D_DYNREC_PROFILER)}profFixDefaults := curTimeMicro()-stt;{$ENDIF}
2362   //writeln('done parsing record <', mName, '>');
2363   //{$IF DEFINED(D2D_DYNREC_PROFILER)}writeln('stall: ', curTimeMicro()-stall);{$ENDIF}
2364   {$IF DEFINED(D2D_DYNREC_PROFILER)}profRecValParse := curTimeMicro()-stall;{$ENDIF}
2365 end;
2366
2367
2368 // ////////////////////////////////////////////////////////////////////////// //
2369 constructor TDynEBS.Create (pr: TTextParser);
2370 begin
2371   cleanup();
2372   parseDef(pr);
2373 end;
2374
2375
2376 destructor TDynEBS.Destroy ();
2377 begin
2378   cleanup();
2379   inherited;
2380 end;
2381
2382
2383 procedure TDynEBS.cleanup ();
2384 begin
2385   mIsEnum := false;
2386   mName := '';
2387   mIds := nil;
2388   mVals := nil;
2389   mMaxName := '';
2390   mMaxVal := 0;
2391 end;
2392
2393
2394 function TDynEBS.findByName (const aname: AnsiString): Integer;
2395 begin
2396   result := 0;
2397   while (result < Length(mIds)) do
2398   begin
2399     if StrEqu(aname, mIds[result]) then exit;
2400     Inc(result);
2401   end;
2402   result := -1;
2403 end;
2404
2405
2406 function TDynEBS.hasByName (const aname: AnsiString): Boolean; inline;
2407 begin
2408   result := (findByName(aname) >= 0);
2409 end;
2410
2411
2412 function TDynEBS.getFieldByName (const aname: AnsiString): Integer; inline;
2413 var
2414   f: Integer;
2415 begin
2416   f := findByName(aname);
2417   if (f >= 0) then result := mVals[f] else result := 0;
2418 end;
2419
2420
2421 function TDynEBS.definition (): AnsiString;
2422 var
2423   f, cv: Integer;
2424 begin
2425   if mIsEnum then result :='enum ' else result := 'bitset ';
2426   result += mName;
2427   result += ' {'#10;
2428   // fields
2429   if mIsEnum then cv := 0 else cv := 1;
2430   for f := 0 to High(mIds) do
2431   begin
2432     if (mIds[f] = mMaxName) then continue;
2433     result += '  '+mIds[f];
2434     if (mVals[f] <> cv) then
2435     begin
2436       result += Format(' = %d', [mVals[f]]);
2437       if mIsEnum then cv := mVals[f];
2438       result += ','#10;
2439     end
2440     else
2441     begin
2442       result += Format(', // %d'#10, [mVals[f]]);
2443     end;
2444     if mIsEnum then Inc(cv) else if (mVals[f] = cv) then cv := cv shl 1;
2445   end;
2446   // max field
2447   if (Length(mMaxName) > 0) then result += '  '+mMaxName+' = MAX,'#10;
2448   result += '}';
2449 end;
2450
2451
2452 function TDynEBS.pasdef (): AnsiString;
2453 var
2454   f: Integer;
2455 begin
2456   result := '// '+mName+#10'const'#10;
2457   // fields
2458   for f := 0 to High(mIds) do
2459   begin
2460     result += formatstrf('  %s = %d;'#10, [mIds[f], mVals[f]]);
2461   end;
2462 end;
2463
2464
2465 function TDynEBS.nameByValue (v: Integer): AnsiString;
2466 var
2467   f: Integer;
2468 begin
2469   for f := 0 to High(mVals) do
2470   begin
2471     if (mVals[f] = v) then begin result := mIds[f]; exit; end;
2472   end;
2473   result := '';
2474 end;
2475
2476
2477 procedure TDynEBS.parseDef (pr: TTextParser);
2478 var
2479   idname: AnsiString;
2480   cv, v: Integer;
2481   f: Integer;
2482   skipAdd: Boolean;
2483   hasV: Boolean;
2484 begin
2485        if pr.eatId('enum') then mIsEnum := true
2486   else if pr.eatId('bitset') then mIsEnum := false
2487   else pr.expectId('enum');
2488   mName := pr.expectId();
2489   mMaxVal := Integer($80000000);
2490   if mIsEnum then cv := 0 else cv := 1;
2491   pr.expectTT(pr.TTBegin);
2492   while (pr.tokType <> pr.TTEnd) do
2493   begin
2494     idname := pr.expectId();
2495     for f := 0 to High(mIds) do
2496     begin
2497       if StrEqu(mIds[f], idname) then raise Exception.Create(Format('duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName]));
2498     end;
2499     if StrEqu(mMaxName, idname) then raise Exception.Create(Format('duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName]));
2500     skipAdd := false;
2501     hasV := false;
2502     v := cv;
2503     // has value?
2504     if pr.eatDelim('=') then
2505     begin
2506       if pr.eatId('MAX') then
2507       begin
2508         if (Length(mMaxName) > 0) then raise Exception.Create(Format('duplicate max field ''%s'' in enum/bitset ''%s''', [idname, mName]));
2509         mMaxName := idname;
2510         skipAdd := true;
2511       end
2512       else
2513       begin
2514         v := pr.expectInt();
2515           if mIsEnum then cv := v;
2516         hasV := true;
2517       end;
2518     end;
2519     // append it?
2520     if not skipAdd then
2521     begin
2522       // fix maxvalue
2523       if mIsEnum or (not hasV) then
2524       begin
2525         if (mMaxVal < v) then mMaxVal := v;
2526       end;
2527       SetLength(mIds, Length(mIds)+1);
2528       mIds[High(mIds)] := idname;
2529       SetLength(mVals, Length(mIds));
2530       mVals[High(mVals)] := v;
2531       // next cv
2532       if mIsEnum or (not hasV) then
2533       begin
2534         if mIsEnum then Inc(cv) else cv := cv shl 1;
2535       end;
2536     end;
2537     if (pr.tokType = pr.TTEnd) then break;
2538     pr.expectTT(pr.TTComma);
2539     while pr.eatTT(pr.TTComma) do begin end;
2540   end;
2541   pr.expectTT(pr.TTEnd);
2542   // add max field
2543   if (Length(mMaxName) > 0) then
2544   begin
2545     SetLength(mIds, Length(mIds)+1);
2546     mIds[High(mIds)] := mMaxName;
2547     SetLength(mVals, Length(mIds));
2548     mVals[High(mVals)] := mMaxVal;
2549   end;
2550 end;
2551
2552
2553 // ////////////////////////////////////////////////////////////////////////// //
2554 constructor TDynMapDef.Create (pr: TTextParser);
2555 begin
2556   recTypes := TDynRecList.Create();
2557   trigTypes := TDynRecList.Create();
2558   ebsTypes := TDynEBSList.Create();
2559   parseDef(pr);
2560 end;
2561
2562
2563 destructor TDynMapDef.Destroy ();
2564 var
2565   rec: TDynRecord;
2566   ebs: TDynEBS;
2567 begin
2568   for rec in recTypes do rec.Free();
2569   for rec in trigTypes do rec.Free();
2570   for ebs in ebsTypes do ebs.Free();
2571   recTypes.Free();
2572   trigTypes.Free();
2573   ebsTypes.Free();
2574   recTypes := nil;
2575   trigTypes := nil;
2576   ebsTypes := nil;
2577   inherited;
2578 end;
2579
2580
2581 function TDynMapDef.getHeaderRecType (): TDynRecord; inline;
2582 begin
2583   if (recTypes.count = 0) then raise Exception.Create('no header in empty mapdef');
2584   result := recTypes[0];
2585 end;
2586
2587
2588 function TDynMapDef.findRecType (const aname: AnsiString): TDynRecord;
2589 var
2590   rec: TDynRecord;
2591 begin
2592   for rec in recTypes do
2593   begin
2594     if StrEqu(rec.name, aname) then begin result := rec; exit; end;
2595   end;
2596   result := nil;
2597 end;
2598
2599
2600 function TDynMapDef.findTrigFor (const aname: AnsiString): TDynRecord;
2601 var
2602   rec: TDynRecord;
2603 begin
2604   for rec in trigTypes do
2605   begin
2606     if (rec.isForTrig[aname]) then begin result := rec; exit; end;
2607   end;
2608   result := nil;
2609 end;
2610
2611
2612 function TDynMapDef.findEBSType (const aname: AnsiString): TDynEBS;
2613 var
2614   ebs: TDynEBS;
2615 begin
2616   for ebs in ebsTypes do
2617   begin
2618     if StrEqu(ebs.name, aname) then begin result := ebs; exit; end;
2619   end;
2620   result := nil;
2621 end;
2622
2623
2624 procedure TDynMapDef.parseDef (pr: TTextParser);
2625 var
2626   rec, hdr: TDynRecord;
2627   eb: TDynEBS;
2628   f: Integer;
2629
2630   // setup header links and type links
2631   procedure linkRecord (rec: TDynRecord);
2632   var
2633     fld: TDynField;
2634   begin
2635     rec.mHeaderRec := recTypes[0];
2636     for fld in rec.mFields do
2637     begin
2638       if (fld.mType = fld.TType.TTrigData) then continue;
2639       case fld.mEBS of
2640         TDynField.TEBS.TNone: begin end;
2641         TDynField.TEBS.TRec:
2642           begin
2643             fld.mEBSType := findRecType(fld.mEBSTypeName);
2644             if (fld.mEBSType = nil) then raise Exception.Create(Format('field ''%s'' of type ''%s'' has no correcponding record definition', [fld.mName, fld.mEBSTypeName]));
2645           end;
2646         TDynField.TEBS.TEnum,
2647         TDynField.TEBS.TBitSet:
2648           begin
2649             fld.mEBSType := findEBSType(fld.mEBSTypeName);
2650             if (fld.mEBSType = nil) then raise Exception.Create(Format('field ''%s'' of type ''%s'' has no correcponding enum/bitset', [fld.mName, fld.mEBSTypeName]));
2651             if ((fld.mEBS = TDynField.TEBS.TEnum) <> (fld.mEBSType as TDynEBS).mIsEnum) then raise Exception.Create(Format('field ''%s'' of type ''%s'' enum/bitset type conflict', [fld.mName, fld.mEBSTypeName]));
2652           end;
2653       end;
2654     end;
2655   end;
2656
2657   // setup default values
2658   procedure fixRecordDefaults (rec: TDynRecord);
2659   var
2660     fld: TDynField;
2661   begin
2662     for fld in rec.mFields do if fld.mHasDefault then fld.parseDefaultValue();
2663   end;
2664
2665 begin
2666   hdr := nil;
2667   while true do
2668   begin
2669     if not pr.skipBlanks() then break;
2670     if (pr.tokType <> pr.TTId) then raise Exception.Create('identifier expected');
2671
2672     if (pr.tokStr = 'enum') or (pr.tokStr = 'bitset') then
2673     begin
2674       eb := TDynEBS.Create(pr);
2675       if (findEBSType(eb.name) <> nil) then
2676       begin
2677         eb.Free();
2678         raise Exception.Create(Format('duplicate enum/bitset ''%s''', [eb.name]));
2679       end;
2680       eb.mOwner := self;
2681       ebsTypes.append(eb);
2682       //writeln(eb.definition); writeln;
2683       continue;
2684     end;
2685
2686     if (pr.tokStr = 'TriggerData') then
2687     begin
2688       rec := TDynRecord.Create(pr);
2689       for f := 0 to High(rec.mTrigTypes) do
2690       begin
2691         if (findTrigFor(rec.mTrigTypes[f]) <> nil) then
2692         begin
2693           rec.Free();
2694           raise Exception.Create(Format('duplicate trigdata ''%s''', [rec.mTrigTypes[f]]));
2695         end;
2696       end;
2697       rec.mOwner := self;
2698       trigTypes.append(rec);
2699       //writeln(dr.definition); writeln;
2700       continue;
2701     end;
2702
2703     rec := TDynRecord.Create(pr);
2704     //writeln(dr.definition); writeln;
2705     if (findRecType(rec.name) <> nil) then begin rec.Free(); raise Exception.Create(Format('duplicate record ''%s''', [rec.name])); end;
2706     if (hdr <> nil) and StrEqu(rec.name, hdr.name) then begin rec.Free(); raise Exception.Create(Format('duplicate record ''%s''', [rec.name])); end;
2707     rec.mOwner := self;
2708     if rec.mHeader then
2709     begin
2710       if (hdr <> nil) then begin rec.Free(); raise Exception.Create(Format('duplicate header record ''%s'' (previous is ''%s'')', [rec.name, hdr.name])); end;
2711       hdr := rec;
2712     end
2713     else
2714     begin
2715       recTypes.append(rec);
2716     end;
2717   end;
2718
2719   // put header record to top
2720   if (hdr = nil) then raise Exception.Create('header definition not found in mapdef');
2721   recTypes.append(nil);
2722   for f := recTypes.count-1 downto 1 do recTypes[f] := recTypes[f-1];
2723   recTypes[0] := hdr;
2724
2725   // setup header links and type links
2726   for rec in recTypes do linkRecord(rec);
2727   for rec in trigTypes do linkRecord(rec);
2728
2729   // setup default values
2730   for rec in recTypes do fixRecordDefaults(rec);
2731   for rec in trigTypes do fixRecordDefaults(rec);
2732 end;
2733
2734
2735 // ////////////////////////////////////////////////////////////////////////// //
2736 function TDynMapDef.parseMap (pr: TTextParser): TDynRecord;
2737 var
2738   res: TDynRecord = nil;
2739 begin
2740   result := nil;
2741   try
2742     pr.expectId(headerType.name);
2743     res := headerType.clone();
2744     res.mHeaderRec := res;
2745     res.parseValue(pr);
2746     result := res;
2747     res := nil;
2748   finally
2749     res.Free();
2750   end;
2751 end;
2752
2753
2754 function TDynMapDef.parseBinMap (st: TStream): TDynRecord;
2755 var
2756   res: TDynRecord = nil;
2757 begin
2758   result := nil;
2759   try
2760     res := headerType.clone();
2761     res.mHeaderRec := res;
2762     res.parseBinValue(st);
2763     result := res;
2764     res := nil;
2765   finally
2766     res.Free();
2767   end;
2768 end;
2769
2770
2771 function TDynMapDef.pasdef (): AnsiString;
2772 var
2773   ebs: TDynEBS;
2774   rec: TDynRecord;
2775   fld: TDynField;
2776   needComma: Boolean;
2777   tn: AnsiString;
2778 begin
2779   result := '';
2780   result += '// ////////////////////////////////////////////////////////////////////////// //'#10;
2781   result += '// enums and bitsets'#10;
2782   for ebs in ebsTypes do result += #10+ebs.pasdef();
2783   result += #10#10'// ////////////////////////////////////////////////////////////////////////// //'#10;
2784   result += '// records'#10'type'#10;
2785   for rec in recTypes do
2786   begin
2787     if (rec.mSize < 1) then continue;
2788     result += rec.pasdef();
2789     result += #10;
2790   end;
2791   result += #10#10'// ////////////////////////////////////////////////////////////////////////// //'#10;
2792   result += '// triggerdata'#10'type'#10;
2793   result += '  TTriggerData = record'#10;
2794   result += '    case Byte of'#10;
2795   result += '      0: (Default: Byte128);'#10;
2796   for rec in trigTypes do
2797   begin
2798     result += '      ';
2799     needComma := false;
2800     for tn in rec.mTrigTypes do
2801     begin
2802       if needComma then result += ', ' else needComma := true;
2803       result += tn;
2804     end;
2805     result += ': ('#10;
2806     for fld in rec.mFields do
2807     begin
2808       if fld.mInternal then continue;
2809       if (fld.mBinOfs < 0) then continue;
2810       result += '        '+fld.pasdef+#10;
2811     end;
2812     result += '      );'#10;
2813   end;
2814   result += '  end;'#10;
2815 end;
2816
2817
2818 end.