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