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