Mercurial > rg
diff parser.pas @ 0:62966dd383ed default tip
initial
| author | Radomir Dopieralski <sheep-devel@sheep.art.pl> |
|---|---|
| date | Sun, 08 Dec 2013 19:39:15 +0100 |
| parents | |
| children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/parser.pas Sun Dec 08 19:39:15 2013 +0100 @@ -0,0 +1,158 @@ +{ File i/o and parsing routines. } + +UNIT Parser; + +INTERFACE + +USES Gzio; + +CONST REMCHAR='#'; + REMEND=#13; + STRCHAR='"'; + VRBCHAR='\'; + +{ TYPE CfgFile=FILE OF CHAR; } +TYPE CfgFile=gzFile; + +CONST PARSE_NOERROR=0; + PARSE_ERR_EOF=1; + PARSE_ERR_NUM=2; + PARSE_ERR_STR=3; + PARSE_ERR_NAM=4; + PARSE_ERR_OPN=5; + +VAR errNum:BYTE; + actLine: WORD; +FUNCTION ReadName(VAR f:CfgFile):STRING; +FUNCTION ReadString(VAR f:CfgFile):STRING; +FUNCTION ReadNumber(VAR f:CfgFile):INTEGER; +PROCEDURE OpenCfg(VAR f:CfgFile; name: STRING); +PROCEDURE CloseCfg(VAR f:CfgFile); + +IMPLEMENTATION + +CONST CHR_EOF=#26; + +PROCEDURE OpenCfg(VAR f:CfgFile; name: STRING); +BEGIN + actLine:=1; + errNum:=PARSE_NOERROR; + + f:=gzOpen(name,'r'); + IF f=NIL THEN BEGIN + errNum:=PARSE_ERR_OPN; + WriteLn('Can''t open ',name); + END; +END; + +PROCEDURE CloseCfg(VAR f:CfgFile); +BEGIN + IF gzClose(f)>0 THEN errNum:=PARSE_ERR_OPN; +END; + +FUNCTION ReadChr(VAR f:CfgFile): CHAR; +VAR c: CHAR; + b: INTEGER; +BEGIN + b:=gzGetC(f); + + IF (b<0) OR (b>255) OR (c=CHR_EOF) THEN BEGIN + errNum:=PARSE_ERR_EOF; + c:=CHR_EOF; + END ELSE c:=Chr(b); + + IF c=#13 THEN Inc(actLine); + ReadChr:=c; +END; + +FUNCTION IsEmpty(c:CHAR):BOOLEAN; +BEGIN + IsEmpty:=(c=' ') OR (c=#9) OR (c=#13) OR (c=#10) OR (c=CHR_EOF); +END; + +FUNCTION ReadName(VAR f:CfgFile):STRING; +VAR s: STRING; + c: CHAR; +BEGIN + ReadName:=''; + REPEAT + c:=ReadChr(f); + IF c=REMCHAR THEN BEGIN + REPEAT + c:=ReadChr(f); + UNTIL (c=REMEND) OR (c=CHR_EOF); + IF (c<>CHR_EOF) THEN c:=' '; + END; + UNTIL (NOT IsEmpty(c)) OR (c=CHR_EOF); + s:=''; + WHILE NOT IsEmpty(c) DO BEGIN + s:=Concat(s,UpCase(c)); + c:=ReadChr(f); + END; + IF s='' THEN errNum:=PARSE_ERR_NAM; + ReadName:=s; +END; + +FUNCTION ReadString(VAR f:CfgFile):STRING; +VAR s: STRING; + c: CHAR; +BEGIN + ReadString:=''; + REPEAT + c:=ReadChr(f); + IF c=REMCHAR THEN BEGIN + REPEAT + c:=ReadChr(f); + UNTIL (c=REMEND) OR (c=CHR_EOF); + IF (c<>CHR_EOF) THEN c:=' '; + END; + UNTIL (NOT IsEmpty(c)) OR (c=CHR_EOF); + s:=''; + IF c<>STRCHAR THEN BEGIN + errNum:=PARSE_ERR_STR; + END ELSE BEGIN + REPEAT + c:=ReadChr(f); + IF c=STRCHAR THEN Break; + IF c=#13 THEN BEGIN + ErrNum:=PARSE_ERR_STR; + Exit; + END; + IF c=CHR_EOF THEN Exit; + IF c=VRBCHAR THEN BEGIN + c:=ReadChr(f); + END; + s:=Concat(s,c); + UNTIL FALSE; + END; + ReadString:=s; +END; + +FUNCTION ReadNumber(VAR f:CfgFile):INTEGER; +VAR s: STRING; + c: CHAR; + i,j: INTEGER; +BEGIN + ReadNumber:=0; + REPEAT + c:=ReadChr(f); + IF c=REMCHAR THEN BEGIN + REPEAT + c:=ReadChr(f); + UNTIL (c=REMEND) OR (c=CHR_EOF); + IF (c<>CHR_EOF) THEN c:=' '; + END; + UNTIL (NOT IsEmpty(c)) OR (c=CHR_EOF); + s:=''; + WHILE NOT IsEmpty(c) DO BEGIN + s:=Concat(s,UpCase(c)); + c:=ReadChr(f); + END; + Val(s,i,j); + IF j=0 THEN ReadNumber:=i + ELSE BEGIN + errNum:=PARSE_ERR_NUM; + END; +END; + +END. \ No newline at end of file
