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