#-h- cprsym           213 asc 07-may-80 15:07:21
 # symbols for compress and expand tools
 # put on a file called 'cprsym'
 # Used only by compress and expand
 
 #must have RCODE > MAXCHUNK or RCODE = 0
 define(MAXCHUNK,124)
 define(RCODE,125)
 define(THRESH,4)
#-h- cpress.r        2000 asc 07-may-80 15:07:22
#-h- main             301 asc 07-may-80 15:07:10
 #---------------------------------------------------------------------
 # include symbol definitions
 #        include symbols
 #---------------------------------------------------------------------
 ## main - driver for cpress tool
 
 include cprsym
 
# call initr4
# call cpress
# call endr4
# end
#-h- cpress           565 asc 07-may-80 15:07:11
 ## cpress - compress input files
# subroutine cpress
 subroutine main
 
 character buf(MAXLINE)
 integer getarg, open
 integer i
 #must have RCODE > MAXCHUNK or RCODE = 0
 
 for (i=1; ; i=i+1)
	{
	if (getarg(i,buf,MAXLINE) == EOF)
		{
		if (i != 1)
			break
		int = STDIN
		}
	else if (buf(1) == QMARK & buf(2) == EOS)
		call error ('usage:  cpress [file ...].')
	else if (buf(1) == MINUS & buf(2) == EOS)
		int = STDIN
	else
		{
		int = open(buf,READ)
		if (int == ERR)
			call cant(buf)
		}
	call press (int)
	if (int != STDIN)
		call close(int)
	}
 return
 end
#-h- press            693 asc 07-may-80 15:07:12
 ## press - compress file -int-
 subroutine press (int)
 character getch
 character buf(MAXCHUNK), c, lastc
 integer int, nrep, nsave
 #must have RCODE > MAXCHUNK or RCODE = 0
 
 nsave = 0
 for (lastc=getch(lastc,int); lastc != EOF; lastc = c)
	{
	for (nrep=1; getch(c,int) == lastc; nrep = nrep + 1)
		if (nrep >= MAXCHUNK)	#count repetitions
			break
	if (nrep < THRESH)		#append short string
		for (; nrep > 0; nrep = nrep - 1)
			{
			nsave = nsave + 1
			buf(nsave) = lastc
			if (nsave >= MAXCHUNK)
				call putbuf(buf, nsave)
			}
	else
		{
		call putbuf(buf, nsave)
		call putc (RCODE)
		call putc(lastc)
		call putc(nrep)
		}
	}
 call putbuf(buf, nsave)		#put last chunk
 return
 end
#-h- putbuf           245 asc 07-may-80 15:07:13
 ## putbuf - output buf(1) ... buf(nsave),  clear nsave
 subroutine putbuf(buf, nsave)
 character buf(MAXCHUNK)
 integer i, nsave
 
 if (nsave > 0)
	{
	call putc (nsave)
	for (i=1; i<=nsave; i=i+1)
		call putc(buf(i))
	}
 nsave = 0
 return
 end