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