Mathematica 9 is now available
Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
1989
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 1989

[Date Index] [Thread Index] [Author Index]

Search the Archive

Mathematica Postscript Macros

  • Subject: Mathematica Postscript Macros
  • From: dhj at rice.edu
  • Date: Mon, 19 Jun 89 12:31:49 -0500
  • Apparently-to: mathgroup-out at yoda.ncsa.uiuc.edu

The PostScript file can be intercepted on its way to the printer on any
Macintosh. When you print, you acknowledge the dialog box which says what
printer you are accessing, the number of copies, etc. Now comes the new
part: after clicking OK, hold down command-f. Rather than messages appearing
about searching for printer, starting job, etc., you obtain the message
"Creating PostScript File". Nothing is printed, but a file is created in the
directory from which Mathematica was launched named PostScript0. This file
is pure text and contains Mathematica's macro definitions and the description
of what you wanted to print. By the way, this procedure will NOT work if you
are running under MultiFinder and are using the PrintMonitor.
	For those who find this inconvenient or don't have a Mac, here is
what my version of Mathematica has for its PostScript macro definitions.

	Don H. Johnson
	Elec. & Comp. Eng. Dept.
	Rice University
        dhj at rice.edu


/Mnodistort true def
/Mpstart {
    MathPictureStart
} bind def
/Mpend {
    MathPictureEnd
} bind def
/Mscale {
    0 1 0 1
    5 -1 roll
    MathScale
} bind def
/Plain
	/Courier findfont
def
/Bold
	/Courier-Bold findfont
def
/Italic
	/Courier-Oblique findfont
def
/MathPictureStart {
	gsave
	newpath
	Mleft
	Mbottom
	translate
	1 -1 scale
	/Mtmatrix
	matrix currentmatrix
	def
	Plain
	Mfontsize scalefont
	setfont
0 setgray 0 setlinewidth
} bind def
/MathPictureEnd {
	grestore
} bind def
/Mdot {
	moveto
	0 0 rlineto
	stroke
} bind def
/Mtetra {
	moveto
	lineto
	lineto
	lineto
	fill
} bind def
/Metetra {
	moveto
	lineto
	lineto
	lineto
	closepath
	gsave
	fill
	grestore
	0 setgray
	stroke
} bind def
/Mistroke {
	flattenpath
	0 0 0
	{
	4 2 roll
	pop pop
	}
	{
	4 -1 roll
	2 index
	sub dup mul
	4 -1 roll
	2 index
	sub dup mul
	add sqrt
	4 -1 roll
	add
	3 1 roll
	}
	{
	stop
	}
	{
	stop
	}
	pathforall
	pop pop
	currentpoint
	stroke
	moveto
	currentdash
	3 -1 roll
	add
	setdash
} bind def
/Mfstroke {
	stroke
	currentdash
	pop 0
	setdash
} bind def
/Msboxa {
	newpath
	5 -1 roll
	Mvboxa
	pop
	6 -1 roll
	5 -1 roll
	4 -1 roll
	Msboxa1
	5 -3 roll
	Msboxa1
	[
	7 -2 roll
	[ 2 index 2 index
	10 -1 roll
	9 -1 roll
	]
	6 1 roll
	5 -2 roll
	]
} bind def
	
