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