home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
pctchnqs
/
1991
/
number5
/
gutil13a.ptl
< prev
next >
Wrap
Text File
|
1991-09-27
|
39KB
|
1,142 lines
% ************************************************************************
% ************************************************************************
% GUTIL13A Guru PostScript power tools (Alpha release)
% ************************************************************************
%
% SUMMARY: An interim upgrade and replacement for #102 GUTILITY.PTL that
% eliminates the ".ep1" bug and the stack clearings that caused
% dipdraw, superstroke and superinsidestroke hassles. The
% graphing grays have been upgraded, and documentation improved.
%
% Additional tools newly added include roundbox, mergestrings,
% stringup borders, hrule, vrule, roman numerals, GEnie dates.
%
% Excerpted from Don Lancaster's POSTSCRIPT BEGINNER STUFF.
%
% Copyright c 1991 by Don Lancaster. All rights fully reserved.
% Free help line and additional info: (602) 428-4073.
%
% ************************************************************************
% Name of textfile: GUTIL13A.GPS
% Source: SYNERGETICS
% Author: Don Lancaster
% Desc: Intermim upgrade for #102 GUTILITY.PTL
% Date: April 12, 1991
% Release: 1.0
% Approx length: 40K
% Status: Copyright 1991 by Don Lancaster and Synergetics.
% 3860 West First Street, Thatcher, AZ. (602) 428-4073.
% All commercial rights reserved. Personal use permitted
% so long as this status message stays present and intact.
% POSTSCRIPT SECRETS book+disk package $39.50 VISA/MC.
%
% Keywords: PostScript, utility, guru, gonzo
%
%
% X E Activate XON/XOFF if necessary.
% Z Values are shown for Apple Super Serial Card
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% This is still being revised. PLEASE TEST AND COMMENT!!!
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% name of textfile: powertool.util
% ....
% decide if you want to be persistent
/persist true def
persist {serverdict begin 0 exitserver} if
/.ep0 {} def
/.ep1 {} def
% last revision: April 91
/ps.util.1 {gutil} def % substitute old name
/gutility {gutil} def % substitute old name
200 dict /gutil exch def gutil begin
% A series of everyday working PostScript utilities that include:
% (1) stepnrepeat - step and repeat routines
% (4) curvetrace - a powerful curve tracing routine
% (5) rubbergrid - dropout-free flexible layout grids
% (6) electronics - electronic schematic icons for rubbergrid
% (7) arcjustify - improved circletext routine with kerning
% (8) nuisances - single command replacements for complex stuff
% (11) errortrap - improved error trapping routines
% (1) step and repeat
% . . . . . . .
/stepnrptparams 40 dict def
stepnrptparams begin
/admitonetick
[6 5 9 150 60 25 25 true 10 true true] def
/babybumper
[1 2 10 270 72 40 30 false 20 true false] def
/badgeaminit
[1 2 3 220 220 90 60 false 250 true false] def
/bigbumpstick
[1 1 3 792 205 0 0 true 40 true false] def
/businesscard
[1 3 4 256 143 12 20 true 20 true false] def
/decaapus
[1 2 5 306 158 0 0 false 50 true false] def
/hexsplit
[1 2 3 306 264 0 0 false 50 true false] def
/lilbumpstick
[1 1 5 610 150 0 20 false 60 true false] def
/octopus
[1 2 4 306 198 0 0 false 50 true false] def
/quadsplit
[1 2 2 396 306 0 0 true 50 true false] def
/readerservice
[1 12 25 25 -15 120 450 false 0 false true] def
/seqbuscard
[1 3 4 256 143 12 20 true 20 true true] def
/shiplabel
[1 1 4 290 180 314 75 false 0 false false] def
/stdplabel
[1 1 11 254 74 320 5 false 20 true false] def
/tenlabel
[1 2 5 305 144 0 45 false 0 false false] def
/vhsvideospline
[1 1 13 424 56 80 35 false 0 false false] def
/3.5disklabel
[1 2 3 216 226 100 60 false 20 false false] def
/5.25disklabel
[1 1 7 316 110 275 35 false 0 false false] def
end
/setrepeatparams {cvn stepnrptparams
exch get aload pop /seqnumber exch
def /ticktrue exch def /ticklen exch
def /portrait exch def /vertstart
exch def /horstart exch def /incvert
exch def /inchoriz exch def /numvert
exch def /numhoriz exch def
/numpages exch def portrait {-90
rotate -792 0 translate } if} def
/onetick { 0 ticklen 2 div rmoveto 0
ticklen neg rlineto ticklen 2 div neg
dup neg rmoveto ticklen 0 rlineto 0
setlinewidth stroke} def
/drawticks {gsave ticktrue {0 0
moveto onetick inchoriz 0 moveto
onetick 0 incvert moveto onetick
inchoriz incvert moveto onetick}
if grestore}def
/stepandrepeat { setrepeatparams
numpages {gsave horstart vertstart
translate gsave numhoriz {gsave
numvert { drawticks save /rptsave1
exch def repeatproc rptsave1
restore seqnumber {/runningnumber
runningnumber 1 add def} if 0
incvert translate } repeat
grestore inchoriz 0 translate}
repeat grestore showpage grestore}
repeat } def
% . . . . .
% DEMO -- remove before use:
% /Helvetica-BoldOblique findfont
% [11 0 0 11 0 0] makefont setfont
% /startingnumber 673 def
% /runningnumber startingnumber def
% /numstring 10 string def
% /repeatproc {57 70 moveto
% (This is business card #) show
% runningnumber numstring cvs show
% } def
% (businesscard) stepandrepeat
% ////////////////////////
% (2) boxdraw
% . . . . .
% This section is obsolete and will be phased out. use roundbox for
% all new work
% Draws various fancy boxes and sidebars, with or without
% rounded corners and double hairlines
/boxpath {/strt br bl add 2 div def
/br {bl bw add} def % attempted repair
/bc {bl bw 2 div add} def
/bb {bt bh sub } def
newpath strt bt moveto br
bt br bb brad arcto br bb bl bb brad arcto bl bb bl bt brad arcto
bl bt strt bt brad arcto closepath blw setlinewidth} def
/br {bl bw add} def
/bc {bl bw 2 div add} def
/bb {bt bh sub} def
/boxdraw {boxpath stroke} def /boxfill {boxpath gsave fill grestore} def
/hairdraw {gsave /hd exch def 0.5 setlinewidth bl bt hd sub moveto
bw 0 rlineto 0 2.5 rmoveto bw neg 0 rlineto stroke} def
/grabbox {/blw exch def /brad exch def /bh exch def /bt exch def /bw
exch def /bl exch def} def
/quickboxdraw {grabbox boxdraw} def
/quickboxpath {grabbox boxpath} def
/quickboxfill {grabbox boxfill} def
% defaults
/bl 200 def /bw 175 def /bt 500 def /bh 240 def /brad 7 def
/blw 2 def /hd 25 def
% use examples: boxdraw hd hairdraw -- draws the box and a title
% boxpath -- generates only the path without stroking
% gsave bl 10 add bb 15 add translate -- locks stuff
% to inside of box; grestore exits
% 200 175 500 240 7 2 quickboxdraw -- draws without
% predefinition, but can't track inside height.
% //////////////////////////////////
% (4) curvetrace
% . . . . .
% curvetrace - creates a smooth curved path from a data point list.
% enter with currentpoint set and absolute array.
/curvetrace {/curvelist exch def tension 0 eq {/tension .000001 def} if
curvelist length 3 div 1 sub cvi /#triads exch def
/ptr 0 def firstpoint morepoint} def
/tension 2.83 def % default value for best fit
/showtick false def % don't show points
/ticklen 15 def % length of ticks
/tickhead ticklen 4 div def
/prvx { curvelist ptr 3 sub get } def
/curx { curvelist ptr get } def
/prvy { curvelist ptr 2 sub get } def
/cury { curvelist ptr 1 add get } def
/prva { curvelist ptr 1 sub get } def
/cura { curvelist ptr 2 add get 180 sub} def
/showtic1 { showtick true eq {gsave currentpoint newpath translate cura
180 add rotate ticklen neg 2 div 0 moveto ticklen 0 rlineto tickhead neg
dup rlineto tickhead dup rlineto tickhead dup neg exch rlineto 0
setlinewidth stroke 0 ticklen neg 2 div moveto 0 ticklen rlineto stroke
grestore} if }def
/firstpoint { curx cury 2 copy abs exch abs add 0 eq {pop pop currentpoint
curvelist exch 1 exch put curvelist exch 0 exch put}{moveto} ifelse
showtic1 /ptr ptr 3 add def}def
/morepoint {#triads { curx prvx sub dup mul cury prvy sub dup mul add sqrt
tension div /zdist exch def prva cos zdist mul prvx add prva sin zdist mul
prvy add cura cos zdist mul curx add cura sin zdist mul cury add curx cury
curveto showtic1 /ptr ptr 3 add def} repeat} def
/showtick false def
% //////////////////////////////////
% (5) Finegray Rubbergrid
% . . . . . .
% Creates fine gray grids without dropouts or rattiness.
% The code shown is device specific for 300 dpi printers.
% To create a grid, use -hpos- -vpos- -gridsize- setgrid
% Until restored, all further images will be "locked" to
% the grid and will expand and contract with it. Note that
% optimum linewidths and font sizes will usually be much
% less than 1.0 after locking.
% To show a grid, use -#hlines- -#vlines- showgrid.
% The seegrid command displays the grid when true.
% The fat5 command emphasizes every fifth line when true.
% the fatter10 command emphasizes every tenth line when true.
% Here are the graphing grays. For most users most of the time,
% select ggray4 or ggray5 as your default ggray.
/ggray1 {/ggray{0 setgray} def}def
/ggray2 {/ggray {150 0 {eq {1}{0} ifelse} setscreen
0.500 setgray} def} def
/ggray3 {/ggray {100 0 {eq {1}{0} ifelse} setscreen
0.667 setgray} def} def
/ggray4 {/ggray { 75 0 {eq {1}{0} ifelse} setscreen
0.750 setgray} def} def
/ggray5 {/ggray { 60 0 {eq {1}{0} ifelse} setscreen
0.800 setgray} def} def
/ggray6 {/ggray { 50 0 {eq {1}{0} ifelse} setscreen
0.833 setgray} def} def
/ggray10 {/ggray { 30 0 {eq {1}{0} ifelse} setscreen
0.900 setgray} def} def
/ggray15 {/ggray { 20 0 {eq {1}{0} ifelse} setscreen
0.933 setgray} def} def
/ggray20 {/ggray { 15 0 {eq {1}{0} ifelse} setscreen
0.950 setgray} def} def
/ggray30 {/ggray { 10 0 {eq {1}{0} ifelse} setscreen
0.966 setgray} def} def
% pick a default working ggray
/ggray {60 0 {eq {1}{0} ifelse} setscreen 0.800 setgray} def
% keep grids unlocked except for Golly Gee Mr. Science!! uses requiring not
% less than two exclamation points...
/lockggrid false def % Don't unless really needed
% gridlockcheck checks to see if an exact pixel lock is wanted for single
% dot crossings. See note above. 51.7 = QMS PS820. Your machine may also
% need "exception tuning" if it does not give you perfect one dot crossings.
/gridlockcheck {lockggrid
{gsave ggray currentscreen grestore pop pop /ggraynum exch def
ggraynum 150 eq {3 1 roll transform 2 div round 2 mul exch
2 div round 2 mul version (51.7) eq {0.5 add } if
exch itransform 3 -1 roll 0 exch dtransform 2 div cvi
2 mul idtransform exch pop} if
ggraynum 100 eq {3 1 roll transform 3 div round 3 mul exch
3 div round 3 mul version (51.7) eq {0.5 add } if
exch itransform 3 -1 roll 0 exch dtransform 3 div cvi
3 mul idtransform exch pop} if
ggraynum 75 eq {3 1 roll transform 4 div round 4 mul exch
4 div round 4 mul version (51.7) eq {0.5 add } if
exch itransform 3 -1 roll 0 exch dtransform 4 div cvi
4 mul idtransform exch pop} if
ggraynum 60 eq {3 1 roll transform 5 div round 5 mul exch
5 div round 5 mul version (51.7) eq {0.5 add } if
exch itransform 3 -1 roll 0 exch dtransform 5 div cvi
5 mul idtransform exch pop} if
ggraynum 50 eq {3 1 roll transform 6 div round 6 mul exch
6 div round 6 mul version (51.7) eq {0.5 add } if
exch itransform 3 -1 roll 0 exch dtransform 6 div cvi
6 mul idtransform exch pop} if
ggraynum 30 eq {3 1 roll transform 10 div round 10 mul exch
10 div round 10 mul version (51.7) eq {0.5 add } if
exch itransform 3 -1 roll 0 exch dtransform 10 div cvi
10 mul idtransform exch pop} if
ggraynum 20 eq {3 1 roll transform 15 div round 15 mul exch
15 div round 15 mul version (51.7) eq {0.5 add } if
exch itransform 3 -1 roll 0 exch dtransform 15 div cvi
15 mul idtransform exch pop} if
ggraynum 15 eq {3 1 roll transform 20 div round 20 mul exch
20 div round 20 mul version (51.7) eq {0.5 add } if
exch itransform 3 -1 roll 0 exch dtransform 20 div cvi
20 mul idtransform exch pop} if
}if} def
/setgrid { gsave gridlockcheck /blocksize exch def translate
blocksize dup scale setfontssmaller} def
/thingridlines {0} def % can alter if you must magnify; but best 0
/showgrid {gsave ggray /vblocks exch def /hblocks exch def
thingridlines setlinewidth
[{0 0 moveto 0 vblocks rlineto stroke} 1
hblocks 1 add] xrpt
[{0 0 moveto hblocks 0 rlineto stroke} 1
vblocks 1 add] yrpt
fatterborder { gsave newpath 0 0.96 blocksize div
dtransform round idtransform
setlinewidth pop 2 setlinecap
0 0 moveto hblocks 0 rlineto 0 vblocks rlineto
hblocks neg 0 rlineto closepath stroke grestore} if
fat5 { gsave newpath 0 0.48 blocksize div dtransform round
idtransform setlinewidth pop mark {5 0 moveto 0 vblocks rlineto
stroke} 5 hblocks 5 div cvi] xrpt mark {0 5 moveto hblocks 0 rlineto
stroke} 5 vblocks 5 div cvi] yrpt grestore} if
fatter10 { gsave newpath 0 0.96 blocksize div
dtransform round idtransform setlinewidth pop
mark {10 0 moveto 0 vblocks rlineto stroke} 10
hblocks 10 div cvi] xrpt mark {0 10 moveto hblocks 0 rlineto stroke} 10
vblocks 10 div cvi] yrpt grestore} if
grestore} def
% Here are our rubbergrid controls...
/lockrubbergrid false def % Don't unless really needed
/fat5 true def % 3 pixels wide every fifth line?
/fatter10 true def % 5 pixels wide every tenth line?
/fatterborder true def % 5 pixel gray outline border?
% rubbergrid utilities - drawing aides for the rubbergrid
% line drawing stuff
/line1 {.06 dup setlinewidth 5 mul /erase exch def} def
/line2 {.12 dup setlinewidth 5 mul /erase exch def} def
/line3 {.18 dup setlinewidth 5 mul /erase exch def} def
% deferred font setting TEMPORARY - will be moved to gonzo
/setfontssmaller {
/font1 /Helvetica [0.7 0 0 0.8 0 0] gonzofont
/font2 /Helvetica-Bold [0.7 0 0 0.8 0 0] gonzofont
/font3 /Symbol [0.7 0 0 0.8 0 0] gonzofont
/font4 /Helvetica [0.5 0 0 0.4 0 0] gonzofont
/font5 /Helvetica-Bold [1.6 0 0 1 0 0] gonzofont
/yinc 1 def /pmrun 0 def /charstretch 0.033 def /spacestretch 0.05 def
/ybot -9999 def /lastlinestretch lastlinestretch 0.1 mul def
} def
/mt {moveto} def
/rm {rmoveto} def
/rl {rlineto} def
% these draw individual lines
/x {rlineto currentpoint stroke moveto} def
/r {0 x} def
/r+ {dup x} def
/r- {dup neg x} def
/l {neg 0 x} def
/l+ {neg dup neg x} def
/l- {neg dup x} def
/u {0 exch x} def
/d {0 exch neg x} def
% these create a path
/pl {neg 0 rl} def
/pl+ {neg dup neg rl} def
/pl- {neg dup rl} def
/pr { 0 rl} def
/pr+ {dup rl} def
/pr- {dup neg rl} def
/pu {0 exch rl} def
/pd {0 exch neg rl} def
% these draw a line and "erase" across the background
/ux {0 exch 2 copy gsave 1 setgray erase setlinewidth
currentpoint .18 add moveto 0 setlinecap x grestore x } def
/dx {neg 0 exch 2 copy gsave 1 setgray erase setlinewidth
currentpoint .18 sub moveto 0 setlinecap x grestore x } def
/rx {0 2 copy gsave 1 setgray erase setlinewidth
currentpoint exch .18 add exch moveto 0 setlinecap x grestore x } def
/lx {neg 0 2 copy gsave 1 setgray erase setlinewidth
currentpoint exch .18 sub exch moveto 0 setlinecap x grestore x } def
/dot { currentpoint newpath 0.150 0 360 arc fill } def
/mdot { m dot} def
% some small default circles
/circ1 {gsave currentpoint newpath 0.20 0 360 arc whitefill
line1 stroke grestore} def %for circle
/circ2 {gsave currentpoint newpath 0.200 0 360 arc whitefill
line2 stroke grestore} def %for complement
/circ3 {gsave currentpoint newpath 0.8 0 360 arc line2 stroke
grestore} def %for led
/circ4 {gsave currentpoint newpath 0.33 0 360 arc whitefill
line2 stroke grestore} def %for test point and switches
% repeats [ proc distance trips] xrpt
/xrpt{gsave aload pop /trips exch def /dist exch def /rproc exch def
trips { gsave rproc grestore dist 0 translate } repeat grestore} def
/yrpt{gsave aload pop /trips exch def /dist exch def /rproc exch def
trips { gsave rproc grestore 0 dist translate } repeat grestore} def
% some arrows . . .
/uarrow {-.15 -.8 rlineto .3 0 rlineto closepath fill} def
/darrow {gsave 180 rotate 0 0.8 rmoveto uarrow grestore} def
/rarrow {gsave -90 rotate uarrow grestore} def
/larrow { gsave 90 rotate uarrow grestore} def
/whitefill { gsave 1 setgray fill grestore} def
% //////////////////////////////////
% (6) electronics
% . . . . . .
% This section is being revised and improved
% Opaque icons for use with the rubbergrid system.
% This is older code that still needs rework.
% In general, use -xpos- -ypos- iconname
/electronics 200 dict def electronics begin
/micro {font3 (m) show font1} def
/ohms {font3 (W) show font1} def
/tstpt {mt circ4 currentpoint 0.15 0 360 arc fill} def
/xinv {0 1.25 rlineto 2.5 -1.25 rlineto -2.5 -1.25 rlineto
closepath whitefill line2 stroke} def
/rinverter{ mt gsave xinv grestore 2.7 0 rm circ2} def
/linverter {mt gsave 180 rotate xinv grestore -2.7 0 rm circ2 } def
/res {-0.8 0 rmoveto gsave 1.6 0 rlineto line1 1 setgray stroke
grestore 0.10 0.3 rlineto 3 { .20 -.6 rlineto .20 .6 rlineto}
repeat .20 -.6 rlineto 0.10 0.3 rlineto stroke} def
/hresistor {mt res} def
/vresistor { mt gsave 90 rotate res grestore} def
/lpot { gsave translate gsave 0 -0.10 translate 0 0 vresistor grestore
-.2 0 moveto rarrow grestore} def
/cap {currentpoint 2 copy gsave 1 setgray 0 -.20 rlineto stroke grestore
moveto -.6 0 rmoveto 1.2 0 rlineto stroke
moveto 0 -1.2 rmoveto currentpoint newpath 1 55 125 arc stroke } def
/vcap { mt cap } def
/hcap { mt gsave 90 rotate cap grestore} def
/uvcap { mt gsave 180 rotate cap grestore} def
/schmitt {mt 0.3 0.3 rmoveto line1 -0.4 0 rlineto 0 -0.6
rlineto -.2 0 rlineto 0.4 0 rlineto 0 .6 rlineto stroke} def
/dpdt {gsave translate 0 0 mt gsave newpath 0 0 mt 1 setgray
0.3 setlinewidth 0 2 rlineto 1.5 0 rlineto 0 -2 rlineto stroke
grestore circ2 0 1 rm circ2 0 1 rm circ2 1.5 0 rm circ2 0 -1 rm
circ2 0 -1 rm circ2 .2 setlinewidth 1 setlinecap -.35 .05 rm 1 u
-.55 0 rm 1 d grestore} def
/spdt { gsave translate 0 0 mt gsave newpath 0 0 mt 1 setgray 0.3
setlinewidth 0 2 rlineto 1.5 0 rlineto 0 -2 rlineto stroke grestore
circ2 0 1 rm circ2 0 1 rm circ2 0.2 setlinewidth 1 setlinecap .45
0.05 mt 1 u grestore} def
/diode{ currentpoint newpath moveto -.3 0 rmoveto gsave .7 -.4 rlineto 0 .8
rlineto closepath fill grestore -0.05 -.4 rmoveto 0 .8 rlineto
0.1 setlinewidth stroke } def
/udiode { gsave moveto -90 rotate diode grestore } def
/ddiode { gsave moveto 90 rotate diode grestore} def
/led { mt currentpoint circ3 ddiode } def
% ......
/negpulse { moveto -.35 .5 rmoveto .2 0 rlineto 0 -.5 rlineto
0.3 0 rlineto 0 .5 rlineto .2 0 rlineto stroke} def
/pospulse { gsave 180 rotate negpulse grestore} def
% ....
% +5
/5vdc {gsave 0 .8 rlineto currentpoint stroke .2 add
0.2 0 360 arc gsave 0.1 setlinewidth stroke grestore } def
/xend { gsave -.1 0 rmoveto 0 .3 rlineto .2 0 rlineto 0 -.6 rlineto -.2 0
rlineto closepath line1 stroke grestore} def
/hxtal { mt gsave -.33 0 rmoveto 0.66 0 rlineto 0.3 setlinewidth 1 setgray stroke
grestore gsave currentpoint exch -.35 add exch moveto
xend 0.7 0 rmoveto xend grestore
gsave 0 0.5 rmoveto 0 -1 rlineto
0.2 setlinewidth stroke grestore} def
/sensor { gsave 2 copy vresistor .1 setlinewidth .5 sub
newpath .6 0 -180 arcn
0 1.1 rlineto currentpoint stroke exch 0.6 add exch .6
180 0 arcn 0 -1.1 rlineto stroke grestore} def
% ......
% gnd
/ground { -.4 0 rmoveto 0.8 0 rlineto -.65 -0.2 rmoveto .5 0 rlineto
-0.35 -0.2 rmoveto .2 0 rlineto
stroke} def
/uground {gsave 180 rotate ground grestore} def
/lground {gsave -90 rotate ground grestore} def
/dground {gsave 90 rotate ground grestore} def
/edgecon { gsave line2 mt 0 1.7 rm currentpoint newpath 0.3 180 0
arcn 1.7 d 0.6 l 1.7 u closepath gsave 1 setgray fill grestore stroke
grestore} def
/whitefill { gsave 1 setgray fill grestore} def
/cell { gsave translate newpath 1 setgray 0 setlinecap
0 .3 mt 2 setlinewidth 0 -.6 rlineto stroke 0 setgray -.6
0.2 mt 0.3 setlinewidth 1.2 r stroke
-1 -.3 mt line2 2 r
grestore} def
% //// DIPDRAW PROC /////
% dipdraw - draws a dip integrated circuit.
% Enter with currentpoint set to pin 1 and scale
% set so that 1.0 = distance between pins. Then
% do a numpins-(name)-(hipins)-(lopins) dipdraw
% Pin callouts preceeded by / will be complemented.
% main dipdraw entry:
/dipdraw { save /snap exch def /hipins exch def /lopins
exch def /chipname exch def /numpins exch def /howlong
{numpins 2 div cvi 1 add} def /howhigh {4 numpins 36 ge
{1 add} if} def /stub {howhigh 1.4 sub 2 div} def
% internal service subs start here:
/pinproc {numpins 2 div cvi{newpath 0 cpos 0.37 0 360 arc
gsave 1 setgray fill grestore 0.067 setlinewidth stroke
pin# 5 string cvs dup stringwidth pop 2 div neg cpos
0.2 sub moveto show 1 0 translate /pin# pin# dir add
def} repeat } def
/stretchprint { dup stringwidth pop 2 div neg exch length
1 sub stretch mul 2 div sub 0 moveto callout (/)
anchorsearch true eq {currentpoint exch stretch add exch
moveto pop dup /callout exch def stringwidth
pop callout length 1 sub stretch mul add /barwide exch def
0.033 setlinewidth gsave currentpoint 0.55 add moveto
barwide 0 rlineto stroke grestore} if stretch 0 callout
ashow pop} def
/pincallouts{0 vpos translate {workstring ( ) search true
eq {/callout exch def pop /workstring exch def callout
stretchprint 1 0 translate}{dup /callout exch def
stretchprint exit } ifelse}loop} def
% actual dipdraw process starts here:
% ........ the outline:
gsave 1 setlinecap 1 setlinejoin
currentpoint translate newpath -.55 .45 0.15 0 360
arc fill newpath -1 howhigh 2 div 0.7 -90 90 arc 0 stub
rlineto howlong 0 rlineto 0 howhigh neg rlineto howlong
neg 0 rlineto closepath 0.36 setlinewidth stroke
% ........ pin circles and numbers:
/Helvetica-Bold findfont [0.4 0 0 0.55 0 0] makefont
setfont gsave /pin# 1 def /dir 1 def /cpos 0 def pinproc
grestore gsave /pin# numpins def /dir -1 def /cpos howhigh
def pinproc grestore
% ........ pin callouts:
/Helvetica findfont [0.35 0 0 0.6 0 0] makefont setfont
/stretch 0.033 def gsave /workstring hipins def /vpos
0.6 def pincallouts grestore gsave /workstring
lopins def /vpos howhigh 1.05 sub def pincallouts
grestore
% ....... device number:
% was 1.4 0 0 1 0 0
/Helvetica-Bold findfont [1.4 0 0 1 0 0] makefont setfont
/stretch 0.05 def gsave numpins 2 div 1 sub 2 div howhigh
2 div 0.33 sub translate chipname dup /callout exch def
stretchprint grestore
% ....... end cleanup:
grestore grestore
snap restore} def
% ...
% new inductor stuff
/lloop { .5 1 -.5 1 0 0 rcurveto} def
/ltie {.2 -.30 .4 -.30 .6 0 rcurveto} def
/lexit{.2 -.40 .4 0 .6 0 rcurveto .4 r } def
/lentry {.4 r .2 0 .4 -.4 .6 0 rcurveto} def
/hcoil { /numloops exch def lentry
numloops 1 sub {lloop ltie} repeat lloop lexit} def
/winding {gsave /numloops exch def translate 0 0 moveto 0 rotate
numloops hcoil grestore} def
/vwinding {gsave /numloops exch def translate 0 0 moveto 90 rotate
numloops hcoil grestore} def
/vrwinding {gsave /numloops exch def translate 90 rotate 1 -1 scale
0 0 moveto numloops hcoil grestore} def
/phonejack {gsave translate 1 setlinecap 0 0 mt 0.15 u 3.85 r 0.3 d
3.85 l 3.95 0.15 mt 0.15 r 0.1 -0.15 rlineto -0.1 -0.15 rlineto 0.15
l 0.3 u 0.4 setlinewidth 2 setlinecap 0 0 mt 2 r 1 setlinecap 0 0.2 mt
2 r 0 -0.2 mt 2 r grestore } def
/lilphonejack{ gsave translate 0.8 dup scale 0 0 phonejack grestore} def
/varistor {gsave translate gsave -.5 0 mt 0.6 setlinewidth 1 setgray
1 r grestore line2 0.6 0.3 mt 1.2 l 0.6 -0.3 mt 1.2 l -0.45 -0.25 mt
0.3 0.50 rlineto 0.3 -0.50 rlineto 0.3 0.50 rlineto
stroke grestore} def
/piezo { gsave translate 0 0 mt gsave 5 dup scale circ1 grestore
gsave 2.5 dup scale circ1 grestore grestore } def
/pctab {gsave 1 setlinecap 1 setlinejoin line2 1 u 2 r
1 d 2 l grestore} def
/npn {gsave newpath exch 0.2 sub exch translate -.1 0 1.2
0 360 arc gsave 1 setgray fill grestore line2 stroke -0.2
0 translate line3 -.3 -.7 moveto 1.4 u line1 -.3 0 mt 1.3
l -.2 .4 mt 0.6 0.4 rlineto 1.2 u newpath -.2 -0.4 mt 0.6
-0.4 rlineto 1.2 d newpath 0.4 -0.75 mt -.2 .3 rlineto
-.2 -.3 rlineto closepath fill grestore} def
/npnl {gsave translate -1 1 scale 0 0 npn grestore} def
/pnp {gsave newpath exch 0.2 sub exch translate -.1 0 1.2
0 360 arc gsave 1 setgray fill grestore line2 stroke -0.2
0 translate line3 -.3 -.7 moveto 1.4 u line1 -.3 0 mt 1.3
l -.2 .4 mt 0.6 0.4 rlineto 1.2 u newpath -.2 -0.4 mt 0.6
-0.4 rlineto 1.2 d newpath -.2 .4 mt .3 .4 rlineto .1 -.3
rlineto closepath fill grestore} def
/pnpl {gsave translate -1 1 scale 0 0 pnp grestore} def
end % -- the electronics dictionary
% //////////////////////////
% (7) arc justify - sets circular text.
% . . . . .
% To use, -xpos -ypos- -radius- (message) arcjustify
% A positive radius creates upward curving arcs.
% A negative radius creates downward curving arcs.
% Use -arckern- to stretch or compress message.
/arckern 2 def /str ( ) def
/arcjustify {gsave /msg exch def /radius exch def translate
msg dup stringwidth pop exch length 1 sub arckern mul add 2 div
dup 57.29578 mul radius div msg {str exch 0 exch put gsave
rotate 0 radius moveto str dup dup stringwidth pop 2 div
57.29578 mul radius div neg rotate show stringwidth pop arckern
add sub dup 57.29578 mul radius div grestore} forall pop pop
grestore} def
% demo -- /Helvetica-Bold findfont [100 0 0 100 0 0] makefont
% setfont 200 0 500 (FREE FONT) arcjustify
% //////////////////////////////////
% (6) nuisance solvers
% . . . . . .
% nuisance - a dictionary of commonly used PostScript sequences
% . . . . . . . . . .
% Copyright c 1988 by Don Lancaster and Synergetics, Box 809,
% Thatcher, AZ 85552. (602) 428-4073. All rights reserved
% Personal, non-commercial use permitted so long as this
% header remains present and intact. Latest disk costs $24.50.
% nuisancedict is usually persistently downloaded as a dictionary.
% it is activated when needed by -- nuisance begin -- .
200 dict /nuisance exch def nuisance begin
/acos {2 copy dup mul exch dup mul sub sqrt exch pop
exch atan} def % arccosine use - xside hypotenuse acos -
/asin {2 copy dup mul exch dup mul sub sqrt exch pop
atan} def % arcsine use - yside hypotenuse asin -
/backwards { 612 0 translate -1 1 scale} def % print backwards
/bestgray {106 45 {dup mul exch dup mul add 1.0 exch sub} setscreen} def
/black {0 setgray} def % draw in black
/blackflash {0 0 moveto 1000 0 rlineto 0 1000 rlineto -1000 0 rlineto
closepath fill showpage } def % black pre-page for highest print quality
/copies { /#copies exch def} def % as in -- 6 copies --
/feetfirst {180 rotate -612 -792 translate} def % eject print feet first
/flushends {0 setlinecap} def % flush path ends
/flushjoins {0 setlinejoin} def % flush path joins
% GEniejul converts GEnie dates to Julian dates Enter with a six
% digit integer; leave with date string on stack
/GEniejul { ( ) cvs dup 2 2 getinterval cvi 1 sub [(January )
(February )(March )(April )(May )(June )(July )(August )(September )
(October )(November )(December )] exch get 1 index 4 2 getinterval
(, ) mergestr mergestr exch 0 2 getinterval cvi dup 50 gt {1900}
{2000}ifelse add ( )cvs mergestr} def
% hrule does a fixed horizontal rule, given xstart ystart xend linewidth
/hrule {gsave newpath setlinewidth 1 index 4 2 roll moveto lineto
stroke grestore} def
% vrule does a fixed vertical rule, given xstart ystart yend linewidth
/vrule {gsave newpath setlinewidth 2 index 4 2 roll moveto exch lineto
stroke grestore} def
/inch {72 mul} def % inches
/indiagray {135 35 {dup mul exch dup mul add 1.0 exch sub} setscreen} def
/landscape {-90 rotate -792 0 translate} def % pick landscape printing
/lightgray {0.99 setgray} def
/listfonts {FontDirectory {pop == flush 200 {37 sin pop}
repeat } forall} def % send installed font list to host
/longjob {statusdict /waittimeout 180 put} def % lengthen job timeout
/manual {statusdict /manualfeed true put} def % start manual feed
% mergestr merges the two top stack strings into one top stack string
/mergestr {2 copy length exch length add string dup dup 4 3 roll
4 index length exch putinterval 3 1 roll exch 0 exch putinterval} def
/negative {{1 sub abs} settransfer} def % negative printing
/outline {false charpath} def % finds character outline path
/persist {serverdict begin 0 exitserver} def % starts persistent download
/pi 3.1415926 def % you wanted rhubarb instead?
/pixel {72 mul 300 div} def % 300 dpi only
/positive {{} settransfer} def % restore positive printing
/printfonts {/Helvetica findfont [10 0 0 10 0 0] makefont
setfont /xpos 150 def /ypos 600 def /yinc 12 def xpos 20
sub ypos 20 add moveto (CURRENTLY INSTALLED FONTS:) show
FontDirectory {pop 100 string cvs xpos ypos moveto (/) show
show /ypos ypos 12 sub def} forall showpage} def % on paper
/putridgray {53 45 {dup mul exch dup mul add 1.0 exch sub} setscreen} def
/random {rand 65536 div 32768 div mul cvi} def % as in -- 6 random --
/report {== flush 100 {37 sin pop} repeat } def % top of stack to host
/reprogray {85 35 {dup mul exch dup mul add 1.0 exch sub} setscreen} def
% Romnum routine converts any number from 0-99 into its equivalent Roman
% numerals. Enter with stack integer. Leave with stack Roman string.
/Romnum { dup 10 div cvi [() (x) (xx) (xxx) (xl) (l) (lx) (lxx)
(lxxx) (xc)] exch get ( ) cvs exch 10 mod cvi [() (i)(ii)(iii)
(iv)(v)(vi)(vii)(viii)(ix)] exch get mergestr} def
/roundends {1 setlinecap} def % rounded path ends
/roundjoins {1 setlinejoin} def % rounded path joins
% This creates a rounded path from -radius- [x1 y1 x2 y2 ... xn yn]
% roundpath. Does NOT round path ends. Use roundbox for boxes
/roundpath {/rpdata exch def /rprad exch def rpdata length 1 sub
cvi /rppoints exch def rpdata 0 get rpdata 1 get moveto 2 2 rppoints
2 sub {/rpvalue exch def 0 1 3 {rpdata exch rpvalue add get } for
rprad arcto pop pop pop pop} for rpdata rppoints 1 sub get rpdata
rppoints get lineto} def
% roundbox draws a box path with rounded corners and locks you to the
% lower lefthand box corner using this format ...
% -xpos- -ypos- -xwidth- -yheight- -cornerrad- roundbox
/roundbox {gsave /rad exch def /bt exch def /br exch def /bb exch
def /bl exch def bl bb translate rad mark br 2 div 0 0 0 0 bt br
bt br 0 br 2 div 0] roundpath /bc br bl sub 2 div def} def
/snoop {1183615869 internaldict begin} def % activates superexec
/stockends {2 setlinecap} def % default path ends
/stockjoins {2 setlinejoin} def % default path joins
/stall {{37 sin pop} repeat} def % delay as in -- 1500 stall --
% timing utilities. use stopwatchon and stopwatchoff for simple
% one shot timing. For multiple time totals, use resettimer
% starttimer stoptimer ... starttimer stoptimer reporttimer
/stopwatchoff {stoptimer reporttimer} def % for single shots
/stopwatchon {resettimer starttimer} def % for single shots
/reporttimer {mytime 1000 div (\rElapsed time: ) print 20
string cvs print ( seconds.\r) print flush} def % to host
/resettimer {/mytime 0 def} def % reset timer
/starttimer {usertime /mytimenow exch def} def % add to time so far
/stoptimer {usertime mytimenow sub /mytime exch mytime
add def} def % for multiple timing intervals
% stringdown, et al repeats a string of one or more characters to form
% a fancy border. use -#repeats- -spacing- (char) stringdown, etc.
/stringdown {/char exch def /vcharsp exch def {gsave char
show currentpoint vcharsp sub moveto} repeat} def
/stringleft {/char exch def /hcharsp exch def {gsave char
show currentpoint exch hcharsp sub exch moveto} repeat} def
/stringright {/char exch def /hcharsp exch def {gsave char
show currentpoint exch hcharsp add exch moveto} repeat} def
/stringup {/char exch def /vcharsp exch def {gsave char
show currentpoint vcharsp add moveto} repeat} def
% superstroke and superinsidestroke take a predefined path and a
% top-of-stack array of [width1 gray1 width2 gray2 .... widthn grayn]
% and do multiple strokes for wires, fancy borders, or braiding.
% Note that the FIRST array value pair has to be the WIDEST, etc.
% Use superstroke for wires; superinsidestroke for borders.
/superstroke { save /sssnap exch def /sscmd exch def mark 0 2 sscmd length
2 div cvi 1 sub 2 mul {/aposn exch def gsave sscmd aposn get
setlinewidth sscmd aposn 1 add get setgray stroke grestore} for cleartomark
sssnap restore newpath} def
/superinsidestroke {save clip /sssnap exch def /sscmd exch def mark 0 2
sscmd length 2 div cvi 1 sub 2 mul {/aposn exch def gsave sscmd aposn
get 2 mul setlinewidth sscmd aposn 1 add get setgray stroke grestore}
for cleartomark sssnap restore newpath} def
/tan {dup sin exch cos dup 0 eq {pop 0.000001} if div} def % tangent
/tray {statusdict /manualfeed false put} def % stop manual feed
/white {1 setgray} def % print in white
/width {stringwidth pop} def % finds x width of string
end % the nuisance dictionary
% //////////////////////////
% (11) switchable error trapper
% . . . . .
% Creates a printing error trapper that dumps the stack and prints what you
% have accomplished so far. While EXTREMELY useful, this is definitely NOT
% to be a replacement for true two-way comm. Adapted from EHANDLER.PS.
% Use gutil begin printerror at the start of your file for time-of-error
% printout and stack dump
/printerror {/$brkpage 64 dict def $brkpage begin /prnt {dup
type/stringtype ne{=string cvs}if dup length 6 mul /tx exch def/ty
10 def currentpoint/toy exch def/tox exch def 1 setgray newpath
tox toy 2 sub moveto 0 ty rlineto tx 0 rlineto 0 ty neg rlineto
closepath fill tox toy moveto 0 setgray show}bind def /nl{currentpoint
exch pop lmargin exch moveto 0 -10 rmoveto}def /=={/cp 0 def
typeprint nl}def /typeprint{dup type dup currentdict exch known
{exec}{unknowntype}ifelse}readonly def /lmargin 72 def /rmargin 72 def
/tprint {dup length cp add rmargin gt{nl/cp 0 def}if dup length cp
add/cp exch def prnt}readonly def /cvsprint{=string cvs tprint( )tprint
}readonly def/unknowntype{exch pop cvlit(??)tprint cvsprint}readonly
def/integertype{cvsprint}readonly def/realtype{cvsprint}readonly def
/booleantype{cvsprint}readonly def/operatortype{(//)tprint cvsprint}
readonly def/marktype{pop(-mark- )tprint}readonly def/dicttype{pop
(-dictionary- )tprint}readonly def/nulltype{pop(-null- )tprint}readonly
def/filetype{pop(-filestream- )tprint}readonly def/savetype{pop
(-savelevel- )tprint}readonly def/fonttype{pop(-fontid- )tprint}readonly
def/nametype{dup xcheck not{(/)tprint}if cvsprint}readonly def/stringtype
{dup rcheck{(\()tprint tprint(\))tprint}{pop(-string- )tprint}ifelse
}readonly def/arraytype{dup rcheck{dup xcheck{({)tprint{typeprint}
forall(})tprint}{([)tprint{typeprint}forall(])tprint}ifelse}{pop
(-array- )tprint}ifelse}readonly def/packedarraytype{dup rcheck{dup
xcheck{({)tprint{typeprint}forall(})tprint}{([)tprint{typeprint}
forall(])tprint}ifelse}{pop(-packedarray- )tprint}ifelse}readonly def
/courier/Courier findfont 10 scalefont def/OLDhandleerror errordict
/handleerror get def end errordict /handleerror {systemdict begin $error
begin $brkpage begin newerror{/newerror false store $error /errorname
get (ioerror) ne $error /command get (exec) ne or {vmstatus pop pop 0
ne{grestoreall}if initgraphics courier setfont lmargin 720 moveto
(ERROR: )prnt errorname prnt nl(OFFENDING COMMAND: )prnt/command
load prnt $error/ostack known {nl nl(STACK:)prnt nl nl $error/ostack
get aload length{==}repeat}if systemdict/showpage get exec /newerror
true store/OLDhandleerror load end end end exec}{end end end} ifelse}
{end end end}ifelse} dup 0 systemdict put dup 4 $brkpage put bind
readonly put} def
% //////////////////////////////////
end % the entire utility dictionary
quit
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Related GEnie PSRT Downloads:
% >>>>> THIS FILE REPLACES #102 GUTILITY.PTL <<<<<
% #257 - GNZOTRX1.GPS Gonzo Special Effects Part I
% #256 - GURUTEMP.GPS Gonzo Multipage/Multifigure Template
% #253 - EXTRACR.TXT Solving PS Carriage Return Hassles
% #252 - KEYSTJST.GPS Gonzo keystone justification tools
% #251 - PAGESBLD.GPS Gonzo Page Builder Template
% #248 - MENUJUST.GPS Gonzo menu justification
%
% #242 - NEWGTOOL.AII Gonzo glossary-lbreaker-fntpicker
% #238 - PULPNOVL.GPS 2-up BOD pulp novel template
% #220 - GONZO13A.TXT Gonzo 13A Tutorial
% #219 - GONZO13A.PTL Gonzo 13A Powertool
% #109 - RAWPS.TXT Working with raw PostScript
% #102 - GUTILITY.PTL Guru Utility PowerTools (DO NOT USE)
%
% #245 - PSRTXREF.TXT PSRT Xref & planner (Text only)
% #246 - PSRTXREF.PS PSRT Xref & planner (Hard copy)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Reprinted from Don Lancaster's POSTSCRIPT BEGINNER STUFF.
% Now available via GEnie email from SYNERGETICS.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% FREE VOICE HELPLINE AND ADDITIONAL INFO: (602) 428-4073
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%