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 // ////////////////////////////////////////////////////////////////////////// //
27 TTextParser
= class(TPoolObject
)
34 //TTFloat = 3; // not yet
39 TTBegin
= 8; // left curly
40 TTEnd
= 9; // right curly
41 TTDelim
= 10; // other delimiters
46 TTGreatEqu
= 14; // >=
52 mCurChar
, mNextChar
: AnsiChar;
54 mAllowSignedNumbers
: Boolean; // internal control
56 mTokLine
, mTokCol
: Integer; // token start
58 mTokStr
: AnsiString; // string or identifier
59 mTokChar
: AnsiChar; // for delimiters
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'
67 constructor Create ();
68 destructor Destroy (); override;
70 function isEOF (): Boolean; inline;
72 function skipChar (): Boolean; // returns `false` on eof
74 function skipBlanks (): Boolean; // ...and comments; returns `false` on eof
76 function skipToken (): Boolean; // returns `false` on eof
77 //function skipToken1 (): Boolean;
79 function expectId (): AnsiString;
80 procedure expectId (const aid
: AnsiString);
81 function eatId (const aid
: AnsiString): Boolean;
83 function expectStr (allowEmpty
: Boolean=false): AnsiString;
84 function expectInt (): Integer;
86 function expectStrOrId (allowEmpty
: Boolean=false): AnsiString;
88 procedure expectTT (ttype
: Integer);
89 function eatTT (ttype
: Integer): Boolean;
91 function expectDelim (const ch
: AnsiChar): AnsiChar;
92 function eatDelim (const ch
: AnsiChar): Boolean;
95 property allowSignedNumbers
: Boolean read mAllowSignedNumbers write mAllowSignedNumbers
;
98 property col
: Integer read mCol
;
99 property line
: Integer read mLine
;
101 property curChar
: AnsiChar read mCurChar
;
102 property nextChar
: AnsiChar read mNextChar
;
105 property tokCol
: Integer read mTokCol
;
106 property tokLine
: Integer read mTokLine
;
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
;
115 // ////////////////////////////////////////////////////////////////////////// //
117 TFileTextParser
= class(TTextParser
)
119 const BufSize
= 16384;
123 mStreamOwned
: Boolean;
129 procedure loadNextChar (); override; // loads next char into mNextChar; #0 means 'eof'
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;
137 TStrTextParser
= class(TTextParser
)
143 procedure loadNextChar (); override; // loads next char into mNextChar; #0 means 'eof'
146 constructor Create (const astr
: AnsiString);
147 destructor Destroy (); override;
151 // ////////////////////////////////////////////////////////////////////////// //
158 procedure putBuf (constref buf
; len
: SizeUInt
); virtual; abstract;
161 constructor Create ();
163 procedure flush (); virtual;
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 ();
171 procedure unindent ();
174 property curIndent
: Integer read mIndent
;
178 // ////////////////////////////////////////////////////////////////////////// //
180 TFileTextWriter
= class(TTextWriter
)
182 const BufSize
= 16384;
186 mStreamOwned
: Boolean;
191 procedure putBuf (constref buf
; len
: SizeUInt
); override;
194 constructor Create (const fname
: AnsiString);
195 constructor Create (ast
: TStream
; astOwned
: Boolean=true); // will own the stream by default
196 destructor Destroy (); override;
198 procedure flush (); override;
201 TStrTextWriter
= class(TTextWriter
)
206 procedure putBuf (constref buf
; len
: SizeUInt
); override;
209 constructor Create ();
210 destructor Destroy (); override;
212 property str
: AnsiString read mStr
;
222 // ////////////////////////////////////////////////////////////////////////// //
223 function StrEqu (const a
, b
: AnsiString): Boolean; inline; begin result
:= (a
= b
); end;
226 // ////////////////////////////////////////////////////////////////////////// //
227 constructor TTextParser
.Create ();
237 mAllowSignedNumbers
:= true;
238 warmup(); // change `mAllowSignedNumbers` there, if necessary
243 destructor TTextParser
.Destroy ();
249 function TTextParser
.isEOF (): Boolean; inline; begin result
:= (mCurChar
= #0); end;
252 procedure TTextParser
.warmup ();
256 mCurChar
:= mNextChar
;
257 if (mNextChar
<> #0) then loadNextChar();
261 function TTextParser
.skipChar (): Boolean;
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;
269 if (mCurChar
= #13) then
271 if (mNextChar
= #10) then loadNextChar();
278 function TTextParser
.skipBlanks (): Boolean;
284 if (curChar
= '/') then
286 // single-line comment
287 if (nextChar
= '/') then
289 while not isEOF
and (curChar
<> #10) do skipChar();
290 skipChar(); // skip EOL
294 if (nextChar
= '*') then
296 // skip comment start
301 if (curChar
= '*') and (nextChar
= '/') then
312 // nesting multline comment
313 if (nextChar
= '+') then
315 // skip comment start
321 if (curChar
= '+') and (nextChar
= '/') then
327 if (level
= 0) then break
;
330 if (curChar
= '/') and (nextChar
= '+') then
332 // skip comment start
343 if (curChar
> ' ') then break
;
344 skipChar(); // skip blank
351 function TTextParser.skipToken (): Boolean;
353 writeln('getting token...');
354 result := skipToken1();
355 writeln(' got token: ', mTokType, ' <', mTokStr, '> : <', mTokChar, '>');
360 function TTextParser
.skipToken (): Boolean;
362 procedure parseInt ();
364 neg
: Boolean = false;
368 if mAllowSignedNumbers
then
370 if (curChar
= '+') or (curChar
= '-') then
372 neg
:= (curChar
= '-');
374 if (curChar
< '0') or (curChar
> '9') then
377 if (neg
) then mTokChar
:= '-' else mTokChar
:= '+';
382 if (curChar
= '0') then
398 if (base
< 0) then base
:= 10;
399 if (digitInBase(curChar
, base
) < 0) then raise Exception
.Create('invalid number');
401 mTokInt
:= 0; // just in case
404 n
:= digitInBase(curChar
, base
);
405 if (n
< 0) then break
;
407 if (n
< 0) or (n
< mTokInt
) then raise Exception
.Create('integer overflow');
411 // check for valid number end
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
417 raise Exception
.Create('invalid number');
420 if neg
then mTokInt
:= -mTokInt
;
423 procedure parseString ();
429 mTokStr
:= ''; // just in case
431 skipChar(); // skip starting quote
435 if (qch
= '"') and (curChar
= '\') then
437 if (nextChar
= #0) then raise Exception
.Create('unterminated string escape');
439 // skip backslash and escape type
448 'x', 'X': // hex escape
450 n
:= digitInBase(curChar
, 16);
451 if (n
< 0) then raise Exception
.Create('invalid hexstr escape');
453 if (digitInBase(curChar
, 16) > 0) then
455 n
:= n
*16+digitInBase(curChar
, 16);
458 mTokStr
+= AnsiChar(n
);
464 // duplicate single quote (pascal style)
465 if (qch
= '''') and (curChar
= '''') and (nextChar
= '''') then
473 if (curChar
= qch
) then
475 skipChar(); // skip ending quote
483 procedure parseId ();
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
503 if not skipBlanks() then
517 if mAllowSignedNumbers
and ((curChar
= '+') or (curChar
= '-')) then begin parseInt(); exit
; end;
518 if (curChar
>= '0') and (curChar
<= '9') then begin parseInt(); exit
; end;
521 if (curChar
= '"') or (curChar
= '''') then begin parseString(); exit
; end;
524 if (curChar
= '_') or ((curChar
>= 'A') and (curChar
<= 'Z')) or ((curChar
>= 'a') and (curChar
<= 'z')) or (curChar
>= #128) then begin parseId(); exit
; end;
530 if (curChar
= '=') then
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;
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;
551 function TTextParser
.expectId (): AnsiString;
553 if (mTokType
<> TTId
) then raise Exception
.Create('identifier expected');
559 procedure TTextParser
.expectId (const aid
: AnsiString);
561 if (mTokType
<> TTId
) or (not StrEqu(mTokStr
, aid
)) then raise Exception
.Create('identifier '''+aid
+''' expected');
566 function TTextParser
.eatId (const aid
: AnsiString): Boolean;
569 if (mTokType
<> TTId
) or (not StrEqu(mTokStr
, aid
)) then exit
;
575 function TTextParser
.expectStr (allowEmpty
: Boolean=false): AnsiString;
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');
584 function TTextParser
.expectStrOrId (allowEmpty
: Boolean=false): AnsiString;
588 if (not allowEmpty
) and (Length(mTokStr
) = 0) then raise Exception
.Create('non-empty string expected');
592 raise Exception
.Create('string or identifier expected');
599 function TTextParser
.expectInt (): Integer;
601 if (mTokType
<> TTInt
) then raise Exception
.Create('string expected');
607 procedure TTextParser
.expectTT (ttype
: Integer);
609 if (mTokType
<> ttype
) then raise Exception
.Create('unexpected token');
614 function TTextParser
.eatTT (ttype
: Integer): Boolean;
616 result
:= (mTokType
= ttype
);
617 if result
then skipToken();
621 function TTextParser
.expectDelim (const ch
: AnsiChar): AnsiChar;
623 if (mTokType
<> TTDelim
) then raise Exception
.Create(Format('delimiter ''%s'' expected', [ch
]));
629 function TTextParser
.eatDelim (const ch
: AnsiChar): Boolean;
632 if (mTokType
<> TTDelim
) or (mTokChar
<> ch
) then exit
;
638 // ////////////////////////////////////////////////////////////////////////// //
639 constructor TFileTextParser
.Create (const fname
: AnsiString);
642 mFile
:= openDiskFileRO(fname
);
643 mStreamOwned
:= true;
644 GetMem(mBuffer
, BufSize
);
646 mBufLen
:= mFile
.Read(mBuffer
^, BufSize
);
647 if (mBufLen
< 0) then raise Exception
.Create('TFileTextParser: read error');
652 constructor TFileTextParser
.Create (st
: TStream
; astOwned
: Boolean=true);
654 if (st
= nil) then raise Exception
.Create('cannot create parser for nil stream');
656 mStreamOwned
:= astOwned
;
657 GetMem(mBuffer
, BufSize
);
659 mBufLen
:= mFile
.Read(mBuffer
^, BufSize
);
660 if (mBufLen
< 0) then raise Exception
.Create('TFileTextParser: read error');
665 destructor TFileTextParser
.Destroy ();
667 if (mBuffer
<> nil) then FreeMem(mBuffer
);
671 if mStreamOwned
then mFile
.Free();
677 procedure TFileTextParser
.loadNextChar ();
679 if (mBufLen
= 0) then begin mNextChar
:= #0; exit
; end;
680 if (mBufPos
>= mBufLen
) then
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;
687 assert(mBufPos
< mBufLen
);
688 mNextChar
:= mBuffer
[mBufPos
];
690 if (mNextChar
= #0) then mNextChar
:= ' ';
694 // ////////////////////////////////////////////////////////////////////////// //
695 constructor TStrTextParser
.Create (const astr
: AnsiString);
703 destructor TStrTextParser
.Destroy ();
710 procedure TStrTextParser
.loadNextChar ();
713 if (mPos
> Length(mStr
)) then exit
;
714 mNextChar
:= mStr
[mPos
]; Inc(mPos
);
715 if (mNextChar
= #0) then mNextChar
:= ' ';
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;
731 // ////////////////////////////////////////////////////////////////////////// //
732 constructor TFileTextWriter
.Create (const fname
: AnsiString);
734 mFile
:= createDiskFile(fname
);
735 mStreamOwned
:= true;
737 GetMem(mBuffer
, BufSize
);
738 assert(mBuffer
<> nil);
743 constructor TFileTextWriter
.Create (ast
: TStream
; astOwned
: Boolean=true);
745 if (ast
= nil) then raise Exception
.Create('cannot write to nil stream');
747 mStreamOwned
:= astOwned
;
749 GetMem(mBuffer
, BufSize
);
750 assert(mBuffer
<> nil);
754 destructor TFileTextWriter
.Destroy ();
757 if (mBuffer
<> nil) then FreeMem(mBuffer
);
760 if (mStreamOwned
) then mFile
.Free();
766 procedure TFileTextWriter
.flush ();
768 if (mFile
<> nil) and (mBufUsed
> 0) then
770 mFile
.WriteBuffer(mBuffer
^, mBufUsed
);
776 procedure TFileTextWriter
.putBuf (constref buf
; len
: SizeUInt
);
781 if (len
= 0) then exit
;
785 left
:= BufSize
-mBufUsed
;
789 left
:= BufSize
-mBufUsed
;
792 if (left
> len
) then left
:= Integer(len
);
793 Move(pc
^, (mBuffer
+mBufUsed
)^, left
);
801 // ////////////////////////////////////////////////////////////////////////// //
802 constructor TStrTextWriter
.Create ();
808 destructor TStrTextWriter
.Destroy ();
815 procedure TStrTextWriter
.putBuf (constref buf
; len
: SizeUInt
);
821 SetLength(st
, Integer(len
));
822 Move(buf
, PChar(st
)^, Integer(len
));