/Msboxa1 {
	sub
	2 div
	dup
	2 index
	1 add
	mul
	3 -1 roll
	-1 add
	3 -1 roll
	mul
} bind def
/Mvboxa {
	gsave
	newpath
	[ true
	3 -1 roll
	{
	Mbbox
	5 -1 roll
	{
	0
	5 1 roll
	}
	{
	7 -1 roll
	exch sub
	(m) stringwidth pop
	.3 mul
	sub
	7 1 roll
	6 -1 roll
	4 -1 roll
	Mmin
	3 -1 roll
	5 index
	add
	5 -1 roll
	4 -1 roll
	Mmax
	4 -1 roll
	}
	ifelse
	false
	}
	forall
	{ stop } if
	counttomark
	1 add
	4 roll
	]
	grestore
} bind def
/Mbbox {
	0 0 moveto
	false charpath
	flattenpath
	pathbbox
	newpath
} bind def
/Mmin {
	2 copy
	gt
	{ exch } if
	pop
} bind def
/Mmax {
	2 copy
	lt
	{ exch } if
	popSERT \  
} bind def
/Mshowa {
	4 -2 roll
	moveto
	2 index
	Mtmatrix setmatrix
	Mvboxa
	7 1 roll
	6 -1 roll
	5 -1 roll
	4 -1 roll
	Mshowa1
	4 1 roll
	Mshowa1
	rmoveto
	currentpoint
	0 1
	4 index length
	-1 add
	{
	2 index
	4 index
	2 index
	get
	3 index
	add
	moveto
	4 index
	exch get
	show
	} for
	pop pop pop pop
	Mgmatrix setmatrix
} bind def
/Mshowa1 {
	2 copy
	add
	4 1 roll
	sub
	mul
	sub
	-2 div
} bind def
/MathScale {
	Mwidth
	Mheight
	Mlp
	translate
	scale
	pop pop pop pop
	/Mgmatrix
	matrix currentmatrix
	def
} bind def
/Mlp {
	3 copy
	Mlpfirst
	{
	Mnodistort
	{
	Mmin
	dup
	} if
	4 index
	2 index
	2 index
	Mlprun
	11 index
	11 -1 roll
	10 -4 roll
	Mlp1
	8 index
	9 -5 roll
	Mlp1
	4 -1 roll
	and
	{ exit } if
	3 -1 roll
	pop pop
	} loop
	exch
	3 1 roll
	7 -3 roll
	pop pop pop
} bind def
/Mlpfirst {
	3 -1 roll
	dup length
	2 copy
	-2 add
	get
	aload
	pop pop pop
	4 -2 roll
	-1 add
	get
	aload
	pop pop pop
	6 -1 roll
	3 -1 roll
	5 -1 roll
	sub
	div
	4 1 roll
	exch sub
	div
} bind def
/Mlprun {
	2 copy
	4 index
	0 get
	dup
	4 1 roll
	Mlprun1
	3 copy
	8 -2 roll
	9 -1 roll
	{
	3 copy
	Mlprun1
	3 copy
	11 -3 roll
	/gt Mlpminmax
	8 3 roll
	11 -3 roll
	/lt Mlpminmax
	8 3 roll
	} forall
	pop pop pop pop
	3 1 roll
	pop pop
	aload pop
	5 -1 roll
	aload pop
	exch
	6 -1 roll
	Mlprun2
	8 2 roll
	4 -1 roll
	Mlprun2
	6 2 roll
	3 -1 roll
	Mlprun2
	4 2 roll
	exch
	Mlprun2
	6 2 roll
} bind def
/Mlprun1 {
	aload pop
	exch
	6 -1 roll
	5 -1 roll
	mul add
	4 -2 roll
	mul
	3 -1 roll
	add
} bind def
/Mlprun2 {
	2 copy
	add 2 div
	3 1 roll
	exch sub
} bind def
/Mlpminmax {
	cvx
	2 index
	6 index
	2 index
	exec
	{
	7 -3 roll
	4 -1 roll
	} if
	1 index
	5 index
	3 -1 roll
	exec
	{
	4 1 roll
	pop
	5 -1 roll
	aload
	pop pop
	4 -1 roll
	aload pop
	[
	8 -2 roll
	pop
	5 -2 roll
	pop
	6 -2 roll
	pop
	5 -1 roll
	]
	4 1 roll
	pop
	}
	{
	pop pop pop
	} ifelse
} bind def
/Mlp1 {
	5 index
	3 index	sub
	5 index
	2 index mul
	1 index
	le
	1 index
	0 le
	or
	dup
	not
	{
	1 index
	3 index	div
	.99999 mul
	8 -1 roll
	pop
	7 1 roll
	}
	if
	8 -1 roll
	2 div
	7 -2 roll
	pop sub
	5 index
	6 -3 roll
	pop pop
	mul sub
	exch
} bind def




  • Prev by Date: Postscript macros in Mathematica
  • Next by Date: Mathematica Problem
  • Previous by thread: Postscript macros in Mathematica
  • Next by thread: Mathematica Problem