src/shared/xdynrec.pas

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