src/shared/xdynrec.pas

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