1 (* Copyright (C) DooM 2D:Forever Developers
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.
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.
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/>.
16 {$INCLUDE a_modes.inc}
25 // ////////////////////////////////////////////////////////////////////////// //
34 //TTFloat = 3; // not yet
39 TTBegin
= 8; // left curly
40 TTEnd
= 9; // right curly
41 TTDelim
= 10; // other delimiters
45 mCurChar
, mNextChar
: AnsiChar;
47 mAllowSignedNumbers
: Boolean; // internal control
49 mTokLine
, mTokCol
: Integer; // token start
51 mTokStr
: AnsiString; // string or identifier
52 mTokChar
: AnsiChar; // for delimiters
56 procedure warmup (); virtual; // called in constructor to warm up the system
57 procedure loadNextChar (); virtual; abstract; // loads next char into mNextChar; #0 means 'eof'
60 constructor Create ();
61 destructor Destroy (); override;
63 function isEOF (): Boolean; inline;
65 function skipChar (): Boolean; // returns `false` on eof
67 function skipBlanks (): Boolean; // ...and comments; returns `false` on eof
69 function skipToken (): Boolean; // returns `false` on eof
71 function expectId (): AnsiString;
72 procedure expectId (const aid
: AnsiString);
73 function eatId (const aid
: AnsiString): Boolean;
75 function expectStr (allowEmpty
: Boolean=false): AnsiString;
76 function expectInt (): Integer;
78 procedure expectTT (ttype
: Integer);
79 function eatTT (ttype
: Integer): Boolean;
81 function expectDelim (const ch
: AnsiChar): AnsiChar;
82 function eatDelim (const ch
: AnsiChar): Boolean;
85 property col
: Integer read mCol
;
86 property line
: Integer read mLine
;
88 property curChar
: AnsiChar read mCurChar
;
89 property nextChar
: AnsiChar read mNextChar
;
92 property tokCol
: Integer read mTokCol
;
93 property tokLine
: Integer read mTokLine
;
95 property tokType
: Integer read mTokType
; // see TTXXX constants
96 property tokStr
: AnsiString read mTokStr
; // string or identifier
97 property tokChar
: AnsiChar read mTokChar
; // for delimiters
98 property tokInt
: Integer read mTokInt
;
102 // ////////////////////////////////////////////////////////////////////////// //
104 TFileTextParser
= class(TTextParser
)
106 const BufSize
= 16384;
110 mStreamOwned
: Boolean;
116 procedure loadNextChar (); override; // loads next char into mNextChar; #0 means 'eof'
119 constructor Create (const fname
: AnsiString);
120 constructor Create (st
: TStream
; astOwned
: Boolean=true); // will take ownership on st by default
121 destructor Destroy (); override;
124 TStrTextParser
= class(TTextParser
)
130 procedure loadNextChar (); override; // loads next char into mNextChar; #0 means 'eof'
133 constructor Create (const astr
: AnsiString);
134 destructor Destroy (); override;
138 // ////////////////////////////////////////////////////////////////////////// //
145 procedure putBuf (constref buf
; len
: SizeUInt
); virtual; abstract;
148 constructor Create ();
150 procedure flush (); virtual;
152 procedure put (const s
: AnsiString); overload
;
153 procedure put (v
: Byte); overload
;
154 procedure put (v
: Integer); overload
;
155 procedure put (const fmt
: AnsiString; args
: array of const); overload
;
156 procedure putIndent ();
158 procedure unindent ();
162 // ////////////////////////////////////////////////////////////////////////// //
164 TFileTextWriter
= class(TTextWriter
)
166 const BufSize
= 16384;
170 mStreamOwned
: Boolean;
175 procedure putBuf (constref buf
; len
: SizeUInt
); override;
178 constructor Create (const fname
: AnsiString);
179 constructor Create (ast
: TStream
; astOwned
: Boolean=true); // will own the stream by default
180 destructor Destroy (); override;
182 procedure flush (); override;
185 TStrTextWriter
= class(TTextWriter
)
190 procedure putBuf (constref buf
; len
: SizeUInt
); override;
193 constructor Create ();
194 destructor Destroy (); override;
196 property str
: AnsiString read mStr
;
206 // ////////////////////////////////////////////////////////////////////////// //
207 function StrEqu (const a
, b
: AnsiString): Boolean; inline; begin result
:= (a
= b
); end;
210 // ////////////////////////////////////////////////////////////////////////// //
211 constructor TTextParser
.Create ();
221 mAllowSignedNumbers
:= true;
222 warmup(); // change `mAllowSignedNumbers` there, if necessary
227 destructor TTextParser
.Destroy ();
233 function TTextParser
.isEOF (): Boolean; inline; begin result
:= (mCurChar
= #0); end;
236 procedure TTextParser
.warmup ();
240 mCurChar
:= mNextChar
;
241 if (mNextChar
<> #0) then loadNextChar();
245 function TTextParser
.skipChar (): Boolean;
247 if (mCurChar
= #0) then begin result
:= false; exit
; end;
248 if (mCurChar
= #10) then begin mCol
:= 1; Inc(mLine
); end else Inc(mCol
);
249 mCurChar
:= mNextChar
;
250 if (mCurChar
= #0) then begin result
:= false; exit
; end;
253 if (mCurChar
= #13) then
255 if (mNextChar
= #10) then loadNextChar();
262 function TTextParser
.skipBlanks (): Boolean;
268 if (curChar
= '/') then
270 // single-line comment
271 if (nextChar
= '/') then
273 while not isEOF
and (curChar
<> #10) do skipChar();
274 skipChar(); // skip EOL
278 if (nextChar
= '*') then
280 // skip comment start
285 if (curChar
= '*') and (nextChar
= '/') then
296 // nesting multline comment
297 if (nextChar
= '+') then
299 // skip comment start
305 if (curChar
= '+') and (nextChar
= '/') then
311 if (level
= 0) then break
;
314 if (curChar
= '/') and (nextChar
= '+') then
316 // skip comment start
327 if (curChar
> ' ') then break
;
328 skipChar(); // skip blank
334 function TTextParser
.skipToken (): Boolean;
336 procedure parseInt ();
338 neg
: Boolean = false;
342 if mAllowSignedNumbers
then
344 if (curChar
= '+') or (curChar
= '-') then
346 neg
:= (curChar
= '-');
348 if (curChar
< '0') or (curChar
> '9') then
351 if (neg
) then mTokChar
:= '-' else mTokChar
:= '+';
356 if (curChar
= '0') then
372 if (base
< 0) then base
:= 10;
373 if (digitInBase(curChar
, base
) < 0) then raise Exception
.Create('invalid number');
375 mTokInt
:= 0; // just in case
378 n
:= digitInBase(curChar
, base
);
379 if (n
< 0) then break
;
381 if (n
< 0) or (n
< mTokInt
) then raise Exception
.Create('integer overflow');
385 // check for valid number end
388 if (curChar
= '.') then raise Exception
.Create('floating numbers aren''t supported yet');
389 if (curChar
= '_') or ((curChar
>= 'A') and (curChar
<= 'Z')) or ((curChar
>= 'a') and (curChar
<= 'z')) or (curChar
>= #128) then
391 raise Exception
.Create('invalid number');
394 if neg
then mTokInt
:= -mTokInt
;
397 procedure parseString ();
403 mTokStr
:= ''; // just in case
405 skipChar(); // skip starting quote
409 if (qch
= '"') and (curChar
= '\') then
411 if (nextChar
= #0) then raise Exception
.Create('unterminated string escape');
413 // skip backslash and escape type
422 'x', 'X': // hex escape
424 n
:= digitInBase(curChar
, 16);
425 if (n
< 0) then raise Exception
.Create('invalid hexstr escape');
427 if (digitInBase(curChar
, 16) > 0) then
429 n
:= n
*16+digitInBase(curChar
, 16);
432 mTokStr
+= AnsiChar(n
);
438 // duplicate single quote (pascal style)
439 if (qch
= '''') and (curChar
= '''') and (nextChar
= '''') then
447 if (curChar
= qch
) then
449 skipChar(); // skip ending quote
457 procedure parseId ();
460 mTokStr
:= ''; // just in case
461 while (curChar
= '_') or ((curChar
>= '0') and (curChar
<= '9')) or
462 ((curChar
>= 'A') and (curChar
<= 'Z')) or
463 ((curChar
>= 'a') and (curChar
<= 'z')) or
477 if not skipBlanks() then
491 if mAllowSignedNumbers
and ((curChar
= '+') or (curChar
= '-')) then begin parseInt(); exit
; end;
492 if (curChar
>= '0') and (curChar
<= '9') then begin parseInt(); exit
; end;
495 if (curChar
= '"') or (curChar
= '''') then begin parseString(); exit
; end;
498 if (curChar
= '_') or ((curChar
>= 'A') and (curChar
<= 'Z')) or ((curChar
>= 'a') and (curChar
<= 'z')) or (curChar
>= #128) then begin parseId(); exit
; end;
502 ',': mTokType
:= TTComma
;
503 ':': mTokType
:= TTColon
;
504 ';': mTokType
:= TTSemi
;
505 '{': mTokType
:= TTBegin
;
506 '}': mTokType
:= TTEnd
;
507 else mTokType
:= TTDelim
;
514 function TTextParser
.expectId (): AnsiString;
516 if (mTokType
<> TTId
) then raise Exception
.Create('identifier expected');
522 procedure TTextParser
.expectId (const aid
: AnsiString);
524 if (mTokType
<> TTId
) or (not StrEqu(mTokStr
, aid
)) then raise Exception
.Create('identifier '''+aid
+''' expected');
529 function TTextParser
.eatId (const aid
: AnsiString): Boolean;
532 if (mTokType
<> TTId
) or (not StrEqu(mTokStr
, aid
)) then exit
;
538 function TTextParser
.expectStr (allowEmpty
: Boolean=false): AnsiString;
540 if (mTokType
<> TTStr
) then raise Exception
.Create('string expected');
541 if (not allowEmpty
) and (Length(mTokStr
) = 0) then raise Exception
.Create('non-empty string expected');
547 function TTextParser
.expectInt (): Integer;
549 if (mTokType
<> TTInt
) then raise Exception
.Create('string expected');
555 procedure TTextParser
.expectTT (ttype
: Integer);
557 if (mTokType
<> ttype
) then raise Exception
.Create('unexpected token');
562 function TTextParser
.eatTT (ttype
: Integer): Boolean;
564 result
:= (mTokType
= ttype
);
565 if result
then skipToken();
569 function TTextParser
.expectDelim (const ch
: AnsiChar): AnsiChar;
571 if (mTokType
<> TTDelim
) then raise Exception
.Create(Format('delimiter ''%s'' expected', [ch
]));
577 function TTextParser
.eatDelim (const ch
: AnsiChar): Boolean;
580 if (mTokType
<> TTDelim
) or (mTokChar
<> ch
) then exit
;
586 // ////////////////////////////////////////////////////////////////////////// //
587 constructor TFileTextParser
.Create (const fname
: AnsiString);
590 mFile
:= openDiskFileRO(fname
);
591 mStreamOwned
:= true;
592 GetMem(mBuffer
, BufSize
);
594 mBufLen
:= mFile
.Read(mBuffer
^, BufSize
);
595 if (mBufLen
< 0) then raise Exception
.Create('TFileTextParser: read error');
600 constructor TFileTextParser
.Create (st
: TStream
; astOwned
: Boolean=true);
602 if (st
= nil) then raise Exception
.Create('cannot create parser for nil stream');
604 mStreamOwned
:= astOwned
;
605 GetMem(mBuffer
, BufSize
);
607 mBufLen
:= mFile
.Read(mBuffer
^, BufSize
);
608 if (mBufLen
< 0) then raise Exception
.Create('TFileTextParser: read error');
613 destructor TFileTextParser
.Destroy ();
615 if (mBuffer
<> nil) then FreeMem(mBuffer
);
619 if mStreamOwned
then mFile
.Free();
625 procedure TFileTextParser
.loadNextChar ();
627 if (mBufLen
= 0) then begin mNextChar
:= #0; exit
; end;
628 if (mBufPos
>= mBufLen
) then
630 mBufLen
:= mFile
.Read(mBuffer
^, BufSize
);
631 if (mBufLen
< 0) then raise Exception
.Create('TFileTextParser: read error');
632 if (mBufLen
= 0) then begin mNextChar
:= #0; exit
; end;
635 assert(mBufPos
< mBufLen
);
636 mNextChar
:= mBuffer
[mBufPos
];
638 if (mNextChar
= #0) then mNextChar
:= ' ';
642 // ////////////////////////////////////////////////////////////////////////// //
643 constructor TStrTextParser
.Create (const astr
: AnsiString);
651 destructor TStrTextParser
.Destroy ();
658 procedure TStrTextParser
.loadNextChar ();
661 if (mPos
> Length(mStr
)) then exit
;
662 mNextChar
:= mStr
[mPos
]; Inc(mPos
);
663 if (mNextChar
= #0) then mNextChar
:= ' ';
667 // ////////////////////////////////////////////////////////////////////////// //
668 constructor TTextWriter
.Create (); begin mIndent
:= 0; end;
669 procedure TTextWriter
.flush (); begin end;
670 procedure TTextWriter
.put (const s
: AnsiString); overload
; begin if (Length(s
) > 0) then putBuf((@(s
[1]))^, Length(s
)); end;
671 procedure TTextWriter
.put (v
: Byte); overload
; begin put('%d', [v
]); end;
672 procedure TTextWriter
.put (v
: Integer); overload
; begin put('%d', [v
]); end;
673 procedure TTextWriter
.put (const fmt
: AnsiString; args
: array of const); overload
; begin put(formatstrf(fmt
, args
)); end;
674 procedure TTextWriter
.putIndent (); var f
: Integer; begin for f
:= 1 to mIndent
do put(' '); end;
675 procedure TTextWriter
.indent (); begin Inc(mIndent
, 2); end;
676 procedure TTextWriter
.unindent (); begin Dec(mIndent
, 2); end;
679 // ////////////////////////////////////////////////////////////////////////// //
680 constructor TFileTextWriter
.Create (const fname
: AnsiString);
682 mFile
:= createDiskFile(fname
);
683 mStreamOwned
:= true;
685 GetMem(mBuffer
, BufSize
);
686 assert(mBuffer
<> nil);
691 constructor TFileTextWriter
.Create (ast
: TStream
; astOwned
: Boolean=true);
693 if (ast
= nil) then raise Exception
.Create('cannot write to nil stream');
695 mStreamOwned
:= astOwned
;
697 GetMem(mBuffer
, BufSize
);
698 assert(mBuffer
<> nil);
702 destructor TFileTextWriter
.Destroy ();
705 if (mBuffer
<> nil) then FreeMem(mBuffer
);
708 if (mStreamOwned
) then mFile
.Free();
714 procedure TFileTextWriter
.flush ();
716 if (mFile
<> nil) and (mBufUsed
> 0) then
718 mFile
.WriteBuffer(mBuffer
^, mBufUsed
);
724 procedure TFileTextWriter
.putBuf (constref buf
; len
: SizeUInt
);
729 if (len
= 0) then exit
;
733 left
:= BufSize
-mBufUsed
;
737 left
:= BufSize
-mBufUsed
;
740 if (left
> len
) then left
:= Integer(len
);
741 Move(pc
^, (mBuffer
+mBufUsed
)^, left
);
749 // ////////////////////////////////////////////////////////////////////////// //
750 constructor TStrTextWriter
.Create ();
756 destructor TStrTextWriter
.Destroy ();
763 procedure TStrTextWriter
.putBuf (constref buf
; len
: SizeUInt
);
769 SetLength(st
, Integer(len
));
770 Move(buf
, PChar(st
)^, Integer(len
));