PROGRAM pretty;
{
	capitalizes reserved words - except in comments
}

CONST	cr=$D;	{ carriage return}
	lf=$A;	{ line feed }
	tab=$9;	{ tab}
	apostrophe=$27;	{apostrophe}

VAR	inword,
	start_of_comment,
	incomment,
	error,
	inquote,
	done:	boolean;

	ch:char;

	word:string;

	number:integer;

	spaceset:	SET OF char;  {set of all space-like char's }

	reserved:	ARRAY[0..40] OF string;

	infile,
	outfile:	FILE OF char;

PROCEDURE initialize;
{
	This procedure sets up the reserved word array etc
}


BEGIN
	inquote:=false;
	word:='';
	incomment:=false;
	start_of_comment:=false;
	done:=false;
	inword:=false;
	spaceset:=['.',';',':','(',')','[',']','*',chr(tab),
		',','=',' ',chr(lf),chr(cr),chr(apostrophe),'^'];
	reserved[0]:='in';
	reserved[1]:='of';
	reserved[2]:='do';
	reserved[3]:='or';
	reserved[4]:='to';
	reserved[5]:='if';
	reserved[6]:='and';
	reserved[7]:='div';
	reserved[8]:='end';
	reserved[9]:='for';
	reserved[10]:='mod';
	reserved[11]:='nil';
	reserved[12]:='not';
	reserved[13]:='set';
	reserved[14]:='var';
	reserved[15]:='case';
	reserved[16]:='else';
	reserved[17]:='file';
	reserved[18]:='goto';
	reserved[19]:='then';
	reserved[20]:='type';
	reserved[21]:='with';
	reserved[22]:='array';
	reserved[23]:='begin';
	reserved[24]:='const';
	reserved[25]:='label';
	reserved[26]:='until';
	reserved[27]:='while';
	reserved[28]:='downto';
	reserved[29]:='packed';
	reserved[30]:='record';
	reserved[31]:='repeat';
	reserved[32]:='forward';
	reserved[33]:='program';
	reserved[34]:='function';
	reserved[35]:='procedure';
	reserved[36]:='external';
	number:=36;
END;	{initialize}

PROCEDURE openfiles(VAR error:	boolean);
{
	This procedure opens the input and output disk files
}

VAR 	p:	^byte;
	cpm_cmd_line:	string[128];
	l:	integer;
	temp:string;

BEGIN
	p:=$80;	{ cpm command buffer address}
	move(p^,cpm_cmd_line,sizeof(cpm_cmd_line));
	IF length(cpm_cmd_line)<>0
	    THEN
		BEGIN
		    IF pos('.',cpm_cmd_line)=0
			THEN cpm_cmd_line:=concat(cpm_cmd_line,'.SRC');
		    writeln('Input file: ',cpm_cmd_line);
		END
	    ELSE
		BEGIN
		    writeln('Type input file name');
		    readln(cpm_cmd_line);
		END;
	assign(infile,cpm_cmd_line);
	reset(infile);
	IF eof(infile) THEN done:=true;
	error:=(ioresult=255);
	IF error
	    THEN
		BEGIN
		    writeln('Unable to open file: ',cpm_cmd_line);
		    exit;
		END;
	l:=pos('.',cpm_cmd_line);
	temp:=copy(cpm_cmd_line,1,l-1);
	temp:=concat(temp,'.TMP');
	assign(outfile,temp);
	rewrite(outfile);
	error:=(ioresult=255);
	IF error
	    THEN
		BEGIN
		    writeln('Unable to open output file: ',temp);
		    exit;
		END
	    ELSE writeln('Opened output file: ',temp);
END;	{openfiles}

PROCEDURE closefiles;

VAR result:	integer;

BEGIN
	close(infile,result);
	IF ioresult=255 THEN writeln('Unable to close input file');
	close(outfile,result);
	IF ioresult=255 THEN writeln('Unable to close output file');
END;	{closefiles}

PROCEDURE get_a_char(VAR ch:	char);
{
	This gets one input character - the 'done' and 'incomment'
    and 'inword' flags are set also
}

BEGIN
	    ch:=infile^;
	    get(infile);   {point to next one}
	    done:=eof(infile) OR (ord(ch)=$1A);
	    IF NOT incomment
		THEN
		    BEGIN
			IF ch=chr(apostrophe) THEN inquote:=NOT inquote;
			IF NOT inquote
			  THEN
			    BEGIN
				incomment:=(ch='{') OR (start_of_comment
				    AND (ch='*'));
				start_of_comment:=	ch='(';
			    END;
		    END
		ELSE
		    BEGIN
			incomment:=NOT ((ch='}') OR
			    (start_of_comment AND (ch=')')));
			IF NOT incomment {ie, just coming out of
				comment}
			    THEN inquote:=false;
			start_of_comment:=	ch='*';
		    END;
	    inword:=NOT (ch IN spaceset);
END;	{get_a_char}

PROCEDURE put_a_char(ch:	char);
{
	Puts one character to output file
}

BEGIN
	outfile^:=ch;
	put(outfile);
END;	{put_a_char}

PROCEDURE make_a_word(VAR word:	string;VAR ch:	char);
{
	Constructs one word from input file
}

BEGIN
	WHILE inword
	    DO
		BEGIN
		    word:=concat(word,ch);
		    get_a_char(ch);
		END;
END;	{make_a_word}

PROCEDURE alter(VAR word:	string);
{
	Looks up word to see if in reserved list - if it is, it
    cpaitalize it - otherwise not
}

VAR	i:	integer;
	flag:	boolean;

	PROCEDURE capitalize(VAR word:	string);

	VAR i,len:	integer;

	BEGIN
		len:=length(word);
		FOR i:=1 TO len DO word[i]:=chr(ord(word[i])-32);
	END;	{ capitalize }

BEGIN
	i:=0;
	flag:=false;
	REPEAT
		flag:=(word=reserved[i]);
		i:=i+1;
	UNTIL flag OR (i>number);
	IF flag THEN capitalize(word);
END;	{alter}

PROCEDURE put_a_word(word:	string);

VAR	i,len:	integer;
	chtemp:	char;

BEGIN
	len:=length(word);
	FOR i:=1 TO len DO
	   BEGIN
		chtemp:=word[i];
		put_a_char(chtemp);
	    END;
END;	{put_a_word}

BEGIN		{   ****  MAIN    ****   }
	openfiles(error);
	IF error THEN exit;
	initialize;
	REPEAT
	    get_a_char(ch);
	    IF NOT done
              THEN
	        BEGIN
		    IF (inquote OR incomment OR NOT inword)
		      THEN put_a_char(ch)
		    ELSE
			BEGIN
				make_a_word(word,ch);
				alter(word);
				put_a_word(word);
				word:='';
				put_a_char(ch);
			END;
		END;
	UNTIL done;
	closefiles;
END.