/* PrintEnvelope.rexx */

 options results
 parse arg file
 if ~show('L','rexxsupport.library') then do
	call addlib('rexxsupport.library',0,-30)
	call null()
	end
 if ~show('L','rexxarplib.library') then do
	call addlib('rexxarplib.library',0,-30)
	call getenv(foo)
	end
 if file="" then do
	numfiles=File_Req('SYS:\Select Address File\\PATGAD\~(#?.info)')
	if numfiles="" then exit
	else file=sel.1
	end
 call pragma('W','N')
 if ~exists(file) then do
	say 'No information for "' || file || '": object not found'
	exit
	end
 if word(statef(file),1)~='FILE' then exit
 call open('f',file)
 h=readch('f',1000)
 call close('f')
 asc=xrange('20'x,'7E'x) || xrange('A0'x,'FF'x) || '0A09'x
 if length(compress(h,asc))=0 then nop
 else do
	text='File: 'BASE_NAME(file) || '0A'x || 'is not a text file'
	call Query(text || '\\\\\')
	exit
	end
 longest=0
 call open(in,file,'R')
 do n=1 to 6 until eof(in)
	line=readln(in)
	line.n=strip(line)
	linelength=length(line.n)
	if linelength>longest then longest=linelength
	end
 if line.n="" then numlines=(n-1)
 else numlines=n
 start=(13-numlines)
 call close(in)
 margin=((80-longest)/2)
 ret=Query('Select Typeface\\CG Times\Courier')
 if ret=0 then do /* CG Times */
	font=4101
	spacing=1
	sp=copies('20'x,trunc(((294*(margin/10)/12)+12.5)))
	end
 else do          /* Courier */
	font=3
	spacing=0
	sp=copies('20'x,trunc(margin+0.5))
	end
 call open(out,'PAR:','W')
 call writech(out,'1B266C383161306F366433481B266B30571B28304E'x,
	|| '1B28733075'x || spacing || '7031306831327630733062'x,
	|| font || '32511B2661'x || start || 'R')
 do n=1 to numlines
	call writech(out,sp || line.n || '0A0D'x)
	end
 call writech(out,'1B45'x)
 call close(out)
 exit

BASE_NAME: procedure
 parse arg name
 n=lastpos('/',name)
 if n=0 then n=lastpos(':',name)
 return substr(name,n+1)

File_Req: procedure expose sel.
 parse arg path '\' title '\' screen '\' opts '\' pat
 if pat>"" & find(opts,'PATGAD')=0 then opts=opts || ' PATGAD'
 if screen="" then screen='Workbench'
 cols=screencols(screen);rows=screenrows(screen)
 x=trunc((cols/4)+0.5);w=(x*2)
 if rows<300 then do
	y=trunc((rows/20)+0.5);h=(y*18)
	end
 else do
	y=trunc((rows/8)+0.5);h=(y*6)
	end
/*
 *  GetFile(x,y,def_path,def_file,title,screen,opts,stem,w,h,pat)
 */
 numfiles=GetFile(x,y,path,,title,screen,opts,sel,w,h,pat)
 return numfiles

QUERY: procedure
 parse arg string '\' gadtext '\' okaytext '\' canceltext '\' title '\' opts
 if okaytext="" & find(opts,'STRING_GAD')=0 then okaytext='OK'
 n=0;longest=0
 do while length(string)>0
	parse var string line '0A'x string
	n=n+1
	line.n=line
	if length(line.n)>longest then longest=length(line.n)
	end
 numlines=n;screen=""
 if opts="" then nop
 else do v=1 to words(opts)
	select
		when word(opts,v)='NOCENTER' then do
			if longest<25 then do
				do n=1 to numlines
					line.n=left(line.n,25,'20'x)
					end
				longest=25
				end
			end
		when left(word(opts,v),7)='SCREEN=' then,
			parse value word(opts,v) with foo '=' screen
		otherwise iterate v
		end
	end
 if find(opts,'NOCENTER')=0 then do
	if longest<25 then longest=25
	do n=1 to numlines
		line.n=center(line.n,longest,'20'x)
		end
	end
 string=""
 if numlines=0 then nop
 else do
	if numlines>1 then do n=1 to numlines
		string=string || line.n || '\'
		end
	else string=line.1
	end
 string=strip(string,'T','\')
 if screen="" then screen='Workbench'
 cols=screencols(screen);rows=screenrows(screen)
 x=trunc((cols/2)+0.5)-(((longest)+8)*4)
 y=trunc((rows/4)+0.5)
/*
 *  result=Request(x,y,string,string_gad_text,okaytext,canceltext,screen)
 */
 if find(opts,'STRING_GAD')>0 then do
	call request(x,y,string,'00'x,,,screen)
	return strip(RESULT)
	end
 else do
	if canceltext="" then call request(x,y,string,,okaytext,,screen)
	else call request(x,y,string,,okaytext,canceltext,screen)
	end
 ret=RESULT
 if ret='OKAY' then return 0
 else return 1