src/shared/xdynrec.pas

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