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