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;
  24
  25
  26 // ////////////////////////////////////////////////////////////////////////// //
  27 type
  28   TDynMapDef = class;
  29   TDynRecord = class;
  30
  31   // this is base type for all scalars (and arrays)
  32   TDynField = class
  33   public
  34     type
  35       TType = (TBool, TChar, TByte, TUByte, TShort, TUShort, TInt, TUInt, TString, TPoint, TSize, TList, TTrigData);
  36       // TPoint: pair of Shorts
  37       // TSize: pair of UShorts
  38       // TList: actually, array of records
  39       // TTrigData: array of bytes
  40       // arrays of chars are pascal shortstrings (with counter in the first byte)
  41
  42     type
  43       TDynFieldArray = array of TDynField;
  44       TDynRecordArray = array of TDynRecord;
  45
  46   private
  47     type
  48       TEBS = (TNone, TRec, TEnum, TBitSet);
  49
  50   private
  51     mOwner: TDynRecord;
  52     mPasName: AnsiString;
  53     mName: AnsiString;
  54     mType: TType;
  55     mIVal: Integer; // for all integer types
  56     mIVal2: Integer; // for point and size
  57     mSVal: AnsiString; // string; for byte and char arrays
  58     mRVal: TDynRecordArray; // for list
  59     mRecRef: TDynRecord; // for record
  60     mMaxDim: Integer; // for byte and char arrays; <0: not an array
  61     mBinOfs: Integer; // offset in binary; <0 - none
  62     mRecOfs: Integer; // offset in record; <0 - none
  63     mSepPosSize: Boolean; // for points and sizes, use separate fields
  64     mAsT: Boolean; // for points and sizes, use separate fields, names starts with `t`
  65     mDefined: Boolean;
  66     mHasDefault: Boolean;
  67     mDefaultValueSet: Boolean;
  68     mOmitDef: Boolean;
  69     mInternal: Boolean;
  70     mNegBool: Boolean;
  71     mBitSetUnique: Boolean; // bitset can contain only one value
  72     // default value
  73     mDefSVal: AnsiString;
  74     mEBS: TEBS; // complex type type
  75     mEBSTypeName: AnsiString; // name of enum, bitset or record
  76
  77     // temp
  78     mDefId: AnsiString;
  79
  80   private
  81     procedure cleanup ();
  82
  83     procedure parseDef (pr: TTextParser);
  84
  85     procedure fixDefaultValue ();
  86     function isDefaultValue (): Boolean;
  87
  88   public
  89     constructor Create (const aname: AnsiString; atype: TType);
  90     constructor Create (pr: TTextParser);
  91     destructor Destroy (); override;
  92
  93     class function getTypeName (t: TType): AnsiString;
  94
  95     function definition (): AnsiString;
  96
  97     function clone (): TDynField;
  98
  99     procedure parseValue (pr: TTextParser; curheader: TDynRecord);
 100     procedure parseBinValue (st: TStream);
 101
 102     procedure writeTo (wr: TTextWriter);
 103     procedure writeBinTo (st: TStream; curheader: TDynRecord);
 104
 105     // won't work for lists
 106     function isSimpleEqu (fld: TDynField): Boolean;
 107
 108   public
 109     property pasname: AnsiString read mPasName;
 110     property name: AnsiString read mName;
 111     property baseType: TType read mType;
 112     property defined: Boolean read mDefined write mDefined;
 113     property internal: Boolean read mInternal write mInternal;
 114     //property ival: Integer read mIVal write setIVal;
 115     //property sval: AnsiString read mSVal write setSVal;
 116     property list: TDynRecordArray read mRVal write mRVal;
 117     property maxdim: Integer read mMaxDim; // for fixed-size arrays
 118     property binOfs: Integer read mBinOfs; // offset in binary; <0 - none
 119     property recOfs: Integer read mRecOfs; // offset in record; <0 - none
 120     property hasDefault: Boolean read mHasDefault;
 121     property defsval: AnsiString read mDefSVal write mDefSVal;
 122     property ebstype: TEBS read mEBS write mEBS;
 123     property ebstypename: AnsiString read mEBSTypeName write mEBSTypeName; // enum/bitset name
 124
 125     property x: Integer read mIVal;
 126     property w: Integer read mIVal;
 127     property y: Integer read mIVal2;
 128     property h: Integer read mIVal2;
 129   end;
 130
 131
 132   // "value" header record contains TList fields, with name equal to record type
 133   TDynRecord = class
 134   private
 135     mOwner: TDynMapDef;
 136     mId: AnsiString;
 137     mPasName: AnsiString;
 138     mName: AnsiString;
 139     mSize: Integer;
 140     mFields: TDynField.TDynFieldArray;
 141     mTrigTypes: array of AnsiString; // if this is triggerdata, we'll hold list of triggers here
 142     mHeader: Boolean; // true for header record
 143     mBinBlock: Integer; // -1: none
 144
 145   private
 146     procedure parseDef (pr: TTextParser); // parse definition
 147
 148     function findByName (const aname: AnsiString): Integer; inline;
 149     function hasByName (const aname: AnsiString): Boolean; inline;
 150     function getFieldByName (const aname: AnsiString): TDynField; inline;
 151
 152     function getIsTrigData (): Boolean; inline;
 153     function getIsForTrig (const aname: AnsiString): Boolean; inline;
 154
 155   public
 156     constructor Create ();
 157     constructor Create (pr: TTextParser); // parse definition
 158     destructor Destroy (); override;
 159
 160     function definition (): AnsiString;
 161
 162     function clone (): TDynRecord;
 163
 164     procedure parseValue (pr: TTextParser; curheader: TDynRecord);
 165     procedure parseBinValue (st: TStream);
 166
 167     procedure writeTo (wr: TTextWriter; putHeader: Boolean=true);
 168     procedure writeBinTo (st: TStream; curheader: TDynRecord; trigbufsz: Integer=-1);
 169
 170   public
 171     property id: AnsiString read mId; // for map parser
 172     property pasname: AnsiString read mPasName;
 173     property name: AnsiString read mName; // record name
 174     property size: Integer read mSize; // size in bytes
 175     property fields: TDynField.TDynFieldArray read mFields write mFields;
 176     property has[const aname: AnsiString]: Boolean read hasByName;
 177     property field[const aname: AnsiString]: TDynField read getFieldByName;
 178     property isTrigData: Boolean read getIsTrigData;
 179     property isForTrig[const aname: AnsiString]: Boolean read getIsForTrig;
 180   end;
 181
 182
 183   TDynEBS = class
 184   private
 185     mOwner: TDynMapDef;
 186     mIsEnum: Boolean;
 187     mName: AnsiString;
 188     mIds: array of AnsiString;
 189     mVals: array of Integer;
 190     mMaxName: AnsiString; // MAX field
 191     mMaxVal: Integer; // max value
 192
 193   private
 194     procedure cleanup ();
 195
 196     procedure parseDef (pr: TTextParser); // parse definition
 197
 198     function findByName (const aname: AnsiString): Integer; inline;
 199     function hasByName (const aname: AnsiString): Boolean; inline;
 200     function getFieldByName (const aname: AnsiString): Integer; inline;
 201
 202   public
 203     constructor Create (pr: TTextParser); // parse definition
 204     destructor Destroy (); override;
 205
 206     function definition (): AnsiString;
 207
 208   public
 209     property name: AnsiString read mName; // record name
 210     property isEnum: Boolean read mIsEnum;
 211     property has[const aname: AnsiString]: Boolean read hasByName;
 212     property field[const aname: AnsiString]: Integer read getFieldByName;
 213   end;
 214
 215
 216   TDynMapDef = class
 217   private
 218     procedure addRecordByType (const atypename: AnsiString; rc: TDynRecord; curheader: TDynRecord);
 219     function findRecordByTypeId (const atypename, aid: AnsiString; curheader: TDynRecord): TDynRecord;
 220     function findRecordNumByType (const atypename: AnsiString; rc: TDynRecord; curheader: TDynRecord): Integer;
 221
 222   public
 223     recTypes: array of TDynRecord; // [0] is always header
 224     trigTypes: array of TDynRecord; // trigdata
 225     ebsTypes: array of TDynEBS; // enums, bitsets
 226
 227   private
 228     procedure parseDef (pr: TTextParser);
 229
 230     function getHeaderRecType (): TDynRecord; inline;
 231
 232   public
 233     constructor Create (pr: TTextParser); // parses data definition
 234     destructor Destroy (); override;
 235
 236     function findRecType (const aname: AnsiString): TDynRecord;
 237     function findTrigFor (const aname: AnsiString): TDynRecord;
 238     function findEBSType (const aname: AnsiString): TDynEBS;
 239
 240     // creates new header record
 241     function parseMap (pr: TTextParser): TDynRecord;
 242
 243     // creates new header record
 244     function parseBinMap (st: TStream): TDynRecord;
 245
 246   public
 247     property headerType: TDynRecord read getHeaderRecType;
 248   end;
 249
 250
 251 implementation
 252
 253 uses
 254   SysUtils,
 255   utils;
 256
 257
 258 // ////////////////////////////////////////////////////////////////////////// //
 259 constructor TDynField.Create (const aname: AnsiString; atype: TType);
 260 begin
 261   mRVal := nil;
 262   mRecRef := nil;
 263   cleanup();
 264   mName := aname;
 265   mType := atype;
 266 end;
 267
 268
 269 constructor TDynField.Create (pr: TTextParser);
 270 begin
 271   cleanup();
 272   parseDef(pr);
 273 end;
 274
 275
 276 destructor TDynField.Destroy ();
 277 begin
 278   cleanup();
 279   inherited;
 280 end;
 281
 282
 283 procedure TDynField.cleanup ();
 284 begin
 285   mName := '';
 286   mType := TType.TInt;
 287   mIVal := 0;
 288   mIVal2 := 0;
 289   mSVal := '';
 290   mRVal := nil;
 291   mRecRef := nil;
 292   mMaxDim := -1;
 293   mBinOfs := -1;
 294   mRecOfs := -1;
 295   mSepPosSize := false;
 296   mAsT := false;
 297   mHasDefault := false;
 298   mDefined := false;
 299   mOmitDef := false;
 300   mInternal := true;
 301   mDefSVal := '';
 302   mEBS := TEBS.TNone;
 303   mEBSTypeName := '';
 304   mBitSetUnique := false;
 305   mNegBool := false;
 306   mDefId := '';
 307   mDefaultValueSet := false;
 308 end;
 309
 310
 311 function TDynField.clone (): TDynField;
 312 var
 313   f: Integer;
 314 begin
 315   result := TDynField.Create(mName, mType);
 316   result.mOwner := mOwner;
 317   result.mPasName := mPasName;
 318   result.mName := mName;
 319   result.mType := mType;
 320   result.mIVal := mIVal;
 321   result.mIVal2 := mIVal2;
 322   result.mSVal := mSVal;
 323   SetLength(result.mRVal, Length(mRVal));
 324   for f := 0 to High(mRVal) do result.mRVal[f] := mRVal[f].clone();
 325   result.mRecRef := mRecRef;
 326   result.mMaxDim := mMaxDim;
 327   result.mBinOfs := mBinOfs;
 328   result.mRecOfs := mRecOfs;
 329   result.mSepPosSize := mSepPosSize;
 330   result.mAsT := mAsT;
 331   result.mDefined := mDefined;
 332   result.mHasDefault := mHasDefault;
 333   result.mOmitDef := mOmitDef;
 334   result.mInternal := mInternal;
 335   result.mDefSVal := mDefSVal;
 336   result.mEBS := mEBS;
 337   result.mEBSTypeName := mEBSTypeName;
 338   result.mBitSetUnique := mBitSetUnique;
 339   result.mNegBool := mNegBool;
 340   result.mDefId := mDefId;
 341   result.mDefaultValueSet := mDefaultValueSet;
 342 end;
 343
 344
 345 // won't work for lists
 346 function TDynField.isSimpleEqu (fld: TDynField): Boolean;
 347 begin
 348   if (fld = nil) or (mType <> fld.mType) then begin result := false; exit; end;
 349   case mType of
 350     TType.TBool: result := ((mIVal <> 0) = (fld.mIVal <> 0));
 351     TType.TChar: result := (mSVal = fld.mSVal);
 352     TType.TByte,
 353     TType.TUByte,
 354     TType.TShort,
 355     TType.TUShort,
 356     TType.TInt,
 357     TType.TUInt:
 358       result := (mIVal = fld.mIVal);
 359     TType.TString: result := (mSVal = fld.mSVal);
 360     TType.TPoint,
 361     TType.TSize:
 362       result := ((mIVal = fld.mIVal) and (mIVal2 = fld.mIVal2));
 363     TType.TList: result := false;
 364     TType.TTrigData: result := false;
 365     else raise Exception.Create('ketmar forgot to handle some field type');
 366   end;
 367 end;
 368
 369
 370 procedure TDynField.fixDefaultValue ();
 371 var
 372   stp: TTextParser;
 373   s: AnsiString;
 374 begin
 375   if not mDefined then
 376   begin
 377     if not mHasDefault then
 378     begin
 379       if mInternal then exit;
 380       raise Exception.Create(Format('field ''%s'' in record ''%s'' of record type ''%s'' is not set', [mName, mOwner.mId, mOwner.mName]));
 381     end;
 382     if (mEBS = TEBS.TRec) then
 383     begin
 384       if (CompareText(mDefSVal, 'null') <> 0) then raise Exception.Create(Format('field ''%s'' in record ''%s'' of record type ''%s'' has non-null default value ''%s''', [mName, mOwner.mId, mOwner.mName, mDefSVal]));
 385       mDefined := true;
 386       assert(mRecRef = nil);
 387       mDefaultValueSet := true;
 388       exit;
 389     end;
 390     s := '';
 391     case mType of
 392       TType.TChar, TType.TString: s := TTextParser.quote(mDefSVal)+';';
 393       TType.TPoint, TType.TSize: assert(false); // no default values for these types yet
 394       else s := mDefSVal+';';
 395     end;
 396     //mDefined := true;
 397     //writeln('DEFAULT for <', mName, '>: <', s, '>');
 398     stp := TStrTextParser.Create(s);
 399     try
 400       parseValue(stp, nil);
 401     finally
 402       stp.Free();
 403     end;
 404     assert(mDefined);
 405     mDefaultValueSet := true;
 406   end;
 407 end;
 408
 409
 410 function TDynField.isDefaultValue (): Boolean;
 411 var
 412   fld: TDynField = nil;
 413   stp: TTextParser = nil;
 414   s: AnsiString;
 415 begin
 416   if not mHasDefault then begin result := false; exit; end;
 417   //result := mDefaultValueSet;
 418   if (mEBS = TEBS.TRec) then begin result := (mRecRef = nil); exit; end;
 419   s := '';
 420   case mType of
 421     TType.TChar, TType.TString: s := TTextParser.quote(mDefSVal)+';';
 422     TType.TPoint, TType.TSize: begin result := false; exit; end; // no default values for these types yet
 423     else s := mDefSVal+';';
 424   end;
 425   stp := TStrTextParser.Create(s);
 426   try
 427     fld := clone();
 428     fld.parseValue(stp, nil);
 429     result := isSimpleEqu(fld);
 430   finally
 431     fld.Free();
 432     stp.Free();
 433   end;
 434 end;
 435
 436
 437 class function TDynField.getTypeName (t: TType): AnsiString;
 438 begin
 439   case t of
 440     TType.TBool: result := 'bool';
 441     TType.TChar: result := 'char';
 442     TType.TByte: result := 'byte';
 443     TType.TUByte: result := 'ubyte';
 444     TType.TShort: result := 'short';
 445     TType.TUShort: result := 'ushort';
 446     TType.TInt: result := 'int';
 447     TType.TUInt: result := 'uint';
 448     TType.TString: result := 'string';
 449     TType.TPoint: result := 'point';
 450     TType.TSize: result := 'size';
 451     TType.TList: result := 'array';
 452     TType.TTrigData: result := 'trigdata';
 453     else raise Exception.Create('ketmar forgot to handle some field type');
 454   end;
 455 end;
 456
 457
 458 function TDynField.definition (): AnsiString;
 459 begin
 460   result := mPasName+' is '+TTextParser.quote(mName)+' type ';
 461   result += getTypeName(mType);
 462   if (mMaxDim >= 0) then result += Format('[%d]', [mMaxDim]);
 463   if (mRecOfs >= 0) then result += Format(' offset %d', [mRecOfs]);
 464   case mEBS of
 465     TEBS.TNone: begin end;
 466     TEBS.TRec: result += ' '+mEBSTypeName;
 467     TEBS.TEnum: result += ' enum '+mEBSTypeName;
 468     TEBS.TBitSet: begin result += ' bitset '; if mBitSetUnique then result += 'unique '; result += mEBSTypeName; end;
 469   end;
 470   if mHasDefault then
 471   begin
 472     if (mType = TType.TChar) or (mType = TType.TString) then result += ' default '+TTextParser.quote(mDefSVal)
 473     else if (Length(mDefSVal) > 0) then result += ' default '+mDefSVal;
 474     {
 475     else
 476     begin
 477       if (mType = TType.TBool) then
 478       begin
 479         result += ' default ';
 480         if (mDefIVal <> 0) then result += 'true' else result += 'false';
 481       end
 482       else
 483       begin
 484         result += Format(' default %d', [mDefIVal]);
 485       end;
 486     end;
 487     }
 488   end;
 489   if mSepPosSize then
 490   begin
 491          if (mType = TType.TPoint) then begin if (mAsT) then result += ' as txy' else result += ' as xy'; end
 492     else if (mType = TType.TSize) then begin if (mAsT) then result += ' as twh' else result += ' as wh'; end;
 493   end;
 494   if mOmitDef then result += ' omitdefault';
 495   if mInternal then result += ' internal';
 496 end;
 497
 498
 499 procedure TDynField.parseDef (pr: TTextParser);
 500 var
 501   fldname: AnsiString;
 502   fldtype: AnsiString;
 503   fldofs: Integer;
 504   fldrecname: AnsiString;
 505   fldpasname: AnsiString;
 506   asxy, aswh, ast: Boolean;
 507   ainternal: Boolean;
 508   omitdef: Boolean;
 509   defstr: AnsiString;
 510   defint: Integer;
 511   hasdefStr: Boolean;
 512   hasdefInt: Boolean;
 513   hasdefId: Boolean;
 514   lmaxdim: Integer;
 515   lebs: TDynField.TEBS;
 516   unique: Boolean;
 517 begin
 518   fldpasname := '';
 519   fldname := '';
 520   fldtype := '';
 521   fldofs := -1;
 522   fldrecname := '';
 523   asxy := false;
 524   aswh := false;
 525   ast := false;
 526   ainternal := false;
 527   omitdef := false;
 528   defstr := '';
 529   defint := 0;
 530   hasdefStr := false;
 531   hasdefInt := false;
 532   hasdefId := false;
 533   unique := false;
 534   lmaxdim := -1;
 535   lebs := TDynField.TEBS.TNone;
 536
 537   fldpasname := pr.expectId(); // pascal field name
 538   // field name
 539   pr.expectId('is');
 540   fldname := pr.expectStr();
 541   // field type
 542   pr.expectId('type');
 543   fldtype := pr.expectId();
 544
 545   // fixed-size array?
 546   if pr.eatDelim('[') then
 547   begin
 548     lmaxdim := pr.expectInt();
 549     if (lmaxdim < 1) then raise Exception.Create(Format('invali field ''%s'' array size', [fldname]));
 550     pr.expectDelim(']');
 551   end;
 552
 553   while (pr.tokType <> pr.TTSemi) do
 554   begin
 555     if pr.eatId('offset') then
 556     begin
 557       if (fldofs >= 0) then raise Exception.Create(Format('duplicate field ''%s'' offset', [fldname]));
 558       fldofs := pr.expectInt();
 559       if (fldofs < 0) then raise Exception.Create(Format('invalid field ''%s'' offset', [fldname]));
 560       continue;
 561     end;
 562
 563     if pr.eatId('as') then
 564     begin
 565            if pr.eatId('xy') then asxy := true
 566       else if pr.eatId('wh') then aswh := true
 567       else if pr.eatId('txy') then begin asxy := true; ast := true; end
 568       else if pr.eatId('twh') then begin aswh := true; ast := true; end
 569       else raise Exception.Create(Format('invalid field ''%s'' as what?', [fldname]));
 570       continue;
 571     end;
 572
 573     if pr.eatId('enum') then
 574     begin
 575       lebs := TDynField.TEBS.TEnum;
 576       if (Length(fldrecname) <> 0) then raise Exception.Create(Format('field ''%s'' already typed as ''%s''', [fldname, fldrecname]));
 577       fldrecname := pr.expectId();
 578       continue;
 579     end;
 580
 581     if pr.eatId('bitset') then
 582     begin
 583       lebs := TDynField.TEBS.TBitSet;
 584       if (Length(fldrecname) <> 0) then raise Exception.Create(Format('field ''%s'' already typed as ''%s''', [fldname, fldrecname]));
 585       unique := pr.eatId('unique');
 586       fldrecname := pr.expectId();
 587       continue;
 588     end;
 589
 590     if pr.eatId('default') then
 591     begin
 592       if hasdefStr or hasdefInt or hasdefId then raise Exception.Create(Format('field ''%s'' has duplicate default', [fldname]));
 593       case pr.tokType of
 594         pr.TTStr:
 595           begin
 596             hasdefStr := true;
 597             defstr := pr.expectStr(true); // allow empty strings
 598           end;
 599         pr.TTId:
 600           begin
 601             hasdefId := true;
 602             defstr := pr.expectId();
 603           end;
 604         pr.TTInt:
 605           begin
 606             hasdefInt := true;
 607             defint := pr.expectInt();
 608           end;
 609         else
 610           raise Exception.Create(Format('field ''%s'' has invalid default', [fldname]));
 611       end;
 612       continue;
 613     end;
 614
 615     if pr.eatId('omitdefault') then
 616     begin
 617       omitdef := true;
 618       continue;
 619     end;
 620
 621     if pr.eatId('internal') then
 622     begin
 623       ainternal := true;
 624       continue;
 625     end;
 626
 627     if (pr.tokType <> pr.TTId) then raise Exception.Create(Format('field ''%s'' has something unexpected in definition', [fldname]));
 628
 629     if (Length(fldrecname) <> 0) then raise Exception.Create(Format('field ''%s'' already typed as ''%s''', [fldname, fldrecname]));
 630     fldrecname := pr.expectId();
 631     lebs := TDynField.TEBS.TRec;
 632   end;
 633
 634   pr.expectTT(pr.TTSemi);
 635
 636   // create field
 637   mName := fldname;
 638        if (fldtype = 'bool') then mType := TType.TBool
 639   else if (fldtype = 'negbool') then begin mType := TType.TBool; mNegBool := true; end
 640   else if (fldtype = 'char') then mType := TType.TChar
 641   else if (fldtype = 'byte') then mType := TType.TByte
 642   else if (fldtype = 'ubyte') then mType := TType.TUByte
 643   else if (fldtype = 'short') then mType := TType.TShort
 644   else if (fldtype = 'ushort') then mType := TType.TUShort
 645   else if (fldtype = 'int') then mType := TType.TInt
 646   else if (fldtype = 'uint') then mType := TType.TUInt
 647   else if (fldtype = 'string') then mType := TType.TString
 648   else if (fldtype = 'point') then mType := TType.TPoint
 649   else if (fldtype = 'size') then mType := TType.TSize
 650   else if (fldtype = 'trigdata') then mType := TType.TTrigData
 651   else raise Exception.Create(Format('field ''%s'' has invalid type ''%s''', [fldname, fldtype]));
 652
 653   {if hasdefId and (self.baseType = self.TType.TBool) then
 654   begin
 655          if (defstr = 'true') or (defstr = 'tan') or (defstr = 'yes') then self.mDefIVal := 1
 656     else if (defstr = 'false') or (defstr = 'ona') or (defstr = 'no') then self.mDefIVal := 0
 657     else raise Exception.Create(Format('field ''%s'' has invalid boolean default ''%s''', [fldname, defstr]));
 658   end
 659   else}
 660   begin
 661          if hasdefStr then self.mDefSVal := defstr
 662     else if hasdefInt then self.mDefSVal := Format('%d', [defint])
 663     else if hasdefId then self.mDefSVal := defstr;
 664   end;
 665
 666   self.mHasDefault := (hasdefStr or hasdefId or hasdefInt);
 667   self.mPasName := fldpasname;
 668   self.mEBS := lebs;
 669   self.mEBSTypeName := fldrecname;
 670   self.mBitSetUnique := unique;
 671   self.mMaxDim := lmaxdim;
 672   self.mBinOfs := fldofs;
 673   self.mRecOfs := fldofs;
 674   self.mSepPosSize := (asxy or aswh);
 675   self.mAsT := ast;
 676   self.mOmitDef := omitdef;
 677   self.mInternal := ainternal;
 678 end;
 679
 680
 681 procedure TDynField.writeBinTo (st: TStream; curheader: TDynRecord);
 682 var
 683   s: AnsiString;
 684   f: Integer;
 685   maxv: Integer;
 686   buf: PByte;
 687   ws: TStream = nil;
 688 begin
 689   case mEBS of
 690     TEBS.TNone: begin end;
 691     TEBS.TRec:
 692       begin
 693         // this must be byte/word/int
 694         if (mMaxDim >= 0) then
 695         begin
 696           // this must be triggerdata
 697           if (CompareText(mEBSTypeName, 'triggerdata') <> 0) then
 698           begin
 699             raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
 700           end;
 701           // write triggerdata
 702           case mType of
 703             TType.TChar, TType.TByte, TType.TUByte: begin end;
 704             else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
 705           end;
 706           //writeln('trigdata size: ', mMaxDim);
 707           GetMem(buf, mMaxDim);
 708           if (buf = nil) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
 709           try
 710             FillChar(buf^, mMaxDim, 0);
 711             if (mRecRef <> nil) then
 712             begin
 713               ws := TSFSMemoryChunkStream.Create(buf, mMaxDim);
 714               mRecRef.writeBinTo(ws, curheader, mMaxDim); // as trigdata
 715             end;
 716             st.WriteBuffer(buf^, mMaxDim);
 717           finally
 718             ws.Free();
 719             if (buf <> nil) then FreeMem(buf);
 720           end;
 721           exit;
 722         end;
 723         if (mRecRef = nil) then
 724         begin
 725           // no ref, write -1
 726           case mType of
 727             TType.TByte, TType.TUByte: writeInt(st, Byte(-1));
 728             TType.TShort, TType.TUShort: writeInt(st, SmallInt(-1));
 729             TType.TInt, TType.TUInt: writeInt(st, Integer(-1));
 730             else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
 731           end;
 732           exit;
 733         end;
 734         case mType of
 735           TType.TByte: maxv := 127;
 736           TType.TUByte: maxv := 254;
 737           TType.TShort: maxv := 32767;
 738           TType.TUShort: maxv := 65534;
 739           TType.TInt: maxv := $7fffffff;
 740           TType.TUInt: maxv := $7fffffff;
 741           else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
 742         end;
 743         // find record number
 744         f := mOwner.mOwner.findRecordNumByType(mEBSTypeName, mRecRef, curheader);
 745         if (f < 0) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' not found in record list', [mEBSTypeName, mName]));
 746         if (f > maxv) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' has too big index', [mEBSTypeName, mName]));
 747         case mType of
 748           TType.TByte, TType.TUByte: writeInt(st, Byte(f));
 749           TType.TShort, TType.TUShort: writeInt(st, SmallInt(f));
 750           TType.TInt, TType.TUInt: writeInt(st, Integer(f));
 751           else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
 752         end;
 753         exit;
 754       end;
 755     TEBS.TEnum: begin end;
 756     TEBS.TBitSet: begin end;
 757     else raise Exception.Create('ketmar forgot to handle some EBS type');
 758   end;
 759
 760   case mType of
 761     TType.TBool:
 762       begin
 763         if (mIVal <> 0) then writeInt(st, Byte(1)) else writeInt(st, Byte(0));
 764         exit;
 765       end;
 766     TType.TChar:
 767       begin
 768         if (mMaxDim = 0) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
 769         if (mMaxDim < 0) then
 770         begin
 771           if (Length(mSVal) <> 1) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
 772           writeInt(st, Byte(mSVal[1]));
 773         end
 774         else
 775         begin
 776           if (Length(mSVal) > mMaxDim) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
 777           //FillChar(s[0], sizeof(s), 0);
 778           s := utfTo1251(mSVal);
 779           //writeln('writing char[', mMaxDim, '] <', mName, '>: ', TTextParser.quote(s));
 780           if (Length(s) > 0) then st.WriteBuffer(PChar(s)^, Length(s));
 781           for f := Length(s) to mMaxDim do writeInt(st, Byte(0));
 782         end;
 783         exit;
 784       end;
 785     TType.TByte,
 786     TType.TUByte:
 787       begin
 788         // either array, and this should be triggerdata, or byte
 789         if (mMaxDim < 0) then
 790         begin
 791           // byte
 792           writeInt(st, Byte(mIVal));
 793         end
 794         else
 795         begin
 796           // array
 797           raise Exception.Create(Format('byte array in field ''%s'' cannot be written', [mName]));
 798         end;
 799         exit;
 800       end;
 801     TType.TShort,
 802     TType.TUShort:
 803       begin
 804         if (mMaxDim > 0) then raise Exception.Create(Format('short array in field ''%s'' cannot be written', [mName]));
 805         writeInt(st, Word(mIVal));
 806         exit;
 807       end;
 808     TType.TInt,
 809     TType.TUInt:
 810       begin
 811         if (mMaxDim > 0) then raise Exception.Create(Format('int array in field ''%s'' cannot be written', [mName]));
 812         writeInt(st, LongWord(mIVal));
 813         exit;
 814       end;
 815     TType.TString:
 816       begin
 817         raise Exception.Create(Format('cannot write string field ''%s''', [mName]));
 818       end;
 819     TType.TPoint,
 820     TType.TSize:
 821       begin
 822         if (mMaxDim > 0) then raise Exception.Create(Format('pos/size array in field ''%s'' cannot be written', [mName]));
 823         writeInt(st, Word(mIVal));
 824         writeInt(st, Word(mIVal2));
 825         exit;
 826       end;
 827     TType.TList:
 828       begin
 829         assert(false);
 830         exit;
 831       end;
 832     TType.TTrigData:
 833       begin
 834         assert(false);
 835         exit;
 836       end;
 837     else raise Exception.Create('ketmar forgot to handle some field type');
 838   end;
 839 end;
 840
 841
 842 procedure TDynField.writeTo (wr: TTextWriter);
 843 var
 844   def: TDynMapDef;
 845   es: TDynEBS = nil;
 846   f, mask: Integer;
 847   first, found: Boolean;
 848 begin
 849   wr.put(mName);
 850   wr.put(' ');
 851   // if this field should contain struct, convert type and parse struct
 852   case mEBS of
 853     TEBS.TNone: begin end;
 854     TEBS.TRec:
 855       begin
 856         if (mRecRef = nil) then
 857         begin
 858           wr.put('null;'#10);
 859         end
 860         else if (Length(mRecRef.mId) = 0) then
 861         begin
 862           mRecRef.writeTo(wr, false); // only data, no header
 863         end
 864         else
 865         begin
 866           wr.put(mRecRef.mId);
 867           wr.put(';'#10);
 868         end;
 869         exit;
 870       end;
 871     TEBS.TEnum:
 872       begin
 873         def := mOwner.mOwner;
 874         es := def.findEBSType(mEBSTypeName);
 875         if (es = nil) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
 876         for f := 0 to High(es.mVals) do
 877         begin
 878           if (es.mVals[f] = mIVal) then
 879           begin
 880             wr.put(es.mIds[f]);
 881             wr.put(';'#10);
 882             exit;
 883           end;
 884         end;
 885         raise Exception.Create(Format('value %d in record enum type ''%s'' for field ''%s'' not found', [mIVal, mEBSTypeName, mName]));
 886       end;
 887     TEBS.TBitSet:
 888       begin
 889         def := mOwner.mOwner;
 890         es := def.findEBSType(mEBSTypeName);
 891         if (es = nil) then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
 892         // none?
 893         if (mIVal = 0) then
 894         begin
 895           for f := 0 to High(es.mVals) do
 896           begin
 897             if (es.mVals[f] = 0) then
 898             begin
 899               wr.put(es.mIds[f]);
 900               wr.put(';'#10);
 901               exit;
 902             end;
 903           end;
 904           raise Exception.Create(Format('value %d in record bitset type ''%s'' for field ''%s'' not found', [0, mEBSTypeName, mName]));
 905         end;
 906         // not none
 907         mask := 1;
 908         first := true;
 909         while (mask <> 0) do
 910         begin
 911           if ((mIVal and mask) <> 0) then
 912           begin
 913             found := false;
 914             for f := 0 to High(es.mVals) do
 915             begin
 916               if (es.mVals[f] = mask) then
 917               begin
 918                 if not first then wr.put('+') else first := false;
 919                 wr.put(es.mIds[f]);
 920                 found := true;
 921                 break;
 922               end;
 923             end;
 924             if not found then raise Exception.Create(Format('value %d in record bitset type ''%s'' for field ''%s'' not found', [mask, mEBSTypeName, mName]));
 925           end;
 926           mask := mask shl 1;
 927         end;
 928         wr.put(';'#10);
 929         exit;
 930       end;
 931     else raise Exception.Create('ketmar forgot to handle some EBS type');
 932   end;
 933
 934   case mType of
 935     TType.TBool:
 936       begin
 937         if (mIVal = 0) then wr.put('false;'#10) else wr.put('true;'#10);
 938         exit;
 939       end;
 940     TType.TChar:
 941       begin
 942         if (mMaxDim = 0) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
 943         wr.put(TTextParser.quote(mSVal));
 944         wr.put(';'#10);
 945         exit;
 946       end;
 947     TType.TByte,
 948     TType.TUByte,
 949     TType.TShort,
 950     TType.TUShort,
 951     TType.TInt,
 952     TType.TUInt:
 953       begin
 954         wr.put('%d;'#10, [mIVal]);
 955         exit;
 956       end;
 957     TType.TString:
 958       begin
 959         wr.put(TTextParser.quote(mSVal));
 960         wr.put(';'#10);
 961         exit;
 962       end;
 963     TType.TPoint,
 964     TType.TSize:
 965       begin
 966         wr.put('(%d %d);'#10, [mIVal, mIVal2]);
 967         exit;
 968       end;
 969     TType.TList:
 970       begin
 971         assert(false);
 972         exit;
 973       end;
 974     TType.TTrigData:
 975       begin
 976         assert(false);
 977         exit;
 978       end;
 979     else raise Exception.Create('ketmar forgot to handle some field type');
 980   end;
 981   raise Exception.Create(Format('cannot parse field ''%s'' yet', [mName]));
 982 end;
 983
 984
 985 procedure TDynField.parseValue (pr: TTextParser; curheader: TDynRecord);
 986
 987   procedure parseInt (min, max: Integer);
 988   begin
 989     mIVal := pr.expectInt();
 990     if (mIVal < min) or (mIVal > max) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
 991     mDefined := true;
 992   end;
 993
 994 var
 995   rec, rc: TDynRecord;
 996   def: TDynMapDef;
 997   es: TDynEBS = nil;
 998   tfld: TDynField;
 999   tk: AnsiString;
1000 begin
1001   // if this field should contain struct, convert type and parse struct
1002   case mEBS of
1003     TEBS.TNone: begin end;
1004     TEBS.TRec:
1005       begin
1006         def := mOwner.mOwner;
1007         // ugly hack. sorry.
1008         if (CompareText(mEBSTypeName, 'triggerdata') = 0) then
1009         begin
1010           rec := mOwner;
1011           // find trigger definition
1012           tfld := rec.field['type'];
1013           if (tfld = nil) then raise Exception.Create(Format('triggerdata value for field ''%s'' in record ''%s'' without ''type'' field', [mName, rec.mName]));
1014           if (tfld.mEBS <> TEBS.TEnum) then raise Exception.Create(Format('triggerdata value for field ''%s'' in record ''%s'' with bad ''type'' field', [mName, rec.mName]));
1015           rc := def.findTrigFor(tfld.mSVal);
1016           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]));
1017           rc := rc.clone();
1018           rc.parseValue(pr, curheader);
1019           mRecRef := rc;
1020           mDefined := true;
1021           exit;
1022         end;
1023         // other record types
1024         if (pr.tokType = pr.TTId) then
1025         begin
1026           rec := def.findRecordByTypeId(mEBSTypeName, pr.tokStr, curheader);
1027           if (rec = nil) then raise Exception.Create(Format('record ''%s'' (%s) value for field ''%s'' not found', [pr.tokStr, mEBSTypeName, mName]));
1028           pr.expectId();
1029           mRecRef := rec;
1030           mDefined := true;
1031           pr.expectTT(pr.TTSemi);
1032           exit;
1033         end
1034         else if (pr.tokType = pr.TTBegin) then
1035         begin
1036           rec := def.findRecType(mEBSTypeName);
1037           if (rec = nil) then raise Exception.Create(Format('record type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1038           rc := rec.clone();
1039           rc.parseValue(pr, curheader);
1040           mRecRef := rc;
1041           mDefined := true;
1042           mOwner.mOwner.addRecordByType(mEBSTypeName, rc, curheader);
1043           pr.eatTT(pr.TTSemi); // hack: allow (but don't require) semicolon after inline records
1044           exit;
1045         end;
1046         pr.expectTT(pr.TTBegin);
1047       end;
1048     TEBS.TEnum:
1049       begin
1050         def := mOwner.mOwner;
1051         es := def.findEBSType(mEBSTypeName);
1052         if (es = nil) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1053         tk := pr.expectId();
1054         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]));
1055         mIVal := es.field[tk];
1056         mSVal := tk;
1057         //writeln('ENUM ', mEBSName, '; element <', mSVal, '> with value ', mIVal);
1058         mDefined := true;
1059         pr.expectTT(pr.TTSemi);
1060         exit;
1061       end;
1062     TEBS.TBitSet:
1063       begin
1064         def := mOwner.mOwner;
1065         es := def.findEBSType(mEBSTypeName);
1066         if (es = nil) then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1067         mIVal := 0;
1068         while true do
1069         begin
1070           tk := pr.expectId();
1071           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]));
1072           mIVal := mIVal or es.field[tk];
1073           mSVal := tk;
1074           if (pr.tokType <> pr.TTDelim) or ((pr.tokChar <> '|') and (pr.tokChar <> '+')) then break;
1075           if mBitSetUnique then raise Exception.Create(Format('record bitset of type ''%s'' for field ''%s'' expects only one value', [tk, mEBSTypeName, mName]));
1076           //pr.expectDelim('|');
1077           pr.skipToken(); // plus or pipe
1078         end;
1079         mDefined := true;
1080         pr.expectTT(pr.TTSemi);
1081         exit;
1082       end;
1083     else raise Exception.Create('ketmar forgot to handle some EBS type');
1084   end;
1085
1086   case mType of
1087     TType.TBool:
1088       begin
1089              if pr.eatId('true') or pr.eatId('tan') or pr.eatId('yes') then mIVal := 1
1090         else if pr.eatId('false') or pr.eatId('ona') or pr.eatId('no') then mIVal := 0
1091         else raise Exception.Create(Format('invalid bool value for field ''%s''', [mName]));
1092         mDefined := true;
1093         pr.expectTT(pr.TTSemi);
1094         exit;
1095       end;
1096     TType.TChar:
1097       begin
1098         if (mMaxDim = 0) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
1099         mSVal := pr.expectStr(true);
1100         if (mMaxDim < 0) then
1101         begin
1102           // single char
1103           if (Length(mSVal) <> 1) then raise Exception.Create(Format('invalid string size for field ''%s''', [mName]));
1104           mIVal := Integer(mSVal[1]);
1105           mSVal := '';
1106         end
1107         else
1108         begin
1109           // string
1110           if (Length(mSVal) > mMaxDim) then raise Exception.Create(Format('invalid string size for field ''%s''', [mName]));
1111         end;
1112         mDefined := true;
1113         pr.expectTT(pr.TTSemi);
1114         exit;
1115       end;
1116     TType.TByte:
1117       begin
1118         parseInt(-128, 127);
1119         pr.expectTT(pr.TTSemi);
1120         exit;
1121       end;
1122     TType.TUByte:
1123       begin
1124         parseInt(0, 255);
1125         pr.expectTT(pr.TTSemi);
1126         exit;
1127       end;
1128     TType.TShort:
1129       begin
1130         parseInt(-32768, 32768);
1131         pr.expectTT(pr.TTSemi);
1132         exit;
1133       end;
1134     TType.TUShort:
1135       begin
1136         parseInt(0, 65535);
1137         pr.expectTT(pr.TTSemi);
1138         exit;
1139       end;
1140     TType.TInt:
1141       begin
1142         parseInt(Integer($80000000), $7fffffff);
1143         pr.expectTT(pr.TTSemi);
1144         exit;
1145       end;
1146     TType.TUInt:
1147       begin
1148         parseInt(0, $7fffffff); //FIXME
1149         pr.expectTT(pr.TTSemi);
1150         exit;
1151       end;
1152     TType.TString:
1153       begin
1154         mSVal := pr.expectStr(true);
1155         mDefined := true;
1156         pr.expectTT(pr.TTSemi);
1157         exit;
1158       end;
1159     TType.TPoint,
1160     TType.TSize:
1161       begin
1162         pr.expectDelim('(');
1163         mIVal := pr.expectInt();
1164         if (mType = TType.TPoint) then
1165         begin
1166           if (mIVal < -32768) or (mIVal > 32767) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
1167         end
1168         else
1169         begin
1170           if (mIVal < 0) or (mIVal > 32767) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
1171         end;
1172         mIVal2 := pr.expectInt();
1173         if (mType = TType.TPoint) then
1174         begin
1175           if (mIVal2 < -32768) or (mIVal2 > 32767) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
1176         end
1177         else
1178         begin
1179           if (mIVal2 < 0) or (mIVal2 > 32767) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
1180         end;
1181         mDefined := true;
1182         pr.expectDelim(')');
1183         pr.expectTT(pr.TTSemi);
1184         exit;
1185       end;
1186     TType.TList:
1187       begin
1188         assert(false);
1189         exit;
1190       end;
1191     TType.TTrigData:
1192       begin
1193         assert(false);
1194         exit;
1195       end;
1196     else raise Exception.Create('ketmar forgot to handle some field type');
1197   end;
1198   raise Exception.Create(Format('cannot parse field ''%s'' yet', [mName]));
1199 end;
1200
1201
1202 procedure TDynField.parseBinValue (st: TStream);
1203 begin
1204 end;
1205
1206
1207 // ////////////////////////////////////////////////////////////////////////// //
1208 constructor TDynRecord.Create (pr: TTextParser);
1209 begin
1210   if (pr = nil) then raise Exception.Create('cannot create record type without type definition');
1211   mId := '';
1212   mName := '';
1213   mSize := 0;
1214   mFields := nil;
1215   mTrigTypes := nil;
1216   mHeader := false;
1217   mBinBlock := -1;
1218   parseDef(pr);
1219 end;
1220
1221
1222 constructor TDynRecord.Create ();
1223 begin
1224   mName := '';
1225   mSize := 0;
1226   mFields := nil;
1227   mTrigTypes := nil;
1228   mHeader := false;
1229 end;
1230
1231
1232 destructor TDynRecord.Destroy ();
1233 begin
1234   mName := '';
1235   mFields := nil;
1236   mTrigTypes := nil;
1237   inherited;
1238 end;
1239
1240
1241 function TDynRecord.findByName (const aname: AnsiString): Integer; inline;
1242 begin
1243   result := 0;
1244   while (result < Length(mFields)) do
1245   begin
1246     if (CompareText(aname, mFields[result].mName) = 0) then exit;
1247     Inc(result);
1248   end;
1249   result := -1;
1250 end;
1251
1252
1253 function TDynRecord.hasByName (const aname: AnsiString): Boolean; inline;
1254 begin
1255   result := (findByName(aname) >= 0);
1256 end;
1257
1258
1259 function TDynRecord.getFieldByName (const aname: AnsiString): TDynField; inline;
1260 var
1261   f: Integer;
1262 begin
1263   f := findByName(aname);
1264   if (f >= 0) then result := mFields[f] else result := nil;
1265 end;
1266
1267
1268 function TDynRecord.getIsTrigData (): Boolean; inline;
1269 begin
1270   result := (Length(mTrigTypes) > 0);
1271 end;
1272
1273
1274 function TDynRecord.getIsForTrig (const aname: AnsiString): Boolean; inline;
1275 var
1276   f: Integer;
1277 begin
1278   result := true;
1279   for f := 0 to High(mTrigTypes) do if (CompareText(mTrigTypes[f], aname) = 0) then exit;
1280   result := false;
1281 end;
1282
1283
1284 function TDynRecord.clone (): TDynRecord;
1285 var
1286   f: Integer;
1287 begin
1288   result := TDynRecord.Create();
1289   result.mOwner := mOwner;
1290   result.mId := mId;
1291   result.mPasName := mPasName;
1292   result.mName := mName;
1293   result.mSize := mSize;
1294   result.mHeader := mHeader;
1295   result.mBinBlock := mBinBlock;
1296   SetLength(result.mFields, Length(mFields));
1297   for f := 0 to High(mFields) do
1298   begin
1299     result.mFields[f] := mFields[f].clone();
1300     result.mFields[f].mOwner := result;
1301   end;
1302   SetLength(result.mTrigTypes, Length(mTrigTypes));
1303   for f := 0 to High(mTrigTypes) do result.mTrigTypes[f] := mTrigTypes[f];
1304 end;
1305
1306
1307 procedure TDynRecord.parseDef (pr: TTextParser);
1308 var
1309   fld: TDynField;
1310   tdn: AnsiString;
1311 begin
1312   if pr.eatId('TriggerData') then
1313   begin
1314     pr.expectId('for');
1315     if pr.eatDelim('(') then
1316     begin
1317       while true do
1318       begin
1319         while pr.eatTT(pr.TTComma) do begin end;
1320         if pr.eatDelim(')') then break;
1321         tdn := pr.expectId();
1322         if isForTrig[tdn] then raise Exception.Create(Format('duplicate trigdata ''%s'' trigtype ''%s''', [mName, tdn]));
1323         SetLength(mTrigTypes, Length(mTrigTypes)+1);
1324         mTrigTypes[High(mTrigTypes)] := tdn;
1325       end;
1326     end
1327     else
1328     begin
1329       tdn := pr.expectId();
1330       SetLength(mTrigTypes, 1);
1331       mTrigTypes[0] := tdn;
1332     end;
1333   end
1334   else
1335   begin
1336     mPasName := pr.expectId(); // pascal record name
1337     pr.expectId('is');
1338     mName := pr.expectStr();
1339     while (pr.tokType <> pr.TTBegin) do
1340     begin
1341       if pr.eatId('header') then begin mHeader := true; continue; end;
1342       if pr.eatId('size') then
1343       begin
1344         if (mSize > 0) then raise Exception.Create(Format('duplicate `size` in record ''%s''', [mName]));
1345         mSize := pr.expectInt();
1346         if (mSize < 1) then raise Exception.Create(Format('invalid record ''%s'' size: %d', [mName, mSize]));
1347         pr.expectId('bytes');
1348         continue;
1349       end;
1350       if pr.eatId('binblock') then
1351       begin
1352         if (mBinBlock >= 0) then raise Exception.Create(Format('duplicate `binblock` in record ''%s''', [mName]));
1353         mBinBlock := pr.expectInt();
1354         if (mBinBlock < 1) then raise Exception.Create(Format('invalid record ''%s'' binblock: %d', [mName, mBinBlock]));
1355         continue;
1356       end;
1357     end;
1358   end;
1359
1360   pr.expectTT(pr.TTBegin);
1361   // load fields
1362   while (pr.tokType <> pr.TTEnd) do
1363   begin
1364     fld := TDynField.Create(pr);
1365     if hasByName(fld.name) then begin fld.Free(); raise Exception.Create(Format('duplicate field ''%s''', [fld.name])); end;
1366     // append
1367     fld.mOwner := self;
1368     SetLength(mFields, Length(mFields)+1);
1369     mFields[High(mFields)] := fld;
1370     // done with field
1371     //writeln('DEF: ', fld.definition);
1372   end;
1373   pr.expectTT(pr.TTEnd);
1374 end;
1375
1376
1377 function TDynRecord.definition (): AnsiString;
1378 var
1379   f: Integer;
1380 begin
1381   if isTrigData then
1382   begin
1383     // trigger data
1384     result := 'TriggerData for ';
1385     if (Length(mTrigTypes) > 1) then
1386     begin
1387       result += '(';
1388       for f := 0 to High(mTrigTypes) do
1389       begin
1390         if (f <> 0) then result += ', ';
1391         result += mTrigTypes[f];
1392       end;
1393       result += ')';
1394     end
1395     else
1396     begin
1397       result += mTrigTypes[0];
1398     end;
1399   end
1400   else
1401   begin
1402     // record
1403     result := mPasName+' is '+TTextParser.quote(mName);
1404     if (mSize >= 0) then result += Format(' size %d bytes', [mSize]);
1405     if mHeader then result += ' header';
1406   end;
1407   result += ' {'#10;
1408   for f := 0 to High(mFields) do
1409   begin
1410     result += '  ';
1411     result += mFields[f].definition;
1412     result += ';'#10;
1413   end;
1414   result += '}';
1415 end;
1416
1417
1418 procedure TDynRecord.writeBinTo (st: TStream; curheader: TDynRecord; trigbufsz: Integer=-1);
1419 var
1420   fld: TDynField;
1421   rec: TDynRecord;
1422   buf: PByte = nil;
1423   ws: TStream = nil;
1424   blk, blkmax: Integer;
1425   f, c: Integer;
1426   bufsz: Integer = 0;
1427 begin
1428   if (curheader = nil) and mHeader then curheader := self;
1429   if (trigbufsz < 0) then
1430   begin
1431     if (mBinBlock < 1) then raise Exception.Create('cannot write binary record without block number');
1432     if (mSize < 1) then raise Exception.Create('cannot write binary record without size');
1433     bufsz := mSize;
1434   end
1435   else
1436   begin
1437     bufsz := trigbufsz;
1438   end;
1439   try
1440     GetMem(buf, bufsz);
1441     FillChar(buf^, bufsz, 0);
1442     ws := TSFSMemoryChunkStream.Create(buf, bufsz);
1443
1444     // write normal fields
1445     for f := 0 to High(mFields) do
1446     begin
1447       fld := mFields[f];
1448       // record list?
1449       if (fld.mType = fld.TType.TList) then continue; // later
1450       if fld.mInternal then continue;
1451       if (fld.mBinOfs < 0) then continue;
1452       if (fld.mBinOfs >= bufsz) then raise Exception.Create('binary value offset is outside of the buffer');
1453       TSFSMemoryChunkStream(ws).setup(buf+fld.mBinOfs, bufsz-fld.mBinOfs);
1454       writeln('writing field <', fld.mName, '>');
1455       fld.writeBinTo(ws, curheader);
1456     end;
1457
1458     // write block with normal fields
1459     if mHeader then
1460     begin
1461       writeln('writing header...');
1462       // signature and version
1463       writeIntBE(st, LongWord($4D415001));
1464       writeInt(st, Byte(mBinBlock)); // type
1465       writeInt(st, LongWord(0)); // reserved
1466       writeInt(st, LongWord(bufsz)); // size
1467     end;
1468     st.WriteBuffer(buf^, bufsz);
1469
1470     ws.Free(); ws := nil;
1471     FreeMem(buf); buf := nil;
1472
1473     // write other blocks, if any
1474     if mHeader then
1475     begin
1476       // calculate blkmax
1477       blkmax := 0;
1478       for f := 0 to High(mFields) do
1479       begin
1480         fld := mFields[f];
1481         // record list?
1482         if (fld.mType = fld.TType.TList) then
1483         begin
1484           if (Length(fld.mRVal) = 0) then continue;
1485           rec := mOwner.findRecType(fld.mName);
1486           if (rec = nil) then continue;
1487           if (rec.mBinBlock <= 0) then continue;
1488           if (blkmax < rec.mBinBlock) then blkmax := rec.mBinBlock;
1489         end;
1490       end;
1491       // write blocks
1492       for blk := 1 to blkmax do
1493       begin
1494         if (blk = mBinBlock) then continue;
1495         ws := nil;
1496         for f := 0 to High(mFields) do
1497         begin
1498           fld := mFields[f];
1499           // record list?
1500           if (fld.mType = fld.TType.TList) then
1501           begin
1502             if (Length(fld.mRVal) = 0) then continue;
1503             rec := mOwner.findRecType(fld.mName);
1504             if (rec = nil) then continue;
1505             if (rec.mBinBlock <> blk) then continue;
1506             if (ws = nil) then ws := TMemoryStream.Create();
1507             //rec.writeBinTo(ws);
1508             for c := 0 to High(fld.mRVal) do fld.mRVal[c].writeBinTo(ws, curheader);
1509           end;
1510         end;
1511         // flush block
1512         if (ws <> nil) then
1513         begin
1514           ws.position := 0;
1515           writeInt(st, Byte(blk)); // type
1516           writeInt(st, LongWord(0)); // reserved
1517           writeInt(st, LongWord(ws.size)); // size
1518           st.CopyFrom(ws, ws.size);
1519           ws.Free();
1520           ws := nil;
1521         end;
1522       end;
1523     end;
1524   finally
1525     ws.Free();
1526     if (buf <> nil) then FreeMem(buf);
1527   end;
1528 end;
1529
1530
1531 procedure TDynRecord.writeTo (wr: TTextWriter; putHeader: Boolean=true);
1532 var
1533   f, c: Integer;
1534   fld: TDynField;
1535 begin
1536   if putHeader then
1537   begin
1538     wr.put(mName);
1539     if (Length(mId) > 0) then begin wr.put(' '); wr.put(mId); end;
1540     wr.put(' ');
1541   end;
1542   wr.put('{'#10);
1543   wr.indent();
1544   try
1545     for f := 0 to High(mFields) do
1546     begin
1547       fld := mFields[f];
1548       // record list?
1549       if (fld.mType = fld.TType.TList) then
1550       begin
1551         if not mHeader then raise Exception.Create('record list in non-header record');
1552         for c := 0 to High(fld.mRVal) do
1553         begin
1554           wr.putIndent();
1555           fld.mRVal[c].writeTo(wr, true);
1556         end;
1557         continue;
1558       end;
1559       if fld.mInternal then continue;
1560       if fld.mOmitDef and fld.isDefaultValue then continue;
1561       wr.putIndent();
1562       fld.writeTo(wr);
1563     end;
1564   finally
1565     wr.unindent();
1566   end;
1567   wr.putIndent();
1568   wr.put('}'#10);
1569 end;
1570
1571
1572 procedure TDynRecord.parseValue (pr: TTextParser; curheader: TDynRecord);
1573 var
1574   f, c: Integer;
1575   fld: TDynField;
1576   rec, trc: TDynRecord;
1577   //success: Boolean;
1578 begin
1579   if (mOwner = nil) then raise Exception.Create(Format('can''t parse record ''%s'' value without owner', [mName]));
1580
1581   // not a header?
1582   if (curheader <> self) then
1583   begin
1584     // id?
1585     if (pr.tokType = pr.TTId) then mId := pr.expectId();
1586   end;
1587
1588   writeln('parsing record <', mName, '>');
1589   pr.expectTT(pr.TTBegin);
1590   while (pr.tokType <> pr.TTEnd) do
1591   begin
1592     if (pr.tokType <> pr.TTId) then raise Exception.Create('identifier expected');
1593     //writeln('<', pr.tokStr, ':', asheader, '>');
1594
1595     // records
1596     if (curheader = self) then
1597     begin
1598       // add records with this type (if any)
1599       trc := mOwner.findRecType(pr.tokStr);
1600       if (trc <> nil) then
1601       begin
1602         rec := trc.clone();
1603         try
1604           pr.skipToken();
1605           rec.parseValue(pr, curheader);
1606           if (Length(rec.mId) > 0) then
1607           begin
1608             fld := field[pr.tokStr];
1609             if (fld <> nil) then
1610             begin
1611               for c := 0 to High(fld.mRVal) do
1612               begin
1613                 if (Length(fld.mRVal[c].mId) > 0) and (CompareText(fld.mRVal[c].mId, rec.mId) = 0) then raise Exception.Create(Format('duplicate thing ''%s'' in record ''%s''', [fld.mName, mName]));
1614               end;
1615             end;
1616           end;
1617           mOwner.addRecordByType(rec.mName, rec, curheader);
1618           rec := nil;
1619         finally
1620           rec.Free();
1621         end;
1622         continue;
1623       end;
1624     end;
1625
1626     // fields
1627     fld := field[pr.tokStr];
1628     if (fld <> nil) then
1629     begin
1630       if fld.defined then raise Exception.Create(Format('duplicate field ''%s'' in record ''%s''', [fld.mName, mName]));
1631       if fld.internal then raise Exception.Create(Format('internal field ''%s'' in record ''%s''', [fld.mName, mName]));
1632       pr.skipToken();
1633       fld.parseValue(pr, curheader);
1634       continue;
1635     end;
1636
1637     // something is wrong
1638     raise Exception.Create(Format('unknown field ''%s'' in record ''%s''', [pr.tokStr, mName]));
1639   end;
1640   pr.expectTT(pr.TTEnd);
1641   // fix field defaults
1642   for f := 0 to High(mFields) do mFields[f].fixDefaultValue();
1643   writeln('done parsing record <', mName, '>');
1644 end;
1645
1646
1647 procedure TDynRecord.parseBinValue (st: TStream);
1648 begin
1649 end;
1650
1651
1652 // ////////////////////////////////////////////////////////////////////////// //
1653 constructor TDynEBS.Create (pr: TTextParser);
1654 begin
1655   cleanup();
1656   parseDef(pr);
1657 end;
1658
1659
1660 destructor TDynEBS.Destroy ();
1661 begin
1662   cleanup();
1663   inherited;
1664 end;
1665
1666
1667 procedure TDynEBS.cleanup ();
1668 begin
1669   mIsEnum := false;
1670   mName := '';
1671   mIds := nil;
1672   mVals := nil;
1673   mMaxName := '';
1674   mMaxVal := 0;
1675 end;
1676
1677
1678 function TDynEBS.findByName (const aname: AnsiString): Integer;
1679 begin
1680   result := 0;
1681   while (result < Length(mIds)) do
1682   begin
1683     if (CompareText(aname, mIds[result]) = 0) then exit;
1684     Inc(result);
1685   end;
1686   result := -1;
1687 end;
1688
1689
1690 function TDynEBS.hasByName (const aname: AnsiString): Boolean; inline;
1691 begin
1692   result := (findByName(aname) >= 0);
1693 end;
1694
1695
1696 function TDynEBS.getFieldByName (const aname: AnsiString): Integer; inline;
1697 var
1698   f: Integer;
1699 begin
1700   f := findByName(aname);
1701   if (f >= 0) then result := mVals[f] else result := 0;
1702 end;
1703
1704
1705 function TDynEBS.definition (): AnsiString;
1706 var
1707   f, cv: Integer;
1708 begin
1709   if mIsEnum then result :='enum ' else result := 'bitset ';
1710   result += mName;
1711   result += ' {'#10;
1712   // fields
1713   if mIsEnum then cv := 0 else cv := 1;
1714   for f := 0 to High(mIds) do
1715   begin
1716     if (mIds[f] = mMaxName) then continue;
1717     result += '  '+mIds[f];
1718     if (mVals[f] <> cv) then
1719     begin
1720       result += Format(' = %d', [mVals[f]]);
1721       if mIsEnum then cv := mVals[f];
1722       result += ','#10;
1723     end
1724     else
1725     begin
1726       result += Format(', // %d'#10, [mVals[f]]);
1727     end;
1728     if mIsEnum then Inc(cv) else if (mVals[f] = cv) then cv := cv shl 1;
1729   end;
1730   // max field
1731   if (Length(mMaxName) > 0) then result += '  '+mMaxName+' = MAX,'#10;
1732   result += '}';
1733 end;
1734
1735
1736 procedure TDynEBS.parseDef (pr: TTextParser);
1737 var
1738   idname: AnsiString;
1739   cv, v: Integer;
1740   f: Integer;
1741   skipAdd: Boolean;
1742   hasV: Boolean;
1743 begin
1744        if pr.eatId('enum') then mIsEnum := true
1745   else if pr.eatId('bitset') then mIsEnum := false
1746   else pr.expectId('enum');
1747   mName := pr.expectId();
1748   mMaxVal := Integer($80000000);
1749   if mIsEnum then cv := 0 else cv := 1;
1750   pr.expectTT(pr.TTBegin);
1751   while (pr.tokType <> pr.TTEnd) do
1752   begin
1753     idname := pr.expectId();
1754     for f := 0 to High(mIds) do
1755     begin
1756       if (CompareText(mIds[f], idname) = 0) then raise Exception.Create(Format('duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName]));
1757     end;
1758     if (CompareText(mMaxName, idname) = 0) then raise Exception.Create(Format('duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName]));
1759     skipAdd := false;
1760     hasV := false;
1761     v := cv;
1762     // has value?
1763     if pr.eatDelim('=') then
1764     begin
1765       if pr.eatId('MAX') then
1766       begin
1767         if (Length(mMaxName) > 0) then raise Exception.Create(Format('duplicate max field ''%s'' in enum/bitset ''%s''', [idname, mName]));
1768         mMaxName := idname;
1769         skipAdd := true;
1770       end
1771       else
1772       begin
1773         v := pr.expectInt();
1774           if mIsEnum then cv := v;
1775         hasV := true;
1776       end;
1777     end;
1778     // append it?
1779     if not skipAdd then
1780     begin
1781       // fix maxvalue
1782       if mIsEnum or (not hasV) then
1783       begin
1784         if (mMaxVal < v) then mMaxVal := v;
1785       end;
1786       SetLength(mIds, Length(mIds)+1);
1787       mIds[High(mIds)] := idname;
1788       SetLength(mVals, Length(mIds));
1789       mVals[High(mVals)] := v;
1790       // next cv
1791       if mIsEnum or (not hasV) then
1792       begin
1793         if mIsEnum then Inc(cv) else cv := cv shl 1;
1794       end;
1795     end;
1796     if (pr.tokType = pr.TTEnd) then break;
1797     pr.expectTT(pr.TTComma);
1798     while pr.eatTT(pr.TTComma) do begin end;
1799   end;
1800   pr.expectTT(pr.TTEnd);
1801   // add max field
1802   if (Length(mMaxName) > 0) then
1803   begin
1804     SetLength(mIds, Length(mIds)+1);
1805     mIds[High(mIds)] := mMaxName;
1806     SetLength(mVals, Length(mIds));
1807     mVals[High(mVals)] := mMaxVal;
1808   end;
1809 end;
1810
1811
1812 // ////////////////////////////////////////////////////////////////////////// //
1813 constructor TDynMapDef.Create (pr: TTextParser);
1814 begin
1815   recTypes := nil;
1816   trigTypes := nil;
1817   ebsTypes := nil;
1818   parseDef(pr);
1819 end;
1820
1821
1822 destructor TDynMapDef.Destroy ();
1823 var
1824   f: Integer;
1825 begin
1826   for f := 0 to High(recTypes) do recTypes[f].Free();
1827   for f := 0 to High(trigTypes) do trigTypes[f].Free();
1828   for f := 0 to High(ebsTypes) do ebsTypes[f].Free();
1829   recTypes := nil;
1830   trigTypes := nil;
1831   ebsTypes := nil;
1832   inherited;
1833 end;
1834
1835
1836 function TDynMapDef.getHeaderRecType (): TDynRecord; inline;
1837 begin
1838   if (Length(recTypes) = 0) then raise Exception.Create('no header in empty mapdef');
1839   result := recTypes[0];
1840 end;
1841
1842
1843 function TDynMapDef.findRecType (const aname: AnsiString): TDynRecord;
1844 var
1845   f: Integer;
1846 begin
1847   for f := 0 to High(recTypes) do
1848   begin
1849     if (CompareText(recTypes[f].name, aname) = 0) then begin result := recTypes[f]; exit; end;
1850   end;
1851   result := nil;
1852 end;
1853
1854
1855 function TDynMapDef.findTrigFor (const aname: AnsiString): TDynRecord;
1856 var
1857   f: Integer;
1858 begin
1859   for f := 0 to High(trigTypes) do
1860   begin
1861     if (trigTypes[f].isForTrig[aname]) then begin result := trigTypes[f]; exit; end;
1862   end;
1863   result := nil;
1864 end;
1865
1866
1867 function TDynMapDef.findEBSType (const aname: AnsiString): TDynEBS;
1868 var
1869   f: Integer;
1870 begin
1871   for f := 0 to High(ebsTypes) do
1872   begin
1873     if (CompareText(ebsTypes[f].name, aname) = 0) then begin result := ebsTypes[f]; exit; end;
1874   end;
1875   result := nil;
1876 end;
1877
1878
1879 function TDynMapDef.findRecordByTypeId (const atypename, aid: AnsiString; curheader: TDynRecord): TDynRecord;
1880 var
1881   rec: TDynRecord;
1882   fld: TDynField;
1883   f: Integer;
1884 begin
1885   result := nil;
1886   // find record type
1887   if (curheader = nil) then exit;
1888   //writeln('searching for type <', atypename, '>');
1889   rec := findRecType(atypename);
1890   if (rec = nil) then exit;
1891   // find record data
1892   //writeln('searching for data of type <', atypename, '>');
1893   fld := curheader.field[atypename];
1894   if (fld = nil) then exit;
1895   if (fld.mType <> fld.TType.TList) then exit;
1896   // find by id
1897   //writeln('searching for data of type <', atypename, '> with id <', aid, '> (', Length(fld.mRVal), ')');
1898   for f := 0 to High(fld.mRVal) do
1899   begin
1900     if (CompareText(fld.mRVal[f].mId, aid) = 0) then
1901     begin
1902       //writeln('  FOUND!');
1903       result := fld.mRVal[f];
1904       exit;
1905     end;
1906   end;
1907   // alas
1908 end;
1909
1910
1911 procedure TDynMapDef.addRecordByType (const atypename: AnsiString; rc: TDynRecord; curheader: TDynRecord);
1912 var
1913   rec: TDynRecord;
1914   fld: TDynField;
1915 begin
1916   assert(curheader <> nil);
1917   // find record type
1918   rec := findRecType(atypename);
1919   assert(rec <> nil);
1920   // find record data
1921   //writeln('searching for data of type <', atypename, '>');
1922   fld := curheader.field[atypename];
1923   if (fld = nil) then
1924   begin
1925     // first record
1926     fld := TDynField.Create(atypename, TDynField.TType.TList);
1927     fld.mOwner := curheader;
1928     SetLength(curheader.mFields, Length(curheader.mFields)+1);
1929     curheader.mFields[High(curheader.mFields)] := fld;
1930   end;
1931   if (fld.mType <> fld.TType.TList) then exit;
1932   // add
1933   SetLength(fld.mRVal, Length(fld.mRVal)+1);
1934   fld.mRVal[High(fld.mRVal)] := rc;
1935 end;
1936
1937
1938 function TDynMapDef.findRecordNumByType (const atypename: AnsiString; rc: TDynRecord; curheader: TDynRecord): Integer;
1939 var
1940   rec: TDynRecord;
1941   fld: TDynField;
1942   f: Integer;
1943 begin
1944   result := -1;
1945   if (curheader = nil) then exit;
1946   // find record type
1947   rec := findRecType(atypename);
1948   if (rec = nil) then exit;
1949   // find record data
1950   fld := curheader.field[atypename];
1951   if (fld = nil) then exit;
1952   if (fld.mType <> fld.TType.TList) then exit;
1953   // find by ref
1954   for f := 0 to High(fld.mRVal) do
1955   begin
1956     if (fld.mRVal[f] = rc) then
1957     begin
1958       result := f;
1959       exit;
1960     end;
1961   end;
1962   // alas
1963 end;
1964
1965
1966 procedure TDynMapDef.parseDef (pr: TTextParser);
1967 var
1968   dr, hdr: TDynRecord;
1969   eb: TDynEBS;
1970   f: Integer;
1971 begin
1972   hdr := nil;
1973   while true do
1974   begin
1975     if not pr.skipBlanks() then break;
1976     if (pr.tokType <> pr.TTId) then raise Exception.Create('identifier expected');
1977
1978     if (pr.tokStr = 'enum') or (pr.tokStr = 'bitset') then
1979     begin
1980       eb := TDynEBS.Create(pr);
1981       if (findEBSType(eb.name) <> nil) then
1982       begin
1983         eb.Free();
1984         raise Exception.Create(Format('duplicate enum/bitset ''%s''', [eb.name]));
1985       end;
1986       eb.mOwner := self;
1987       SetLength(ebsTypes, Length(ebsTypes)+1);
1988       ebsTypes[High(ebsTypes)] := eb;
1989       //writeln(eb.definition); writeln;
1990       continue;
1991     end;
1992
1993     if (pr.tokStr = 'TriggerData') then
1994     begin
1995       dr := TDynRecord.Create(pr);
1996       for f := 0 to High(dr.mTrigTypes) do
1997       begin
1998         if (findTrigFor(dr.mTrigTypes[f]) <> nil) then
1999         begin
2000           dr.Free();
2001           raise Exception.Create(Format('duplicate trigdata ''%s''', [dr.mTrigTypes[f]]));
2002         end;
2003       end;
2004       dr.mOwner := self;
2005       SetLength(trigTypes, Length(trigTypes)+1);
2006       trigTypes[High(trigTypes)] := dr;
2007       //writeln(dr.definition); writeln;
2008       continue;
2009     end;
2010
2011     dr := TDynRecord.Create(pr);
2012     //writeln(dr.definition); writeln;
2013     if (findRecType(dr.name) <> nil) then begin dr.Free(); raise Exception.Create(Format('duplicate record ''%s''', [dr.name])); end;
2014     if (hdr <> nil) and (CompareText(dr.name, hdr.name) = 0) then begin dr.Free(); raise Exception.Create(Format('duplicate record ''%s''', [dr.name])); end;
2015     dr.mOwner := self;
2016     if dr.mHeader then
2017     begin
2018       if (hdr <> nil) then begin dr.Free(); raise Exception.Create(Format('duplicate header record ''%s'' (previous is ''%s'')', [dr.name, hdr.name])); end;
2019       hdr := dr;
2020     end
2021     else
2022     begin
2023       SetLength(recTypes, Length(recTypes)+1);
2024       recTypes[High(recTypes)] := dr;
2025     end;
2026   end;
2027
2028   if (hdr = nil) then raise Exception.Create('header definition not found in mapdef');
2029   SetLength(recTypes, Length(recTypes)+1);
2030   for f := High(recTypes) downto 1 do recTypes[f] := recTypes[f-1];
2031   recTypes[0] := hdr;
2032 end;
2033
2034
2035 // ////////////////////////////////////////////////////////////////////////// //
2036 function TDynMapDef.parseMap (pr: TTextParser): TDynRecord;
2037 var
2038   res: TDynRecord = nil;
2039 begin
2040   result := nil;
2041   try
2042     pr.expectId(headerType.name);
2043     res := headerType.clone();
2044     res.parseValue(pr, res);
2045     result := res;
2046     res := nil;
2047   except on E: Exception do
2048     begin
2049       res.Free();
2050       raise;
2051     end;
2052   end;
2053 end;
2054
2055
2056 function TDynMapDef.parseBinMap (st: TStream): TDynRecord;
2057 begin
2058   result := nil;
2059 end;
2060
2061
2062 end.