Initial commit

17 files changed, 1799 insertions, 0 deletions

diff --git a/sys/psio/README b/sys/psio/README
new file mode 100644
index 00000000..a1786fd7
--- /dev/null
+++ b/sys/psio/README
@@ -0,0 +1,339 @@
+PSIO -- The Postscript I/O package.
+
+	The PSIO interface is used to format a block of text as Postscript
+output on a page of a given size (Letter, Legal, A4 or B5).  Once initialized
+by a ps_open() call, programs can set various options related to the page
+size or properties, preferred fonts, etc.  Output is begun with a call to
+the ps_write_prolog() routine to initialize the PS prolog.  Afterwards,
+text may be fed to a buffer using ps_deposit() to fill the output page to
+a right justified margin, inserting linebreaks where needed.  Other routines
+permit specific linebreaks or text positioning as required.
+
+
+1) PSIO Interface Summary
+-------------------------
+
+		     include  <psset.h>
+
+		ps = ps_open  (fd, default_footer)
+	          ps_setfont  (ps, font)
+	        ps_page_size  (ps, page)
+	        ps_font_size  (ps, font_size)
+		   ps_header  (ps, ledge, center, redge)
+		   ps_footer  (ps, ledge, center, redge)
+	       ps_setmargins  (ps, left, right, top, bottom)
+	     ps_write_prolog  (ps)
+		    ps_close  (ps)
+
+	             ps_xpos  (ps, xpos)
+	             ps_ypos  (ps, ypos)
+	           ps_indent  (ps, nchars)
+	         ps_testpage  (ps, nlines)
+	          ps_deposit  (ps, line)
+	        ps_linebreak  (ps, fill_flag)
+	        ps_pagebreak  (ps, fill_flag)
+	          ps_newline  (ps)
+	           ps_output  (ps, line)
+	           ps_center  (ps, line)
+	     ps_rightjustify  (ps, text)
+
+	width = ps_textwidth  (ps, string)
+	  pos = ps_centerpos  (ps, text)
+	      pos = ps_rjpos  (ps, text)
+
+
+
+2) PSIO Interface Description
+-----------------------------
+
+    ps = ps_open (fd, default_footer)
+	Initialize the PS structure with default page size and margins,
+	set output file descriptor. Returns the PS struct pointer initialized
+	with defaults.  If the 'default_footer' int flag is enabled a default
+	footer containing the string "NOAO/IRAF" in the bottom left corner,
+	the IRAF version string in the center, and the page number in the 
+	bottom right will be created for each page.  Otherwise only a page
+	number will appear unless a different footer is defined with the
+	ps_footer() command.
+
+
+    ps_setfont (ps, font)
+	Set the current font to be used.  Allowable values for 'font' are set
+	in the <psset.h> include file as
+
+	    define F_ROMAN         1           	# times-roman font
+	    define F_ITALIC        2           	# times-roman italic font
+	    define F_BOLD          3           	# times-roman bold font
+	    define F_TELETYPE      4           	# fixed-width font
+	    define F_PREVIOUS      5           	# previous font
+
+	The default font will be a 10-point Times-Roman.
+
+    ps_font_size (ps, font_size)
+	Set the font size in points to be used.  Font sizes are not changeable
+	once the interface has been opened so this routine must be called
+	before the Postscript prolog is written.
+
+    ps_page_size (ps, page)
+
+	Set the default page size to be used.  Allowable values for 'page'
+	are set in the <psset.h> include file as
+
+	    define PAGE_LETTER     1        # US Letter (612x792  @ 300 dpi)
+	    define PAGE_LEGAL      2	    # US Legal  (612x1008 @ 300 dpi)
+	    define PAGE_A4         3	    # A4 size   (595x850  @ 300 dpi)
+	    define PAGE_B5         4	    # B5 size   (524x765  @ 300 dpi)
+
+	The default page size will be US Letter but can be overridden in the
+	environment by defining a 'pspage' variable as e.g.
+
+	    cl> reset pspage = "legal"
+
+    ps_header (ps, ledge, center, redge)
+	Set header text tags.  The header will appear on each page, empty
+	strings are allowed to indicate no text is to be written in that
+	part of the header.
+
+    ps_footer (ps, ledge, center, redge)
+	Set footer text tags.  The footer will appear on each page, empty
+	strings are allowed to indicate no text is to be written in that
+	part of the header.  A running page number will always be written
+	to the 'redge' field unless a non-empty value is defined, a white-
+	space character can be used to indicate no text should be written
+	to that part of the footer.
+
+    ps_setmargins (ps, left, right, top, bottom)
+	Set/Change page margins from defaults set by ps_open().  Values are
+	defined in units of inches given as a floating point number.
+
+    ps_write_prolog (ps)
+	Write the PS prolog given the current postscript struct.  This
+	initializes a flag preventing subsequent changes from taking effect
+	once called.
+
+    ps_close (ps)
+	Close the struct, flush the page, and free memory
+
+
+    ps_xpos (ps, xpos)
+    ps_ypos (ps, ypos)
+	Set current X or Y position on page
+
+    ps_indent  (ps, nchars)
+	Set a temporary indenture of the page from the permanent left margin.
+	Value is given as a number of fixed-width characters, negative values
+	are not permitted, a value of zero may be used to reset to the left
+	margin.
+	         
+    ps_testpage  (ps, nlines)
+	Test whether the output is within the specified number of line of
+	the end of the page, if so do a page break.  This routine can be used
+	to force a page break when a certain number of lines is to be reserved
+	to e.g. keep a group of text together on a page.
+
+    ps_deposit (ps, line)
+	Deposit a line of text to the output buffer.  When the output width
+	exceeds the permanent right margin the line is flushed to the output
+	file and the x-position reset to the current left margin, the y-pos
+	is moved to the next line determined by the font size.   Remaining
+	words in the line buffer to added to the next line buffer. 
+	    Width of the line is computed from the width of each word plus
+	a space char, including font changes.  The line buffer outputs each
+	word plus spacing individually,  font changes are handled in the
+	output routine.
+
+    ps_linebreak (ps, fill_flag)
+	Break the current line regardless of whether it has been filled.  
+	The int 'fill_flag' says whether to fill the current line to be right 
+	justified.  May be called to simply flush the current line buffer.
+
+    ps_output (ps, line, fill_flag)
+	Output the given line and break, fill to be right justified if the
+	int 'fill_flag' is set.
+	
+    ps_center (ps, line)
+	Center the line on the page and break.
+
+    ps_rightjustify (ps, text)
+	Right justfify text on the current line.
+
+
+    width = ps_textwidth (ps, string)
+	Get the width of the given string.  Width is returned in terms of
+	Postscript pixels assuming a 72 point, 300 dpi page.
+
+    pos = ps_centerpos (ps, text)
+    pos = ps_rjpos (ps, text)
+	Get the X position of the centered and right-justified strings.
+
+
+3) Postscript Prolog
+--------------------
+
+	Example prolog for the postscript output.  The actual prolog is
+created based on parameters specified such as the page size, header/footer
+text, etc.  Lines with '***' indicate those which are set dependent upon 
+PS structure values.
+
+
+%!PS-Adobe-1.0
+%%Creator: IRAF postscript translator
+%%CreationDate: Wed May 19 14:34:47 1999
+%%Pages: (atend)
+%%DocumentFonts: (atend)
+%%EndComments
+%%BeginProlog
+
+/inch	{ 72 mul    } def		% 72 points per inch
+/PL 	{ 792  	    } def		% set page height	     	   ***
+/FtrY	{ 20	    } def		% footer Y position
+/HdrY	{ PL 40 sub } def		% header Y position
+/xOrg	72 	   def			% 1 inch left margin         	   ***
+/yOrg	720    	   def			% 1 inch top margin          	   ***
+/yDelta 12 	   def			% line spacing		     	   ***
+/Line	1 	   def			% line number
+/Page	0 	   def			% page number
+/pnum   4 string   def			% sizeof page number cvs buffer
+/res	10.00	   def			% pixel resolution factor    	   ***
+
+/TA { 	newpath 			% Draw a box around our text
+    xOrg yOrg moveto 			% area as a debugging procedure.
+       0 -664 rlineto                   %                                  ***
+     467    0 rlineto                   %                                  ***
+       0  664 rlineto                   %                                  ***
+    closepath 
+    stroke
+} bind def
+
+/FS 	{ findfont exch scalefont } bind def 	% find and scale a font
+/Fonts [					% create an array of fonts
+    10 /Times-Roman FS 				%		     	   ***
+    10 /Times-Bold FS 				%		     	   ***
+    10 /Times-Italic FS 			%			   ***
+    10 /Courier FS 				%			   ***
+    12 /Times-Bold FS 				%		     	   ***
+] def
+/R  {	Fonts 0 get setfont } bind def 		% set roman font
+/B  {	Fonts 1 get setfont } bind def 		% set bold font
+/I  {	Fonts 2 get setfont } bind def 		% set italic font
+/T  {	Fonts 3 get setfont } bind def 		% set teletype font
+/H  {	Fonts 4 get setfont } bind def 		% set header font
+
+/NL {	Line 1 add SL 	} bind def 		% newline
+/H  {	res div 
+	currentpoint exch pop 
+	moveto 		} def			% horizontal position
+/S  {	exch H show 	} bind def 		% show
+/SL {	/Line exch def 				% set line position
+	xOrg yOrg Line yDelta mul sub moveto
+} bind def
+
+
+/BP {	 					% Begin page (header).
+    xOrg HdrY moveto R (TEE \(Nov97\)) show	% write the header         ***
+     280 HdrY moveto R (system) show            %                          ***
+     485 HdrY moveto R (TEE \(Nov97\)) show     %                          ***
+    1 SL R
+} bind def
+
+/EP {	     					% End page (footer).
+    /Page Page 1 add def			% increment page number
+    xOrg FtrY moveto R (NOAO/IRAF) show	% write the footer                 ***
+    250  FtrY moveto R (IRAF V2.11 May 1997) show                          ***
+    530  FtrY moveto R Page pnum cvs show                                  ***
+    showpage					% show the page
+} bind def
+
+%%EndProlog
+%%Page: 1 1
+%-----------------------------------------------------------------------------
+
+initgraphics
+TA
+BP
+	...<postscript generated by translator>...
+EP
+	...<repeat above as needed>...
+
+% end of listing
+%%Trailer
+%%DocumentFonts: Times-Roman Times-Bold Times-Italic Courier
+%%Pages: <N>								   ***
+
+
+
+4) Example Program
+------------------
+
+include <time.h>
+include <psset.h>
+
+task   pstest        = t_pstest
+
+# PSTEST -- Test the PSIO package.  This test program pretty-prints a file
+# with a header message and page number suitable for output to a printer.
+
+procedure t_pstest()
+
+pointer	ps
+int     fd, ip, op
+char    fname[SZ_FNAME], date[SZ_TIME], line[SZ_LINE], outline[SZ_LINE]
+
+pointer ps_open()
+int     open(), getline()
+long    clktime()
+
+begin
+        # Get the file to format and date string.
+        call clgstr ("filename", fname, SZ_FNAME)
+        call cnvtime (clktime(0), date, SZ_TIME)
+
+        # Open the file.
+        fd = open (fname, READ_ONLY, TEXT_FILE)
+
+        # Initialize the PSIO interface.
+        ps = ps_open (STDOUT, NO)
+        call ps_header (ps, fname, "NOAO/IRAF", date)
+        call ps_footer (ps, "PSIO Test Page", "", "")
+        call ps_write_prolog (ps)
+
+        # Output the text in a fixed-width font.
+        call ps_setfont (ps, F_TELETYPE)
+
+        call ps_linebreak (ps, NO)
+        while (getline (fd, line) != EOF) {
+	
+            if (line[1] == EOS) {
+		# Simple break on a newline.
+                call ps_linebreak (ps, NO)
+
+            } else {
+	        # Detab the line.
+	        ip = 1
+	        op = 1
+                while (line[ip] != EOS && op <= SZ_LINE) {
+                    if (line[ip] == '\t') {
+                        repeat {
+                            outline[op] = ' '
+                            op = op + 1
+                        } until (mod(op,8) == 1)
+                        ip = ip + 1
+                    } else {
+                        outline[op] = line [ip]
+                        ip = ip + 1
+                        op = op + 1
+                    }
+                }
+                outline[op] = EOS
+
+                # Output the line and a newline.
+                call ps_output (ps, outline, NO)            
+                call ps_newline (ps)
+            }
+        }
+
+        # Close the file and PSIO interface.
+        call close (fd)
+        call ps_close (ps)
+end
+
diff --git a/sys/psio/font.com b/sys/psio/font.com
new file mode 100644
index 00000000..30ae823e
--- /dev/null
+++ b/sys/psio/font.com
@@ -0,0 +1,68 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# FONT.COM -- Character width font tables.  Each array contains the width
+# of ASCII chars 32 (space) thru 126 (~) expressed as 10 times the width 
+# in pixels as drawn on a 300dpi page.  This allows us to compute fractional
+# pixels when placing strings.
+#
+# The default font chosen is a 10-point Times-Roman in normal, bold and italic.
+# Other font sizes chosen will be scaled from these values.  Fixed width fonts
+# don't need width tables and are defined in the PSTOOLS.H file.
+
+# Set an alias for the width of a space char so we can change it easily
+# in the package include and not forget about it here.
+define	SW	SPACE_WIDTH
+
+# Declare the width tables.
+int	i
+short	roman[96], bold[96], italic[96]	
+
+
+# Times-Roman 10-point normal.
+data	(roman(i), i= 1, 7)  /  SW,  33,  41,  50,  50,  83,  78/
+data	(roman(i), i= 8,14)  /  33,  33,  33,  50,  56,  25,  33/
+data	(roman(i), i=15,21)  /  25,  28,  50,  50,  50,  50,  50/
+data	(roman(i), i=22,28)  /  50,  50,  50,  50,  50,  28,  28/
+data	(roman(i), i=29,35)  /  56,  56,  56,  44,  92,  72,  67/
+data	(roman(i), i=36,42)  /  67,  72,  61,  56,  72,  72,  33/
+data	(roman(i), i=43,49)  /  39,  72,  61,  89,  72,  72,  56/
+data	(roman(i), i=50,56)  /  72,  67,  56,  61,  72,  72,  94/
+data	(roman(i), i=57,63)  /  72,  72,  61,  33,  28,  33,  47/
+data	(roman(i), i=64,70)  /  50,  33,  44,  50,  44,  50,  44/
+data	(roman(i), i=71,77)  /  33,  50,  50,  28,  28,  50,  28/
+data	(roman(i), i=78,84)  /  78,  50,  50,  50,  50,  33,  39/
+data	(roman(i), i=85,91)  /  28,  50,  50,  72,  50,  50,  44/
+data	(roman(i), i=92,96)  /  48,  20,  48,  54, 0/
+
+# Times-Roman 10-point bold.
+data	(bold(i), i= 1, 7)   /  SW,  33,  56,  50,  50, 100,  83/
+data	(bold(i), i= 8,14)   /  33,  33,  33,  50,  57,  25,  33/
+data	(bold(i), i=15,21)   /  25,  28,  50,  50,  50,  50,  50/
+data	(bold(i), i=22,28)   /  50,  50,  50,  50,  50,  33,  33/
+data	(bold(i), i=29,35)   /  57,  57,  57,  50,  93,  72,  67/
+data	(bold(i), i=36,42)   /  72,  72,  67,  61,  78,  78,  39/
+data	(bold(i), i=43,49)   /  50,  78,  67,  94,  72,  78,  61/
+data	(bold(i), i=50,56)   /  78,  72,  56,  67,  72,  72, 100/
+data	(bold(i), i=57,63)   /  72,  72,  67,  33,  28,  33,  58/
+data	(bold(i), i=64,70)   /  50,  33,  50,  56,  44,  56,  44/
+data	(bold(i), i=71,77)   /  33,  50,  56,  28,  33,  56,  28/
+data	(bold(i), i=78,84)   /  83,  56,  50,  56,  56,  44,  39/
+data	(bold(i), i=85,91)   /  33,  56,  50,  72,  50,  50,  44/
+data	(bold(i), i=92,96)   /  39,  22,  39,  52, 0/
+
+# Times-Roman 10-point italic.
+data	(italic(i), i= 1, 7) /  SW,  33,  42,  50,  50,  83,  78/
+data	(italic(i), i= 8,14) /  33,  33,  33,  50,  68,  25,  33/
+data	(italic(i), i=15,21) /  25,  28,  50,  50,  50,  50,  50/
+data	(italic(i), i=22,28) /  50,  50,  50,  50,  50,  33,  33/
+data	(italic(i), i=29,35) /  68,  68,  68,  50,  92,  61,  61/
+data	(italic(i), i=36,42) /  67,  72,  61,  61,  72,  72,  33/
+data	(italic(i), i=43,49) /  44,  67,  56,  83,  67,  72,  61/
+data	(italic(i), i=50,56) /  72,  61,  50,  56,  72,  61,  83/
+data	(italic(i), i=57,63) /  61,  56,  56,  39,  28,  39,  42/
+data	(italic(i), i=64,70) /  50,  33,  50,  50,  44,  50,  44/
+data	(italic(i), i=71,77) /  28,  50,  50,  28,  28,  44,  28/
+data	(italic(i), i=78,84) /  72,  50,  50,  50,  50,  39,  39/
+data	(italic(i), i=85,91) /  28,  50,  44,  67,  44,  44,  39/
+data	(italic(i), i=92,96) /  40,  27,  40,  54, 0/
+
diff --git a/sys/psio/mkpkg b/sys/psio/mkpkg
new file mode 100644
index 00000000..8c5fa1e8
--- /dev/null
+++ b/sys/psio/mkpkg
@@ -0,0 +1,29 @@
+# Make the PSIO interface library.
+
+$checkout libsys.a lib$
+$update   libsys.a
+$checkin  libsys.a lib$
+$exit
+
+
+zzdebug:
+zzdebug.e:
+        $set    XFLAGS = "$(XFLAGS) -q"
+        $omake  zzdebug.x psio.h <psset.h> <time.h>
+        $link   zzdebug.o -o zzdebug.e
+        ;
+
+libsys.a:
+        psbreak.x       psio.h <psset.h>
+        pscenter.x      psio.h
+        psclose.x       psio.h
+        psdeposit.x     psio.h <ctype.h>
+        psfont.x        psio.h <psset.h>
+        psjustify.x     psio.h
+        psopen.x        psio.h <psset.h>
+        psoutput.x      psio.h <ctype.h> <psset.h>
+        pspos.x 	psio.h
+        psprolog.x      psio.h
+        pssetup.x       psio.h <psset.h>
+        pswidth.x       psio.h font.com <ctype.h> <psset.h>
+	;
diff --git a/sys/psio/psbreak.x b/sys/psio/psbreak.x
new file mode 100644
index 00000000..eb82b541
--- /dev/null
+++ b/sys/psio/psbreak.x
@@ -0,0 +1,80 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <psset.h>
+include "psio.h"
+
+
+# PS_LINEBREAK -- Break the current line regardless of whether it has been
+# filled.  The fill_flag says whether to fill the current line to be right 
+# justified.  May be called to simply output the current line buffer.
+
+procedure ps_linebreak (ps, fill_flag)
+
+pointer	ps					#I PSIO descriptor
+int	fill_flag				#I fill line flag
+
+begin
+	iferr (call ps_output (ps, Memc[PS_WBPTR(ps)], fill_flag))
+	    return
+
+	# Do a variable spacing depending on whether we're within unformatted
+	# text where the font is smaller, or outputting a regular line.
+
+	if (PS_CFONT(ps) == F_TELETYPE)
+            PS_YPOS(ps) = PS_YPOS(ps) - ((LINE_HEIGHT-2) * RESOLUTION)
+	else 
+            PS_YPOS(ps) = PS_YPOS(ps) - (LINE_HEIGHT * RESOLUTION)
+
+	# Check for a page break.
+        if (PS_YPOS(ps) <= PS_PBMARGIN(ps))
+            call ps_pagebreak (ps)
+	else {
+	    call fprintf (PS_FD(ps), "%d V\n")
+	        call pargi (PS_YPOS(ps))
+	}
+
+        # Reset the X position to current left margin.
+        PS_XPOS(ps) = PS_CLMARGIN(ps)
+
+	# Clear the word buffer.
+	call aclrc (Memc[PS_WBPTR(ps)], SZ_LINE)
+end
+
+
+# PS_NEWLINE -- Output a newline (vertical space actually).
+
+procedure ps_newline (ps)
+
+pointer	ps					#I PSIO descriptor
+
+begin
+	# Check for a page break.
+        PS_YPOS(ps) = PS_YPOS(ps) - ((LINE_HEIGHT-4) * RESOLUTION)
+        if (PS_YPOS(ps) <= PS_PBMARGIN(ps))
+            call ps_pagebreak (ps)
+	else {
+	    call fprintf (PS_FD(ps), "%d V\n")
+	        call pargi (PS_YPOS(ps))
+	}
+
+        # Reset the X position to current left margin.
+        PS_XPOS(ps) = PS_CLMARGIN(ps)
+end
+
+
+# PS_PAGEBREAK -- Break the current page regardless of whether it has been
+# filled.
+
+procedure ps_pagebreak (ps)
+
+pointer	ps					#I PSIO descriptor
+
+begin
+	PS_PNUM(ps) = PS_PNUM(ps) + 1
+	call fprintf (PS_FD(ps), "EP\n%%%%Page: %d %d\nBP\n")
+	    call pargi (PS_PNUM(ps))
+	    call pargi (PS_PNUM(ps))
+
+	PS_YPOS(ps) = (PS_PHEIGHT(ps) * RESOLUTION) - PS_PTMARGIN(ps)
+	call ps_ypos (ps, PS_YPOS(ps))
+end
diff --git a/sys/psio/pscenter.x b/sys/psio/pscenter.x
new file mode 100644
index 00000000..818c33cb
--- /dev/null
+++ b/sys/psio/pscenter.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "psio.h"
+
+
+# PS_CENTER -- Center the string on the page and break.
+
+procedure ps_center (ps, str)
+
+pointer	ps					#I PSIO descriptor
+char	str[ARB]				#I text string
+
+int	mtemp, ps_centerPos()
+errchk	ps_centerpos, ps_output
+
+begin
+	mtemp = PS_CLMARGIN(ps)
+	PS_CLMARGIN(ps) = ps_centerpos (ps, str)
+	call ps_output (ps, str, NO)
+	PS_CLMARGIN(ps) = mtemp
+end
+
+
+# PS_CENTERPOS -- Get the X position of the centered string.
+
+int procedure ps_centerpos (ps, str)
+
+pointer	ps					#I PSIO descriptor
+char    str[ARB]                             	#I string to center
+
+int	ps_textwidth()
+errchk	ps_textwidth
+
+begin
+	return (((PS_PWIDTH(ps) * RESOLUTION)/2) - ps_textwidth (ps, str) / 2)
+end
diff --git a/sys/psio/psclose.x b/sys/psio/psclose.x
new file mode 100644
index 00000000..ba0d694e
--- /dev/null
+++ b/sys/psio/psclose.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "psio.h"
+
+
+# PS_CLOSE -- Close the struct and free memory.
+
+procedure ps_close (ps)
+
+pointer	ps					#I PSIO descriptor
+
+errchk	mfree
+
+begin
+	# Write the page trailer.
+	call ps_trailer(ps)
+
+	call mfree (PS_HLE(ps), TY_CHAR)
+	call mfree (PS_HCE(ps), TY_CHAR)
+	call mfree (PS_HRE(ps), TY_CHAR)
+	call mfree (PS_FLE(ps), TY_CHAR)
+	call mfree (PS_FCE(ps), TY_CHAR)
+	call mfree (PS_FRE(ps), TY_CHAR)
+	call mfree (PS_WBPTR(ps), TY_CHAR)
+
+	call mfree (ps, TY_STRUCT)
+end
diff --git a/sys/psio/psdeposit.x b/sys/psio/psdeposit.x
new file mode 100644
index 00000000..a3df3ea9
--- /dev/null
+++ b/sys/psio/psdeposit.x
@@ -0,0 +1,94 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <ctype.h>
+include "psio.h"
+
+
+# PS_DEPOSIT -- Deposit a line of text to the output buffer.  When the output
+# width exceeds the permanent right margin the line us flushed to the output
+# file and the x-position reset to the current left margin, the y-pos is 
+# moved to the next line dependent on the font size.   Remaining words in the
+# line buffer to added to the next line buffer. 
+
+procedure ps_deposit (ps, line)
+
+pointer	ps					#I PSIO descriptor
+char	line[ARB]				#I text line
+
+char	word[SZ_FNAME]
+pointer	wbuf, wp
+int	i, ip, start_ip
+int	len, width, curpos, rmargin
+
+int	strlen(), ps_textwidth(), ps_chwidth()
+errchk	ps_chwidth, ps_textwidth, ps_linebreak
+
+begin
+	# Process the line, collect all the words that will fit on the
+	# line and add to the word buffer.  When the line fills output
+	# it, otherwise fill the buffer.
+
+	wbuf = PS_WBPTR(ps)
+	wp = PS_WBPTR(ps) + strlen (Memc[wbuf])
+	curpos = PS_CLMARGIN(ps) + ps_textwidth (ps, Memc[wbuf])
+	rmargin = PS_CRMPOS(ps)
+	len = strlen (line)
+
+	# Trim trailing whitespace or newlines.
+	for ( ; IS_WHITE(line[len]) || line[len] == '\n'; len=len-1)
+	    line[len] = EOS
+
+	# Take care of any leading whitespace.  Tabs are treated as
+	# spaces, we assume the caller has 'detabbed' the line before
+	# we are called.
+	for (ip=1; IS_WHITE(line[ip]); ip=ip+1)
+	    width = width + ps_chwidth (line[ip], PS_CFONT(ps))
+	if (PS_JUSTIFY(ps) == NO)
+	    curpos = curpos + width
+
+	# Process the rest of the line.
+	for (; ip <= len; ip=ip+1) {
+
+	    # Get the next word on the line and it's length.
+	    start_ip = ip
+	    for (i=1; !IS_WHITE(line[ip]) && line[ip] != EOS; i=i+1) {
+		word[i] = line[ip]
+		ip = ip + 1
+	    }
+	    word[i] = EOS
+	    len = ps_textwidth (ps, word)
+
+	    if (curpos + len > rmargin) {
+		# We would overflow the line so break it here.
+		len = strlen (Memc[wbuf])
+		Memc[wbuf+len-1] = EOS
+		call ps_linebreak (ps, PS_JUSTIFY(ps))
+
+		call aclrc (Memc[wbuf], SZ_FNAME)
+		call strcpy (line[start_ip], Memc[wbuf], SZ_LINE)
+		call strcat (" ", Memc[wbuf], SZ_LINE)
+		return
+
+	    } else {
+		# Copy the word to the buffer and update the position.
+		call strcat (word, Memc[wbuf], SZ_LINE)
+		curpos = curpos + len
+	 	wp = wp + strlen (word)
+	    }
+
+	    # Get the spaces between words.
+	    for (; IS_WHITE(line[ip]) && line[ip] != EOS; ip=ip+1) {
+		curpos = curpos + ps_chwidth (line[ip], PS_CFONT(ps))
+		Memc[wp] = line[ip]
+		wp = wp + 1
+	    }
+
+	    if (line[ip] == EOS)
+		break
+	    else
+	        ip = ip - 1
+	}
+
+	call strcat (" ", Memc[wbuf], SZ_LINE)
+	PS_XPOS(ps) = curpos
+end
diff --git a/sys/psio/psfont.x b/sys/psio/psfont.x
new file mode 100644
index 00000000..ca91b719
--- /dev/null
+++ b/sys/psio/psfont.x
@@ -0,0 +1,145 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include <psset.h>
+include "psio.h"
+
+
+# PS_SETFONT -- Set the font to be used.
+
+procedure ps_setfont (ps, font)
+
+pointer	ps					#I PSIO descriptor
+int	font					#I font type
+
+int	old_font
+char	old_font_ch, ps_fontchar()
+errchk	syserr
+
+begin
+	old_font = PS_CFONT(ps)
+	old_font_ch = PS_CFONT_CH(ps)
+
+	switch (font) {
+	case F_ROMAN:
+	    PS_CFONT(ps) = F_ROMAN
+	    PS_CFONT_CH(ps) = 'R'
+	    call fprintf (PS_FD(ps), "R ")
+	case F_ITALIC:
+	    PS_CFONT(ps) = F_ITALIC
+	    PS_CFONT_CH(ps) = 'I'
+	    call fprintf (PS_FD(ps), "I ")
+	case F_BOLD:
+	    PS_CFONT(ps) = F_BOLD
+	    PS_CFONT_CH(ps) = 'B'
+	    call fprintf (PS_FD(ps), "B ")
+	case F_TELETYPE:
+	    PS_CFONT(ps) = F_TELETYPE
+	    PS_CFONT_CH(ps) = 'T'
+	    call fprintf (PS_FD(ps), "T ")
+	case F_PREVIOUS:
+	    if (PS_SFONT(ps) != NULL) {
+	        call fprintf (PS_FD(ps), "%c ")
+		    call pargc (ps_fontchar (ps, PS_SFONT(ps)))
+	    } else {
+	        call fprintf (PS_FD(ps), "%c ")
+		    call pargc (ps_fontchar (ps, PS_PFONT(ps)))
+	    }
+	default:
+	    call syserr (SYS_PSFONT)
+	}
+
+	PS_PFONT(ps) = old_font
+	PS_PFONT_CH(ps) = old_font_ch
+end
+
+
+# PS_SPFONT -- Set the special font to be used.
+
+procedure ps_spfont (ps, font)
+
+pointer	ps					#I PSIO descriptor
+int	font					#I font type
+
+errchk	syserr
+
+begin
+	if (font == NULL) {
+	    PS_SFONT(ps) = NULL
+	    PS_SFONT_CH(ps) = EOS
+	    call fprintf (PS_FD(ps), "R ")
+	    return
+	}
+
+	switch (font) {
+	case F_ROMAN:
+	    PS_SFONT(ps) = F_ROMAN
+	    PS_SFONT_CH(ps) = 'R'
+	    call fprintf (PS_FD(ps), "R ")
+	case F_ITALIC:
+	    PS_SFONT(ps) = F_ITALIC
+	    PS_SFONT_CH(ps) = 'I'
+	    call fprintf (PS_FD(ps), "I ")
+	case F_BOLD:
+	    PS_SFONT(ps) = F_BOLD
+	    PS_SFONT_CH(ps) = 'B'
+	    call fprintf (PS_FD(ps), "B ")
+	case F_TELETYPE:
+	    PS_SFONT(ps) = F_TELETYPE
+	    PS_SFONT_CH(ps) = 'T'
+	    call fprintf (PS_FD(ps), "T ")
+	default:
+	    call syserr (SYS_PSSPFONT)
+	}
+end
+
+
+# PS_GETFONT -- Given the font character in a "\fN" string return the font
+# type code. 
+
+int procedure ps_getfont (ps, font_char)
+
+pointer	ps					#I PSIO descriptor
+char	font_char				#I font type character
+
+begin
+	switch (font_char) {
+	case 'R':
+	    return (F_ROMAN)
+	case 'B':
+	    return (F_BOLD)
+	case 'I':
+	    return (F_ITALIC)
+	case 'T':
+	    return (F_TELETYPE)
+	case 'P':
+	    return (F_PREVIOUS)
+	default:
+	    return (PS_CFONT(ps))
+	}
+end
+
+
+# PS_FONTCHAR -- Given the font code return the character for it.
+
+char procedure ps_fontchar (ps, font)
+
+pointer	ps					#I PSTIO descriptor
+int	font					#I font type character
+
+begin
+	switch (font) {
+	case F_ROMAN:
+	    return ('R')
+	case F_BOLD:
+	    return ('B')
+	case F_ITALIC:
+	    return ('I')
+	case F_TELETYPE:
+	    return ('T')
+	case F_PREVIOUS:
+	    return ('P')
+	default:
+	    return (PS_CFONT_CH(ps))
+	}
+end
diff --git a/sys/psio/psio.h b/sys/psio/psio.h
new file mode 100644
index 00000000..418b05bc
--- /dev/null
+++ b/sys/psio/psio.h
@@ -0,0 +1,90 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# PSIO.H -- Private definitions for the PSIO interface.
+
+# Page size definitions.
+define  LETTER_WIDTH    612             # resolutions at 72 points (300 dpi)
+define  LETTER_HEIGHT   792
+define  LEGAL_WIDTH     612
+define  LEGAL_HEIGHT    1008
+define  A4_WIDTH        595
+define  A4_HEIGHT       850
+define  B5_WIDTH        524
+define  B5_HEIGHT       765
+
+# Font definitions.
+define  FIXED_WIDTH     54              # width of a courier 9-pt font
+define  SPACE_WIDTH     30              # width of a 10-point space character
+define  FONT_SIZE	10              # default font size (points)
+define  START_CH	32              # width table start character
+define  END_CH		128             # width table end character
+define  LINE_HEIGHT	12              # height of a line (points)
+
+define  RESOLUTION      10              # pixel resolution scale factor
+define  PPI             72              # points-per-inch
+
+# Default margins.
+define  TMARGIN         1.25             # default margins (inches)
+define  BMARGIN         1.0
+define  LMARGIN         1.0
+define  RMARGIN         1.0
+
+
+# The main PSIO data structure.
+define	LEN_PSSTRUCT	45
+define	SZ_WORD		128
+
+define	PS_FD		Memi[$1+00]	# output file descriptor
+define	PS_INITIALIZED	Memi[$1+01]	# prolog written flag
+define	PS_NUMBER	Memi[$1+02]	# number pages?
+define	PS_PNUM		Memi[$1+03]	# current page number
+define	PS_JUSTIFY	Memi[$1+04]	# text justification flag
+
+define	PS_PAGE		Memi[$1+06]	# page size 	    (letter|legal|a4|b5)
+define	PS_PWIDTH	Memi[$1+07]	# page width	    (points)
+define	PS_PHEIGHT	Memi[$1+08]	# page height	    (points)
+define	PS_FONTSZ	Memi[$1+09]	# default font size (points)
+
+define	PS_PLMARGIN	Memi[$1+10]	# perm. L margin    (pixres)
+define	PS_PRMARGIN	Memi[$1+11]	# perm. R margin    (pixres)
+define	PS_PTMARGIN	Memi[$1+12]	# perm. L margin    (pixres)
+define	PS_PBMARGIN	Memi[$1+13]	# perm. R margin    (pixres)
+define	PS_CLMARGIN	Memi[$1+14]	# current L margin  (pixres)
+define	PS_CRMARGIN	Memi[$1+15]	# current R margin  (pixres)
+define	PS_PRMPOS	Memi[$1+16]	# perm R margin pos (pixres)
+define	PS_CRMPOS	Memi[$1+17]	# cur. R margin pos (pixres)
+define	PS_CURPOS	Memi[$1+18]	# current page pos  (pixres)
+
+define	PS_LMARGIN	Memr[P2R($1+20)]# left margin	    (inches)
+define	PS_RMARGIN	Memr[P2R($1+21)]# right margin	    (inches)
+define	PS_TMARGIN	Memr[P2R($1+22)]# top margin	    (inches)
+define	PS_BMARGIN	Memr[P2R($1+23)]# bottom margin	    (inches)
+
+define	PS_HLE		Memi[$1+25]	# header left edge tag str
+define	PS_HCE		Memi[$1+26]	# header center tag str
+define	PS_HRE		Memi[$1+27]	# header right edge tag str
+define	PS_FLE		Memi[$1+28]	# footer left edge tag str
+define	PS_FCE		Memi[$1+29]	# footer center tag str
+define	PS_FRE		Memi[$1+30]	# footer right edge tag str
+
+define	PS_WBPTR	Memi[$1+31]	# word buffer ptr
+
+# Runtime descriptor.
+define  PS_XPOS         Memi[$1+35]     # current page X position
+define  PS_YPOS         Memi[$1+36]     # current page Y position
+define  PS_CFONT        Memi[$1+37]     # current font type
+define  PS_PFONT        Memi[$1+38]     # previous font
+define  PS_SFONT        Memi[$1+39]     # special font (forced)
+define  PS_CFONT_CH     Memi[$1+40]     # current font code char
+define  PS_PFONT_CH     Memi[$1+41]     # special font code char
+define  PS_SFONT_CH     Memi[$1+42]     # special font code char
+define  PS_LINE_WIDTH   Memi[$1+43]     # current allowable line (points)
+
+
+# Utility shorthand macros.
+define	HLEDGE	     Memc[PS_HLE($1)]	# Header tag strings
+define	HCENTER	     Memc[PS_HCE($1)]
+define	HREDGE	     Memc[PS_HRE($1)]
+define	FLEDGE	     Memc[PS_FLE($1)]	# Footer tag strings
+define	FCENTER	     Memc[PS_FCE($1)]
+define	FREDGE	     Memc[PS_FRE($1)]
diff --git a/sys/psio/psjustify.x b/sys/psio/psjustify.x
new file mode 100644
index 00000000..367cc6fe
--- /dev/null
+++ b/sys/psio/psjustify.x
@@ -0,0 +1,48 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "psio.h"
+
+
+# PS_RIGHTJUSTIFY -- Right justfify text on the given string and break.
+
+procedure ps_rightjustify (ps, str)
+
+pointer ps                                      #I PSIO descriptor
+char    str[ARB]                                #I text line
+
+int     mtemp, ps_rjPos()
+errchk	ps_output
+
+begin
+	mtemp = PS_CLMARGIN(ps)
+        PS_CLMARGIN(ps) = ps_rjpos (ps, str)
+	call ps_output (ps, str, NO)
+	PS_CLMARGIN(ps) = mtemp
+end
+
+
+# PS_RJPOS -- Get the X position of the right-justified string.
+
+int procedure ps_rjpos (ps, str)
+
+pointer	ps					#I PSIO descriptor
+char	str[ARB]				#I text to justify
+
+int	ps_textwidth()
+errchk	ps_textwidth
+
+begin
+	return (PS_CRMPOS(ps) - ps_textwidth (ps, str))
+end
+
+
+# PS_SET_JUSTIFY -- Set the justification flag.
+
+procedure ps_setjustify (ps, justify)
+
+pointer	ps					#I PSIO descriptor
+int	justify					#I justificaton flag
+
+begin
+	PS_JUSTIFY(ps) = justify
+end
diff --git a/sys/psio/psopen.x b/sys/psio/psopen.x
new file mode 100644
index 00000000..289fafcc
--- /dev/null
+++ b/sys/psio/psopen.x
@@ -0,0 +1,107 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include <psset.h>
+include "psio.h"
+
+define	PSPAGE_ENV	"pspage"
+
+
+# PS_OPEN -- Initialize the PSTOOLS structure.
+
+pointer procedure ps_open (fd, default_footer)
+
+int	fd					#I output file descriptor
+int	default_footer				#I option flags
+
+pointer	ps
+int	scale
+char	page[SZ_FNAME], version[SZ_FNAME]
+int	envgets()
+bool	streq()
+errchk	calloc, syserr
+
+begin
+	# Allocate the structure.
+	iferr {
+	    call calloc (ps, LEN_PSSTRUCT, TY_STRUCT)
+
+	    call calloc (PS_HLE(ps), SZ_WORD, TY_CHAR)
+	    call calloc (PS_HCE(ps), SZ_WORD, TY_CHAR)
+	    call calloc (PS_HRE(ps), SZ_WORD, TY_CHAR)
+	    call calloc (PS_FLE(ps), SZ_WORD, TY_CHAR)
+	    call calloc (PS_FCE(ps), SZ_WORD, TY_CHAR)
+	    call calloc (PS_FRE(ps), SZ_WORD, TY_CHAR)
+	
+	    call calloc (PS_WBPTR(ps), SZ_LINE, TY_CHAR)
+	} then
+	    call syserr (SYS_PSOPEN)
+
+	# Set the output file descriptor
+	PS_FD(ps) = fd
+
+	# Initialize default values of the struct.
+	call aclrc (page, SZ_FNAME)
+	if (envgets (PSPAGE_ENV, page, SZ_FNAME) != 0) {
+	    call strlwr (page)
+	    if (streq (page, "letter"))
+	        call ps_page_size (ps, PAGE_LETTER)
+	    else if (streq (page, "legal"))
+	        call ps_page_size (ps, PAGE_LEGAL)
+	    else if (streq (page, "a4"))
+	        call ps_page_size (ps, PAGE_A4)
+	    else if (streq (page, "b5"))
+	        call ps_page_size (ps, PAGE_B5)
+	} else
+	    call ps_page_size (ps, PAGE_LETTER)
+
+	PS_FONTSZ(ps)	= FONT_SIZE		# default font size
+	PS_JUSTIFY(ps)	= YES			# justify text?
+
+	# Set the margin values.
+	scale = PPI * RESOLUTION
+	PS_PLMARGIN(ps)	= LMARGIN * scale	# perm. L margin     (points)
+	PS_PRMARGIN(ps)	= RMARGIN * scale	# perm. R margin     (points)
+	PS_PTMARGIN(ps)	= TMARGIN * scale	# perm. T margin     (points)
+	PS_PBMARGIN(ps)	= BMARGIN * scale	# perm. B margin     (points)
+
+	PS_CLMARGIN(ps)	= PS_PLMARGIN(ps)	# current L margin   (points)
+	PS_CRMARGIN(ps)	= PS_PRMARGIN(ps)	# current R margin   (points)
+
+	# Set the right margin in pixel coords.
+	PS_CRMPOS(ps)   = (PS_PWIDTH(ps) * RESOLUTION) - PS_CRMARGIN(ps)
+	PS_PRMPOS(ps)   = PS_CRMPOS(ps)
+	PS_CURPOS(ps)   = PS_PLMARGIN(ps)
+
+	PS_LMARGIN(ps)	= LMARGIN		# page left margin   (inches)
+	PS_RMARGIN(ps)	= RMARGIN		# page right margin  (inches)
+	PS_TMARGIN(ps)	= TMARGIN		# page top margin    (inches)
+	PS_BMARGIN(ps)	= BMARGIN		# page bottom margin (inches)
+
+	PS_XPOS(ps)	= PS_PLMARGIN(ps)
+	PS_YPOS(ps)	= (RESOLUTION * PS_PHEIGHT(ps)) - PS_PTMARGIN(ps)
+
+	PS_CFONT(ps)	= F_ROMAN		# font initializations
+	PS_PFONT(ps)	= F_ROMAN
+	PS_SFONT(ps)	= NULL
+	PS_CFONT_CH(ps)	= 'R'
+	PS_SFONT_CH(ps)	= EOS
+
+	# Compute the width of the line.
+	PS_LINE_WIDTH(ps) = (PS_PWIDTH(ps) * RESOLUTION) - 
+	    PS_PLMARGIN(ps) - PS_PRMARGIN(ps) 
+
+	# Set the footer flags.
+	PS_PNUM(ps) = 1
+	PS_NUMBER(ps) = YES
+	if (default_footer == YES) {
+	    call aclrc (version, SZ_FNAME)
+	    if (envgets ("version", version, SZ_FNAME) != 0)
+		call strcpy (version, FLEDGE(ps), SZ_FNAME)
+	    else
+	        call strcpy ("NOAO/IRAF", FLEDGE(ps), SZ_WORD)
+	    call strcpy (" ", FCENTER(ps), SZ_FNAME)
+	} 
+
+	return (ps)
+end
diff --git a/sys/psio/psoutput.x b/sys/psio/psoutput.x
new file mode 100644
index 00000000..e94cd8c9
--- /dev/null
+++ b/sys/psio/psoutput.x
@@ -0,0 +1,199 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <ctype.h>
+include <psset.h>
+include "psio.h"
+
+
+# PS_OUTPUT -- Output the given line and break, fill if requested.
+
+procedure ps_output (ps, str, fill_flag)
+
+pointer	ps					#I PSIO descriptor
+char	str[ARB]				#I text string to write
+int	fill_flag				#I fill line flag
+
+char	ch, word[SZ_FNAME]
+int	fd, last_nscan, ip, op, curpos
+int	i, spacing, nspaces, nwords, ngaps, twidth, len
+int	ps_textwidth(), strmatch(), strlen()
+errchk	ps_wrtblock, ps_textwidth
+
+define	break_	99
+
+begin
+	# Idiot check.
+	if (str[1] == EOS)
+	    return
+
+	if (PS_INITIALIZED(ps) == NO)
+	    call ps_write_prolog (ps)
+
+	# Initialize.
+	fd = PS_FD(ps)
+	curpos = PS_CLMARGIN(ps)
+	last_nscan = 0
+
+        # Trim trailing whitespace or newlines.
+        len = strlen (str)
+        for ( ; IS_WHITE(str[len]) || str[len] == '\n'; len=len-1)
+            str[len] = EOS
+
+	if (fill_flag == NO && strmatch(str, "\\\\f?") != 0) {
+	    # No font changes or filling, just dump it as one string.
+	    call ps_wrtblock (ps, curpos, str)
+	    return
+	}
+
+	# Get the number of words in the line.
+	nspaces = 0
+	for (ip=1; str[ip] != EOS; ip=ip+1) {
+	    if (IS_WHITE(str[ip]) && !IS_WHITE(str[ip+1]))
+	        nspaces = nspaces + 1
+	}
+	nwords = nspaces + 1
+	ngaps = max (1, nspaces)
+	twidth = ps_textwidth (ps, str)
+
+	# Calculate the inter-word spacing.
+	if (PS_CFONT(ps) == F_TELETYPE)
+	    spacing = FIXED_WIDTH
+	else
+	    spacing = SPACE_WIDTH
+
+	if (fill_flag == YES)
+	    spacing = spacing + (PS_LINE_WIDTH(ps) - twidth) / ngaps
+
+	# Set the base font for the line
+	if (PS_SFONT(ps) != NULL)
+	    ch = PS_SFONT_CH(ps)
+	else
+	    ch = PS_CFONT_CH(ps)
+	call fprintf (fd, "%c\n")
+	    call pargc (ch)
+
+	# Process the words on the line.
+	ip = 1
+	do i = 1, nwords {
+
+	    if (str[ip] == EOS)
+		break
+
+	    # Collect chars up to the end of the word.
+	    for (op=1; str[ip] != EOS && str[ip] != ' '; op=op+1) {
+		word[op] = str[ip]
+		ip = ip + 1
+	    }
+	    word[op] = EOS
+	    twidth = ps_textwidth (ps, word)
+
+	    # if we're filling, force the right-justification of the last
+	    # word to cover for any roundoff in the spacing computation.
+	    if (fill_flag == YES && i == nwords)
+	    	curpos = PS_CRMPOS(ps) - twidth
+
+	    # Write it out, handling font changes.
+	    if (op > 1)
+	        call ps_wrtblock (ps, curpos, word)
+
+	    # Increment the position for the next word.
+	    curpos = curpos + twidth
+
+	    # Increment for the spaces between words.
+	    for ( ; IS_WHITE(str[ip]) && str[ip] != EOS; ip=ip+1)
+	        curpos = curpos + spacing
+	}
+end
+
+
+# PS_WRTBLOCK -- Write a block of text at the given position.  We escape the
+# parenthesis here since they were needed in computing the width.
+
+procedure ps_wrtblock (ps, curpos, str)
+
+pointer	ps					#I PSIO descriptor
+int	curpos					#I X position of text
+char	str[ARB]				#I string to write
+
+char	word[SZ_WORD], line[SZ_LINE]
+int	i, fd, ip, pos, st, en, gstrmatch()
+int	ps_textwidth(), ps_getfont()
+errchk	ps_setfont, ps_textwidth
+
+begin
+	fd = PS_FD(ps)
+
+	call aclrc (word, SZ_WORD)
+	call aclrc (line, SZ_LINE)
+
+	if (gstrmatch (str, "\\\\f?", st, en) == 0) {
+	    # No font changes so just output the word.
+	    call ps_escText (str, line, SZ_LINE)
+	    call fprintf (fd, "%d (%s) S\n")
+		call pargi (curpos)
+		call pargstr (line)
+
+	} else {
+	    # We have a font change.  Collect all chars up to the font change
+	    # and output as an atom.  Change the font, and repeat until we
+	    # use up the string.
+
+	    pos = curpos
+	    i = 1
+	    for (ip=1; str[ip] != EOS; ip=ip+1) {
+		if (str[ip] == '\\' && str[ip+1] == 'f') {
+		    if (word[1] != EOS) {
+			word[i] = EOS
+	    		call ps_esctext (word, line, SZ_LINE)
+	    		call fprintf (fd, "%d (%s) S\n")
+			    call pargi (pos)
+			    call pargstr (line)
+			pos = pos + ps_textwidth (ps, word)
+		    }
+		    iferr (call ps_setfont (ps, ps_getfont(ps, str[ip+2])))
+		        break;
+		    ip = ip + 2
+		    i = 1
+		    word[1] = EOS
+	 	} else {
+		    word[i] = str[ip]
+		    i = i + 1
+		}
+	    }
+ 	    word[i] = EOS
+
+	    if (word[1] != EOS) {
+    		call ps_esctext (word, line, SZ_LINE)
+    		call fprintf (fd, "%d (%s) S\n")
+		    call pargi (pos)
+		    call pargstr (line)
+		pos = pos + ps_textwidth (ps, word)
+	    }
+	}
+end
+
+
+# PS_ESCTEXT -- Escape the parenthesis in a text string.
+
+procedure ps_esctext (in, out, maxch)
+
+char	in[ARB]					#I input text
+char	out[ARB]				#O output text
+int	maxch					#I max characters
+
+int	ip, op
+
+begin
+	ip = 1
+	op = 1
+	while (in[ip] != EOS) {
+	    if (in[ip] == '(' || in[ip] == ')' || in[ip] == '\\') {
+		out[op] = '\\'
+		op = op + 1
+	    }
+	    out[op] = in[ip]
+	    op = op + 1
+	    ip = ip + 1
+	}
+	out[op] = EOS
+end
diff --git a/sys/psio/pspos.x b/sys/psio/pspos.x
new file mode 100644
index 00000000..55a918c1
--- /dev/null
+++ b/sys/psio/pspos.x
@@ -0,0 +1,63 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "psio.h"
+
+
+# PS_XPOS -- Set current X position on page.
+
+procedure ps_xpos (ps, xpos)
+
+pointer	ps					#I PSIO descriptor
+int	xpos					#I position
+
+begin
+	PS_XPOS(ps) = xpos
+	call fprintf (PS_FD(ps), "%d H\n")
+	    call pargi (PS_XPOS(ps))
+end
+
+
+# PS_YPOS -- Set current Y position on page.
+
+procedure ps_ypos (ps, ypos)
+
+pointer	ps					#I PSIO descriptor
+int	ypos					#I position
+
+begin
+	PS_YPOS(ps) = ypos
+	call fprintf (PS_FD(ps), "%d V\n")
+	    call pargi (PS_YPOS(ps))
+end
+
+
+# PS_INDENT -- Set current left margin defined as a number of fixed width
+# characters from the permanent left margin.
+
+procedure ps_indent (ps, nchars)
+
+pointer	ps					#I PSIO descriptor
+int	nchars					#I position
+
+begin
+	PS_CLMARGIN(ps) = PS_PLMARGIN(ps) + max(0,nchars) * FIXED_WIDTH
+	PS_LINE_WIDTH(ps) = (PS_PWIDTH(ps) * RESOLUTION) - 
+                                PS_CLMARGIN(ps) - PS_PRMARGIN(ps) 
+end
+
+
+# PS_TESTPAGE -- Test whether we are within the given number of lines from
+# the bottom of the page, if so break.
+
+procedure ps_testpage (ps, nlines)
+
+pointer	ps					#I PSIO descriptor
+int	nlines					#I position
+
+int	nleft
+
+begin
+	nleft = nlines * LINE_HEIGHT * RESOLUTION
+	if ((PS_YPOS(ps) - PS_PBMARGIN(ps)) < nleft)
+	    call ps_pagebreak (ps)
+end
diff --git a/sys/psio/psprolog.x b/sys/psio/psprolog.x
new file mode 100644
index 00000000..79ed63c1
--- /dev/null
+++ b/sys/psio/psprolog.x
@@ -0,0 +1,189 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "psio.h"
+
+
+# PS_WRITE_PROLOG -- Write the PS prolog given the current postscript struct.
+# This initializes a flag keeping other changes from taking effect once
+# this is called.
+
+procedure ps_write_prolog (ps)
+
+pointer	ps					#I PSIO descriptor
+
+int	fd, sz_font
+char	buf[SZ_LINE]
+
+int	itoc(), ps_centerPos(), ps_rjPos()
+long	clktime()
+
+begin
+	fd = PS_FD(ps)
+	call cnvtime (clktime(long(0)), buf, SZ_LINE)
+
+	# Write the header stuff.
+	call fprintf (fd, "%%!PS-Adobe-1.0\n")
+	call fprintf (fd, "%%%%Creator: IRAF PostScript Translator\n")
+	call fprintf (fd, "%%%%CreationDate: %s\n") 	; call pargstr (buf)
+	call fprintf (fd, "%%%%Pages: (atend)\n")
+	call fprintf (fd, "%%%%DocumentFonts: (atend)\n")
+	call fprintf (fd, "%%%%EndComments\n")
+	call fprintf (fd, "%%%%BeginProlog\n")
+
+
+	# Initialize page values.
+	call fprintf (fd,
+	    "/inch\t{ 72 mul \t} def\t\t\t%% 72 points per inch\n")
+	call fprintf (fd,
+	    "/PL \t{ %d  \t\t} def\t\t\t%% set page height\n")
+	    call pargi (PS_PHEIGHT(ps))
+	call fprintf (fd,
+	    "/FtrY\t{ 20  \t\t} def\t\t\t%% footer Y position\n")
+	call fprintf (fd,
+	    "/HdrY\t{ PL 40 sub  \t} def\t\t\t%% header Y position\n")
+	call fprintf (fd,
+	    "/xOrg\t%d \t   def\t\t\t\t%% left margin (inches)\n")
+	    call pargi (PS_PLMARGIN(ps))
+	call fprintf (fd,
+	    "/yOrg\t%d \t   def\t\t\t\t%% top margin (inches)\n")
+	    call pargi (PS_PTMARGIN(ps))
+	call fprintf (fd,
+	    "/Page\t0 \t   def\t\t\t\t%% page number\n")
+	call fprintf (fd,
+	    "/pnum\t4 string def\t\t\t\t%% sizeof pnum cvs buffer\n")
+	call fprintf (fd,
+	    "/res\t%4.2f\tdef\t\t\t\t%% pixel resolution factor\n")
+	    call pargi (RESOLUTION)
+	call fprintf (fd, "\n")
+
+
+	# Create the font array to be used.
+	sz_font = PS_FONTSZ(ps)
+	call fprintf (fd, "/FS \t{ findfont exch scalefont } bind def ")
+	call fprintf (fd, "\t%% find and scale a font\n")
+	call fprintf (fd, "/Fonts [\t\t\t\t\t%% create an array of fonts\n")
+	call fprintf (fd, "\t%d /Times-Roman FS\n")  ; call pargi (sz_font)
+	call fprintf (fd, "\t%d /Times-Bold FS\n")   ; call pargi (sz_font)
+	call fprintf (fd, "\t%d /Times-Italic FS\n") ; call pargi (sz_font)
+	call fprintf (fd, "\t%d /Courier FS\n")      ; call pargi (sz_font-1)
+	call fprintf (fd, "\t11 /Times-Bold FS\n")   
+	    if (sz_font >= 6 && sz_font <= 10)
+		call pargi (sz_font+2)
+	    else
+		call pargi (sz_font)
+	call fprintf (fd, "] def\n")
+
+	# Set the fonts.
+	call fprintf (fd,
+	    "/SF { setfont       \t} bind def\n")
+	call fprintf (fd,
+	    "/R  { Fonts 0 get SF\t} bind def\t\t%% roman font\n")
+	call fprintf (fd,
+	    "/B  { Fonts 1 get SF\t} bind def\t\t%% bold font\n")
+	call fprintf (fd,
+	    "/I  { Fonts 2 get SF\t} bind def\t\t%% italic font\n")
+	call fprintf (fd,
+	    "/T  { Fonts 3 get SF\t} bind def\t\t%% teletype font\n")
+	call fprintf (fd,
+	    "/HD { Fonts 4 get SF\t} bind def\t\t%% header font\n")
+
+	# Define line motion bindings.
+	call fprintf (fd, "/H  { res div\n")
+	call fprintf (fd, "\tcurrentpoint exch pop\n")
+	call fprintf (fd, "\tmoveto \t\t} def\t\t\t%% horizontal position\n")
+	call fprintf (fd, "/V  { res div\n")
+	call fprintf (fd, "\tcurrentpoint pop exch\n")
+	call fprintf (fd, "\tmoveto \t\t} def\t\t\t%% vertical position\n")
+	call fprintf (fd, "/S  { exch H show\t} bind def\t\t%% show\n")
+
+
+	# Write the page header routine.
+	call fprintf (fd, "/BP {\t\t\t\t\t\t%% Begin page (header).\n")
+	if (HLEDGE(ps) != EOS) {
+	    call fprintf (fd, "\txOrg %d div HdrY moveto B (%s) show\n")
+		call pargi (RESOLUTION)
+		call pargstr (HLEDGE(ps))
+	}
+	if (HCENTER(ps) != EOS) {
+	    call fprintf (fd, "\t%d %d div HdrY moveto B (%s) show\n")
+		call pargi (ps_centerPos(ps, HCENTER(ps)))
+		call pargi (RESOLUTION)
+		call pargstr (HCENTER(ps))
+	}
+	if (HREDGE(ps) != EOS) {
+	    call fprintf (fd, "\t%d %d div HdrY moveto B (%s) show\n")
+		call pargi (ps_rjPos(ps, HREDGE(ps)))
+		call pargi (RESOLUTION)
+		call pargstr (HREDGE(ps))
+	}
+	call fprintf (fd, "\txOrg yOrg moveto\n")
+	call fprintf (fd, "} bind def\n")
+
+
+	# Write the page footer routine.
+	call fprintf (fd, "/EP {\t\t\t\t\t\t%% End page (footer).\n")
+	call fprintf (fd,
+	    "\t/Page Page 1 add def\t\t\t%% increment page number\n")
+	if (FLEDGE(ps) != EOS) {
+	    call fprintf (fd, "\txOrg %d div FtrY moveto R (%s) show\n")
+		call pargi (RESOLUTION)
+		call pargstr (FLEDGE(ps))
+	}
+	if (FCENTER(ps) != EOS) {
+	    call fprintf (fd, "\t%d %d div FtrY moveto R (%s) show\n")
+		call pargi (ps_centerPos(ps, FLEDGE(ps)))
+		call pargi (RESOLUTION)
+		call pargstr (FCENTER(ps))
+	}
+	if (PS_NUMBER(ps) == YES) {
+	    if (itoc (PS_PNUM(ps), buf, SZ_LINE) != 0) {
+		call fprintf (fd,
+		    "\t%d %d div FtrY moveto R Page pnum cvs show\n")
+		    call pargi (ps_rjPos(ps, buf))
+		    call pargi (RESOLUTION)
+	    }
+	} else if (FREDGE(ps) != EOS) {
+	    call fprintf (fd, "\t%d %d div FtrY moveto R (%s) show\n")
+		call pargi (ps_rjPos(ps, FREDGE(ps)))
+		call pargi (RESOLUTION)
+		call pargstr (FREDGE(ps))
+	}
+	call fprintf (fd, "\tshowpage\t\t\t\t%% show the page\n")
+	call fprintf (fd, "} bind def\n")
+
+
+	# Finish the prolog header and flush the output.
+	call fprintf (fd, "%%%%EndProlog\n")
+	call fprintf (fd, "%%%%Page: 1 1\n")
+	call fprintf (fd, "%%----------\n")
+	call fprintf (fd, "initgraphics\n")
+	call fprintf (fd, "R\n")
+	call fprintf (fd, "BP\n")
+	call flush (fd)
+
+	# Set the flag indicating we've written the prolog
+	PS_INITIALIZED(ps) = YES
+end
+
+
+# PS_TRAILER - Write the postscript trailer.
+
+procedure ps_trailer (ps)
+
+pointer	ps					#I PSIO descriptor
+
+int	fd
+
+begin
+	fd = PS_FD(ps)
+
+	call fprintf (fd, "EP\n")
+	call fprintf (fd, "%% end of document\n")
+	call fprintf (fd, "%%%%Trailer\n")
+	call fprintf (fd, "%%%%DocumentFonts: ")
+	call fprintf (fd, "Times-Roman Times-Bold Times-Italic Courier\n")
+	call fprintf (fd, "%%%%Pages: %d\n")
+	    call pargi(PS_PNUM(ps))
+
+	call flush (fd)
+end
diff --git a/sys/psio/pssetup.x b/sys/psio/pssetup.x
new file mode 100644
index 00000000..3afe6644
--- /dev/null
+++ b/sys/psio/pssetup.x
@@ -0,0 +1,132 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <psset.h>
+include "psio.h"
+
+
+# PS_PAGE_SIZE -- Set the page size (letter|legal|a4|b5).
+
+procedure ps_page_size (ps, page)
+
+pointer	ps					#I PSIO descriptor
+int	page					#I page type
+
+begin
+	if (PS_INITIALIZED(ps) == YES)
+	    return
+
+	if (page >= PAGE_LETTER && page <= PAGE_B5) {
+	    switch (page) {
+	    case PAGE_LETTER:
+	        PS_PAGE(ps)    = PAGE_LETTER
+	        PS_PWIDTH(ps)  = LETTER_WIDTH
+	        PS_PHEIGHT(ps) = LETTER_HEIGHT
+	    case PAGE_LEGAL:
+	        PS_PAGE(ps)    = PAGE_LEGAL
+	        PS_PWIDTH(ps)  = LEGAL_WIDTH
+	        PS_PHEIGHT(ps) = LEGAL_HEIGHT
+	    case PAGE_A4:
+	        PS_PAGE(ps)    = PAGE_A4
+	        PS_PWIDTH(ps)  = A4_WIDTH
+	        PS_PHEIGHT(ps) = A4_HEIGHT
+	    case PAGE_B5:
+	        PS_PAGE(ps)    = PAGE_B5
+	        PS_PWIDTH(ps)  = B5_WIDTH
+	        PS_PHEIGHT(ps) = B5_HEIGHT
+	    default:
+	        call eprintf (
+		    "Warning (PSIO): attempt to set illegal page size.")
+	    }
+	}
+end
+
+
+# PS_FONT_SIZE -- Set the default font size to use (default = 10 points).
+
+procedure ps_font_size (ps, font_size)
+
+pointer	ps					#I PSIO descriptor
+int	font_size				#I default font size
+
+begin
+	if (PS_INITIALIZED(ps) == YES)
+	    return
+
+	PS_FONTSZ(ps) = font_size
+end
+
+
+# PS_HEADER -- Set the header tag strings.
+
+procedure ps_header (ps, ledge, center, redge)
+
+pointer	ps					#I PSIO descriptor
+char	ledge[ARB]				#I left edge text
+char	center[ARB]				#I center text
+char	redge[ARB]				#I right edge text
+
+begin
+	if (PS_INITIALIZED(ps) == YES)
+	    return
+
+	if (ledge[1] != EOS)
+	    call strcpy (ledge, HLEDGE(ps), SZ_WORD)
+	if (center[1] != EOS)
+	    call strcpy (center, HCENTER(ps), SZ_WORD)
+	if (redge[1] != EOS)
+	    call strcpy (redge, HREDGE(ps), SZ_WORD)
+end
+
+
+# PS_FOOTER -- Set the footer tag strings.
+
+procedure ps_footer (ps, ledge, center, redge)
+
+pointer	ps					#I PSIO descriptor
+char	ledge[ARB]				#I left edge text
+char	center[ARB]				#I center text
+char	redge[ARB]				#I right edge text
+
+begin
+	if (PS_INITIALIZED(ps) == YES)
+	    return
+
+	if (ledge[1] != EOS)
+	    call strcpy (ledge, FLEDGE(ps), SZ_WORD)
+	if (center[1] != EOS)
+	    call strcpy (center, FCENTER(ps), SZ_WORD)
+	if (redge[1] != EOS) {
+	    call strcpy (redge, FREDGE(ps), SZ_WORD)
+	    PS_NUMBER(ps) = NO
+	}
+end
+
+
+# PS_SETMARGINS -- Set the permanent page margins (in inches).
+
+procedure ps_setmargins (ps, left, right, top, bottom)
+
+pointer	ps					#I PSIO descriptor
+real	left, right, top, bottom		#I margins
+
+int	scale
+
+begin
+	if (PS_INITIALIZED(ps) == YES)
+	    return
+
+	PS_LMARGIN(ps)	= left
+	PS_RMARGIN(ps)	= right
+	PS_TMARGIN(ps)	= top
+	PS_BMARGIN(ps)	= bottom
+
+        # Set the margin values.
+        scale = PPI * RESOLUTION
+        PS_PLMARGIN(ps) = left * scale       	# perm. L margin     (points)
+        PS_PRMARGIN(ps) = right * scale       	# perm. R margin     (points)
+        PS_PTMARGIN(ps) = top * scale       	# perm. T margin     (points)
+        PS_PBMARGIN(ps) = bottom * scale       	# perm. B margin     (points)
+
+        PS_CLMARGIN(ps) = PS_PLMARGIN(ps)       # current L margin   (points)
+        PS_CRMARGIN(ps) = PS_PRMARGIN(ps)       # current R margin   (points)
+end
diff --git a/sys/psio/pswidth.x b/sys/psio/pswidth.x
new file mode 100644
index 00000000..e102f37c
--- /dev/null
+++ b/sys/psio/pswidth.x
@@ -0,0 +1,76 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include <ctype.h>
+include <psset.h>
+include "psio.h"
+
+
+# PS_TEXTWIDTH -- Return the length in PS pixels of the given string.  We 
+# handle font changes here and keep track of the current and previous font.
+
+int procedure ps_textwidth (ps, str)
+
+pointer	ps					#I package pointer
+char	str[ARB]				#I string to check
+
+int	ip, width, f_current
+int	ps_getfont(), ps_chwidth()
+errchk	ps_chwidth
+
+begin
+	# Initialize.
+	width = 0
+	f_current = PS_CFONT(ps)
+
+	# Now process the word, computing the width of each character and
+	# returning the total width.  Handle inline font changes.
+
+	for (ip=1; str[ip] != EOS; ip=ip+1) {
+
+	    # Handle any font changes.
+	    if (str[ip] == '\\' && str[ip+1] == 'f') {
+	        f_current = ps_getfont (ps, str[ip+2])
+	        ip = ip + 2
+	    } else if ((str[ip] == '\\' && str[ip+1] == '(') ||
+	    	       (str[ip] == '\\' && str[ip+1] == ')')) {
+		# Skip over escaped parens in width computation.
+	        ip = ip + 1
+	        width = width + ps_chwidth (str[ip], f_current)
+	    } else
+	        width = width + ps_chwidth (str[ip], f_current)
+	}
+
+	return (width)
+end
+
+
+# PS_CHWIDTH -- Given the font type and a character return the width.
+
+int procedure ps_chwidth (ch, font)
+
+char	ch					#I character
+int	font					#I font type character
+
+errchk	syserr
+include	"font.com"
+
+begin
+	if (ch < START_CH || ch > END_CH)
+	    return (0)
+
+	switch (font) {
+	case F_ROMAN: 	
+	    return (roman[(ch-START_CH+1)])
+	case F_BOLD: 	
+	    return (bold[(ch-START_CH+1)])
+	case F_ITALIC: 	
+	    return (italic[(ch-START_CH+1)])
+	case F_TELETYPE: 	
+	    return (FIXED_WIDTH)
+	case F_PREVIOUS: 	
+	    return (FIXED_WIDTH)
+	default:
+	    call syserr (SYS_PSFONT)
+	}
+end
diff --git a/sys/psio/zzdebug.x b/sys/psio/zzdebug.x
new file mode 100644
index 00000000..97e78aa7
--- /dev/null
+++ b/sys/psio/zzdebug.x
@@ -0,0 +1,77 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <time.h>
+include <psset.h>
+
+
+task   pstest        = t_pstest
+
+# PSTEST -- Test the PSIO package.  This test program pretty-prints a file
+# with a header message and page number suitable for output to a printer.
+
+procedure t_pstest()
+
+pointer	ps
+int     fd, ip, op
+char    fname[SZ_FNAME], date[SZ_TIME], line[SZ_LINE], outline[SZ_LINE]
+
+pointer ps_open()
+int     open(), getline()
+long    clktime()
+errchk	open, close, getline, ps_setfont, ps_open
+
+begin
+        # Get the file to format and date string.
+        call clgstr ("filename", fname, SZ_FNAME)
+        call cnvtime (clktime(0), date, SZ_TIME)
+
+        # Open the file.
+        iferr (fd = open (fname, READ_ONLY, TEXT_FILE))
+	    call error (1, "Error opening file.")
+
+        # Initialize the PSIO interface.
+        iferr (ps = ps_open (STDOUT, NO))
+	    call error (1, "Error opening PSIO interface.")
+        call ps_header (ps, fname, "NOAO/IRAF", date)
+        call ps_footer (ps, "PSIO Test Page", "", "")
+        call ps_write_prolog (ps)
+
+        # Output the text in a fixed-width font.
+        call ps_setfont (ps, F_TELETYPE)
+
+        call ps_linebreak (ps, NO)
+        while (getline (fd, line) != EOF) {
+	
+            if (line[1] == EOS) {
+		# Simply break on a newline.
+                call ps_linebreak (ps, NO)
+
+            } else {
+	        # Detab the line to preserve the spacing.
+	        ip = 1
+	        op = 1
+                while (line[ip] != EOS && op <= SZ_LINE) {
+                    if (line[ip] == '\t') {
+                        repeat {
+                            outline[op] = ' '
+                            op = op + 1
+                        } until (mod(op,8) == 1)
+                        ip = ip + 1
+                    } else {
+                        outline[op] = line [ip]
+                        ip = ip + 1
+                        op = op + 1
+                    }
+                }
+                outline[op] = EOS
+
+                # Output the line and a newline break.
+                call ps_output (ps, outline, NO)            
+                call ps_newline (ps)
+            }
+        }
+        call close (fd) 			# close the file
+
+        # Close the PSIO interface, this writes the PS trailer.
+        call ps_close (ps)
+end