src/shared/xparser.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 xparser;
  18
  19 interface
  20
  21 uses
  22   Classes;
  23
  24
  25 // ////////////////////////////////////////////////////////////////////////// //
  26 type
  27   TTextParser = class
  28   public
  29     const
  30       TTNone = -1;
  31       TTEOF = 0;
  32       TTId = 1;
  33       TTInt = 2;
  34       //TTFloat = 3; // not yet
  35       TTStr = 4; // string
  36       TTComma = 5; // ','
  37       TTColon = 6; // ':'
  38       TTSemi = 7; // ';'
  39       TTBegin = 8; // left curly
  40       TTEnd = 9; // right curly
  41       TTDelim = 10; // other delimiters
  42       //
  43       TTLogAnd = 11; // &&
  44       TTLogOr = 12; // ||
  45       TTLessEqu = 13; // <=
  46       TTGreatEqu = 14; // >=
  47       TTNotEqu = 15; // !=
  48       TTEqu = 16; // ==
  49
  50   private
  51     mLine, mCol: Integer;
  52     mCurChar, mNextChar: AnsiChar;
  53
  54     mAllowSignedNumbers: Boolean; // internal control
  55
  56     mTokLine, mTokCol: Integer; // token start
  57     mTokType: Integer;
  58     mTokStr: AnsiString; // string or identifier
  59     mTokChar: AnsiChar; // for delimiters
  60     mTokInt: Integer;
  61
  62   protected
  63     procedure warmup (); virtual; // called in constructor to warm up the system
  64     procedure loadNextChar (); virtual; abstract; // loads next char into mNextChar; #0 means 'eof'
  65
  66   public
  67     constructor Create ();
  68     destructor Destroy (); override;
  69
  70     function isEOF (): Boolean; inline;
  71
  72     function skipChar (): Boolean; // returns `false` on eof
  73
  74     function skipBlanks (): Boolean; // ...and comments; returns `false` on eof
  75
  76     function skipToken (): Boolean; // returns `false` on eof
  77     //function skipToken1 (): Boolean;
  78
  79     function expectId (): AnsiString;
  80     procedure expectId (const aid: AnsiString);
  81     function eatId (const aid: AnsiString): Boolean;
  82
  83     function expectStr (allowEmpty: Boolean=false): AnsiString;
  84     function expectInt (): Integer;
  85
  86     function expectStrOrId (allowEmpty: Boolean=false): AnsiString;
  87
  88     procedure expectTT (ttype: Integer);
  89     function eatTT (ttype: Integer): Boolean;
  90
  91     function expectDelim (const ch: AnsiChar): AnsiChar;
  92     function eatDelim (const ch: AnsiChar): Boolean;
  93
  94   public
  95     property allowSignedNumbers: Boolean read mAllowSignedNumbers write mAllowSignedNumbers;
  96
  97   public
  98     property col: Integer read mCol;
  99     property line: Integer read mLine;
 100
 101     property curChar: AnsiChar read mCurChar;
 102     property nextChar: AnsiChar read mNextChar;
 103
 104     // token start
 105     property tokCol: Integer read mTokCol;
 106     property tokLine: Integer read mTokLine;
 107
 108     property tokType: Integer read mTokType; // see TTXXX constants
 109     property tokStr: AnsiString read mTokStr; // string or identifier
 110     property tokChar: AnsiChar read mTokChar; // for delimiters
 111     property tokInt: Integer read mTokInt;
 112   end;
 113
 114
 115 // ////////////////////////////////////////////////////////////////////////// //
 116 type
 117   TFileTextParser = class(TTextParser)
 118   private
 119     const BufSize = 16384;
 120
 121   private
 122     mFile: TStream;
 123     mStreamOwned: Boolean;
 124     mBuffer: PChar;
 125     mBufLen: Integer;
 126     mBufPos: Integer;
 127
 128   protected
 129     procedure loadNextChar (); override; // loads next char into mNextChar; #0 means 'eof'
 130
 131   public
 132     constructor Create (const fname: AnsiString);
 133     constructor Create (st: TStream; astOwned: Boolean=true); // will take ownership on st by default
 134     destructor Destroy (); override;
 135   end;
 136
 137   TStrTextParser = class(TTextParser)
 138   private
 139     mStr: AnsiString;
 140     mPos: Integer;
 141
 142   protected
 143     procedure loadNextChar (); override; // loads next char into mNextChar; #0 means 'eof'
 144
 145   public
 146     constructor Create (const astr: AnsiString);
 147     destructor Destroy (); override;
 148   end;
 149
 150
 151 // ////////////////////////////////////////////////////////////////////////// //
 152 type
 153   TTextWriter = class
 154   protected
 155     mIndent: Integer;
 156
 157   protected
 158     procedure putBuf (constref buf; len: SizeUInt); virtual; abstract;
 159
 160   public
 161     constructor Create ();
 162
 163     procedure flush (); virtual;
 164
 165     procedure put (const s: AnsiString); overload;
 166     procedure put (v: Byte); overload;
 167     procedure put (v: Integer); overload;
 168     procedure put (const fmt: AnsiString; args: array of const); overload;
 169     procedure putIndent ();
 170     procedure indent ();
 171     procedure unindent ();
 172
 173   public
 174     property curIndent: Integer read mIndent;
 175   end;
 176
 177
 178 // ////////////////////////////////////////////////////////////////////////// //
 179 type
 180   TFileTextWriter = class(TTextWriter)
 181   private
 182     const BufSize = 16384;
 183
 184   private
 185     mFile: TStream;
 186     mStreamOwned: Boolean;
 187     mBuffer: PAnsiChar;
 188     mBufUsed: Integer;
 189
 190   protected
 191     procedure putBuf (constref buf; len: SizeUInt); override;
 192
 193   public
 194     constructor Create (const fname: AnsiString);
 195     constructor Create (ast: TStream; astOwned: Boolean=true); // will own the stream by default
 196     destructor Destroy (); override;
 197
 198     procedure flush (); override;
 199   end;
 200
 201   TStrTextWriter = class(TTextWriter)
 202   private
 203     mStr: AnsiString;
 204
 205   protected
 206     procedure putBuf (constref buf; len: SizeUInt); override;
 207
 208   public
 209     constructor Create ();
 210     destructor Destroy (); override;
 211
 212     property str: AnsiString read mStr;
 213   end;
 214
 215
 216 implementation
 217
 218 uses
 219   SysUtils, utils;
 220
 221
 222 // ////////////////////////////////////////////////////////////////////////// //
 223 function StrEqu (const a, b: AnsiString): Boolean; inline; begin result := (a = b); end;
 224
 225
 226 // ////////////////////////////////////////////////////////////////////////// //
 227 constructor TTextParser.Create ();
 228 begin
 229   mLine := 1;
 230   mCol := 1;
 231   mCurChar := #0;
 232   mNextChar := #0;
 233   mTokType := TTNone;
 234   mTokStr := '';
 235   mTokChar := #0;
 236   mTokInt := 0;
 237   mAllowSignedNumbers := true;
 238   warmup(); // change `mAllowSignedNumbers` there, if necessary
 239   skipToken();
 240 end;
 241
 242
 243 destructor TTextParser.Destroy ();
 244 begin
 245   inherited;
 246 end;
 247
 248
 249 function TTextParser.isEOF (): Boolean; inline; begin result := (mCurChar = #0); end;
 250
 251
 252 procedure TTextParser.warmup ();
 253 begin
 254   mNextChar := ' ';
 255   loadNextChar();
 256   mCurChar := mNextChar;
 257   if (mNextChar <> #0) then loadNextChar();
 258 end;
 259
 260
 261 function TTextParser.skipChar (): Boolean;
 262 begin
 263   if (mCurChar = #0) then begin result := false; exit; end;
 264   if (mCurChar = #10) then begin mCol := 1; Inc(mLine); end else Inc(mCol);
 265   mCurChar := mNextChar;
 266   if (mCurChar = #0) then begin result := false; exit; end;
 267   loadNextChar();
 268   // skip CR in CR/LF
 269   if (mCurChar = #13) then
 270   begin
 271     if (mNextChar = #10) then loadNextChar();
 272     mCurChar := #10;
 273   end;
 274   result := true;
 275 end;
 276
 277
 278 function TTextParser.skipBlanks (): Boolean;
 279 var
 280   level: Integer;
 281 begin
 282   while not isEOF do
 283   begin
 284     if (curChar = '/') then
 285     begin
 286       // single-line comment
 287       if (nextChar = '/') then
 288       begin
 289         while not isEOF and (curChar <> #10) do skipChar();
 290         skipChar(); // skip EOL
 291         continue;
 292       end;
 293       // multline comment
 294       if (nextChar = '*') then
 295       begin
 296         // skip comment start
 297         skipChar();
 298         skipChar();
 299         while not isEOF do
 300         begin
 301           if (curChar = '*') and (nextChar = '/') then
 302           begin
 303             // skip comment end
 304             skipChar();
 305             skipChar();
 306             break;
 307           end;
 308           skipChar();
 309         end;
 310         continue;
 311       end;
 312       // nesting multline comment
 313       if (nextChar = '+') then
 314       begin
 315         // skip comment start
 316         skipChar();
 317         skipChar();
 318         level := 1;
 319         while not isEOF do
 320         begin
 321           if (curChar = '+') and (nextChar = '/') then
 322           begin
 323             // skip comment end
 324             skipChar();
 325             skipChar();
 326             Dec(level);
 327             if (level = 0) then break;
 328             continue;
 329           end;
 330           if (curChar = '/') and (nextChar = '+') then
 331           begin
 332             // skip comment start
 333             skipChar();
 334             skipChar();
 335             Inc(level);
 336             continue;
 337           end;
 338           skipChar();
 339         end;
 340         continue;
 341       end;
 342     end;
 343     if (curChar > ' ') then break;
 344     skipChar(); // skip blank
 345   end;
 346   result := not isEOF;
 347 end;
 348
 349
 350 {
 351 function TTextParser.skipToken (): Boolean;
 352 begin
 353   writeln('getting token...');
 354   result := skipToken1();
 355   writeln('  got token: ', mTokType, ' <', mTokStr, '> : <', mTokChar, '>');
 356 end;
 357 }
 358
 359
 360 function TTextParser.skipToken (): Boolean;
 361
 362   procedure parseInt ();
 363   var
 364     neg: Boolean = false;
 365     base: Integer = -1;
 366     n: Integer;
 367   begin
 368     if mAllowSignedNumbers then
 369     begin
 370       if (curChar = '+') or (curChar = '-') then
 371       begin
 372         neg := (curChar = '-');
 373         skipChar();
 374         if (curChar < '0') or (curChar > '9') then
 375         begin
 376           mTokType := TTDelim;
 377           if (neg) then mTokChar := '-' else mTokChar := '+';
 378           exit;
 379         end;
 380       end;
 381     end;
 382     if (curChar = '0') then
 383     begin
 384       case nextChar of
 385         'b','B': base := 2;
 386         'o','O': base := 8;
 387         'd','D': base := 10;
 388         'h','H': base := 16;
 389       end;
 390       if (base > 0) then
 391       begin
 392         // skip prefix
 393         skipChar();
 394         skipChar();
 395       end;
 396     end;
 397     // default base
 398     if (base < 0) then base := 10;
 399     if (digitInBase(curChar, base) < 0) then raise Exception.Create('invalid number');
 400     mTokType := TTInt;
 401     mTokInt := 0; // just in case
 402     while not isEOF do
 403     begin
 404       n := digitInBase(curChar, base);
 405       if (n < 0) then break;
 406       n := mTokInt*10+n;
 407       if (n < 0) or (n < mTokInt) then raise Exception.Create('integer overflow');
 408       mTokInt := n;
 409       skipChar();
 410     end;
 411     // check for valid number end
 412     if not isEOF then
 413     begin
 414       if (curChar = '.') then raise Exception.Create('floating numbers aren''t supported yet');
 415       if (curChar = '_') or ((curChar >= 'A') and (curChar <= 'Z')) or ((curChar >= 'a') and (curChar <= 'z')) or (curChar >= #128) then
 416       begin
 417         raise Exception.Create('invalid number');
 418       end;
 419     end;
 420     if neg then mTokInt := -mTokInt;
 421   end;
 422
 423   procedure parseString ();
 424   var
 425     qch, ch: AnsiChar;
 426     n: Integer;
 427   begin
 428     mTokType := TTStr;
 429     mTokStr := ''; // just in case
 430     qch := curChar;
 431     skipChar(); // skip starting quote
 432     while not isEOF do
 433     begin
 434       // escape
 435       if (qch = '"') and (curChar = '\') then
 436       begin
 437         if (nextChar = #0) then raise Exception.Create('unterminated string escape');
 438         ch := nextChar;
 439         // skip backslash and escape type
 440         skipChar();
 441         skipChar();
 442         case ch of
 443           't': mTokStr += #9;
 444           'n': mTokStr += #10;
 445           'r': mTokStr += #13;
 446           'z': mTokStr += #0;
 447           'e': mTokStr += #27;
 448           'x', 'X': // hex escape
 449             begin
 450               n := digitInBase(curChar, 16);
 451               if (n < 0) then raise Exception.Create('invalid hexstr escape');
 452               skipChar();
 453               if (digitInBase(curChar, 16) > 0) then
 454               begin
 455                 n := n*16+digitInBase(curChar, 16);
 456                 skipChar();
 457               end;
 458               mTokStr += AnsiChar(n);
 459             end;
 460           else mTokStr += ch;
 461         end;
 462         continue;
 463       end;
 464       // duplicate single quote (pascal style)
 465       if (qch = '''') and (curChar = '''') and (nextChar = '''') then
 466       begin
 467         // skip both quotes
 468         skipChar();
 469         skipChar();
 470         mTokStr += '''';
 471         continue;
 472       end;
 473       if (curChar = qch) then
 474       begin
 475         skipChar(); // skip ending quote
 476         break;
 477       end;
 478       mTokStr += curChar;
 479       skipChar();
 480     end;
 481   end;
 482
 483   procedure parseId ();
 484   begin
 485     mTokType := TTId;
 486     mTokStr := ''; // just in case
 487     while (curChar = '_') or ((curChar >= '0') and (curChar <= '9')) or
 488           ((curChar >= 'A') and (curChar <= 'Z')) or
 489           ((curChar >= 'a') and (curChar <= 'z')) or
 490           (curChar >= #128) do
 491     begin
 492       mTokStr += curChar;
 493       skipChar();
 494     end;
 495   end;
 496
 497 begin
 498   mTokType := TTEOF;
 499   mTokStr := '';
 500   mTokChar := #0;
 501   mTokInt := 0;
 502
 503   if not skipBlanks() then
 504   begin
 505     result := false;
 506     mTokLine := mLine;
 507     mTokCol := mCol;
 508     exit;
 509   end;
 510
 511   mTokLine := mLine;
 512   mTokCol := mCol;
 513
 514   result := true;
 515
 516   // number?
 517   if mAllowSignedNumbers and ((curChar = '+') or (curChar = '-')) then begin parseInt(); exit; end;
 518   if (curChar >= '0') and (curChar <= '9') then begin parseInt(); exit; end;
 519
 520   // string?
 521   if (curChar = '"') or (curChar = '''') then begin parseString(); exit; end;
 522
 523   // identifier?
 524   if (curChar = '_') or ((curChar >= 'A') and (curChar <= 'Z')) or ((curChar >= 'a') and (curChar <= 'z')) or (curChar >= #128) then begin parseId(); exit; end;
 525
 526   // known delimiters?
 527   mTokChar := curChar;
 528   mTokType := TTDelim;
 529   skipChar();
 530   if (curChar = '=') then
 531   begin
 532     case mTokChar of
 533       '<': begin mTokType := TTLessEqu; mTokStr := '<='; skipChar(); exit; end;
 534       '>': begin mTokType := TTGreatEqu; mTokStr := '>='; skipChar(); exit; end;
 535       '!': begin mTokType := TTNotEqu; mTokStr := '!='; skipChar(); exit; end;
 536       '=': begin mTokType := TTEqu; mTokStr := '=='; skipChar(); exit; end;
 537     end;
 538   end;
 539   case mTokChar of
 540     ',': mTokType := TTComma;
 541     ':': mTokType := TTColon;
 542     ';': mTokType := TTSemi;
 543     '{': mTokType := TTBegin;
 544     '}': mTokType := TTEnd;
 545     '&': if (curChar = '&') then begin mTokType := TTLogAnd; mTokStr := '&&'; skipChar(); exit; end;
 546     '|': if (curChar = '|') then begin mTokType := TTLogOr; mTokStr := '||'; skipChar(); exit; end;
 547   end;
 548 end;
 549
 550
 551 function TTextParser.expectId (): AnsiString;
 552 begin
 553   if (mTokType <> TTId) then raise Exception.Create('identifier expected');
 554   result := mTokStr;
 555   skipToken();
 556 end;
 557
 558
 559 procedure TTextParser.expectId (const aid: AnsiString);
 560 begin
 561   if (mTokType <> TTId) or (not StrEqu(mTokStr, aid)) then raise Exception.Create('identifier '''+aid+''' expected');
 562   skipToken();
 563 end;
 564
 565
 566 function TTextParser.eatId (const aid: AnsiString): Boolean;
 567 begin
 568   result := false;
 569   if (mTokType <> TTId) or (not StrEqu(mTokStr, aid)) then exit;
 570   result := true;
 571   skipToken();
 572 end;
 573
 574
 575 function TTextParser.expectStr (allowEmpty: Boolean=false): AnsiString;
 576 begin
 577   if (mTokType <> TTStr) then raise Exception.Create('string expected');
 578   if (not allowEmpty) and (Length(mTokStr) = 0) then raise Exception.Create('non-empty string expected');
 579   result := mTokStr;
 580   skipToken();
 581 end;
 582
 583
 584 function TTextParser.expectStrOrId (allowEmpty: Boolean=false): AnsiString;
 585 begin
 586   case mTokType of
 587     TTStr:
 588       if (not allowEmpty) and (Length(mTokStr) = 0) then raise Exception.Create('non-empty string expected');
 589     TTId:
 590       begin end;
 591     else
 592       raise Exception.Create('string or identifier expected');
 593   end;
 594   result := mTokStr;
 595   skipToken();
 596 end;
 597
 598
 599 function TTextParser.expectInt (): Integer;
 600 begin
 601   if (mTokType <> TTInt) then raise Exception.Create('string expected');
 602   result := mTokInt;
 603   skipToken();
 604 end;
 605
 606
 607 procedure TTextParser.expectTT (ttype: Integer);
 608 begin
 609   if (mTokType <> ttype) then raise Exception.Create('unexpected token');
 610   skipToken();
 611 end;
 612
 613
 614 function TTextParser.eatTT (ttype: Integer): Boolean;
 615 begin
 616   result := (mTokType = ttype);
 617   if result then skipToken();
 618 end;
 619
 620
 621 function TTextParser.expectDelim (const ch: AnsiChar): AnsiChar;
 622 begin
 623   if (mTokType <> TTDelim) then raise Exception.Create(Format('delimiter ''%s'' expected', [ch]));
 624   result := mTokChar;
 625   skipToken();
 626 end;
 627
 628
 629 function TTextParser.eatDelim (const ch: AnsiChar): Boolean;
 630 begin
 631   result := false;
 632   if (mTokType <> TTDelim) or (mTokChar <> ch) then exit;
 633   result := true;
 634   skipToken();
 635 end;
 636
 637
 638 // ////////////////////////////////////////////////////////////////////////// //
 639 constructor TFileTextParser.Create (const fname: AnsiString);
 640 begin
 641   mBuffer := nil;
 642   mFile := openDiskFileRO(fname);
 643   mStreamOwned := true;
 644   GetMem(mBuffer, BufSize);
 645   mBufPos := 0;
 646   mBufLen := mFile.Read(mBuffer^, BufSize);
 647   if (mBufLen < 0) then raise Exception.Create('TFileTextParser: read error');
 648   inherited Create();
 649 end;
 650
 651
 652 constructor TFileTextParser.Create (st: TStream; astOwned: Boolean=true);
 653 begin
 654   if (st = nil) then raise Exception.Create('cannot create parser for nil stream');
 655   mFile := st;
 656   mStreamOwned := astOwned;
 657   GetMem(mBuffer, BufSize);
 658   mBufPos := 0;
 659   mBufLen := mFile.Read(mBuffer^, BufSize);
 660   if (mBufLen < 0) then raise Exception.Create('TFileTextParser: read error');
 661   inherited Create();
 662 end;
 663
 664
 665 destructor TFileTextParser.Destroy ();
 666 begin
 667   if (mBuffer <> nil) then FreeMem(mBuffer);
 668   mBuffer := nil;
 669   mBufPos := 0;
 670   mBufLen := 0;
 671   if mStreamOwned then mFile.Free();
 672   mFile := nil;
 673   inherited;
 674 end;
 675
 676
 677 procedure TFileTextParser.loadNextChar ();
 678 begin
 679   if (mBufLen = 0) then begin mNextChar := #0; exit; end;
 680   if (mBufPos >= mBufLen) then
 681   begin
 682     mBufLen := mFile.Read(mBuffer^, BufSize);
 683     if (mBufLen < 0) then raise Exception.Create('TFileTextParser: read error');
 684     if (mBufLen = 0) then begin mNextChar := #0; exit; end;
 685     mBufPos := 0;
 686   end;
 687   assert(mBufPos < mBufLen);
 688   mNextChar := mBuffer[mBufPos];
 689   Inc(mBufPos);
 690   if (mNextChar = #0) then mNextChar := ' ';
 691 end;
 692
 693
 694 // ////////////////////////////////////////////////////////////////////////// //
 695 constructor TStrTextParser.Create (const astr: AnsiString);
 696 begin
 697   mStr := astr;
 698   mPos := 1;
 699   inherited Create();
 700 end;
 701
 702
 703 destructor TStrTextParser.Destroy ();
 704 begin
 705   mStr := '';
 706   inherited;
 707 end;
 708
 709
 710 procedure TStrTextParser.loadNextChar ();
 711 begin
 712   mNextChar := #0;
 713   if (mPos > Length(mStr)) then exit;
 714   mNextChar := mStr[mPos]; Inc(mPos);
 715   if (mNextChar = #0) then mNextChar := ' ';
 716 end;
 717
 718
 719 // ////////////////////////////////////////////////////////////////////////// //
 720 constructor TTextWriter.Create (); begin mIndent := 0; end;
 721 procedure TTextWriter.flush (); begin end;
 722 procedure TTextWriter.put (const s: AnsiString); overload; begin if (Length(s) > 0) then putBuf((@(s[1]))^, Length(s)); end;
 723 procedure TTextWriter.put (v: Byte); overload; begin put('%d', [v]); end;
 724 procedure TTextWriter.put (v: Integer); overload; begin put('%d', [v]); end;
 725 procedure TTextWriter.put (const fmt: AnsiString; args: array of const); overload; begin put(formatstrf(fmt, args)); end;
 726 procedure TTextWriter.putIndent (); var f: Integer; begin for f := 1 to mIndent do put(' '); end;
 727 procedure TTextWriter.indent (); begin Inc(mIndent, 2); end;
 728 procedure TTextWriter.unindent (); begin Dec(mIndent, 2); end;
 729
 730
 731 // ////////////////////////////////////////////////////////////////////////// //
 732 constructor TFileTextWriter.Create (const fname: AnsiString);
 733 begin
 734   mFile := createDiskFile(fname);
 735   mStreamOwned := true;
 736   mBufUsed := 0;
 737   GetMem(mBuffer, BufSize);
 738   assert(mBuffer <> nil);
 739   inherited Create();
 740 end;
 741
 742
 743 constructor TFileTextWriter.Create (ast: TStream; astOwned: Boolean=true);
 744 begin
 745   if (ast = nil) then raise Exception.Create('cannot write to nil stream');
 746   mFile := ast;
 747   mStreamOwned := astOwned;
 748   mBufUsed := 0;
 749   GetMem(mBuffer, BufSize);
 750   assert(mBuffer <> nil);
 751 end;
 752
 753
 754 destructor TFileTextWriter.Destroy ();
 755 begin
 756   flush();
 757   if (mBuffer <> nil) then FreeMem(mBuffer);
 758   mBufUsed := 0;
 759   mBuffer := nil;
 760   if (mStreamOwned) then mFile.Free();
 761   mFile := nil;
 762   inherited;
 763 end;
 764
 765
 766 procedure TFileTextWriter.flush ();
 767 begin
 768   if (mFile <> nil) and (mBufUsed > 0) then
 769   begin
 770     mFile.WriteBuffer(mBuffer^, mBufUsed);
 771   end;
 772   mBufUsed := 0;
 773 end;
 774
 775
 776 procedure TFileTextWriter.putBuf (constref buf; len: SizeUInt);
 777 var
 778   pc: PChar;
 779   left: Integer;
 780 begin
 781   if (len = 0) then exit;
 782   pc := @buf;
 783   while (len > 0) do
 784   begin
 785     left := BufSize-mBufUsed;
 786     if (left = 0) then
 787     begin
 788       flush();
 789       left := BufSize-mBufUsed;
 790       assert(left > 0);
 791     end;
 792     if (left > len) then left := Integer(len);
 793     Move(pc^, (mBuffer+mBufUsed)^, left);
 794     Inc(mBufUsed, left);
 795     pc += left;
 796     len -= left;
 797   end;
 798 end;
 799
 800
 801 // ////////////////////////////////////////////////////////////////////////// //
 802 constructor TStrTextWriter.Create ();
 803 begin
 804   mStr := '';
 805 end;
 806
 807
 808 destructor TStrTextWriter.Destroy ();
 809 begin
 810   mStr := '';
 811   inherited;
 812 end;
 813
 814
 815 procedure TStrTextWriter.putBuf (constref buf; len: SizeUInt);
 816 var
 817   st: AnsiString = '';
 818 begin
 819   if (len > 0) then
 820   begin
 821     SetLength(st, Integer(len));
 822     Move(buf, PChar(st)^, Integer(len));
 823     mStr += st;
 824     st := '';
 825   end;
 826 end;
 827
 828
 829 end.