keves@net1.ucsd.edu (Brian Keves) (01/14/88)
Here are the responses I received from my request for a postscript device
driver for S. Thanks very much to all who responded.
The first three responses give information, the last two contain sources.
-----------------
Brian Keves ARPA: keves@sdcsvax.ucsd.edu
P.O. Box 12238 UUCP: sdcsvax!keves
La Jolla, CA 92037-0620 BITNET: keves@ucsd
PHONE: 619-534-3839 Please leave a message
ORGANIZATION: Lab for Mathematics and Statistics @ UCSD
Any opinions expressed are strictly my own and do not necessarily reflect the
opinions of my employer or UC Regents.
---
From alan@cunixc.columbia.edu Mon Jan 11 20:04:11 1988
From: Alan Crosswell <alan@cunixc.columbia.edu>
Subject: Re: Need postscript device driver for S
Newsgroups: sci.math.stat,comp.lang.postscript
Organization: Columbia University
Get a newer S distribution from AT&T. A postscript driver is now included.
Here's the ~s/VERSION file that we have: Fri Feb 28 07:56:08 EST 1986
Alan Crosswell
User Services
Columbia University Center for Computing Activities
---
From uw-beaver!fluke!battan@sdcsvax Wed Jan 13 00:48:37 1988
From: uw-beaver!tc.fluke.COM!battan@sdcsvax (Jim Battan)
Subject: Re: Need postscript device driver for S
Newsgroups: sci.math.stat,comp.lang.postscript
Organization: John Fluke Mfg. Co., Inc., Everett, WA
If no one else offers, I've got one. But I'm quite busy, so choose me as a
last resort.
--
Jim Battan Domain: battan@tc.fluke.COM Voice: +1 206 356 6469
UUCP: {uw-beaver,decvax!microsof,ucbvax!lbl-csam,allegra,sun}!fluke!battan
---
From ucbvax!violet.berkeley.edu!forags@sdcsvax Mon Jan 11 17:50:06 1988
Subject: Re: Need postscript device driver for S
Newsgroups: sci.math.stat,comp.lang.postscript
Organization: University of California, Berkeley
Call Fran Rizzardi at Academic Computing Services at Berkeley.
(415) 642-6406 or ATSS 8-582-6406
I think she mentioned such a driver at a consultants' meeting a couple of
months ago.
Al Stangenberger Dept. of Forestry & Resource Mgt.
forags@violet.berkeley.edu 145 Mulford Hall
uucp: ucbvax!ucbviolet!forags Univ. of California
(415) 642-4424 Berkeley, CA 94720
---
From this point on, I include the two sources that I received. I haven't
had time to figure out which one works the best, but I wanted to include both
because there is quite a bit of useful information in both letters. [BWK]
---
From spector%springer.Berkeley.EDU@Berkeley.EDU Mon Jan 11 16:05:50 1988
From: spector%springer.Berkeley.EDU@berkeley.edu (Philip Spector)
Subject: Postscript Driver for S
Brian -
The following Bourne shell archive should put the postscript
device driver in ~s/slocal/x. It assumes that you have a bunch
of S programs like MAKE, INSTALL,etc., which you probably do.
Just store the program in a file, say, sps and then type
"/bin/sh sps". Let me know if it works.
- Phil
------------------------ cut below this line ---------------------------
if test -f ~s/slocal
then
echo 'slocal should be a directory, not a file'
exit
fi
if test ! -d ~s/slocal
then
echo 'creating slocal directory'
mkdir ~s/slocal
fi
cd ~s/slocal
if test ! -d x
then
echo 'creating x directory in slocal'
fi
if test ! -d postscriptsource
then
mkdir postscriptsource
fi
/bin/sh <<'$$$$$$$$$$'
echo ./postscript.d 1>&2
cat >./postscript.d <<'End of ./postscript.d'
.BG
.FN postscript
.TL
postscript: Device driver for PostScript\(tm printers
.CS
postscript(width, height, horizo, font, ptsize)
.PP
.AG width
Width of plotting region in inches (default is 8 inches)
.AG height
Height of plotting region in inches (default is 10 inches)
.AG horizo
Change to horizontal orientation (default is FALSE)
.AG font
Font number (default is 5 which is Helvetica - see below)
.AG ptsize
Point size for cex = 1 (default is 14 pt.)
.PP
This function identifies the device driver which produces a file of
commands in the PostScript language to produce the plots.
This file is named "PostScript.out" and would usually be sent directly
to the PostScript\(tm printer via a command such as
.PP
lpr -Pps PostScript.out
.PP
Note that `postscript' erases any existing "PostScript.out".
.PP
The available fonts are the standard fonts for a PostScript printer
and are identified by the numbers
.nf
1 Times-Roman
2 Times-Italic
3 Times-Bold
4 Times-BoldItalic
5 Helvetica
6 Helvetica-Oblique
7 Helvetica-Bold
8 Helvetica-BoldOblique
9 Courier
10 Courier-Oblique
11 Courier-Bold
12 Courier-BoldOblique
13 Symbol
.fi
.PP
A device must be specified before any graphics functions can be used.
.KW graphics
.WR
End of ./postscript.d
echo ./postscriptsource/postscript.C 1>&2
cat >./postscriptsource/postscript.C <<'End of ./postscriptsource/postscript.C'
/* S device driver for PostScript printers */
#include <stdio.h>
#include <time.h>
#include <pwd.h>
INCLUDE(device)
char *getenv(), *getlogin (), *ctime (), *user;
long time (), tloc;
struct passwd *getpwuid ();
extern float F77_COM(bgrp)[]; /* graphical parameters */
define(`am',`F77_COM(bgrp)[$1-1]')
/* for ease of writing, F77_COM should be defined for
the C preprocessor rather than the m4 preprocessor */
#define am(i) (bgrp_[i-1])
#define MAXLINES 500
#define Ltype ((int)am(8))
#define Lwidth ((int)am(9))
#define Color ((int)am(10))
#define Font ((int)am(79))
#define Cex (am(18))
#define Srot (am(48))
#define Adjust (am(100))
#define Rxmin ((int)am(22))
#define Rxmax ((int)am(23))
#define Rymin ((int)am(24))
#define Rymax ((int)am(25))
#define Xorigin (am(36))
#define Yorigin (am(38))
#define Xscale (am(37))
#define Yscale (am(39))
#define UxR(x) ((int)((x) * Xscale + Xorigin))
#define UyR(y) ((int)((y) * Yscale + Yorigin))
#define RxU(x) (((x) - Xorigin) / Xscale)
#define RyU(y) (((y) - Yorigin) / Yscale)
#define Xmin ((int)am(32))
#define Xmax ((int)am(33))
#define Ymin ((int)am(34))
#define Ymax ((int)am(35))
#define Max(a,b) ((a)>(b)?(a):(b))
static int moved=0, lines=0, npage=1, clipped = 0;
static int line_type = -1, line_width = -1;
static long current_color = -1;
static int OXmin = 0, OXmax = -1, OYmin = 0, OYmax = -1;
static char *dash_patterns[] = {
"[120 40]",
"[]",
"[10 20]",
"[40 40]",
"[80 40]",
"[130 30]",
"[160 20 20 20]",
"[80 20 20 20]",
"[10 130]",
"[60 50]"
};
static char *fontnames[] = {
"Times-Roman",
"Times-Italic",
"Times-Bold",
"Times-BoldItalic",
"Helvetica",
"Helvetica-Oblique",
"Helvetica-Bold",
"Helvetica-BoldOblique",
"Courier",
"Courier-Oblique",
"Courier-Bold",
"Courier-BoldOblique",
"Symbol"
};
static int widths[] = { 1, 5, 10, 15, 20, 25, 30, 35, 40, 45 };
#define NCOLOR 10.0
#define NLTYPE (sizeof(dash_patterns)/sizeof(dash_patterns[0]))
#define NLWIDTH (sizeof(widths)/sizeof(widths[0]))
#define NFONT (sizeof(fontnames)/sizeof(fontnames[0]))
F77_SUB(zparmz) (par, n)
float par[];
long *n;
{
int i, horizontal, font;
float xmax, ymax;
for (i = 1; i <= 39; i++)
am(i) = 0.0;
am(21) = 10 * par[4]; /* char size in rasters (tenths of a point) */
am(20) = 80 * par[4]/14; /* average width of a character */
if (*n>2 && par[2]) { horizontal = 1; xmax = 11.; ymax = 8.5;}
else { horizontal = 0; xmax=8.5; ymax=11.;}
am(22) = (xmax - par[0]) * 360.0; /* x limits in rasters */
am(23) = (xmax + par[0]) * 360.0;
am(24) = (ymax - par[1]) * 360.0; /* y limits in rasters */
am(25) = (ymax + par[1]) * 360.0;
am(26) = 0.5; /* character offset */
am(27) = 0.5;
am(28) = 1.0 / 720; /* raster size in inches */
am(29) = am(28); /* raster is 1/10 point */
am(30) = -998; /* device code number */
am(31) = 1;
am(1) = 1;
freopen("PostScript.out","w",stdout);
printf("%%!PS-Adobe-1.0\n");
user = getenv ("NAME");
if (user == NULL) user = getlogin ();
if (user == NULL) user = (getpwuid (getuid ())) -> pw_name;
printf ("%%%%Creator: %s\n", user);
tloc = time (0);
printf("%%%%CreationDate: %s", ctime (&tloc));
printf("%%%%Pages: (atend)\n");
printf("%%%%DocumentFonts: Helvetica Symbol\n");
printf("%%%%BoundingBox: %g %g %g %g\n",
am(22)/10, am(24)/10, am(23)/10, am(25))/10;
printf("%%%%EndComments\n");
printf("/$Sdict 25 dict def $Sdict begin\n%% variables\n\n");
printf("/basesize %g def\n", par[4]*10.0);
put_header();
if(horizontal)
printf("90 rotate\n0 %d translate\n",(int) (-ymax*720));
font = par[3];
if (font < 0 || font >= NFONT) font = 4;
printf("/%s F\n", fontnames[font]);
printf("%%%%EndProlog\n");
F77_SUB(zejecz)();
}
F77_SUB(ztextz) (xx, yy, buf, n, pos)
float *xx, *yy, *pos;
char buf[];
int *n;
{
int nn = *n;
if (nn <= 0) {
F77_SUB(zflshz) ();
F77_SUB(zerrpz) ("ztextz","Number of characters not positive",0L,0L);
return;
}
set_pars();
printf("%g %g %g %d %d ", Adjust, Srot, Cex, UxR(*xx), UyR(*yy));
putchar('(');
while(nn--) {
switch(*buf) {
case '(':
case ')':
putchar('\\');
}
putchar(*buf++);
}
printf(") T\n");
moved++;
}
F77_SUB(zpntsz) (xx, yy, n)
float *xx, *yy;
int *n;
{
int nn = *n;
if (nn <= 0) {
F77_SUB(zflshz) ();
F77_SUB(zerrpz) ("zpntsz","Number of points not positive",0L,0L);
return;
}
set_pars();
if (am(15) < 32) { /* draw marks for non-printing ascii */
nn = (long) am(15);
F77_SUB(dmarkz) (xx, yy, n, nn);
return;
}
printf("(%c) %g Pchar\n", (char) am(15), Cex);
while(nn--)
printf("%d %d P\n", UxR(*xx++), UyR(*yy++));
}
F77_SUB(zlinsz) (xx, yy, n)
float *xx, *yy;
int *n;
{
int nn = *n, i;
if (nn < 2) {
F77_SUB(zflshz) ();
F77_SUB(zerrpz) ("zlinsz","Needs at least 2 points",0L,0L);
return;
}
set_pars();
printf("%d %d M\n", UxR(xx[0]), UyR(yy[0]));
for(i = 1; i < nn; i++) {
printf("%d %d L\n", UxR(xx[i]), UyR(yy[i]));
if(i % MAXLINES == 0)
printf("S %d %d M\n", UxR(xx[i]), UyR(yy[i]));
}
printf("S\n");
}
F77_SUB(zpolyz) (xx, yy, n)
float *xx, *yy;
long *n;
{
int nn = *n, i;
if (nn < 3) {
F77_SUB(zflshz) ();
F77_SUB(zerrpz) ("zpolyz","Needs at least 3 points",0L,0L);
return;
}
set_pars();
printf("newpath %d %d M\n", UxR(*xx++), UyR(*yy++));
while(--nn)
printf("%d %d L\n", UxR(*xx++), UyR(*yy++));
printf("closepath fill\n");
}
F77_SUB(zsegsz) (x1, y1, x2, y2, n)
float *x1, *y1, *x2, *y2;
long *n;
{
int nn = *n, i;
if (nn <= 0) {
F77_SUB(zflshz) ();
F77_SUB(zerrpz) ("zsegsz","Number of points must be positive",0L,0L);
return;
}
set_pars();
while(nn--)
printf("%d %d M %d %d L S\n", UxR(*x1++), UyR(*y1++),
UxR(*x2++), UyR(*y2++));
}
F77_SUB(zejecz) ()
{
if (moved) {
if (clipped)
{
printf("grestore\n");
clipped = 0;
}
printf ("gsave showpage grestore\n");
npage++;
}
/* isolate each page */
printf ("%%%%Page: %d %d\n",npage,npage);
moved = 0;
lines = 0;
clipped = 0;
line_type = -1;
line_width = -1;
current_color = -1;
OXmin = 0;
OXmax = -1;
}
F77_SUB(zflshz) ()
{
if (lines) { printf("S\n"); lines = 0; }
fflush (stdout);
}
F77_SUB(zwrapz) ()
{
if (clipped) printf("grestore\n");
printf ("gsave showpage grestore\n");
printf("%%%%Trailer\n%%%%Pages: %d\nend\n",npage);
fflush (stdout);
}
static set_pars()
{
int lwid;
if (Xmin != OXmin || Xmax != OXmax || Ymin != OYmin || Ymax !=
OYmax) /* set clipping region if changed */
{
if (clipped++) printf("grestore\n");
lwid = (widths[Lwidth % NLWIDTH] + 1)/2;
OXmin = Xmin;
OXmax = Xmax;
OYmin = Ymin;
OYmax = Ymax;
printf("gsave newpath\n");
printf(
"%d %d M %d %d L %d %d L %d %d L closepath clip newpath\n",
OXmin-lwid, OYmin-lwid, OXmax+lwid, OYmin-lwid, OXmax+lwid,
OYmax+lwid, OXmin-lwid, OYmax+lwid);
/* reset line type, etc. because of */
/* the gsave */
current_color = line_width = line_type = -1;
};
if (line_type != Ltype) /* set line type if changed */
{
line_type = Ltype;
printf ("%s 0 setdash\n",dash_patterns[line_type % NLTYPE]);
};
if (line_width != Lwidth) /* set line width if changed */
{
line_width = Lwidth;
printf ("%d setlinewidth\n",widths[line_width % NLWIDTH]);
};
if(current_color != Color) /* set color if changed */
{
if(Color == 0)
printf("1.0 setgray\n");
else
printf("%g setgray\n", ((Color-1)%10)/NCOLOR);
current_color = Color;
}
moved++;
}
/* low-level routines for older S */
/* device drivers - should not be */
/* needed */
F77_SUB(zseekz) (ix, iy)
long int *ix, *iy;
{
if (lines) { printf("S\n"); lines = 0; }
set_pars();
printf ("%d %d M\n", *ix, *iy);
}
F77_SUB(zlinez) (ix, iy)
long *ix, *iy;
{
printf ("%d %d L\n", *ix, *iy);
if(++lines > MAXLINES) {
printf ("S\n%d %d M\n", *ix, *iy);
lines = 0;
}
}
F77_SUB(zfillz) ()
{
printf ("fill\n");
}
/* PostScript header definitions */
char *header[] = {
"",
"/oldcex 1 def",
"/cex 1 def",
"/ratio 1 def",
"/pch (*) def",
"/coffset basesize -0.345 mul def % vertical offset for characters",
"/pcxshift 0 def",
"",
"% procedures",
"",
"/checksize % adjust font size if needed. Stack: cex",
" {",
" /cex exch def",
" oldcex cex ne % scale sizes",
" { ",
" /ratio cex oldcex div def",
" /TextFont TextFont ratio scalefont def",
" /PchFont PchFont ratio scalefont def",
" /coffset coffset ratio mul def",
" /oldcex cex def",
" } if",
" } def",
"",
"/Pchar % define the plot character. Stack: string cex",
" {",
" checksize",
" /pch exch def",
" pch (.) eq % replace period by bullet",
" { (\\267) pch copy pop } if",
" pch (,) eq % replace comma by middot",
" { (\\264) pch copy pop } if",
" /PchFont TextFont def",
" pch (*) eq pch (+) eq or % switch to symbol font for these characters",
" { /PchFont /Symbol findfont basesize oldcex mul scalefont def } if",
" PchFont setfont",
" pch stringwidth pop neg 2 div /pcxshift exch def",
" } def",
"",
"/M {moveto} def % move to a point. Stack: x y",
"",
"/L {lineto} def % line to a point. Stack: x y",
"",
"/S {stroke} def",
"",
"/P % plot a character at a point. Stack: x y",
" {",
" M % move to the point",
" pcxshift coffset rmoveto % offset for the character",
" pch show",
" } def",
"",
"/T % show a text string. Stack: adj srot cex x y string",
" { /str exch def",
" M % move to the point (pops x and y)",
" checksize % change size if necessary (pops cex)",
" TextFont setfont",
" dup rotate exch % (moves adj to top)",
" str stringwidth pop neg mul % pops adj",
" coffset rmoveto",
" str show",
" neg rotate",
" } def",
"",
"/Sub %add a subscript. Stack: string srot",
" {",
" oldcex 0.75 mul checksize",
" TextFont setfont",
" dup rotate",
" oldcex -0.5 mul basesize mul 0 exch rmoveto",
" exch show",
" oldcex 0.5 mul basesize mul 0 exch rmoveto",
" neg rotate",
" oldcex 4 3 div mul checksize TextFont setfont",
" } def",
"",
"/Sup %add a superscript. Stack: string srot",
" {",
" oldcex 0.75 mul checksize",
" TextFont setfont",
" dup rotate",
" oldcex 0.5 mul basesize mul 0 exch rmoveto",
" exch show",
" oldcex -0.5 mul basesize mul 0 exch rmoveto",
" neg rotate",
" oldcex 4 3 div mul checksize TextFont setfont",
" } def",
"",
"/F % change the base font. Stack: fontname",
" {",
" /TextFont exch findfont basesize oldcex mul scalefont def",
" /PchFont TextFont def",
" } def",
"",
"/ST % text in Symbol font. Stack: (as for T)",
" {",
" /Symbol F T /Helvetica F",
" } def",
"",
"0.1 0.1 scale %integer coordinates in 1/10's of a point",
"1 setlinecap 1 setlinejoin",
0
};
static put_header()
{
char **p;
for (p = header; *p; p++)
printf("%s\n", *p);
}
/* Routine needed for the link using */
/* the old libraries */
f77_abort ()
{
abort();
}
End of ./postscriptsource/postscript.C
echo ./postscript.i 1>&2
cat >./postscript.i <<'End of ./postscript.i'
# PostScript device driver function
FUNCTION postscript(
width /REAL,1,7.5/
height /REAL,1,10.0/
horizo /LGL,1,FALSE/
font /INT,1,5/
ptsize /REAL,1,14.0/
)
STATIC(logical streq)
STRUCTURE(parms/REAL,5/) # w,h,vertical
if(streq(TEXT(FNAME),TSTRING(postscripth))|| horizo){
horizo = TRUE
if(MISSING(width)) width=10
else if (width > 11) FATAL(Width cannot exceed 11 inches)
if(MISSING(height)) height=7.5
else if (height > 8.5) FATAL(Height cannot exceed 8.5 inches)
}
else {
if (width > 8.5) FATAL(Width cannot exceed 8.5 inches)
if (height > 11) FATAL(Height cannot exceed 11 inches)
}
parms[1] = width
parms[2] = height
if(horizo) parms[3]=1; else parms[3]=0
parms[4] = font - 1
parms[5] = ptsize
DEVICE_DRIVER
RETURN(parms)
END
End of ./postscript.i
echo appending ./Smakefile 1>&2
cat >>./Smakefile <<'End of ./Smakefile'
i.postscript.C: ; echo 'INCLUDE(u/cinter)CINTER(postscript,-d)' >i.postscript.C
postscript: i.postscript.o postscript.x # -d
$(F77) $(LDFLAGS) $(STRIP) -o x/postscript i.postscript.o postscript.x $(LIBR)
@touch postscript
@echo postscript loaded
dev.postscript:
cd postscriptsource; S COMPILEALL
$(F77) $(LDFLAGS) $(STRIP) -o x/dev.postscript $L/device.z $L/defer.z postscriptsource/*.o $(GRZLIB)
@echo postscript driver loaded
End of ./Smakefile
$$$$$$$$$$
S MAKE postscript
S MAKE dev.postscript
S NEWDOC postscript.d
---
From bill%hilbert.ms@beaver.cs.washington.edu Mon Jan 11 18:28:50 1988
From: bill%hilbert.ms@beaver.cs.washington.edu (Bill Dunlap)
Subject: postscript graphics
Brian -- Here is the postscript driver we use. It is called "pscript".
I think it originally came from Wisconsin (several years ago) and I've made
some modifications to it over the years.
I recently wrote a new version of the basic graphics driver which
is able to generate a PostScript file corresponding to what is on your
screen. Thus if you are using the vt240 driver and have a picture on
the screen, you type "printgraph" and a PostScript description of the
picture is generated and sent to the printer. This is not a screen dump;
the PostScript is generated from a display list. I'll be glad to send it
but it includes a fair bit of S source code so I would need to see
a liscence first. It is basically two libraries to replace $L/inddev.z
and $L/device.z and the commands "printgraph" and "replot". I use
it with vt240, crt (a curses based graphics driver for nongraphics
terminals), and tek10.
Well here is the pscript stuff. Clip at the dotted line and
put the resulting file in ~s/slocal/pscript.shar. Then:
cd ~s/slocal
sh pscript.shar
cd pscript
S MAKE all.
and you should be done. S MAKE clean will tidy things up. Use
S MAKE virgin if you want to delete any machine dependent stuff.
---------------------------------------------------------------
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create:
# pscript
# This archive created: Mon Jan 11 17:36:35 1988
export PATH; PATH=/bin:/usr/bin:$PATH
if test ! -d 'pscript'
then
mkdir 'pscript'
fi
cd 'pscript'
if test ! -d 'pscriptsource'
then
mkdir 'pscriptsource'
fi
cd 'pscriptsource'
if test -f 'pscplot.C'
then
echo shar: "will not over-write existing file 'pscplot.C'"
else
cat << \SHAR_EOF > 'pscplot.C'
/* S device driver for PostScript printers */
#include <stdio.h>
#include <strings.h>
extern float F77_COM(bgrp)[];/* graphical parameters */
define(`am',`F77_COM(bgrp)[$1-1]')
int moved=0; /* 1 if plot has anything on it */
int num_since_stroke=0; /* protect against current path getting too long */
int max_since_stroke=500; /* can be about 1500, I think, but let's be safe */
char *dash_patterns[] = {
"[10 20 30 40 50 60]", /* 10 */
"[]", /* 1 */
"[10 20]", /* 2 */
"[80 30 10 30]", /* 3 */
"[130 30]", /* 4 */
"[130 20 8 20 8 20 8 20]", /* 5 */
"[160 20 20 20]", /* 6 */
"[5 20 5 20 5 20 5 50]", /* 7 */
"[40 40]", /* 8 */
"[60 20 5 20]" /* 9 */
};
int widths[] = { 1, 5, 10, 15, 20, 25 };
F77_SUB(zparmz) (par, n)
float par[];
long *n;
{
int i;
FILE *fp, *fopen();
char c;
for (i = 1; i <= 39; i++)
am(i) = 0.0;
am(20) = 80.0; /* char size in rasters (tenths of a
point) */
am(21) = 140.0;
if (par[2]==0) { /* vertical plot */
am(22) = (8.5 - *par) * 360.0; /* x limits in rasters */
am(23) = (8.5 + *par) * 360.0;
am(24) = (11.0 - par[1]) * 360.0; /* y limits in rasters */
am(25) = (11.0 + par[1]) * 360.0;
} else {
am(22) = (11.0 - *par) * 360.0; /* x limits in rasters */
am(23) = (11.0 + *par) * 360.0;
am(24) = (8.5 - par[1]) * 360.0; /* y limits in rasters */
am(25) = (8.5 + par[1]) * 360.0;
}
am(26) = 0.5; /* character offset */
am(27) = 0.5;
am(28) = 1.0 / 720; /* raster size in inches - raster is 1/10
point */
am(29) = am(28);
am(30) = -423; /* device code number - a magic number
(same as `pic' device) to allow
batch use */
am(31) = 1;
am(1) = 1;
freopen("PostScript.out", "a", stdout) ;
printf ("%%! PostScript from S\n");/* initialize device */
print_prolog() ;
if (par[2]) { /* horizontal plot */
printf("90 rotate\n");
printf("0 -6120 translate\n");
}
F77_SUB(zejecz) ();
}
F77_SUB(zseekz) (ix, iy)
long int *ix,
*iy;
{
static float line_type = -1,
line_width = -1;
moved++;
if (line_type != am(8)) { /* set line type if changed */
line_type = am(8);
printf ("%s 0 setdash\n",dash_patterns[((int) line_type) % 10]);
};
if (line_width != am(10)) { /* set line width if changed */
line_width = am(10);
printf ("%d setlinewidth\n",widths[((int) line_width) % 5]);
};
printf ("%d %d M\n", *ix, *iy);
}
F77_SUB(zlinez) (ix, iy)
long int *ix,
*iy;
{
printf ("%d %d L\n", *ix, *iy);
/* get "limitcheck" error if path is too long */
/* stroke and start new path occasionaly */
num_since_stroke++;
if (num_since_stroke >= max_since_stroke) {
printf("stroke %% to avoid limitcheck\n%d %d M\n", *ix, *iy);
num_since_stroke = 0;
}
}
F77_SUB(zptchz) (ich, crot)
char *ich;
float *crot;
{
if (*ich == '*') {
printf ("(\\267) %g Schar\n", am(18)/am(89) );/* print the character */
} else {
printf ("(%c) %g Schar\n", *ich,am(18)/am(89) );/* print the character */
}
}
F77_SUB(zejecz) () {
if (moved)
printf ("copypage erasepage %% end of one plot\n");
}
F77_SUB(zflshz) () {
if (num_since_stroke>0)
printf ("stroke\n");
num_since_stroke = 0;
fflush (stdout);
}
F77_SUB(zwrapz) () {
printf ("showpage %% end of all S plots\n");
fflush (stdout);
}
F77_SUB(ztextz) (xx, yy, buf, n, pos, m)
float *xx, *yy, *pos;
char buf[];
int *n, m;
{
int i;
if (*n <= 0) {
F77_SUB(zejecz) ();
F77_SUB(zerrpz) ("ztextz","Number of characters not positive",6);
}
putchar('(');
for (i = *n; i--; buf++) {
switch (*buf) {
case '(':
case ')':
putchar('\\');
}
putchar(*buf);
}
printf ("\) %g %g %g %g %g Stext\n", *xx * am(37) + am(36),
*yy * am(39) + am(38), am(18)/am(89), am(48), *pos);
moved++;
}
SHAR_EOF
fi
if test -f 'zpolyz.C'
then
echo shar: "will not over-write existing file 'zpolyz.C'"
else
cat << \SHAR_EOF > 'zpolyz.C'
/* zpolyz - filled polygon with n vertices at user coordinates x,y */
#include <stdio.h>
extern float F77_COM(bgrp)[];
F77_SUB(zpolyz)(x, y, n)
float *x, *y;
long *n;
{
long *ix, *iy;
int i, j;
float col;
char *calloc();
i = *n;
ix = (long*) calloc(i, sizeof(long));
iy = (long*) calloc(i, sizeof(long));
for (j=0;j<i;j++) {
ix[j] = F77_COM(bgrp)[35] + F77_COM(bgrp)[36]*x[j] + 0.5;
iy[j] = F77_COM(bgrp)[37] + F77_COM(bgrp)[38]*y[j] + 0.5;
}
/* draw the polygon */
printf("newpath\n");
printf("%d %d moveto\n", ix[0], iy[0]);
for (j=1;j<i;j++)
printf("%d %d lineto\n", ix[j], iy[j]);
printf("closepath\n");
/* set color for fill (actually pattern) */
/* col is gray scale, 0 is black, 1 is white(==invisible) */
/* users idea of color is integer between 1 and 6 */
col = (float)(F77_COM(bgrp)[9]-1) / 6.0;
col = col<0.0 ? -col : col;
col = col>=1.0 ? .98 : col;
printf("%f setgray\n", col);
/* fill in polygon */
printf("fill\n");
/* reset color to black */
printf("0.0 setgray\n");
/* fill in polygon */
/* free up allocated space */
free(iy) ; free(ix) ;
}
SHAR_EOF
fi
if test -f 'print_prolog.c'
then
echo shar: "will not over-write existing file 'print_prolog.c'"
else
cat << \SHAR_EOF > 'print_prolog.c'
#include <stdio.h>
print_prolog()
{
fprintf(stdout, "/M {moveto} def\n") ;
fprintf(stdout, "/L {lineto} def\n") ;
fprintf(stdout, "/oldcex 1 def\n") ;
fprintf(stdout, "/coffset 140 0.375 mul def\n") ;
fprintf(stdout, "/Stext\n") ;
fprintf(stdout, " { /pos exch def\n") ;
fprintf(stdout, " /srot exch def\n") ;
fprintf(stdout, " /cex exch def\n") ;
fprintf(stdout, " /ypos exch def\n") ;
fprintf(stdout, " /xpos exch def\n") ;
fprintf(stdout, " /str exch def\n") ;
fprintf(stdout, " \n") ;
fprintf(stdout, " xpos ypos moveto\n") ;
fprintf(stdout, " oldcex cex ne\n") ;
fprintf(stdout, " { currentfont cex oldcex div scalefont setfont\n") ;
fprintf(stdout, " /coffset coffset cex oldcex div mul store\n") ;
fprintf(stdout, " /oldcex cex store\n") ;
fprintf(stdout, " } if\n") ;
fprintf(stdout, " gsave\n") ;
fprintf(stdout, " srot rotate\n") ;
fprintf(stdout, " str stringwidth pop neg\n") ;
fprintf(stdout, " pos 0.5 eq\n") ;
fprintf(stdout, " { 2 div }\n") ;
fprintf(stdout, " { pos 0.5 lt\n") ;
fprintf(stdout, " { pop 0 }\n") ;
fprintf(stdout, " if }\n") ;
fprintf(stdout, " ifelse\n") ;
fprintf(stdout, " coffset neg rmoveto\n") ;
fprintf(stdout, " str show\n") ;
fprintf(stdout, " grestore\n") ;
fprintf(stdout, " } store\n") ;
fprintf(stdout, "/Schar\n") ;
fprintf(stdout, " { /cex exch def\n") ;
fprintf(stdout, " /str exch def\n") ;
fprintf(stdout, " oldcex cex ne\n") ;
fprintf(stdout, " { currentfont cex oldcex div scalefont setfont\n") ;
fprintf(stdout, " /coffset coffset cex oldcex div mul store\n") ;
fprintf(stdout, " /oldcex cex store\n") ;
fprintf(stdout, " } if\n") ;
fprintf(stdout, " str stringwidth pop neg 2 div coffset neg rmoveto\n") ;
fprintf(stdout, " str show\n") ;
fprintf(stdout, " } store\n") ;
fprintf(stdout, "0.1 0.1 scale %% this version uses integer coordinates at 1/10's of a point\n") ;
fprintf(stdout, "1 setlinecap 1 setlinejoin\n") ;
fprintf(stdout, "/Helvetica findfont 140 scalefont setfont %% default font is 14 pt. Helvetica\n") ;
fprintf(stdout, "/oldcex 1 def\n") ;
fprintf(stdout, "/coffset 140 0.375 mul def\n") ;
fprintf(stdout, "%% end of S header\n") ;
}
SHAR_EOF
fi
cd ..
if test -f 'pscript.d'
then
echo shar: "will not over-write existing file 'pscript.d'"
else
cat << \SHAR_EOF > 'pscript.d'
.BG
.FN pscript
.TL
pscript: Device driver for PostScript\(tm printers
.CS
pscript(width, height, horizo)
.PP
.AG width
Width of plotting region in inches - defaults to 10 if horizo=T, 8 otherwise.
.AG height
Height of plotting region in inches - defaults to 8 is horizo=T, 10 otherwise.
.AG horizo
If TRUE (the default),
the x axis lies along the long side of the paper (a.k.a. "landscape" mode);
if FALSE, the long side is vertical (a.k.a. "portrait" mode).
(The width and height variables refer to the x and y axis directions,
respectively.)
.PP
This function identifies the device driver which produces a file of
commands in the PostScript\(tm language to produce the plots.
This file is named "PostScript.out" and would usually be sent directly
to the PostScript\(tm printer via a command such as
.PP
lpr -Pstat PostScript.out
.PP
Note that `pscript' appends to the file "PostScript.out" so it is a good
idea to remove it after you have printed it.
A device must be specified before any graphics functions can be used.
.EX
% S
> pscript
> plot(hstart)
> q # exit from S
% lpr -Pstat -r PostScript.out
This last line is specific to Berkeley (BSD) Unix systems. The -Pstat
means to send the file to the printer called "stat"; it must be a PostScript
printer such as the Apple LaserWriter. You must exit S before printing
the file; you cannot simply escape to the shell and print it because
a trailer must be put at the end of the file to make it work.
.KW graphics
.WR
SHAR_EOF
fi
if test -f 'pscript.i'
then
echo shar: "will not over-write existing file 'pscript.i'"
else
cat << \SHAR_EOF > 'pscript.i'
# PostScript device driver function
FUNCTION pscript(
width /REAL,1,7.5/
height /REAL,1,10.0/
horizo /LGL,1,TRUE/
)
STATIC(logical streq)
STRUCTURE(parms/REAL,3/) # w,h,vertical
if(streq(TEXT(FNAME),TSTRING(pscripth))|| horizo){
horizo = TRUE
if(MISSING(width)) width=10
else if (width > 11) FATAL(Width cannot exceed 11 inches)
if(MISSING(height)) height=7.5
else if (height > 8.5) FATAL(Height cannot exceed 8.5 inches)
}
else {
if (width > 8.5) FATAL(Width cannot exceed 8.5 inches)
if (height > 11) FATAL(Height cannot exceed 11 inches)
}
parms[1] = width
parms[2] = height
if(horizo) parms[3]=1; else parms[3]=0
DEVICE_DRIVER
RETURN(parms)
END
SHAR_EOF
fi
if test ! -d 'x'
then
mkdir 'x'
fi
cd 'x'
cd ..
if test ! -d '.help'
then
mkdir '.help'
fi
cd '.help'
cd ..
if test -f 'Smakefile'
then
echo shar: "will not over-write existing file 'Smakefile'"
else
cat << \SHAR_EOF > 'Smakefile'
#Used by S MAKE utility
DEST=..
all : pscript dev.pscript help
help :
cp pscript.d $(DEST)/.help/pscript
clean :
rm -f *.o i.*.C *.x
rm -f pscriptsource/*.o
virgin : clean
rm -f pscript
rm -fr sdata swork sdump sedit
rm -f x/*
i.pscript.C: ; echo 'INCLUDE(u/cinter)CINTER(pscript,-d)' >i.pscript.C
pscript: i.pscript.o pscript.x # -d
$(F77) $(LDFLAGS) $(STRIP) -o $(DEST)/x/pscript i.pscript.o pscript.x $(LIBR)
@touch pscript
@echo pscript loaded
dev.pscript:
cd pscriptsource; S COMPILEALL
$(F77) $(LDFLAGS) $(STRIP) -o $(DEST)/x/dev.pscript $L/device.z $L/defer.z pscriptsource/*.o $(GRZLIB)
@echo pscript driver loaded
SHAR_EOF
fi
cd ..
exit 0
# End of shell archive
-----------------
Brian Keves ARPA: keves@sdcsvax.ucsd.edu
P.O. Box 12238 UUCP: sdcsvax!keves
La Jolla, CA 92037-0620 BITNET: keves@ucsd