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;
 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 raise Exception.Create(Format('record of type ''%s'' with id ''%s'' links to inexistant record of type ''%s'' with id ''%d''', [rec.mName, rec.mId, fld.mEBSTypeName, fld.mRecRefId]));
1856       //writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')');
1857       fld.mRecRefId := '';
1858       fld.mRecRef := rt;
1859       fld.mDefined := true;
1860     end;
1861     for fld in rec.mFields do
1862     begin
1863       //writeln('  ', fld.mName);
1864       fld.fixDefaultValue(); // just in case
1865     end;
1866   end;
1867
1868 begin
1869   for f := 0 to High(loaded) do loaded[f] := false;
1870   mst := TSFSMemoryChunkStream.Create(nil, 0);
1871   try
1872     if mHeader and not forceData then
1873     begin
1874       // parse map file as sequence of blocks
1875       sign[0] := #4;
1876       st.ReadBuffer(sign[1], 4);
1877       if (sign <> 'MAP'#1) then raise Exception.Create('invalid binary map signature');
1878       // parse blocks
1879       while (st.position < st.size) do
1880       begin
1881         btype := readByte(st);
1882         if (btype = 0) then break; // no more blocks
1883         readLongWord(st); // reserved
1884         bsize := readLongInt(st);
1885         //writeln('btype=', btype, '; bsize=', bsize);
1886         if (bsize < 0) or (bsize > $1fffffff) then raise Exception.Create(Format('block of type %d has invalid size %d', [btype, bsize]));
1887         if loaded[btype] then raise Exception.Create(Format('block of type %d already loaded', [btype]));
1888         loaded[btype] := true;
1889         // find record type for this block
1890         rect := nil;
1891         for rec in mOwner.recTypes do if (rec.mBinBlock = btype) then begin rect := rec; break; end;
1892         if (rect = nil) then raise Exception.Create(Format('block of type %d has no corresponding record', [btype]));
1893         //writeln('found type ''', rec.mName, ''' for block type ', btype);
1894         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]));
1895         // header?
1896         if (rect.mHeader) then
1897         begin
1898           if (bsize <> mSize) then raise Exception.Create(Format('header block of type %d has invalid number of records', [btype]));
1899           GetMem(buf, bsize);
1900           st.ReadBuffer(buf^, bsize);
1901           mst.setup(buf, mSize);
1902           parseBinValue(mst, true); // force parsing data
1903         end
1904         else
1905         begin
1906           // create list for this type
1907           fld := TDynField.Create(rec.mName, TDynField.TType.TList);
1908           fld.mOwner := self;
1909           mFields.append(fld);
1910           if (bsize > 0) then
1911           begin
1912             GetMem(buf, bsize);
1913             st.ReadBuffer(buf^, bsize);
1914             for f := 0 to (bsize div rec.mSize)-1 do
1915             begin
1916               mst.setup(buf+f*rec.mSize, rec.mSize);
1917               rec := rect.clone();
1918               rec.mHeaderRec := self;
1919               rec.parseBinValue(mst);
1920               rec.mId := Format('%s%d', [rec.mName, f]);
1921               fld.mRVal.append(rec);
1922               //writeln('parsed ''', rec.mId, '''...');
1923             end;
1924           end;
1925         end;
1926         FreeMem(buf);
1927         buf := nil;
1928         //st.position := st.position+bsize;
1929       end;
1930       // link fields
1931       for fld in mFields do
1932       begin
1933         if (fld.mType <> TDynField.TType.TList) then continue;
1934         for rec in fld.mRVal do linkNames(rec);
1935       end;
1936       exit;
1937     end;
1938
1939     // read fields
1940     if StrEqu(mName, 'TriggerData') then mSize := Integer(st.size-st.position);
1941     if (mSize < 1) then raise Exception.Create(Format('cannot read record of type ''%s'' with unknown size', [mName]));
1942     GetMem(buf, mSize);
1943     st.ReadBuffer(buf^, mSize);
1944     for fld in mFields do
1945     begin
1946       if fld.mInternal then continue;
1947       if (fld.mBinOfs < 0) then continue;
1948       if (fld.mBinOfs >= st.size) then raise Exception.Create(Format('record of type ''%s'' has invalid field ''%s''', [fld.mName]));
1949       mst.setup(buf+fld.mBinOfs, mSize-fld.mBinOfs);
1950       //writeln('parsing ''', mName, '.', fld.mName, '''...');
1951       fld.parseBinValue(mst);
1952     end;
1953   finally
1954     mst.Free();
1955     if (buf <> nil) then FreeMem(buf);
1956   end;
1957 end;
1958
1959
1960 procedure TDynRecord.writeBinTo (st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false);
1961 var
1962   fld: TDynField;
1963   rec, rv: TDynRecord;
1964   buf: PByte = nil;
1965   ws: TStream = nil;
1966   blk, blkmax: Integer;
1967   //f, c: Integer;
1968   bufsz: Integer = 0;
1969   blksz: Integer;
1970 begin
1971   if (trigbufsz < 0) then
1972   begin
1973     if (mBinBlock < 1) then raise Exception.Create('cannot write binary record without block number');
1974     if (mSize < 1) then raise Exception.Create('cannot write binary record without size');
1975     bufsz := mSize;
1976   end
1977   else
1978   begin
1979     bufsz := trigbufsz;
1980   end;
1981   try
1982     GetMem(buf, bufsz);
1983     FillChar(buf^, bufsz, 0);
1984     ws := TSFSMemoryChunkStream.Create(buf, bufsz);
1985
1986     // write normal fields
1987     for fld in mFields do
1988     begin
1989       // record list?
1990       if (fld.mType = fld.TType.TList) then continue; // later
1991       if fld.mInternal then continue;
1992       if (fld.mBinOfs < 0) then continue;
1993       if (fld.mBinOfs >= bufsz) then raise Exception.Create('binary value offset is outside of the buffer');
1994       TSFSMemoryChunkStream(ws).setup(buf+fld.mBinOfs, bufsz-fld.mBinOfs);
1995       //writeln('writing field <', fld.mName, '>');
1996       fld.writeBinTo(ws);
1997     end;
1998
1999     // write block with normal fields
2000     if mHeader and not onlyFields then
2001     begin
2002       //writeln('writing header...');
2003       // signature and version
2004       writeIntBE(st, LongWord($4D415001));
2005       writeInt(st, Byte(mBinBlock)); // type
2006       writeInt(st, LongWord(0)); // reserved
2007       writeInt(st, LongWord(bufsz)); // size
2008     end;
2009     st.WriteBuffer(buf^, bufsz);
2010
2011     ws.Free(); ws := nil;
2012     FreeMem(buf); buf := nil;
2013
2014     // write other blocks, if any
2015     if mHeader and not onlyFields then
2016     begin
2017       // calculate blkmax
2018       blkmax := 0;
2019       for fld in mFields do
2020       begin
2021         // record list?
2022         if (fld.mType = fld.TType.TList) then
2023         begin
2024           if (fld.mRVal = nil) or (fld.mRVal.count = 0) then continue;
2025           rec := mOwner.findRecType(fld.mName);
2026           if (rec = nil) then continue;
2027           if (rec.mBinBlock <= 0) then continue;
2028           if (blkmax < rec.mBinBlock) then blkmax := rec.mBinBlock;
2029         end;
2030       end;
2031       // write blocks
2032       for blk := 1 to blkmax do
2033       begin
2034         if (blk = mBinBlock) then continue;
2035         ws := nil;
2036         for fld in mFields do
2037         begin
2038           // record list?
2039           if (fld.mType = fld.TType.TList) then
2040           begin
2041             if (fld.mRVal = nil) or (fld.mRVal.count = 0) then continue;
2042             rec := mOwner.findRecType(fld.mName);
2043             if (rec = nil) then continue;
2044             if (rec.mBinBlock <> blk) then continue;
2045             if (ws = nil) then ws := TMemoryStream.Create();
2046             for rv in fld.mRVal do rv.writeBinTo(ws);
2047           end;
2048         end;
2049         // flush block
2050         if (ws <> nil) then
2051         begin
2052           blksz := Integer(ws.position);
2053           ws.position := 0;
2054           writeInt(st, Byte(blk)); // type
2055           writeInt(st, LongWord(0)); // reserved
2056           writeInt(st, LongWord(blksz)); // size
2057           st.CopyFrom(ws, blksz);
2058           ws.Free();
2059           ws := nil;
2060         end;
2061       end;
2062       // write end marker
2063       writeInt(st, Byte(0));
2064       writeInt(st, LongWord(0));
2065       writeInt(st, LongWord(0));
2066     end;
2067   finally
2068     ws.Free();
2069     if (buf <> nil) then FreeMem(buf);
2070   end;
2071 end;
2072
2073
2074 procedure TDynRecord.writeTo (wr: TTextWriter; putHeader: Boolean=true);
2075 var
2076   fld: TDynField;
2077   rec: TDynRecord;
2078 begin
2079   if putHeader then
2080   begin
2081     wr.put(mName);
2082     if (Length(mId) > 0) then begin wr.put(' '); wr.put(mId); end;
2083     wr.put(' ');
2084   end;
2085   wr.put('{'#10);
2086   wr.indent();
2087   try
2088     for fld in mFields do
2089     begin
2090       // record list?
2091       if (fld.mType = fld.TType.TList) then
2092       begin
2093         if not mHeader then raise Exception.Create('record list in non-header record');
2094         if (fld.mRVal <> nil) then
2095         begin
2096           for rec in fld.mRVal do
2097           begin
2098             if (Length(rec.mId) = 0) then continue;
2099             wr.putIndent();
2100             rec.writeTo(wr, true);
2101           end;
2102         end;
2103         continue;
2104       end;
2105       if fld.mInternal then continue;
2106       if fld.mOmitDef and fld.isDefaultValue then continue;
2107       wr.putIndent();
2108       fld.writeTo(wr);
2109     end;
2110   finally
2111     wr.unindent();
2112   end;
2113   wr.putIndent();
2114   wr.put('}'#10);
2115 end;
2116
2117
2118 procedure TDynRecord.parseValue (pr: TTextParser; beginEaten: Boolean=false);
2119 var
2120   fld: TDynField;
2121   rec, trc, rv: TDynRecord;
2122 begin
2123   if (mOwner = nil) then raise Exception.Create(Format('can''t parse record ''%s'' value without owner', [mName]));
2124
2125   // not a header?
2126   if not mHeader then
2127   begin
2128     // id?
2129     if (not beginEaten) and (pr.tokType = pr.TTId) then mId := pr.expectId();
2130   end
2131   else
2132   begin
2133     assert(mHeaderRec = self);
2134   end;
2135
2136   //writeln('parsing record <', mName, '>');
2137   if not beginEaten then pr.expectTT(pr.TTBegin);
2138   while (pr.tokType <> pr.TTEnd) do
2139   begin
2140     if (pr.tokType <> pr.TTId) then raise Exception.Create('identifier expected');
2141     //writeln('<', mName, '.', pr.tokStr, '>');
2142
2143     // records
2144     if mHeader then
2145     begin
2146       // add records with this type (if any)
2147       trc := mOwner.findRecType(pr.tokStr);
2148       if (trc <> nil) then
2149       begin
2150         rec := trc.clone();
2151         rec.mHeaderRec := mHeaderRec;
2152         try
2153           pr.skipToken();
2154           rec.parseValue(pr);
2155           if (Length(rec.mId) > 0) then
2156           begin
2157             fld := field[pr.tokStr];
2158             if (fld <> nil) and (fld.mRVal <> nil) then
2159             begin
2160               for rv in fld.mRVal do
2161               begin
2162                 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]));
2163               end;
2164             end;
2165           end;
2166           addRecordByType(rec.mName, rec);
2167           rec := nil;
2168         finally
2169           rec.Free();
2170         end;
2171         continue;
2172       end;
2173     end;
2174
2175     // fields
2176     fld := field[pr.tokStr];
2177     if (fld <> nil) then
2178     begin
2179       if fld.defined then raise Exception.Create(Format('duplicate field ''%s'' in record ''%s''', [fld.mName, mName]));
2180       if fld.internal then raise Exception.Create(Format('internal field ''%s'' in record ''%s''', [fld.mName, mName]));
2181       pr.skipToken();
2182       fld.parseValue(pr);
2183       continue;
2184     end;
2185
2186     // something is wrong
2187     raise Exception.Create(Format('unknown field ''%s'' in record ''%s''', [pr.tokStr, mName]));
2188   end;
2189   pr.expectTT(pr.TTEnd);
2190   // fix field defaults
2191   for fld in mFields do fld.fixDefaultValue();
2192   //writeln('done parsing record <', mName, '>');
2193 end;
2194
2195
2196 // ////////////////////////////////////////////////////////////////////////// //
2197 constructor TDynEBS.Create (pr: TTextParser);
2198 begin
2199   cleanup();
2200   parseDef(pr);
2201 end;
2202
2203
2204 destructor TDynEBS.Destroy ();
2205 begin
2206   cleanup();
2207   inherited;
2208 end;
2209
2210
2211 procedure TDynEBS.cleanup ();
2212 begin
2213   mIsEnum := false;
2214   mName := '';
2215   mIds := nil;
2216   mVals := nil;
2217   mMaxName := '';
2218   mMaxVal := 0;
2219 end;
2220
2221
2222 function TDynEBS.findByName (const aname: AnsiString): Integer;
2223 begin
2224   result := 0;
2225   while (result < Length(mIds)) do
2226   begin
2227     if StrEqu(aname, mIds[result]) then exit;
2228     Inc(result);
2229   end;
2230   result := -1;
2231 end;
2232
2233
2234 function TDynEBS.hasByName (const aname: AnsiString): Boolean; inline;
2235 begin
2236   result := (findByName(aname) >= 0);
2237 end;
2238
2239
2240 function TDynEBS.getFieldByName (const aname: AnsiString): Integer; inline;
2241 var
2242   f: Integer;
2243 begin
2244   f := findByName(aname);
2245   if (f >= 0) then result := mVals[f] else result := 0;
2246 end;
2247
2248
2249 function TDynEBS.definition (): AnsiString;
2250 var
2251   f, cv: Integer;
2252 begin
2253   if mIsEnum then result :='enum ' else result := 'bitset ';
2254   result += mName;
2255   result += ' {'#10;
2256   // fields
2257   if mIsEnum then cv := 0 else cv := 1;
2258   for f := 0 to High(mIds) do
2259   begin
2260     if (mIds[f] = mMaxName) then continue;
2261     result += '  '+mIds[f];
2262     if (mVals[f] <> cv) then
2263     begin
2264       result += Format(' = %d', [mVals[f]]);
2265       if mIsEnum then cv := mVals[f];
2266       result += ','#10;
2267     end
2268     else
2269     begin
2270       result += Format(', // %d'#10, [mVals[f]]);
2271     end;
2272     if mIsEnum then Inc(cv) else if (mVals[f] = cv) then cv := cv shl 1;
2273   end;
2274   // max field
2275   if (Length(mMaxName) > 0) then result += '  '+mMaxName+' = MAX,'#10;
2276   result += '}';
2277 end;
2278
2279
2280 function TDynEBS.pasdef (): AnsiString;
2281 var
2282   f: Integer;
2283 begin
2284   result := '// '+mName+#10'const'#10;
2285   // fields
2286   for f := 0 to High(mIds) do
2287   begin
2288     result += formatstrf('  %s = %d;'#10, [mIds[f], mVals[f]]);
2289   end;
2290 end;
2291
2292
2293 function TDynEBS.nameByValue (v: Integer): AnsiString;
2294 var
2295   f: Integer;
2296 begin
2297   for f := 0 to High(mVals) do
2298   begin
2299     if (mVals[f] = v) then begin result := mIds[f]; exit; end;
2300   end;
2301   result := '';
2302 end;
2303
2304
2305 procedure TDynEBS.parseDef (pr: TTextParser);
2306 var
2307   idname: AnsiString;
2308   cv, v: Integer;
2309   f: Integer;
2310   skipAdd: Boolean;
2311   hasV: Boolean;
2312 begin
2313        if pr.eatId('enum') then mIsEnum := true
2314   else if pr.eatId('bitset') then mIsEnum := false
2315   else pr.expectId('enum');
2316   mName := pr.expectId();
2317   mMaxVal := Integer($80000000);
2318   if mIsEnum then cv := 0 else cv := 1;
2319   pr.expectTT(pr.TTBegin);
2320   while (pr.tokType <> pr.TTEnd) do
2321   begin
2322     idname := pr.expectId();
2323     for f := 0 to High(mIds) do
2324     begin
2325       if StrEqu(mIds[f], idname) then raise Exception.Create(Format('duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName]));
2326     end;
2327     if StrEqu(mMaxName, idname) then raise Exception.Create(Format('duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName]));
2328     skipAdd := false;
2329     hasV := false;
2330     v := cv;
2331     // has value?
2332     if pr.eatDelim('=') then
2333     begin
2334       if pr.eatId('MAX') then
2335       begin
2336         if (Length(mMaxName) > 0) then raise Exception.Create(Format('duplicate max field ''%s'' in enum/bitset ''%s''', [idname, mName]));
2337         mMaxName := idname;
2338         skipAdd := true;
2339       end
2340       else
2341       begin
2342         v := pr.expectInt();
2343           if mIsEnum then cv := v;
2344         hasV := true;
2345       end;
2346     end;
2347     // append it?
2348     if not skipAdd then
2349     begin
2350       // fix maxvalue
2351       if mIsEnum or (not hasV) then
2352       begin
2353         if (mMaxVal < v) then mMaxVal := v;
2354       end;
2355       SetLength(mIds, Length(mIds)+1);
2356       mIds[High(mIds)] := idname;
2357       SetLength(mVals, Length(mIds));
2358       mVals[High(mVals)] := v;
2359       // next cv
2360       if mIsEnum or (not hasV) then
2361       begin
2362         if mIsEnum then Inc(cv) else cv := cv shl 1;
2363       end;
2364     end;
2365     if (pr.tokType = pr.TTEnd) then break;
2366     pr.expectTT(pr.TTComma);
2367     while pr.eatTT(pr.TTComma) do begin end;
2368   end;
2369   pr.expectTT(pr.TTEnd);
2370   // add max field
2371   if (Length(mMaxName) > 0) then
2372   begin
2373     SetLength(mIds, Length(mIds)+1);
2374     mIds[High(mIds)] := mMaxName;
2375     SetLength(mVals, Length(mIds));
2376     mVals[High(mVals)] := mMaxVal;
2377   end;
2378 end;
2379
2380
2381 // ////////////////////////////////////////////////////////////////////////// //
2382 constructor TDynMapDef.Create (pr: TTextParser);
2383 begin
2384   recTypes := TDynRecList.Create();
2385   trigTypes := TDynRecList.Create();
2386   ebsTypes := TDynEBSList.Create();
2387   parseDef(pr);
2388 end;
2389
2390
2391 destructor TDynMapDef.Destroy ();
2392 var
2393   rec: TDynRecord;
2394   ebs: TDynEBS;
2395 begin
2396   for rec in recTypes do rec.Free();
2397   for rec in trigTypes do rec.Free();
2398   for ebs in ebsTypes do ebs.Free();
2399   recTypes.Free();
2400   trigTypes.Free();
2401   ebsTypes.Free();
2402   recTypes := nil;
2403   trigTypes := nil;
2404   ebsTypes := nil;
2405   inherited;
2406 end;
2407
2408
2409 function TDynMapDef.getHeaderRecType (): TDynRecord; inline;
2410 begin
2411   if (recTypes.count = 0) then raise Exception.Create('no header in empty mapdef');
2412   result := recTypes[0];
2413 end;
2414
2415
2416 function TDynMapDef.findRecType (const aname: AnsiString): TDynRecord;
2417 var
2418   rec: TDynRecord;
2419 begin
2420   for rec in recTypes do
2421   begin
2422     if StrEqu(rec.name, aname) then begin result := rec; exit; end;
2423   end;
2424   result := nil;
2425 end;
2426
2427
2428 function TDynMapDef.findTrigFor (const aname: AnsiString): TDynRecord;
2429 var
2430   rec: TDynRecord;
2431 begin
2432   for rec in trigTypes do
2433   begin
2434     if (rec.isForTrig[aname]) then begin result := rec; exit; end;
2435   end;
2436   result := nil;
2437 end;
2438
2439
2440 function TDynMapDef.findEBSType (const aname: AnsiString): TDynEBS;
2441 var
2442   ebs: TDynEBS;
2443 begin
2444   for ebs in ebsTypes do
2445   begin
2446     if StrEqu(ebs.name, aname) then begin result := ebs; exit; end;
2447   end;
2448   result := nil;
2449 end;
2450
2451
2452 procedure TDynMapDef.parseDef (pr: TTextParser);
2453 var
2454   rec, hdr: TDynRecord;
2455   eb: TDynEBS;
2456   f: Integer;
2457
2458   // setup header links and type links
2459   procedure linkRecord (rec: TDynRecord);
2460   var
2461     fld: TDynField;
2462   begin
2463     rec.mHeaderRec := recTypes[0];
2464     for fld in rec.mFields do
2465     begin
2466       if (fld.mType = fld.TType.TTrigData) then continue;
2467       case fld.mEBS of
2468         TDynField.TEBS.TNone: begin end;
2469         TDynField.TEBS.TRec:
2470           begin
2471             fld.mEBSType := findRecType(fld.mEBSTypeName);
2472             if (fld.mEBSType = nil) then raise Exception.Create(Format('field ''%s'' of type ''%s'' has no correcponding record definition', [fld.mName, fld.mEBSTypeName]));
2473           end;
2474         TDynField.TEBS.TEnum,
2475         TDynField.TEBS.TBitSet:
2476           begin
2477             fld.mEBSType := findEBSType(fld.mEBSTypeName);
2478             if (fld.mEBSType = nil) then raise Exception.Create(Format('field ''%s'' of type ''%s'' has no correcponding enum/bitset', [fld.mName, fld.mEBSTypeName]));
2479             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]));
2480           end;
2481       end;
2482     end;
2483   end;
2484
2485   // setup default values
2486   procedure fixRecordDefaults (rec: TDynRecord);
2487   var
2488     fld: TDynField;
2489   begin
2490     for fld in rec.mFields do if fld.mHasDefault then fld.parseDefaultValue();
2491   end;
2492
2493 begin
2494   hdr := nil;
2495   while true do
2496   begin
2497     if not pr.skipBlanks() then break;
2498     if (pr.tokType <> pr.TTId) then raise Exception.Create('identifier expected');
2499
2500     if (pr.tokStr = 'enum') or (pr.tokStr = 'bitset') then
2501     begin
2502       eb := TDynEBS.Create(pr);
2503       if (findEBSType(eb.name) <> nil) then
2504       begin
2505         eb.Free();
2506         raise Exception.Create(Format('duplicate enum/bitset ''%s''', [eb.name]));
2507       end;
2508       eb.mOwner := self;
2509       ebsTypes.append(eb);
2510       //writeln(eb.definition); writeln;
2511       continue;
2512     end;
2513
2514     if (pr.tokStr = 'TriggerData') then
2515     begin
2516       rec := TDynRecord.Create(pr);
2517       for f := 0 to High(rec.mTrigTypes) do
2518       begin
2519         if (findTrigFor(rec.mTrigTypes[f]) <> nil) then
2520         begin
2521           rec.Free();
2522           raise Exception.Create(Format('duplicate trigdata ''%s''', [rec.mTrigTypes[f]]));
2523         end;
2524       end;
2525       rec.mOwner := self;
2526       trigTypes.append(rec);
2527       //writeln(dr.definition); writeln;
2528       continue;
2529     end;
2530
2531     rec := TDynRecord.Create(pr);
2532     //writeln(dr.definition); writeln;
2533     if (findRecType(rec.name) <> nil) then begin rec.Free(); raise Exception.Create(Format('duplicate record ''%s''', [rec.name])); end;
2534     if (hdr <> nil) and StrEqu(rec.name, hdr.name) then begin rec.Free(); raise Exception.Create(Format('duplicate record ''%s''', [rec.name])); end;
2535     rec.mOwner := self;
2536     if rec.mHeader then
2537     begin
2538       if (hdr <> nil) then begin rec.Free(); raise Exception.Create(Format('duplicate header record ''%s'' (previous is ''%s'')', [rec.name, hdr.name])); end;
2539       hdr := rec;
2540     end
2541     else
2542     begin
2543       recTypes.append(rec);
2544     end;
2545   end;
2546
2547   // put header record to top
2548   if (hdr = nil) then raise Exception.Create('header definition not found in mapdef');
2549   recTypes.append(nil);
2550   for f := recTypes.count-1 downto 1 do recTypes[f] := recTypes[f-1];
2551   recTypes[0] := hdr;
2552
2553   // setup header links and type links
2554   for rec in recTypes do linkRecord(rec);
2555   for rec in trigTypes do linkRecord(rec);
2556
2557   // setup default values
2558   for rec in recTypes do fixRecordDefaults(rec);
2559   for rec in trigTypes do fixRecordDefaults(rec);
2560 end;
2561
2562
2563 // ////////////////////////////////////////////////////////////////////////// //
2564 function TDynMapDef.parseMap (pr: TTextParser): TDynRecord;
2565 var
2566   res: TDynRecord = nil;
2567 begin
2568   result := nil;
2569   try
2570     pr.expectId(headerType.name);
2571     res := headerType.clone();
2572     res.mHeaderRec := res;
2573     res.parseValue(pr);
2574     result := res;
2575     res := nil;
2576   except on E: Exception do
2577     begin
2578       res.Free();
2579       raise;
2580     end;
2581   end;
2582 end;
2583
2584
2585 function TDynMapDef.parseBinMap (st: TStream): TDynRecord;
2586 var
2587   res: TDynRecord = nil;
2588 begin
2589   result := nil;
2590   try
2591     res := headerType.clone();
2592     res.mHeaderRec := res;
2593     res.parseBinValue(st);
2594     result := res;
2595     res := nil;
2596   except on E: Exception do
2597     begin
2598       res.Free();
2599       raise;
2600     end;
2601   end;
2602 end;
2603
2604
2605 function TDynMapDef.pasdef (): AnsiString;
2606 var
2607   ebs: TDynEBS;
2608   rec: TDynRecord;
2609   fld: TDynField;
2610   needComma: Boolean;
2611   tn: AnsiString;
2612 begin
2613   result := '';
2614   result += '// ////////////////////////////////////////////////////////////////////////// //'#10;
2615   result += '// enums and bitsets'#10;
2616   for ebs in ebsTypes do result += #10+ebs.pasdef();
2617   result += #10#10'// ////////////////////////////////////////////////////////////////////////// //'#10;
2618   result += '// records'#10'type'#10;
2619   for rec in recTypes do
2620   begin
2621     if (rec.mSize < 1) then continue;
2622     result += rec.pasdef();
2623     result += #10;
2624   end;
2625   result += #10#10'// ////////////////////////////////////////////////////////////////////////// //'#10;
2626   result += '// triggerdata'#10'type'#10;
2627   result += '  TTriggerData = record'#10;
2628   result += '    case Byte of'#10;
2629   result += '      0: (Default: Byte128);'#10;
2630   for rec in trigTypes do
2631   begin
2632     result += '      ';
2633     needComma := false;
2634     for tn in rec.mTrigTypes do
2635     begin
2636       if needComma then result += ', ' else needComma := true;
2637       result += tn;
2638     end;
2639     result += ': ('#10;
2640     for fld in rec.mFields do
2641     begin
2642       if fld.mInternal then continue;
2643       if (fld.mBinOfs < 0) then continue;
2644       result += '        '+fld.pasdef+#10;
2645     end;
2646     result += '      );'#10;
2647   end;
2648   result += '  end;'#10;
2649 end;
2650
2651
2652 end.