diff options
Diffstat (limited to 'sys/psio')
| -rw-r--r-- | sys/psio/README | 339 | ||||
| -rw-r--r-- | sys/psio/font.com | 68 | ||||
| -rw-r--r-- | sys/psio/mkpkg | 29 | ||||
| -rw-r--r-- | sys/psio/psbreak.x | 80 | ||||
| -rw-r--r-- | sys/psio/pscenter.x | 36 | ||||
| -rw-r--r-- | sys/psio/psclose.x | 27 | ||||
| -rw-r--r-- | sys/psio/psdeposit.x | 94 | ||||
| -rw-r--r-- | sys/psio/psfont.x | 145 | ||||
| -rw-r--r-- | sys/psio/psio.h | 90 | ||||
| -rw-r--r-- | sys/psio/psjustify.x | 48 | ||||
| -rw-r--r-- | sys/psio/psopen.x | 107 | ||||
| -rw-r--r-- | sys/psio/psoutput.x | 199 | ||||
| -rw-r--r-- | sys/psio/pspos.x | 63 | ||||
| -rw-r--r-- | sys/psio/psprolog.x | 189 | ||||
| -rw-r--r-- | sys/psio/pssetup.x | 132 | ||||
| -rw-r--r-- | sys/psio/pswidth.x | 76 | ||||
| -rw-r--r-- | sys/psio/zzdebug.x | 77 |
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 |