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