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     // find field with `TriggerType` type
 191     function trigTypeField (): TDynField;
 192
 193   public
 194     property id: AnsiString read mId; // for map parser
 195     property pasname: AnsiString read mPasName;
 196     property name: AnsiString read mName; // record name
 197     property size: Integer read mSize; // size in bytes
 198     property fields: TDynFieldList read mFields;
 199     property has[const aname: AnsiString]: Boolean read hasByName;
 200     property field[const aname: AnsiString]: TDynField read getFieldByName;
 201     property isTrigData: Boolean read getIsTrigData;
 202     property isForTrig[const aname: AnsiString]: Boolean read getIsForTrig;
 203   end;
 204
 205
 206   TDynEBS = class
 207   private
 208     mOwner: TDynMapDef;
 209     mIsEnum: Boolean;
 210     mName: AnsiString;
 211     mIds: array of AnsiString;
 212     mVals: array of Integer;
 213     mMaxName: AnsiString; // MAX field
 214     mMaxVal: Integer; // max value
 215
 216   private
 217     procedure cleanup ();
 218
 219     procedure parseDef (pr: TTextParser); // parse definition
 220
 221     function findByName (const aname: AnsiString): Integer; inline;
 222     function hasByName (const aname: AnsiString): Boolean; inline;
 223     function getFieldByName (const aname: AnsiString): Integer; inline;
 224
 225   public
 226     constructor Create (pr: TTextParser); // parse definition
 227     destructor Destroy (); override;
 228
 229     function definition (): AnsiString;
 230
 231     // return empty string if not found
 232     function nameByValue (v: Integer): AnsiString;
 233
 234   public
 235     property name: AnsiString read mName; // record name
 236     property isEnum: Boolean read mIsEnum;
 237     property has[const aname: AnsiString]: Boolean read hasByName;
 238     property field[const aname: AnsiString]: Integer read getFieldByName;
 239   end;
 240
 241
 242   TDynMapDef = class
 243   public
 244     recTypes: TDynRecList; // [0] is always header
 245     trigTypes: TDynRecList; // trigdata
 246     ebsTypes: TDynEBSList; // enums, bitsets
 247
 248   private
 249     procedure parseDef (pr: TTextParser);
 250
 251     function getHeaderRecType (): TDynRecord; inline;
 252
 253   public
 254     constructor Create (pr: TTextParser); // parses data definition
 255     destructor Destroy (); override;
 256
 257     function findRecType (const aname: AnsiString): TDynRecord;
 258     function findTrigFor (const aname: AnsiString): TDynRecord;
 259     function findEBSType (const aname: AnsiString): TDynEBS;
 260
 261     // creates new header record
 262     function parseMap (pr: TTextParser): TDynRecord;
 263
 264     // creates new header record
 265     function parseBinMap (st: TStream): TDynRecord;
 266
 267   public
 268     property headerType: TDynRecord read getHeaderRecType;
 269   end;
 270
 271
 272 implementation
 273
 274 uses
 275   SysUtils;
 276
 277
 278 // ////////////////////////////////////////////////////////////////////////// //
 279 constructor TDynField.Create (const aname: AnsiString; atype: TType);
 280 begin
 281   mRVal := nil;
 282   mRecRef := nil;
 283   cleanup();
 284   mName := aname;
 285   mType := atype;
 286   if (mType = TType.TList) then mRVal := TDynRecList.Create();
 287 end;
 288
 289
 290 constructor TDynField.Create (pr: TTextParser);
 291 begin
 292   cleanup();
 293   parseDef(pr);
 294 end;
 295
 296
 297 destructor TDynField.Destroy ();
 298 begin
 299   cleanup();
 300   inherited;
 301 end;
 302
 303
 304 procedure TDynField.cleanup ();
 305 begin
 306   mName := '';
 307   mType := TType.TInt;
 308   mIVal := 0;
 309   mIVal2 := 0;
 310   mSVal := '';
 311   mRVal.Free();
 312   mRVal := nil;
 313   mRecRef := nil;
 314   mMaxDim := -1;
 315   mBinOfs := -1;
 316   mRecOfs := -1;
 317   mSepPosSize := false;
 318   mAsT := false;
 319   mHasDefault := false;
 320   mDefined := false;
 321   mOmitDef := false;
 322   mInternal := true;
 323   mDefUnparsed := '';
 324   mDefSVal := '';
 325   mDefIVal := 0;
 326   mDefIVal2 := 0;
 327   mDefRecRef := nil;
 328   mEBS := TEBS.TNone;
 329   mEBSTypeName := '';
 330   mEBSType := nil;
 331   mBitSetUnique := false;
 332   mNegBool := false;
 333   mRecRefId := '';
 334   if (mType = TType.TList) then mRVal := TDynRecList.Create();
 335 end;
 336
 337
 338 function TDynField.clone (newOwner: TDynRecord=nil): TDynField;
 339 var
 340   rec: TDynRecord;
 341 begin
 342   result := TDynField.Create(mName, mType);
 343   result.mOwner := mOwner;
 344   if (newOwner <> nil) then result.mOwner := newOwner else result.mOwner := mOwner;
 345   result.mPasName := mPasName;
 346   result.mName := mName;
 347   result.mType := mType;
 348   result.mIVal := mIVal;
 349   result.mIVal2 := mIVal2;
 350   result.mSVal := mSVal;
 351   if (mRVal <> nil) then
 352   begin
 353     result.mRVal := TDynRecList.Create(mRVal.count);
 354     for rec in mRVal do result.mRVal.append(rec.clone());
 355   end
 356   else
 357   begin
 358     if (mType = TType.TList) then result.mRVal := TDynRecList.Create() else result.mRVal := nil;
 359   end;
 360   result.mRecRef := mRecRef;
 361   result.mMaxDim := mMaxDim;
 362   result.mBinOfs := mBinOfs;
 363   result.mRecOfs := mRecOfs;
 364   result.mSepPosSize := mSepPosSize;
 365   result.mAsT := mAsT;
 366   result.mDefined := mDefined;
 367   result.mHasDefault := mHasDefault;
 368   result.mOmitDef := mOmitDef;
 369   result.mInternal := mInternal;
 370   result.mNegBool := mNegBool;
 371   result.mBitSetUnique := mBitSetUnique;
 372   result.mDefUnparsed := mDefUnparsed;
 373   result.mDefSVal := mDefSVal;
 374   result.mDefIVal := mDefIVal;
 375   result.mDefIVal2 := mDefIVal2;
 376   result.mDefRecRef := mDefRecRef;
 377   result.mEBS := mEBS;
 378   result.mEBSTypeName := mEBSTypeName;
 379   result.mEBSType := mEBSType;
 380   result.mRecRefId := mRecRefId;
 381 end;
 382
 383
 384 // won't work for lists
 385 function TDynField.isSimpleEqu (fld: TDynField): Boolean;
 386 begin
 387   if (fld = nil) or (mType <> fld.mType) then begin result := false; exit; end;
 388   case mType of
 389     TType.TBool: result := ((mIVal <> 0) = (fld.mIVal <> 0));
 390     TType.TChar: result := (mSVal = fld.mSVal);
 391     TType.TByte,
 392     TType.TUByte,
 393     TType.TShort,
 394     TType.TUShort,
 395     TType.TInt,
 396     TType.TUInt:
 397       result := (mIVal = fld.mIVal);
 398     TType.TString: result := (mSVal = fld.mSVal);
 399     TType.TPoint,
 400     TType.TSize:
 401       result := ((mIVal = fld.mIVal) and (mIVal2 = fld.mIVal2));
 402     TType.TList: result := false;
 403     TType.TTrigData:
 404       begin
 405         if (mRecRef = nil) then begin result := (fld.mRecRef = nil); exit; end;
 406         result := mRecRef.isSimpleEqu(fld.mRecRef);
 407       end;
 408     else raise Exception.Create('ketmar forgot to handle some field type');
 409   end;
 410 end;
 411
 412
 413 procedure TDynField.setValue (const s: AnsiString);
 414 var
 415   stp: TTextParser;
 416 begin
 417   stp := TStrTextParser.Create(s+';');
 418   try
 419     parseValue(stp);
 420   finally
 421     stp.Free();
 422   end;
 423 end;
 424
 425
 426 procedure TDynField.parseDefaultValue ();
 427 var
 428   stp: TTextParser = nil;
 429   oSVal: AnsiString;
 430   oIVal, oIVal2: Integer;
 431   oRRef: TDynRecord;
 432   oDef: Boolean;
 433 begin
 434   if not mHasDefault then
 435   begin
 436     mDefSVal := '';
 437     mDefIVal := 0;
 438     mDefIVal2 := 0;
 439     mDefRecRef := nil;
 440   end
 441   else
 442   begin
 443     oSVal := mSVal;
 444     oIVal := mIVal;
 445     oIVal2 := mIVal2;
 446     oRRef := mRecRef;
 447     oDef := mDefined;
 448     try
 449       stp := TStrTextParser.Create(mDefUnparsed+';');
 450       parseValue(stp);
 451       mDefSVal := mSVal;
 452       mDefIVal := mIVal;
 453       mDefIVal2 := mIVal2;
 454       mDefRecRef := mRecRef;
 455     finally
 456       mSVal := oSVal;
 457       mIVal := oIVal;
 458       mIVal2 := oIVal2;
 459       mRecRef := oRRef;
 460       mDefined := oDef;
 461       stp.Free();
 462     end;
 463   end;
 464 end;
 465
 466
 467 // default value should be parsed
 468 procedure TDynField.fixDefaultValue ();
 469 begin
 470   if mDefined then exit;
 471   if not mHasDefault then
 472   begin
 473     if mInternal then exit;
 474     raise Exception.Create(Format('field ''%s'' in record ''%s'' of record type ''%s'' is not set', [mName, mOwner.mId, mOwner.mName]));
 475   end;
 476   if (mEBS = TEBS.TRec) then mRecRef := mDefRecRef;
 477   mSVal := mDefSVal;
 478   mIVal := mDefIVal;
 479   mIVal2 := mDefIVal2;
 480   mDefined := true;
 481 end;
 482
 483
 484 // default value should be parsed
 485 function TDynField.isDefaultValue (): Boolean;
 486 begin
 487   if not mHasDefault then begin result := false; exit; end;
 488   if (mEBS = TEBS.TRec) then begin result := (mRecRef = mDefRecRef); exit; end;
 489   case mType of
 490     TType.TChar, TType.TString: result := (mSVal = mDefSVal);
 491     TType.TPoint, TType.TSize: result := (mIVal = mDefIVal2) and (mIVal2 = mDefIVal2);
 492     TType.TList, TType.TTrigData: result := false; // no default values for those types
 493     else result := (mIVal = mDefIVal);
 494   end;
 495 end;
 496
 497
 498 class function TDynField.getTypeName (t: TType): AnsiString;
 499 begin
 500   case t of
 501     TType.TBool: result := 'bool';
 502     TType.TChar: result := 'char';
 503     TType.TByte: result := 'byte';
 504     TType.TUByte: result := 'ubyte';
 505     TType.TShort: result := 'short';
 506     TType.TUShort: result := 'ushort';
 507     TType.TInt: result := 'int';
 508     TType.TUInt: result := 'uint';
 509     TType.TString: result := 'string';
 510     TType.TPoint: result := 'point';
 511     TType.TSize: result := 'size';
 512     TType.TList: result := 'array';
 513     TType.TTrigData: result := 'trigdata';
 514     else raise Exception.Create('ketmar forgot to handle some field type');
 515   end;
 516 end;
 517
 518
 519 function TDynField.definition (): AnsiString;
 520 begin
 521   result := mPasName+' is '+quoteStr(mName)+' type ';
 522   result += getTypeName(mType);
 523   if (mMaxDim >= 0) then result += Format('[%d]', [mMaxDim]);
 524   if (mRecOfs >= 0) then result += Format(' offset %d', [mRecOfs]);
 525   case mEBS of
 526     TEBS.TNone: begin end;
 527     TEBS.TRec: result += ' '+mEBSTypeName;
 528     TEBS.TEnum: result += ' enum '+mEBSTypeName;
 529     TEBS.TBitSet: begin result += ' bitset '; if mBitSetUnique then result += 'unique '; result += mEBSTypeName; end;
 530   end;
 531   if mHasDefault and (Length(mDefUnparsed) > 0) then result += ' default '+mDefUnparsed;
 532   if mSepPosSize then
 533   begin
 534          if (mType = TType.TPoint) then begin if (mAsT) then result += ' as txy' else result += ' as xy'; end
 535     else if (mType = TType.TSize) then begin if (mAsT) then result += ' as twh' else result += ' as wh'; end;
 536   end;
 537   if mOmitDef then result += ' omitdefault';
 538   if mInternal then result += ' internal';
 539 end;
 540
 541
 542 procedure TDynField.parseDef (pr: TTextParser);
 543 var
 544   fldname: AnsiString;
 545   fldtype: AnsiString;
 546   fldofs: Integer;
 547   fldrecname: AnsiString;
 548   fldpasname: AnsiString;
 549   asxy, aswh, ast: Boolean;
 550   ainternal: Boolean;
 551   omitdef: Boolean;
 552   defstr: AnsiString;
 553   defint: Integer;
 554   hasdefStr: Boolean;
 555   hasdefInt: Boolean;
 556   hasdefId: Boolean;
 557   lmaxdim: Integer;
 558   lebs: TDynField.TEBS;
 559   unique: Boolean;
 560 begin
 561   fldpasname := '';
 562   fldname := '';
 563   fldtype := '';
 564   fldofs := -1;
 565   fldrecname := '';
 566   asxy := false;
 567   aswh := false;
 568   ast := false;
 569   ainternal := false;
 570   omitdef := false;
 571   defstr := '';
 572   defint := 0;
 573   hasdefStr := false;
 574   hasdefInt := false;
 575   hasdefId := false;
 576   unique := false;
 577   lmaxdim := -1;
 578   lebs := TDynField.TEBS.TNone;
 579
 580   fldpasname := pr.expectId(); // pascal field name
 581   // field name
 582   pr.expectId('is');
 583   fldname := pr.expectStr();
 584   // field type
 585   pr.expectId('type');
 586   fldtype := pr.expectId();
 587
 588   // fixed-size array?
 589   if pr.eatDelim('[') then
 590   begin
 591     lmaxdim := pr.expectInt();
 592     if (lmaxdim < 1) then raise Exception.Create(Format('invalid field ''%s'' array size', [fldname]));
 593     pr.expectDelim(']');
 594   end;
 595
 596   while (pr.tokType <> pr.TTSemi) do
 597   begin
 598     if pr.eatId('offset') then
 599     begin
 600       if (fldofs >= 0) then raise Exception.Create(Format('duplicate field ''%s'' offset', [fldname]));
 601       fldofs := pr.expectInt();
 602       if (fldofs < 0) then raise Exception.Create(Format('invalid field ''%s'' offset', [fldname]));
 603       continue;
 604     end;
 605
 606     if pr.eatId('as') then
 607     begin
 608            if pr.eatId('xy') then asxy := true
 609       else if pr.eatId('wh') then aswh := true
 610       else if pr.eatId('txy') then begin asxy := true; ast := true; end
 611       else if pr.eatId('twh') then begin aswh := true; ast := true; end
 612       else raise Exception.Create(Format('invalid field ''%s'' as what?', [fldname]));
 613       continue;
 614     end;
 615
 616     if pr.eatId('enum') then
 617     begin
 618       lebs := TDynField.TEBS.TEnum;
 619       if (Length(fldrecname) <> 0) then raise Exception.Create(Format('field ''%s'' already typed as ''%s''', [fldname, fldrecname]));
 620       fldrecname := pr.expectId();
 621       continue;
 622     end;
 623
 624     if pr.eatId('bitset') then
 625     begin
 626       lebs := TDynField.TEBS.TBitSet;
 627       if (Length(fldrecname) <> 0) then raise Exception.Create(Format('field ''%s'' already typed as ''%s''', [fldname, fldrecname]));
 628       unique := pr.eatId('unique');
 629       fldrecname := pr.expectId();
 630       continue;
 631     end;
 632
 633     if pr.eatId('default') then
 634     begin
 635       if hasdefStr or hasdefInt or hasdefId then raise Exception.Create(Format('field ''%s'' has duplicate default', [fldname]));
 636       case pr.tokType of
 637         pr.TTStr:
 638           begin
 639             hasdefStr := true;
 640             defstr := pr.expectStr(true); // allow empty strings
 641           end;
 642         pr.TTId:
 643           begin
 644             hasdefId := true;
 645             defstr := pr.expectId();
 646           end;
 647         pr.TTInt:
 648           begin
 649             hasdefInt := true;
 650             defint := pr.expectInt();
 651           end;
 652         else
 653           raise Exception.Create(Format('field ''%s'' has invalid default', [fldname]));
 654       end;
 655       continue;
 656     end;
 657
 658     if pr.eatId('omitdefault') then
 659     begin
 660       omitdef := true;
 661       continue;
 662     end;
 663
 664     if pr.eatId('internal') then
 665     begin
 666       ainternal := true;
 667       continue;
 668     end;
 669
 670     if (pr.tokType <> pr.TTId) then raise Exception.Create(Format('field ''%s'' has something unexpected in definition', [fldname]));
 671
 672     if (Length(fldrecname) <> 0) then raise Exception.Create(Format('field ''%s'' already typed as ''%s''', [fldname, fldrecname]));
 673     fldrecname := pr.expectId();
 674     lebs := TDynField.TEBS.TRec;
 675   end;
 676
 677   pr.expectTT(pr.TTSemi);
 678
 679   // create field
 680   mName := fldname;
 681        if (fldtype = 'bool') then mType := TType.TBool
 682   else if (fldtype = 'negbool') then begin mType := TType.TBool; mNegBool := true; end
 683   else if (fldtype = 'char') then mType := TType.TChar
 684   else if (fldtype = 'byte') then mType := TType.TByte
 685   else if (fldtype = 'ubyte') then mType := TType.TUByte
 686   else if (fldtype = 'short') then mType := TType.TShort
 687   else if (fldtype = 'ushort') then mType := TType.TUShort
 688   else if (fldtype = 'int') then mType := TType.TInt
 689   else if (fldtype = 'uint') then mType := TType.TUInt
 690   else if (fldtype = 'string') then mType := TType.TString
 691   else if (fldtype = 'point') then mType := TType.TPoint
 692   else if (fldtype = 'size') then mType := TType.TSize
 693   else if (fldtype = 'trigdata') then mType := TType.TTrigData
 694   else raise Exception.Create(Format('field ''%s'' has invalid type ''%s''', [fldname, fldtype]));
 695
 696   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]));
 697   if (mType = TType.TTrigData) then
 698   begin
 699     if (lmaxdim < 1) then raise Exception.Create(Format('field ''%s'' of type ''%s'' cannot be array', [fldname, fldtype]));
 700     if (Length(fldrecname) > 0) then raise Exception.Create(Format('field ''%s'' of type ''%s'' cannot have another type', [fldname, fldtype]));
 701     lebs := TDynField.TEBS.TRec;
 702   end;
 703
 704        if hasdefStr then self.mDefUnparsed := quoteStr(defstr)
 705   else if hasdefInt then self.mDefUnparsed := Format('%d', [defint])
 706   else if hasdefId then self.mDefUnparsed := defstr;
 707
 708   self.mHasDefault := (hasdefStr or hasdefId or hasdefInt);
 709   self.mPasName := fldpasname;
 710   self.mEBS := lebs;
 711   self.mEBSTypeName := fldrecname;
 712   self.mBitSetUnique := unique;
 713   self.mMaxDim := lmaxdim;
 714   self.mBinOfs := fldofs;
 715   self.mRecOfs := fldofs;
 716   self.mSepPosSize := (asxy or aswh);
 717   self.mAsT := ast;
 718   self.mOmitDef := omitdef;
 719   self.mInternal := ainternal;
 720 end;
 721
 722
 723 procedure TDynField.writeBinTo (st: TStream);
 724 var
 725   s: AnsiString;
 726   f: Integer;
 727   maxv: Integer;
 728   buf: PByte;
 729   ws: TStream = nil;
 730 begin
 731   case mEBS of
 732     TEBS.TNone: begin end;
 733     TEBS.TRec:
 734       begin
 735         if (mMaxDim >= 0) then
 736         begin
 737           // this must be triggerdata
 738           if (mType <> TType.TTrigData) then
 739           begin
 740             raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
 741           end;
 742           // write triggerdata
 743           GetMem(buf, mMaxDim);
 744           if (buf = nil) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
 745           try
 746             FillChar(buf^, mMaxDim, 0);
 747             if (mRecRef <> nil) then
 748             begin
 749               ws := TSFSMemoryChunkStream.Create(buf, mMaxDim);
 750               mRecRef.writeBinTo(ws, mMaxDim); // as trigdata
 751             end;
 752             st.WriteBuffer(buf^, mMaxDim);
 753           finally
 754             ws.Free();
 755             if (buf <> nil) then FreeMem(buf);
 756           end;
 757           exit;
 758         end;
 759         // record reference
 760         if (mRecRef = nil) then
 761         begin
 762           // no ref, write -1
 763           case mType of
 764             TType.TByte, TType.TUByte: writeInt(st, Byte(-1));
 765             TType.TShort, TType.TUShort: writeInt(st, SmallInt(-1));
 766             TType.TInt, TType.TUInt: writeInt(st, Integer(-1));
 767             else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
 768           end;
 769           exit;
 770         end;
 771         case mType of
 772           TType.TByte: maxv := 127;
 773           TType.TUByte: maxv := 254;
 774           TType.TShort: maxv := 32767;
 775           TType.TUShort: maxv := 65534;
 776           TType.TInt: maxv := $7fffffff;
 777           TType.TUInt: maxv := $7fffffff;
 778           else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
 779         end;
 780         // find record number
 781         f := mOwner.findRecordNumByType(mEBSTypeName, mRecRef);
 782         if (f < 0) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' not found in record list', [mEBSTypeName, mName]));
 783         if (f > maxv) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' has too big index', [mEBSTypeName, mName]));
 784         case mType of
 785           TType.TByte, TType.TUByte: writeInt(st, Byte(f));
 786           TType.TShort, TType.TUShort: writeInt(st, SmallInt(f));
 787           TType.TInt, TType.TUInt: writeInt(st, Integer(f));
 788           else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
 789         end;
 790         exit;
 791       end;
 792     TEBS.TEnum: begin end;
 793     TEBS.TBitSet: begin end;
 794     else raise Exception.Create('ketmar forgot to handle some EBS type');
 795   end;
 796
 797   case mType of
 798     TType.TBool:
 799       begin
 800         if not mNegBool then
 801         begin
 802           if (mIVal <> 0) then writeInt(st, Byte(1)) else writeInt(st, Byte(0));
 803         end
 804         else
 805         begin
 806           if (mIVal = 0) then writeInt(st, Byte(1)) else writeInt(st, Byte(0));
 807         end;
 808         exit;
 809       end;
 810     TType.TChar:
 811       begin
 812         if (mMaxDim = 0) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
 813         if (mMaxDim < 0) then
 814         begin
 815           if (Length(mSVal) <> 1) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
 816           writeInt(st, Byte(mSVal[1]));
 817         end
 818         else
 819         begin
 820           if (Length(mSVal) > mMaxDim) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
 821           s := utf2win(mSVal);
 822           if (Length(s) > 0) then st.WriteBuffer(PChar(s)^, Length(s));
 823           for f := Length(s) to mMaxDim do writeInt(st, Byte(0));
 824         end;
 825         exit;
 826       end;
 827     TType.TByte,
 828     TType.TUByte:
 829       begin
 830         // triggerdata array was processed earlier
 831         if (mMaxDim >= 0) then Exception.Create(Format('byte array in field ''%s'' cannot be written', [mName]));
 832         writeInt(st, Byte(mIVal));
 833         exit;
 834       end;
 835     TType.TShort,
 836     TType.TUShort:
 837       begin
 838         if (mMaxDim >= 0) then raise Exception.Create(Format('short array in field ''%s'' cannot be written', [mName]));
 839         writeInt(st, Word(mIVal));
 840         exit;
 841       end;
 842     TType.TInt,
 843     TType.TUInt:
 844       begin
 845         if (mMaxDim >= 0) then raise Exception.Create(Format('int array in field ''%s'' cannot be written', [mName]));
 846         writeInt(st, LongWord(mIVal));
 847         exit;
 848       end;
 849     TType.TString:
 850       begin
 851         raise Exception.Create(Format('cannot write string field ''%s''', [mName]));
 852       end;
 853     TType.TPoint:
 854       begin
 855         if (mMaxDim >= 0) then raise Exception.Create(Format('pos/size array in field ''%s'' cannot be written', [mName]));
 856         writeInt(st, LongInt(mIVal));
 857         writeInt(st, LongInt(mIVal2));
 858         exit;
 859       end;
 860     TType.TSize:
 861       begin
 862         if (mMaxDim >= 0) then raise Exception.Create(Format('pos/size array in field ''%s'' cannot be written', [mName]));
 863         writeInt(st, Word(mIVal));
 864         writeInt(st, Word(mIVal2));
 865         exit;
 866       end;
 867     TType.TList:
 868       begin
 869         assert(false);
 870         exit;
 871       end;
 872     TType.TTrigData:
 873       begin
 874         assert(false);
 875         exit;
 876       end;
 877     else raise Exception.Create('ketmar forgot to handle some field type');
 878   end;
 879 end;
 880
 881
 882 procedure TDynField.writeTo (wr: TTextWriter);
 883 var
 884   es: TDynEBS = nil;
 885   f, mask: Integer;
 886   first, found: Boolean;
 887 begin
 888   wr.put(mName);
 889   wr.put(' ');
 890   case mEBS of
 891     TEBS.TNone: begin end;
 892     TEBS.TRec:
 893       begin
 894         if (mRecRef = nil) then
 895         begin
 896           if (mType = TType.TTrigData) then wr.put('{}'#10) else wr.put('null;'#10);
 897         end
 898         else if (Length(mRecRef.mId) = 0) then
 899         begin
 900           mRecRef.writeTo(wr, false); // only data, no header
 901         end
 902         else
 903         begin
 904           wr.put(mRecRef.mId);
 905           wr.put(';'#10);
 906         end;
 907         exit;
 908       end;
 909     TEBS.TEnum:
 910       begin
 911         //def := mOwner.mOwner;
 912         //es := def.findEBSType(mEBSTypeName);
 913         es := nil;
 914         if (mEBSType <> nil) and (mEBSType is TDynEBS) then es := (mEBSType as TDynEBS);
 915         if (es = nil) or (not es.mIsEnum) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
 916         for f := 0 to High(es.mVals) do
 917         begin
 918           if (es.mVals[f] = mIVal) then
 919           begin
 920             wr.put(es.mIds[f]);
 921             wr.put(';'#10);
 922             exit;
 923           end;
 924         end;
 925         raise Exception.Create(Format('value %d in record enum type ''%s'' for field ''%s'' not found', [mIVal, mEBSTypeName, mName]));
 926       end;
 927     TEBS.TBitSet:
 928       begin
 929         //def := mOwner.mOwner;
 930         //es := def.findEBSType(mEBSTypeName);
 931         es := nil;
 932         if (mEBSType <> nil) and (mEBSType is TDynEBS) then es := (mEBSType as TDynEBS);
 933         if (es = nil) or es.mIsEnum then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
 934         // none?
 935         if (mIVal = 0) then
 936         begin
 937           for f := 0 to High(es.mVals) do
 938           begin
 939             if (es.mVals[f] = 0) then
 940             begin
 941               wr.put(es.mIds[f]);
 942               wr.put(';'#10);
 943               exit;
 944             end;
 945           end;
 946           raise Exception.Create(Format('value %d in record bitset type ''%s'' for field ''%s'' not found', [0, mEBSTypeName, mName]));
 947         end;
 948         // not none
 949         mask := 1;
 950         first := true;
 951         while (mask <> 0) do
 952         begin
 953           if ((mIVal and mask) <> 0) then
 954           begin
 955             found := false;
 956             for f := 0 to High(es.mVals) do
 957             begin
 958               if (es.mVals[f] = mask) then
 959               begin
 960                 if not first then wr.put('+') else first := false;
 961                 wr.put(es.mIds[f]);
 962                 found := true;
 963                 break;
 964               end;
 965             end;
 966             if not found then raise Exception.Create(Format('value %d in record bitset type ''%s'' for field ''%s'' not found', [mask, mEBSTypeName, mName]));
 967           end;
 968           mask := mask shl 1;
 969         end;
 970         wr.put(';'#10);
 971         exit;
 972       end;
 973     else raise Exception.Create('ketmar forgot to handle some EBS type');
 974   end;
 975
 976   case mType of
 977     TType.TBool:
 978       begin
 979         if (mIVal = 0) then wr.put('false;'#10) else wr.put('true;'#10);
 980         exit;
 981       end;
 982     TType.TChar:
 983       begin
 984         if (mMaxDim = 0) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
 985         wr.put(quoteStr(mSVal));
 986         wr.put(';'#10);
 987         exit;
 988       end;
 989     TType.TByte,
 990     TType.TUByte,
 991     TType.TShort,
 992     TType.TUShort,
 993     TType.TInt,
 994     TType.TUInt:
 995       begin
 996         wr.put('%d;'#10, [mIVal]);
 997         exit;
 998       end;
 999     TType.TString:
1000       begin
1001         wr.put(quoteStr(mSVal));
1002         wr.put(';'#10);
1003         exit;
1004       end;
1005     TType.TPoint,
1006     TType.TSize:
1007       begin
1008         wr.put('(%d %d);'#10, [mIVal, mIVal2]);
1009         exit;
1010       end;
1011     TType.TList:
1012       begin
1013         assert(false);
1014         exit;
1015       end;
1016     TType.TTrigData:
1017       begin
1018         assert(false);
1019         exit;
1020       end;
1021     else raise Exception.Create('ketmar forgot to handle some field type');
1022   end;
1023   raise Exception.Create(Format('cannot parse field ''%s'' yet', [mName]));
1024 end;
1025
1026 procedure TDynField.parseBinValue (st: TStream);
1027 var
1028   rec, rc: TDynRecord;
1029   tfld: TDynField;
1030   es: TDynEBS = nil;
1031   tdata: PByte = nil;
1032   f, mask: Integer;
1033   s: AnsiString;
1034 begin
1035   case mEBS of
1036     TEBS.TNone: begin end;
1037     TEBS.TRec:
1038       begin
1039         // this must be triggerdata
1040         if (mType = TType.TTrigData) then
1041         begin
1042           assert(mMaxDim > 0);
1043           rec := mOwner;
1044           // find trigger definition
1045           tfld := rec.trigTypeField();
1046           if (tfld = nil) then raise Exception.Create(Format('triggerdata value for field ''%s'' in record ''%s'' without TriggerType 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           try
1052             rc.parseBinValue(st, true);
1053             mRecRef := rc;
1054             rc := nil;
1055           finally
1056             rc.Free();
1057           end;
1058           mDefined := true;
1059           exit;
1060         end
1061         else
1062         begin
1063           // not a trigger data
1064           case mType of
1065             TType.TByte: f := readShortInt(st);
1066             TType.TUByte: f := readByte(st);
1067             TType.TShort: f := readSmallInt(st);
1068             TType.TUShort: f := readWord(st);
1069             TType.TInt: f := readLongInt(st);
1070             TType.TUInt: f := readLongWord(st);
1071             else raise Exception.Create(Format('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName]));
1072           end;
1073           if (f < 0) then mRecRefId := '' else mRecRefId := Format('%s%d', [mEBSTypeName, f]);
1074         end;
1075         mDefined := true;
1076         exit;
1077       end;
1078     TEBS.TEnum,
1079     TEBS.TBitSet:
1080       begin
1081         assert(mMaxDim < 0);
1082         case mType of
1083           TType.TByte: f := readShortInt(st);
1084           TType.TUByte: f := readByte(st);
1085           TType.TShort: f := readSmallInt(st);
1086           TType.TUShort: f := readWord(st);
1087           TType.TInt: f := readLongInt(st);
1088           TType.TUInt: f := readLongWord(st);
1089           else raise Exception.Create(Format('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName]));
1090         end;
1091         es := nil;
1092         if (mEBSType <> nil) and (mEBSType is TDynEBS) then es := (mEBSType as TDynEBS);
1093         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]));
1094         mIVal := f;
1095         // build enum/bitfield values
1096         if (mEBS = TEBS.TEnum) then
1097         begin
1098           mSVal := es.nameByValue(mIVal);
1099           if (Length(mSVal) = 0) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mIVal]));
1100         end
1101         else
1102         begin
1103           // special for 'none'
1104           if (mIVal = 0) then
1105           begin
1106             mSVal := es.nameByValue(mIVal);
1107             if (Length(mSVal) = 0) then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mIVal]));
1108           end
1109           else
1110           begin
1111             mSVal := '';
1112             mask := 1;
1113             while (mask <> 0) do
1114             begin
1115               if ((mIVal and mask) <> 0) then
1116               begin
1117                 s := es.nameByValue(mask);
1118                 if (Length(s) = 0) then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mask]));
1119                 if (Length(mSVal) <> 0) then mSVal += '+';
1120                 mSVal += s;
1121               end;
1122               mask := mask shl 1;
1123             end;
1124           end;
1125         end;
1126         //writeln('ebs <', es.mName, '>: ', mSVal);
1127         mDefined := true;
1128         exit;
1129       end;
1130     else raise Exception.Create('ketmar forgot to handle some EBS type');
1131   end;
1132
1133   case mType of
1134     TType.TBool:
1135       begin
1136         f := readByte(st);
1137         if (f <> 0) then f := 1;
1138         if mNegBool then f := 1-f;
1139         mIVal := f;
1140         mDefined := true;
1141         exit;
1142       end;
1143     TType.TChar:
1144       begin
1145         if (mMaxDim < 0) then
1146         begin
1147           mIVal := readByte(st);
1148         end
1149         else
1150         begin
1151           mSVal := '';
1152           GetMem(tdata, mMaxDim);
1153           try
1154             st.ReadBuffer(tdata^, mMaxDim);
1155             f := 0;
1156             while (f < mMaxDim) and (tdata[f] <> 0) do Inc(f);
1157             if (f > 0) then
1158             begin
1159               SetLength(mSVal, f);
1160               Move(tdata^, PChar(mSVal)^, f);
1161               mSVal := win2utf(mSVal);
1162             end;
1163           finally
1164             FreeMem(tdata);
1165           end;
1166         end;
1167         mDefined := true;
1168         exit;
1169       end;
1170     TType.TByte: begin mIVal := readShortInt(st); mDefined := true; exit; end;
1171     TType.TUByte: begin mIVal := readByte(st); mDefined := true; exit; end;
1172     TType.TShort: begin mIVal := readSmallInt(st); mDefined := true; exit; end;
1173     TType.TUShort: begin mIVal := readWord(st); mDefined := true; exit; end;
1174     TType.TInt: begin mIVal := readLongInt(st); mDefined := true; exit; end;
1175     TType.TUInt: begin mIVal := readLongWord(st); mDefined := true; exit; end;
1176     TType.TString:
1177       begin
1178         raise Exception.Create('cannot read strings from binaries yet');
1179         exit;
1180       end;
1181     TType.TPoint:
1182       begin
1183         mIVal := readLongInt(st);
1184         mIVal2 := readLongInt(st);
1185         mDefined := true;
1186         exit;
1187       end;
1188     TType.TSize:
1189       begin
1190         mIVal := readWord(st);
1191         mIVal2 := readWord(st);
1192         mDefined := true;
1193         exit;
1194       end;
1195     TType.TList:
1196       begin
1197         assert(false);
1198         exit;
1199       end;
1200     TType.TTrigData:
1201       begin
1202         assert(false);
1203         exit;
1204       end;
1205     else raise Exception.Create('ketmar forgot to handle some field type');
1206   end;
1207   raise Exception.Create(Format('cannot parse field ''%s'' yet', [mName]));
1208 end;
1209
1210
1211 procedure TDynField.parseValue (pr: TTextParser);
1212
1213   procedure parseInt (min, max: Integer);
1214   begin
1215     mIVal := pr.expectInt();
1216     if (mIVal < min) or (mIVal > max) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
1217     mDefined := true;
1218   end;
1219
1220 var
1221   rec, rc: TDynRecord;
1222   es: TDynEBS = nil;
1223   tfld: TDynField;
1224   tk: AnsiString;
1225 begin
1226   // if this field should contain struct, convert type and parse struct
1227   case mEBS of
1228     TEBS.TNone: begin end;
1229     TEBS.TRec:
1230       begin
1231         // ugly hack. sorry.
1232         if (mType = TType.TTrigData) then
1233         begin
1234           pr.expectTT(pr.TTBegin);
1235           if (pr.tokType = pr.TTEnd) then
1236           begin
1237             // '{}'
1238             mRecRef := nil;
1239             pr.expectTT(pr.TTEnd);
1240           end
1241           else
1242           begin
1243             rec := mOwner;
1244             // find trigger definition
1245             tfld := rec.trigTypeField();
1246             if (tfld = nil) then raise Exception.Create(Format('triggerdata value for field ''%s'' in record ''%s'' without ''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 function TDynRecord.trigTypeField (): TDynField;
1634 var
1635   fld: TDynField;
1636   es: TDynEBS = nil;
1637 begin
1638   for fld in mFields do
1639   begin
1640     if (fld.mEBS <> TDynField.TEBS.TEnum) then continue;
1641     if not (fld.mEBSType is TDynEBS) then continue;
1642     es := (fld.mEBSType as TDynEBS);
1643     assert(es <> nil);
1644     if (CompareText(es.mName, 'TriggerType') = 0) then begin result := fld; exit; end;
1645   end;
1646   result := nil;
1647 end;
1648
1649
1650 procedure TDynRecord.parseDef (pr: TTextParser);
1651 var
1652   fld: TDynField;
1653   tdn: AnsiString;
1654 begin
1655   if pr.eatId('TriggerData') then
1656   begin
1657     pr.expectId('for');
1658     if pr.eatDelim('(') then
1659     begin
1660       while true do
1661       begin
1662         while pr.eatTT(pr.TTComma) do begin end;
1663         if pr.eatDelim(')') then break;
1664         tdn := pr.expectId();
1665         if isForTrig[tdn] then raise Exception.Create(Format('duplicate trigdata ''%s'' trigtype ''%s''', [mName, tdn]));
1666         SetLength(mTrigTypes, Length(mTrigTypes)+1);
1667         mTrigTypes[High(mTrigTypes)] := tdn;
1668       end;
1669     end
1670     else
1671     begin
1672       tdn := pr.expectId();
1673       SetLength(mTrigTypes, 1);
1674       mTrigTypes[0] := tdn;
1675     end;
1676     mName := 'TriggerData';
1677   end
1678   else
1679   begin
1680     mPasName := pr.expectId(); // pascal record name
1681     pr.expectId('is');
1682     mName := pr.expectStr();
1683     while (pr.tokType <> pr.TTBegin) do
1684     begin
1685       if pr.eatId('header') then begin mHeader := true; continue; end;
1686       if pr.eatId('size') then
1687       begin
1688         if (mSize > 0) then raise Exception.Create(Format('duplicate `size` in record ''%s''', [mName]));
1689         mSize := pr.expectInt();
1690         if (mSize < 1) then raise Exception.Create(Format('invalid record ''%s'' size: %d', [mName, mSize]));
1691         pr.expectId('bytes');
1692         continue;
1693       end;
1694       if pr.eatId('binblock') then
1695       begin
1696         if (mBinBlock >= 0) then raise Exception.Create(Format('duplicate `binblock` in record ''%s''', [mName]));
1697         mBinBlock := pr.expectInt();
1698         if (mBinBlock < 1) then raise Exception.Create(Format('invalid record ''%s'' binblock: %d', [mName, mBinBlock]));
1699         continue;
1700       end;
1701     end;
1702   end;
1703
1704   pr.expectTT(pr.TTBegin);
1705   // load fields
1706   while (pr.tokType <> pr.TTEnd) do
1707   begin
1708     fld := TDynField.Create(pr);
1709     if hasByName(fld.name) then begin fld.Free(); raise Exception.Create(Format('duplicate field ''%s''', [fld.name])); end;
1710     // append
1711     fld.mOwner := self;
1712     mFields.append(fld);
1713     // done with field
1714   end;
1715   pr.expectTT(pr.TTEnd);
1716 end;
1717
1718
1719 function TDynRecord.definition (): AnsiString;
1720 var
1721   f: Integer;
1722 begin
1723   if isTrigData then
1724   begin
1725     // trigger data
1726     result := 'TriggerData for ';
1727     if (Length(mTrigTypes) > 1) then
1728     begin
1729       result += '(';
1730       for f := 0 to High(mTrigTypes) do
1731       begin
1732         if (f <> 0) then result += ', ';
1733         result += mTrigTypes[f];
1734       end;
1735       result += ')';
1736     end
1737     else
1738     begin
1739       result += mTrigTypes[0];
1740     end;
1741   end
1742   else
1743   begin
1744     // record
1745     result := mPasName+' is '+quoteStr(mName);
1746     if (mSize >= 0) then result += Format(' size %d bytes', [mSize]);
1747     if mHeader then result += ' header';
1748   end;
1749   result += ' {'#10;
1750   for f := 0 to mFields.count-1 do
1751   begin
1752     result += '  ';
1753     result += mFields[f].definition;
1754     result += ';'#10;
1755   end;
1756   result += '}';
1757 end;
1758
1759
1760 procedure TDynRecord.parseBinValue (st: TStream; forceData: Boolean=false);
1761 var
1762   sign: string[4];
1763   btype: Integer;
1764   bsize: Integer;
1765   buf: PByte = nil;
1766   loaded: array[0..255] of Boolean;
1767   rec, rect: TDynRecord;
1768   fld: TDynField;
1769   f: Integer;
1770   mst: TSFSMemoryChunkStream = nil;
1771
1772   procedure linkNames (rec: TDynRecord);
1773   var
1774     fld: TDynField;
1775     rt: TDynRecord;
1776   begin
1777     //writeln('*** rec: ', rec.mName, '.', rec.mId, ' (', rec.mFields.count, ')');
1778     for fld in rec.mFields do
1779     begin
1780       if (fld.mType = TDynField.TType.TTrigData) then
1781       begin
1782         if (fld.mRecRef <> nil) then linkNames(fld.mRecRef);
1783         continue;
1784       end;
1785       if (Length(fld.mRecRefId) = 0) then continue;
1786       assert(fld.mEBSType <> nil);
1787       rt := findRecordByTypeId(fld.mEBSTypeName, fld.mRecRefId);
1788       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]));
1789       //writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')');
1790       fld.mRecRefId := '';
1791       fld.mRecRef := rt;
1792       fld.mDefined := true;
1793     end;
1794     for fld in rec.mFields do
1795     begin
1796       //writeln('  ', fld.mName);
1797       fld.fixDefaultValue(); // just in case
1798     end;
1799   end;
1800
1801 begin
1802   for f := 0 to High(loaded) do loaded[f] := false;
1803   mst := TSFSMemoryChunkStream.Create(nil, 0);
1804   try
1805     if mHeader and not forceData then
1806     begin
1807       // parse map file as sequence of blocks
1808       sign[0] := #4;
1809       st.ReadBuffer(sign[1], 4);
1810       if (sign <> 'MAP'#1) then raise Exception.Create('invalid binary map signature');
1811       // parse blocks
1812       while (st.position < st.size) do
1813       begin
1814         btype := readByte(st);
1815         if (btype = 0) then break; // no more blocks
1816         readLongWord(st); // reserved
1817         bsize := readLongInt(st);
1818         writeln('btype=', btype, '; bsize=', bsize);
1819         if (bsize < 0) or (bsize > $1fffffff) then raise Exception.Create(Format('block of type %d has invalid size %d', [btype, bsize]));
1820         if loaded[btype] then raise Exception.Create(Format('block of type %d already loaded', [btype]));
1821         loaded[btype] := true;
1822         // find record type for this block
1823         rect := nil;
1824         for rec in mOwner.recTypes do if (rec.mBinBlock = btype) then begin rect := rec; break; end;
1825         if (rect = nil) then raise Exception.Create(Format('block of type %d has no corresponding record', [btype]));
1826         writeln('found type ''', rec.mName, ''' for block type ', btype);
1827         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]));
1828         // header?
1829         if (rect.mHeader) then
1830         begin
1831           if (bsize <> mSize) then raise Exception.Create(Format('header block of type %d has invalid number of records', [btype]));
1832           GetMem(buf, bsize);
1833           st.ReadBuffer(buf^, bsize);
1834           mst.setup(buf, mSize);
1835           parseBinValue(mst, true); // force parsing data
1836         end
1837         else
1838         begin
1839           // create list for this type
1840           fld := TDynField.Create(rec.mName, TDynField.TType.TList);
1841           fld.mOwner := self;
1842           mFields.append(fld);
1843           if (bsize > 0) then
1844           begin
1845             GetMem(buf, bsize);
1846             st.ReadBuffer(buf^, bsize);
1847             for f := 0 to (bsize div rec.mSize)-1 do
1848             begin
1849               mst.setup(buf+f*rec.mSize, rec.mSize);
1850               rec := rect.clone();
1851               rec.mHeaderRec := self;
1852               rec.parseBinValue(mst);
1853               rec.mId := Format('%s%d', [rec.mName, f]);
1854               fld.mRVal.append(rec);
1855               //writeln('parsed ''', rec.mId, '''...');
1856             end;
1857           end;
1858         end;
1859         FreeMem(buf);
1860         buf := nil;
1861         //st.position := st.position+bsize;
1862       end;
1863       // link fields
1864       for fld in mFields do
1865       begin
1866         if (fld.mType <> TDynField.TType.TList) then continue;
1867         for rec in fld.mRVal do linkNames(rec);
1868       end;
1869       exit;
1870     end;
1871
1872     // read fields
1873     if (CompareText(mName, 'TriggerData') = 0) then mSize := Integer(st.size-st.position);
1874     if (mSize < 1) then raise Exception.Create(Format('cannot read record of type ''%s'' with unknown size', [mName]));
1875     GetMem(buf, mSize);
1876     st.ReadBuffer(buf^, mSize);
1877     for fld in mFields do
1878     begin
1879       if fld.mInternal then continue;
1880       if (fld.mBinOfs < 0) then continue;
1881       if (fld.mBinOfs >= st.size) then raise Exception.Create(Format('record of type ''%s'' has invalid field ''%s''', [fld.mName]));
1882       mst.setup(buf+fld.mBinOfs, mSize-fld.mBinOfs);
1883       //writeln('parsing ''', mName, '.', fld.mName, '''...');
1884       fld.parseBinValue(mst);
1885     end;
1886   finally
1887     mst.Free();
1888     if (buf <> nil) then FreeMem(buf);
1889   end;
1890 end;
1891
1892
1893 procedure TDynRecord.writeBinTo (st: TStream; trigbufsz: Integer=-1);
1894 var
1895   fld: TDynField;
1896   rec, rv: TDynRecord;
1897   buf: PByte = nil;
1898   ws: TStream = nil;
1899   blk, blkmax: Integer;
1900   //f, c: Integer;
1901   bufsz: Integer = 0;
1902   blksz: Integer;
1903 begin
1904   if (trigbufsz < 0) then
1905   begin
1906     if (mBinBlock < 1) then raise Exception.Create('cannot write binary record without block number');
1907     if (mSize < 1) then raise Exception.Create('cannot write binary record without size');
1908     bufsz := mSize;
1909   end
1910   else
1911   begin
1912     bufsz := trigbufsz;
1913   end;
1914   try
1915     GetMem(buf, bufsz);
1916     FillChar(buf^, bufsz, 0);
1917     ws := TSFSMemoryChunkStream.Create(buf, bufsz);
1918
1919     // write normal fields
1920     for fld in mFields do
1921     begin
1922       // record list?
1923       if (fld.mType = fld.TType.TList) then continue; // later
1924       if fld.mInternal then continue;
1925       if (fld.mBinOfs < 0) then continue;
1926       if (fld.mBinOfs >= bufsz) then raise Exception.Create('binary value offset is outside of the buffer');
1927       TSFSMemoryChunkStream(ws).setup(buf+fld.mBinOfs, bufsz-fld.mBinOfs);
1928       //writeln('writing field <', fld.mName, '>');
1929       fld.writeBinTo(ws);
1930     end;
1931
1932     // write block with normal fields
1933     if mHeader then
1934     begin
1935       //writeln('writing header...');
1936       // signature and version
1937       writeIntBE(st, LongWord($4D415001));
1938       writeInt(st, Byte(mBinBlock)); // type
1939       writeInt(st, LongWord(0)); // reserved
1940       writeInt(st, LongWord(bufsz)); // size
1941     end;
1942     st.WriteBuffer(buf^, bufsz);
1943
1944     ws.Free(); ws := nil;
1945     FreeMem(buf); buf := nil;
1946
1947     // write other blocks, if any
1948     if mHeader then
1949     begin
1950       // calculate blkmax
1951       blkmax := 0;
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 <= 0) then continue;
1961           if (blkmax < rec.mBinBlock) then blkmax := rec.mBinBlock;
1962         end;
1963       end;
1964       // write blocks
1965       for blk := 1 to blkmax do
1966       begin
1967         if (blk = mBinBlock) then continue;
1968         ws := nil;
1969         for fld in mFields do
1970         begin
1971           // record list?
1972           if (fld.mType = fld.TType.TList) then
1973           begin
1974             if (fld.mRVal = nil) or (fld.mRVal.count = 0) then continue;
1975             rec := mOwner.findRecType(fld.mName);
1976             if (rec = nil) then continue;
1977             if (rec.mBinBlock <> blk) then continue;
1978             if (ws = nil) then ws := TMemoryStream.Create();
1979             for rv in fld.mRVal do rv.writeBinTo(ws);
1980           end;
1981         end;
1982         // flush block
1983         if (ws <> nil) then
1984         begin
1985           blksz := Integer(ws.position);
1986           ws.position := 0;
1987           writeInt(st, Byte(blk)); // type
1988           writeInt(st, LongWord(0)); // reserved
1989           writeInt(st, LongWord(blksz)); // size
1990           st.CopyFrom(ws, blksz);
1991           ws.Free();
1992           ws := nil;
1993         end;
1994       end;
1995       // write end marker
1996       writeInt(st, Byte(0));
1997       writeInt(st, LongWord(0));
1998       writeInt(st, LongWord(0));
1999     end;
2000   finally
2001     ws.Free();
2002     if (buf <> nil) then FreeMem(buf);
2003   end;
2004 end;
2005
2006
2007 procedure TDynRecord.writeTo (wr: TTextWriter; putHeader: Boolean=true);
2008 var
2009   fld: TDynField;
2010   rec: TDynRecord;
2011 begin
2012   if putHeader then
2013   begin
2014     wr.put(mName);
2015     if (Length(mId) > 0) then begin wr.put(' '); wr.put(mId); end;
2016     wr.put(' ');
2017   end;
2018   wr.put('{'#10);
2019   wr.indent();
2020   try
2021     for fld in mFields do
2022     begin
2023       // record list?
2024       if (fld.mType = fld.TType.TList) then
2025       begin
2026         if not mHeader then raise Exception.Create('record list in non-header record');
2027         if (fld.mRVal <> nil) then
2028         begin
2029           for rec in fld.mRVal do
2030           begin
2031             if (Length(rec.mId) = 0) then continue;
2032             wr.putIndent();
2033             rec.writeTo(wr, true);
2034           end;
2035         end;
2036         continue;
2037       end;
2038       if fld.mInternal then continue;
2039       if fld.mOmitDef and fld.isDefaultValue then continue;
2040       wr.putIndent();
2041       fld.writeTo(wr);
2042     end;
2043   finally
2044     wr.unindent();
2045   end;
2046   wr.putIndent();
2047   wr.put('}'#10);
2048 end;
2049
2050
2051 procedure TDynRecord.parseValue (pr: TTextParser; beginEaten: Boolean=false);
2052 var
2053   fld: TDynField;
2054   rec, trc, rv: TDynRecord;
2055 begin
2056   if (mOwner = nil) then raise Exception.Create(Format('can''t parse record ''%s'' value without owner', [mName]));
2057
2058   // not a header?
2059   if not mHeader then
2060   begin
2061     // id?
2062     if (not beginEaten) and (pr.tokType = pr.TTId) then mId := pr.expectId();
2063   end
2064   else
2065   begin
2066     assert(mHeaderRec = self);
2067   end;
2068
2069   //writeln('parsing record <', mName, '>');
2070   if not beginEaten then pr.expectTT(pr.TTBegin);
2071   while (pr.tokType <> pr.TTEnd) do
2072   begin
2073     if (pr.tokType <> pr.TTId) then raise Exception.Create('identifier expected');
2074     //writeln('<', mName, '.', pr.tokStr, '>');
2075
2076     // records
2077     if mHeader then
2078     begin
2079       // add records with this type (if any)
2080       trc := mOwner.findRecType(pr.tokStr);
2081       if (trc <> nil) then
2082       begin
2083         rec := trc.clone();
2084         rec.mHeaderRec := mHeaderRec;
2085         try
2086           pr.skipToken();
2087           rec.parseValue(pr);
2088           if (Length(rec.mId) > 0) then
2089           begin
2090             fld := field[pr.tokStr];
2091             if (fld <> nil) and (fld.mRVal <> nil) then
2092             begin
2093               for rv in fld.mRVal do
2094               begin
2095                 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]));
2096               end;
2097             end;
2098           end;
2099           addRecordByType(rec.mName, rec);
2100           rec := nil;
2101         finally
2102           rec.Free();
2103         end;
2104         continue;
2105       end;
2106     end;
2107
2108     // fields
2109     fld := field[pr.tokStr];
2110     if (fld <> nil) then
2111     begin
2112       if fld.defined then raise Exception.Create(Format('duplicate field ''%s'' in record ''%s''', [fld.mName, mName]));
2113       if fld.internal then raise Exception.Create(Format('internal field ''%s'' in record ''%s''', [fld.mName, mName]));
2114       pr.skipToken();
2115       fld.parseValue(pr);
2116       continue;
2117     end;
2118
2119     // something is wrong
2120     raise Exception.Create(Format('unknown field ''%s'' in record ''%s''', [pr.tokStr, mName]));
2121   end;
2122   pr.expectTT(pr.TTEnd);
2123   // fix field defaults
2124   for fld in mFields do fld.fixDefaultValue();
2125   //writeln('done parsing record <', mName, '>');
2126 end;
2127
2128
2129 // ////////////////////////////////////////////////////////////////////////// //
2130 constructor TDynEBS.Create (pr: TTextParser);
2131 begin
2132   cleanup();
2133   parseDef(pr);
2134 end;
2135
2136
2137 destructor TDynEBS.Destroy ();
2138 begin
2139   cleanup();
2140   inherited;
2141 end;
2142
2143
2144 procedure TDynEBS.cleanup ();
2145 begin
2146   mIsEnum := false;
2147   mName := '';
2148   mIds := nil;
2149   mVals := nil;
2150   mMaxName := '';
2151   mMaxVal := 0;
2152 end;
2153
2154
2155 function TDynEBS.findByName (const aname: AnsiString): Integer;
2156 begin
2157   result := 0;
2158   while (result < Length(mIds)) do
2159   begin
2160     if (CompareText(aname, mIds[result]) = 0) then exit;
2161     Inc(result);
2162   end;
2163   result := -1;
2164 end;
2165
2166
2167 function TDynEBS.hasByName (const aname: AnsiString): Boolean; inline;
2168 begin
2169   result := (findByName(aname) >= 0);
2170 end;
2171
2172
2173 function TDynEBS.getFieldByName (const aname: AnsiString): Integer; inline;
2174 var
2175   f: Integer;
2176 begin
2177   f := findByName(aname);
2178   if (f >= 0) then result := mVals[f] else result := 0;
2179 end;
2180
2181
2182 function TDynEBS.definition (): AnsiString;
2183 var
2184   f, cv: Integer;
2185 begin
2186   if mIsEnum then result :='enum ' else result := 'bitset ';
2187   result += mName;
2188   result += ' {'#10;
2189   // fields
2190   if mIsEnum then cv := 0 else cv := 1;
2191   for f := 0 to High(mIds) do
2192   begin
2193     if (mIds[f] = mMaxName) then continue;
2194     result += '  '+mIds[f];
2195     if (mVals[f] <> cv) then
2196     begin
2197       result += Format(' = %d', [mVals[f]]);
2198       if mIsEnum then cv := mVals[f];
2199       result += ','#10;
2200     end
2201     else
2202     begin
2203       result += Format(', // %d'#10, [mVals[f]]);
2204     end;
2205     if mIsEnum then Inc(cv) else if (mVals[f] = cv) then cv := cv shl 1;
2206   end;
2207   // max field
2208   if (Length(mMaxName) > 0) then result += '  '+mMaxName+' = MAX,'#10;
2209   result += '}';
2210 end;
2211
2212
2213 function TDynEBS.nameByValue (v: Integer): AnsiString;
2214 var
2215   f: Integer;
2216 begin
2217   for f := 0 to High(mVals) do
2218   begin
2219     if (mVals[f] = v) then begin result := mIds[f]; exit; end;
2220   end;
2221   result := '';
2222 end;
2223
2224
2225 procedure TDynEBS.parseDef (pr: TTextParser);
2226 var
2227   idname: AnsiString;
2228   cv, v: Integer;
2229   f: Integer;
2230   skipAdd: Boolean;
2231   hasV: Boolean;
2232 begin
2233        if pr.eatId('enum') then mIsEnum := true
2234   else if pr.eatId('bitset') then mIsEnum := false
2235   else pr.expectId('enum');
2236   mName := pr.expectId();
2237   mMaxVal := Integer($80000000);
2238   if mIsEnum then cv := 0 else cv := 1;
2239   pr.expectTT(pr.TTBegin);
2240   while (pr.tokType <> pr.TTEnd) do
2241   begin
2242     idname := pr.expectId();
2243     for f := 0 to High(mIds) do
2244     begin
2245       if (CompareText(mIds[f], idname) = 0) then raise Exception.Create(Format('duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName]));
2246     end;
2247     if (CompareText(mMaxName, idname) = 0) then raise Exception.Create(Format('duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName]));
2248     skipAdd := false;
2249     hasV := false;
2250     v := cv;
2251     // has value?
2252     if pr.eatDelim('=') then
2253     begin
2254       if pr.eatId('MAX') then
2255       begin
2256         if (Length(mMaxName) > 0) then raise Exception.Create(Format('duplicate max field ''%s'' in enum/bitset ''%s''', [idname, mName]));
2257         mMaxName := idname;
2258         skipAdd := true;
2259       end
2260       else
2261       begin
2262         v := pr.expectInt();
2263           if mIsEnum then cv := v;
2264         hasV := true;
2265       end;
2266     end;
2267     // append it?
2268     if not skipAdd then
2269     begin
2270       // fix maxvalue
2271       if mIsEnum or (not hasV) then
2272       begin
2273         if (mMaxVal < v) then mMaxVal := v;
2274       end;
2275       SetLength(mIds, Length(mIds)+1);
2276       mIds[High(mIds)] := idname;
2277       SetLength(mVals, Length(mIds));
2278       mVals[High(mVals)] := v;
2279       // next cv
2280       if mIsEnum or (not hasV) then
2281       begin
2282         if mIsEnum then Inc(cv) else cv := cv shl 1;
2283       end;
2284     end;
2285     if (pr.tokType = pr.TTEnd) then break;
2286     pr.expectTT(pr.TTComma);
2287     while pr.eatTT(pr.TTComma) do begin end;
2288   end;
2289   pr.expectTT(pr.TTEnd);
2290   // add max field
2291   if (Length(mMaxName) > 0) then
2292   begin
2293     SetLength(mIds, Length(mIds)+1);
2294     mIds[High(mIds)] := mMaxName;
2295     SetLength(mVals, Length(mIds));
2296     mVals[High(mVals)] := mMaxVal;
2297   end;
2298 end;
2299
2300
2301 // ////////////////////////////////////////////////////////////////////////// //
2302 constructor TDynMapDef.Create (pr: TTextParser);
2303 begin
2304   recTypes := TDynRecList.Create();
2305   trigTypes := TDynRecList.Create();
2306   ebsTypes := TDynEBSList.Create();
2307   parseDef(pr);
2308 end;
2309
2310
2311 destructor TDynMapDef.Destroy ();
2312 var
2313   rec: TDynRecord;
2314   ebs: TDynEBS;
2315 begin
2316   for rec in recTypes do rec.Free();
2317   for rec in trigTypes do rec.Free();
2318   for ebs in ebsTypes do ebs.Free();
2319   recTypes.Free();
2320   trigTypes.Free();
2321   ebsTypes.Free();
2322   recTypes := nil;
2323   trigTypes := nil;
2324   ebsTypes := nil;
2325   inherited;
2326 end;
2327
2328
2329 function TDynMapDef.getHeaderRecType (): TDynRecord; inline;
2330 begin
2331   if (recTypes.count = 0) then raise Exception.Create('no header in empty mapdef');
2332   result := recTypes[0];
2333 end;
2334
2335
2336 function TDynMapDef.findRecType (const aname: AnsiString): TDynRecord;
2337 var
2338   rec: TDynRecord;
2339 begin
2340   for rec in recTypes do
2341   begin
2342     if (CompareText(rec.name, aname) = 0) then begin result := rec; exit; end;
2343   end;
2344   result := nil;
2345 end;
2346
2347
2348 function TDynMapDef.findTrigFor (const aname: AnsiString): TDynRecord;
2349 var
2350   rec: TDynRecord;
2351 begin
2352   for rec in trigTypes do
2353   begin
2354     if (rec.isForTrig[aname]) then begin result := rec; exit; end;
2355   end;
2356   result := nil;
2357 end;
2358
2359
2360 function TDynMapDef.findEBSType (const aname: AnsiString): TDynEBS;
2361 var
2362   ebs: TDynEBS;
2363 begin
2364   for ebs in ebsTypes do
2365   begin
2366     if (CompareText(ebs.name, aname) = 0) then begin result := ebs; exit; end;
2367   end;
2368   result := nil;
2369 end;
2370
2371
2372 procedure TDynMapDef.parseDef (pr: TTextParser);
2373 var
2374   rec, hdr: TDynRecord;
2375   eb: TDynEBS;
2376   f: Integer;
2377
2378   // setup header links and type links
2379   procedure linkRecord (rec: TDynRecord);
2380   var
2381     fld: TDynField;
2382   begin
2383     rec.mHeaderRec := recTypes[0];
2384     for fld in rec.mFields do
2385     begin
2386       if (fld.mType = fld.TType.TTrigData) then continue;
2387       case fld.mEBS of
2388         TDynField.TEBS.TNone: begin end;
2389         TDynField.TEBS.TRec:
2390           begin
2391             fld.mEBSType := findRecType(fld.mEBSTypeName);
2392             if (fld.mEBSType = nil) then raise Exception.Create(Format('field ''%s'' of type ''%s'' has no correcponding record definition', [fld.mName, fld.mEBSTypeName]));
2393           end;
2394         TDynField.TEBS.TEnum,
2395         TDynField.TEBS.TBitSet:
2396           begin
2397             fld.mEBSType := findEBSType(fld.mEBSTypeName);
2398             if (fld.mEBSType = nil) then raise Exception.Create(Format('field ''%s'' of type ''%s'' has no correcponding enum/bitset', [fld.mName, fld.mEBSTypeName]));
2399             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]));
2400           end;
2401       end;
2402     end;
2403   end;
2404
2405   // setup default values
2406   procedure fixRecordDefaults (rec: TDynRecord);
2407   var
2408     fld: TDynField;
2409   begin
2410     for fld in rec.mFields do if fld.mHasDefault then fld.parseDefaultValue();
2411   end;
2412
2413 begin
2414   hdr := nil;
2415   while true do
2416   begin
2417     if not pr.skipBlanks() then break;
2418     if (pr.tokType <> pr.TTId) then raise Exception.Create('identifier expected');
2419
2420     if (pr.tokStr = 'enum') or (pr.tokStr = 'bitset') then
2421     begin
2422       eb := TDynEBS.Create(pr);
2423       if (findEBSType(eb.name) <> nil) then
2424       begin
2425         eb.Free();
2426         raise Exception.Create(Format('duplicate enum/bitset ''%s''', [eb.name]));
2427       end;
2428       eb.mOwner := self;
2429       ebsTypes.append(eb);
2430       //writeln(eb.definition); writeln;
2431       continue;
2432     end;
2433
2434     if (pr.tokStr = 'TriggerData') then
2435     begin
2436       rec := TDynRecord.Create(pr);
2437       for f := 0 to High(rec.mTrigTypes) do
2438       begin
2439         if (findTrigFor(rec.mTrigTypes[f]) <> nil) then
2440         begin
2441           rec.Free();
2442           raise Exception.Create(Format('duplicate trigdata ''%s''', [rec.mTrigTypes[f]]));
2443         end;
2444       end;
2445       rec.mOwner := self;
2446       trigTypes.append(rec);
2447       //writeln(dr.definition); writeln;
2448       continue;
2449     end;
2450
2451     rec := TDynRecord.Create(pr);
2452     //writeln(dr.definition); writeln;
2453     if (findRecType(rec.name) <> nil) then begin rec.Free(); raise Exception.Create(Format('duplicate record ''%s''', [rec.name])); end;
2454     if (hdr <> nil) and (CompareText(rec.name, hdr.name) = 0) then begin rec.Free(); raise Exception.Create(Format('duplicate record ''%s''', [rec.name])); end;
2455     rec.mOwner := self;
2456     if rec.mHeader then
2457     begin
2458       if (hdr <> nil) then begin rec.Free(); raise Exception.Create(Format('duplicate header record ''%s'' (previous is ''%s'')', [rec.name, hdr.name])); end;
2459       hdr := rec;
2460     end
2461     else
2462     begin
2463       recTypes.append(rec);
2464     end;
2465   end;
2466
2467   // put header record to top
2468   if (hdr = nil) then raise Exception.Create('header definition not found in mapdef');
2469   recTypes.append(nil);
2470   for f := recTypes.count-1 downto 1 do recTypes[f] := recTypes[f-1];
2471   recTypes[0] := hdr;
2472
2473   // setup header links and type links
2474   for rec in recTypes do linkRecord(rec);
2475   for rec in trigTypes do linkRecord(rec);
2476
2477   // setup default values
2478   for rec in recTypes do fixRecordDefaults(rec);
2479   for rec in trigTypes do fixRecordDefaults(rec);
2480 end;
2481
2482
2483 // ////////////////////////////////////////////////////////////////////////// //
2484 function TDynMapDef.parseMap (pr: TTextParser): TDynRecord;
2485 var
2486   res: TDynRecord = nil;
2487 begin
2488   result := nil;
2489   try
2490     pr.expectId(headerType.name);
2491     res := headerType.clone();
2492     res.mHeaderRec := res;
2493     res.parseValue(pr);
2494     result := res;
2495     res := nil;
2496   except on E: Exception do
2497     begin
2498       res.Free();
2499       raise;
2500     end;
2501   end;
2502 end;
2503
2504
2505 function TDynMapDef.parseBinMap (st: TStream): TDynRecord;
2506 var
2507   res: TDynRecord = nil;
2508 begin
2509   result := nil;
2510   try
2511     res := headerType.clone();
2512     res.mHeaderRec := res;
2513     res.parseBinValue(st);
2514     result := res;
2515     res := nil;
2516   except on E: Exception do
2517     begin
2518       res.Free();
2519       raise;
2520     end;
2521   end;
2522 end;
2523
2524
2525 end.