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