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