Download raw (101.6 KB)
%!PS-Adobe-3.0 EPSF-3.0
%%Title: PS library. Version May 2011
%%Author: Kees van der Laan kisa1@xs4all.nl
%%Kernel: Adobe's BLUebook operators, with my own operators added
%% Inspired by Don Lancaster Gonzo collection.
%% Extended with transcriptions of Lauwerier's BASIC Fractals.
%%Use: Include in your PS program: (C:\\PSlib\\PSlib.eps) run
%
%---CONTENTS---
%
% Constants
% fonts
% cmyk-colours
% conventions Circle Inversion printing
% ++
% anglemark
% Apollonius
% Apollonius2
% arrowdict
% arrow (BLUebook)
% astroide
% Bintree (binarytree; auxiliaries /E, /W, /N /S)
% bintree (with trunk length on stack)
% bolspira (H A Lauwerier Fractals)
% boomh2 (H-fractal (backtracking), H A Lauwerier Fractals)
% boom3 (trinaire boom, H A Lauwerier Fractals)
% cat
% cadd
% char (BlueBook)
% csub
% cdiv
% cdivdict
% centerdash (BLUebook)
% centershow (BLUebook)
% centersquare (BLUebook)
% circleinversion
% circleorthogonaltotwocircles
% circleatalpha
% circtextdict
% circumscribed
% closepathproc
% cm
% crlf
% censhow
% curvetoproc
% dotsandnames
% draak (H A Lauwerier Fractals)
% dragon (H A Lauwerier Fractals)
% DrawPieChart
% epicycle (H A Lauwerier Graphics and Fractals)
% errorhandler
% dwirlingsquares
% ellipse (BLUebook)
% equalcirclesintersection
% escherknot
% eschertriangle
% factorial
% fern
% fractiondict
% fractionshow (BLUebook)
% gentwocirclesintersection
% gradientfill2 %(Courtesy Acumen)
% Hfractal
% inch (BLUebook)
% inproduct
% inscribed
% insidecircletext (BLUebook)
% insideplacechar (BLUebook)
% intersect
% kronkel (Lauwerier's general fractal islands creator)
% length (overloaded operator)
% levyfractal
% LevyLauwerier
% lineintersectscircle
% lineinversion
% linetoproc
% linetree
% linepieceinversion
% lissajous
% LM
% logspiral (H A Lauwerier Fractals)
% makecoef
% maxint
% montecarlocsierpinskicgl
% mean
% mediation
% middleperpendicular
% middleperpendicularvar
% mink (Minkowski fractal)
% mm
% mondrian
% mondriancmyk
% mousetail
% movetoproc
% ncircles
% newline (BlueBook)
% nfactorial
% nl (ie newline; font size dependent)
% octaederincube
% origin (2D)
% ortho
% orthogonal
% orthocirclethroughp
% oshow (BlueBook p98 outline show)
% opythtree (H A Lauwerier Fractals)
% outproduct
% outsidecircletext (BLUeBook)
% outsideplacechar (BLUeBook)
% pathtext
% pathtextdict
% pathlength
% pi
% pidecimals
% Piedict
% plus
% pointinversion
% prt-n (BLUebook)
% PrintCodeandChar (BlueBook)
% ptp
% ptpf
% pythsq
% pythsqsym
% pythtree
% pythtreesym
% PYTHB1
% QSortarray Removed not correct
% radical
% ReEncodeSmall (BlueBook)
% rot
% RUSvec (encoding vectore for Cyrillics)
% s and scalingfactor
% scdict
% Schroefer
% scshow
% setchar
% shellsort
% showobject
% sierpinskitriangle (H A Lauwerier)
% size
% solveit
% solve22
% solve33
% splinetree
% starfractal (H A Lauwerier Fractals)
% star5(Adobe Blue Book)
% threepointscircle
% tOnSpline (Casteljau algorithm)
% tOnSplineclassic via Horner scheme)
% trinarytree
% twoconjcircles2invcircle
% twocirclesintersection
% twocircles2inversioncircle
% twopointsincircle
% unifrmdev
% vshowdict
% vshow
% wedge
% wervel (H A Lauwerier Fractals)
% wikkel (H A Lauwerier Fractals)
% Xmastree (H A Lauwerier Fractals)
% YinYang
%end Contents
%
%
%variables: predefined fonts at sizes 5 7, 10, 12, 14, 15
%
%/H15pt /Helvetica-Bold findfont 15 scalefont def
%/H16pt /Helvetica findfont 16 scalefont def
%/H14pt /Helvetica findfont 14 scalefont def
%/H12pt /Helvetica findfont 12 scalefont def
%/H10pt /Helvetica findfont 10 scalefont def
%/H7pt /Helvetica findfont 7 scalefont def
%/H5pt /Helvetica findfont 5 scalefont def
%/HB15pt /Helvetica-Bold findfont 15 scalefont def
%/HB14pt /Helvetica findfont 14 scalefont def
%/HB12pt /Helvetica findfont 12 scalefont def
%/HB10pt /Helvetica findfont 10 scalefont def
%/HB7pt /Helvetica-Bold findfont 7 scalefont def
%/HB5pt /Helvetica findfont 5 scalefont def
%/HO15pt /Helvetica-Oblique findfont 15 scalefont def
%/HO14pt /Helvetica-Oblique findfont 14 scalefont def
%/HO12pt /Helvetica-Oblique findfont 12 scalefont def
%/HO10pt /Helvetica-Oblique findfont 10 scalefont def
%/HO7pt /Helvetica-Oblique findfont 7 scalefont def
%/HO5pt /Helvetica-Oblique findfont 5 scalefont def
%/HBO15pt /Helvetica-Oblique findfont 15 scalefont def
%/HBO14pt /Helvetica-Oblique findfont 14 scalefont def
%/HBO12pt /Helvetica-BoldOblique findfont 12 scalefont def
%/HBO10pt /Helvetica-BoldOblique findfont 10 scalefont def
%/HBO7pt /Helvetica-BoldOblique findfont 7 scalefont def
%/HBO5pt /Helvetica-BoldOblique findfont 5 scalefont def
%/S15pt /Symbol findfont 15 scalefont def
%/S14pt /Symbol findfont 14 scalefont def
%/S12pt /Symbol findfont 12 scalefont def
%/S10pt /Symbol findfont 10 scalefont def
%/S7pt /Symbol findfont 7 scalefont def
%/S5pt /Symbol findfont 5 scalefont def
%/C15pt /Courier findfont 15 scalefont def
%/C14pt /Courier findfont 14 scalefont def
%/C12pt /Courier findfont 12 scalefont def
%/C10pt /Courier findfont 10 scalefont def
%/C7pt /Courier findfont 7 scalefont def
%/C5pt /Courier findfont 5 scalefont def
%/CSTD15pt /CourierStd findfont 15 scalefont def
%/CSTD14pt /CourierStd findfont 14 scalefont def
%/CSTD12pt /CourierSTD findfont 12 scalefont def
%/CSTD10pt /CourierSTD findfont 10 scalefont def
%/CSTD7pt /CourierSTD findfont 7 scalefont def
%/CSTD5pt /CourierSTD findfont 5 scalefont def
%/CSTDB15pt /CourierStd-Bold findfont 15 scalefont def
%/CSTDB14pt /CourierStd-Bold findfont 14 scalefont def
%/CSTDB12pt /CourierSTD-Bold findfont 12 scalefont def
%/CSTDB10pt /CourierSTD-Bold findfont 10 scalefont def
%/CSTDB7pt /CourierSTD-Bold findfont 7 scalefont def
%/CSTDB5pt /CourierSTD-Bold findfont 5 scalefont def
%/CB15pt /Courier-Bold findfont 15 scalefont def
%/CB14pt /Courier-Bold findfont 14 scalefont def
%/CB12pt /Courier-Bold findfont 12 scalefont def
%/CB10pt /Courier-Bold findfont 10 scalefont def
%/CB7pt /Courier-Bold findfont 7 scalefont def
%/CB5pt /Courier-Bold findfont 5 scalefont def
%/CO15pt /Courier-Oblique findfont 15 scalefont def
%/CO14pt /Courier-Oblique findfont 14 scalefont def
%/CO12pt /Courier-Oblique findfont 12 scalefont def
%/CO10pt /Courier-Oblique findfont 10 scalefont def
%/CO7pt /Courier-Oblique findfont 7 scalefont def
%/CO5pt /Courier-Oblique findfont 5 scalefont def
%/CBO15pt /Courier-BoldOblique findfont 15 scalefont def
%/CBO14pt /Courier-BoldOblique findfont 14 scalefont def
%/CBO12pt /Courier-BoldOblique findfont 12 scalefont def
%/CBO10pt /Courier-BoldOblique findfont 10 scalefont def
%/CBO7pt /Courier-BoldOblique findfont 7 scalefont def
%/CBO5pt /Courier-BoldOblique findfont 5 scalefont def
%/TR15pt /Times-Roman findfont 15 scalefont def
%/TR14pt /Times-Roman findfont 14 scalefont def
%/TR12pt /Times-Roman findfont 12 scalefont def
%/TR10pt /Times-Roman findfont 10 scalefont def
%/TR7pt /Times-Roman findfont 7 scalefont def
%/TR5pt /Times-Roman findfont 5 scalefont def
%/TB15pt /Times-Bold findfont 15 scalefont def
%/TB14pt /Times-Bold findfont 14 scalefont def
%/TB12pt /Times-Bold findfont 12 scalefont def
%/TB10pt /Times-Bold findfont 10 scalefont def
%/TB7pt /Times-Bold findfont 7 scalefont def
%/TB5pt /Times-Bold findfont 5 scalefont def
%/TI15pt /Times-Italic findfont 15 scalefont def
%/TI14pt /Times-Italic findfont 14 scalefont def
%/TI12pt /Times-Italic findfont 12 scalefont def
%/TI10pt /Times-Italic findfont 10 scalefont def
%/TI7pt /Times-Italic findfont 7 scalefont def
%/TI5pt /Times-Italic findfont 5 scalefont def
%/TBI15pt /Times-BoldItalic findfont 15 scalefont def
%/TBI14pt /Times-BoldItalic findfont 14 scalefont def
%/TBI12pt /Times-BoldItalic findfont 12 scalefont def
%/TBI10pt /Times-BoldItalic findfont 10 scalefont def
%/TBI7pt /Times-BoldItalic findfont 7 scalefont def
%/TBI5pt /Times-BoldItalic findfont 5 scalefont def
%/MPR14pt /MinionPro-Regular findfont 14 scalefont def
%/MPR12pt /MinionPro-Regular findfont 12 scalefont def
%/MPR10pt /MinionPro-Regular findfont 10 scalefont def
%/MPR7pt /MinionPro-Regular findfont 7 scalefont def
%/MPR5pt /MinionPro-Regular findfont 5 scalefont def
%/MPB14pt /MinionPro-Bold findfont 14 scalefont def
%/MPB12pt /MinionPro-Bold findfont 12 scalefont def
%/MPB10pt /MinionPro-Bold findfont 10 scalefont def
%/MPB7pt /MinionPro-Bold findfont 7 scalefont def
%/MPB5pt /MinionPro-Bold findfont 5 scalefont def
%/API14pt /AdobePiStd findfont 14 scalefont def
%/API12pt /AdobePiStd findfont 12 scalefont def
%/API10pt /AdobePiStd findfont 10 scalefont def
%/API7pt /AdobePiStd findfont 7 scalefont def
%/API5pt /AdobePiStd findfont 5 scalefont def
% Procedures: colors
/black {0 0 0 setrgbcolor} def
/white {1 1 1 setrgbcolor} def
/red {1 0 0 setrgbcolor} def
/green {0 1 0 setrgbcolor} def
/blue {0 0 1 setrgbcolor} def
/greenblue{0 .7 1 setrgbcolor} def
/backgroundlightblue {0 0 moveto 620 0 lineto 620 790 lineto 0 790 lineto closepath
0.075 0 0 0 setcmykcolor fill} def
%
% procedures: Cmyk values for PS a la pdfTeX
/cmykGreenYellow{0.15 0 0.69 0}def
/cmykYellow{0 0 1 0}def
/cmykGoldenrod{0 0.10 0.84 0}def
/cmykDandelion{0 0.29 0.84 0}def
/cmykApricot{0 0.32 0.52 0}def
/cmykPeach{0 0.50 0.70 0}def
/cmykMelon{0 0.46 0.50 0}def
/cmykYellowOrange{0 0.42 1 0}def
/cmykOrange{0 0.61 0.87 0}def
/cmykBurntOrange{0 0.51 1 0}def
/cmykBittersweet{0 0.75 1 0.24}def
/cmykRedOrange{0 0.77 0.87 0}def
/cmykMahogany{0 0.85 0.87 0.35}def
/cmykMaroon{0 0.87 0.68 0.32}def
/cmykBrickRed{0 0.89 0.94 0.28}def
/cmykRed{0 1 1 0}def
/cmykOrangeRed{0 1 0.50 0}def
/cmykRubineRed{0 1 0.13 0}def
/cmykWildStrawberry{0 0.96 0.39 0}def
/cmykSalmon{0 0.53 0.38 0}def
/cmykCarnationPink{0 0.63 0 0}def
/cmykMagenta{0 1 0 0}def
/cmykVioletRed{0 0.81 0 0}def
/cmykRhodamine{0 0.82 0 0}def
/cmykMulberry{0.34 0.90 0 0.02}def
/cmykRedViolet{0.07 0.90 0 0.34}def
/cmykFuchsia{0.47 0.91 0 0.08}def
/cmykLavender{0 0.48 0 0}def
/cmykThistle{0.12 0.59 0 0}def
/cmykOrchid{0.32 0.64 0 0}def
/cmykDarkOrchid{0.40 0.80 0.20 0}def
/cmykPurple{0.45 0.86 0 0}def
/cmykPlum{0.50 1 0 0}def
/cmykViolet{0.79 0.88 0 0}def
/cmykRoyalPurple{0.75 0.90 0 0}def
/cmykBlueViolet{0.86 0.91 0 0.04}def
/cmykPeriwinkle{0.57 0.55 0 0}def
/cmykCadetBlue{0.62 0.57 0.23 0}def
/cmykCornflowerBlue{0.65 0.13 0 0}def
/cmykMidnightBlue{0.98 0.13 0 0.43}def
/cmykNavyBlue{0.94 0.54 0 0}def
/cmykRoyalBlue{1 0.50 0 0}def
/cmykBlue{1 1 0 0}def
/cmykCerulean{0.94 0.11 0 0}def
/cmykCyan{1 0 0 0}def
/cmykProcessBlue{0.96 0 0 0}def
/cmykSkyBlue{0.62 0 0.12 0}def
/cmykTurquoise{0.85 0 0.20 0}def
/cmykTealBlue{0.86 0 0.34 0.02}def
/cmykAquamarine{0.82 0 0.30 0}def
/cmykBlueGreen{0.85 0 0.33 0}def
/cmykEmerald{1 0 0.50 0}def
/cmykJungleGreen{0.99 0 0.52 0}def
/cmykSeaGreen{0.69 0 0.50 0}def
/cmykGreen{1 0 1 0}def
/cmykForestGreen{0.91 0 0.88 0.12}def
/cmykPineGreen{0.92 0 0.59 0.25}def
/cmykLimeGreen{0.50 0 1 0}def
/cmykYellowGreen{0.44 0 0.74 0}def
/cmykSpringGreen{0.26 0 0.76 0}def
/cmykOliveGreen{0.64 0 0.95 0.40}def
/cmykRawSienna{0 0.72 1 0.45}def
/cmykSepia{0 0.83 1 0.70}def
/cmykBrown{0 0.81 1 0.60}def
/cmykTan{0.14 0.42 0.56 0}def
/cmykGray{0 0 0 0.50}def
/cmykBlack{0 0 0 1}def
/cmykWhite{0 0 0 0}def
%
% procedures for cmyk colors
/GreenYellow{ cmykGreenYellow setcmykcolor } def
/Yellow{ cmykYellow setcmykcolor } def
/Goldenrod{ cmykGoldenrod setcmykcolor } def
/Dandelion{ cmykDandelion setcmykcolor } def
/Apricot{ cmykApricot setcmykcolor } def
/Peach{ cmykPeach setcmykcolor } def
/Melon{ cmykMelon setcmykcolor } def
/YellowOrange{ cmykYellowOrange setcmykcolor } def
/Orange{ cmykOrange setcmykcolor } def
/BurntOrange{ cmykBurntOrange setcmykcolor } def
/Bittersweet{ cmykBittersweet setcmykcolor } def
/RedOrange{ cmykRedOrange setcmykcolor } def
/Mahogany{ cmykMahogany setcmykcolor } def
/Maroon{ cmykMaroon setcmykcolor } def
/BrickRed{ cmykBrickRed setcmykcolor } def
/Red{ cmykRed setcmykcolor } def
/OrangeRed{ cmykOrangeRed setcmykcolor } def
/RubineRed{ cmykRubineRed setcmykcolor } def
/WildStrawberry{ cmykWildStrawberry setcmykcolor } def
/Salmon{ cmykSalmon setcmykcolor } def
/CarnationPink{ cmykCarnationPink setcmykcolor } def
/Magenta{ cmykMagenta setcmykcolor } def
/VioletRed{ cmykVioletRed setcmykcolor } def
/Rhodamine{ cmykRhodamine setcmykcolor } def
/Mulberry{ cmykMulberry setcmykcolor } def
/RedViolet{ cmykRedViolet setcmykcolor } def
/Fuchsia{ cmykFuchsia setcmykcolor } def
/Lavender{ cmykLavender setcmykcolor } def
/Thistle{ cmykThistle setcmykcolor } def
/Orchid{ cmykOrchid setcmykcolor } def
/DarkOrchid{ cmykDarkOrchid setcmykcolor } def
/Purple{ cmykPurple setcmykcolor } def
/Plum{ cmykPlum setcmykcolor } def
/Violet{ cmykViolet setcmykcolor } def
/RoyalPurple{ cmykRoyalPurple setcmykcolor } def
/BlueViolet{ cmykBlueViolet setcmykcolor } def
/Periwinkle{ cmykPeriwinkle setcmykcolor } def
/CadetBlue{ cmykCadetBlue setcmykcolor } def
/CornflowerBlue{ cmykCornflowerBlue setcmykcolor } def
/MidnightBlue{ cmykMidnightBlue setcmykcolor } def
/NavyBlue{ cmykNavyBlue setcmykcolor } def
/RoyalBlue{ cmykRoyalBlue setcmykcolor } def
/Blue{ cmykBlue setcmykcolor } def
/Cerulean{ cmykCerulean setcmykcolor } def
/Cyan{ cmykCyan setcmykcolor } def
/ProcessBlue{ cmykProcessBlue setcmykcolor } def
/SkyBlue{ cmykSkyBlue setcmykcolor } def
/Turquoise{ cmykTurquoise setcmykcolor } def
/TealBlue{ cmykTealBlue setcmykcolor } def
/Aquamarine{ cmykAquamarine setcmykcolor } def
/BlueGreen{ cmykBlueGreen setcmykcolor } def
/Emerald{ cmykEmerald setcmykcolor } def
/JungleGreen{ cmykJungleGreen setcmykcolor } def
/SeaGreen{ cmykSeaGreen setcmykcolor } def
/Green{ cmykGreen setcmykcolor } def
/ForestGreen{ cmykForestGreen setcmykcolor } def
/PineGreen{ cmykPineGreen setcmykcolor } def
/LimeGreen{ cmykLimeGreen setcmykcolor } def
/YellowGreen{ cmykYellowGreen setcmykcolor } def
/SpringGreen{ cmykSpringGreen setcmykcolor } def
/OliveGreen{ cmykOliveGreen setcmykcolor } def
/RawSienna{ cmykRawSienna setcmykcolor } def
/Sepia{ cmykSepia setcmykcolor } def 071
/Brown{ cmykBrown setcmykcolor } def
/Tan{ cmykTan setcmykcolor } def
/Gray{ cmykGray setcmykcolor } def
/Black{ cmykBlack setcmykcolor } def
/White{ cmykWhite setcmykcolor } def
%Numerical Constants and some common names, such as r, mr, hr, and ilks
/sqrt2 1.414213562 def
/sqrt3 1.732050808 def
/sqrt5 2.236067977 def
/pi 3.14159265358979 def %3223846 %extra decimals
/reus 2 30 exp dup 1 sub add def %2.14748e+09
/LM 72 def
/RM 216 def
%(Constants) for Circle Inversion
/r 25 def %/r 50 def
/mr r neg def /2r r r add def
/3r 2r r add def
/4r 2r 2r add def
/5r 4r r add def
/6r 4r 2r add def
/7r 6r r add def
/hr r .5 mul def /qr hr .5 mul def /mhr hr neg def
/rsqrt2 r sqrt2 mul def /rdsqrt2 r sqrt2 div def
/rsqrt3 r sqrt3 mul def
/rdsqrt3 r sqrt3 div def
/nstr 100 string def
%conventions for circle inversion printing in B&W
/lw 1 def
lw 1 setlinewidth
2 setlinecap
/invcir {.5 setlinewidth [1 2] 0 setdash } def
/cirlin {1 setlinewidth [] 0 setdash } def
/invlin {1 setlinewidth [1 1] 0 setdash } def
/auxlin {.25 setlinewidth [1 3] 0 setdash } def
/Auxlin {.75 setlinewidth [1 3] 0 setdash } def
/wanlin {1.5 setlinewidth [] 0 setdash } def
%end conventions
%end constants
%
%Alphabetic library
%
/++ %Purpose add 1 to name on stack
%stk: /anyname ==> -
{dup load % load current value onto stack
1 add % add 1 to that value
def % store it back into same name
} def
%
/anglemark
%l r c radius: point left leg, point right leg, corner, radius
%==> angle marker in drawing
{anglemarkdict begin /r exch def
/cy exch def
/cx exch def
/ry exch def
/rx exch def
/ly exch def
/lx exch def
gsave
cx cy translate
newpath 0 0 r ry cy sub rx cx sub atan
ly cy sub lx cx sub atan
arc stroke
grestore
end} def
/anglemarkdict 7 dict def
/Apollonius{inscribed}def
/Apollonius2%non disjunct circles, where there are 2 solutions
%Purpose: Calculate inscribed/cricumscribed/... circle(s) given three circles
%x1 y1 r1, x2 y2 r2, x3 y3 r3 midpoints and radii of three (disjunt) circles
%==>
%x1 y1 r1 midpoint and radius of the first circle
%x2 y2 r2 midpoint and radius of the second circle
{0 begin
/r3 exch def /y3 exch def /x3 exch def
/r2 exch def /y2 exch def /x2 exch def
/r1 exch def /y1 exch def /x1 exch def
%auxiliary data
/x21 x2 x1 sub def /x31 x3 x1 sub def /x32 x3 x2 sub def
/y21 y2 y1 sub def /y31 y3 y1 sub def /y32 y3 y2 sub def
/r21 r2 r1 sub def /r31 r3 r1 sub def /r32 r3 r2 sub def
/mx21 x2 x1 add 2 div def /mx31 x3 x1 add 2 div def /mx32 x3 x2 add 2 div def
/my21 y2 y1 add 2 div def /my31 y3 y1 add 2 div def /my32 y3 y2 add 2 div def
/mr21 r2 r1 add 2 div def /mr31 r3 r1 add 2 div def /mr32 r3 r2 add 2 div def
/g21 x21 mx21 mul y21 my21 mul add r21 mr21 mul sub def
/g32 x32 mx32 mul y32 my32 mul add r32 mr32 mul sub def
%exchange rows if |a21|> |a11| ie |x32| > |x21|
x32 abs x21 abs gt
{/aux x32 def /x32 x21 def /x21 aux def
/aux y32 def /y32 y21 def /y21 aux def
/aux r32 def /r32 r21 def /r21 aux def
/aux g32 def /g32 g21 def /g21 aux def
%gsave 0 20 moveto (rows exchanged) show grestore
} if
%express equations for x and y in r
/p x32 x21 div def
/a22 y32 p y21 mul sub def
/a2 r32 neg p r21 mul add a22 div def
/b2 g32 p g21 mul sub a22 div def
/a1 a2 y21 mul r21 add neg x21 div def
/b1 g21 y21 b2 mul sub x21 div def
/x {a1 r mul b1 add} def
/y {a2 r mul b2 add} def
%coefficients of quadratic equatio A*r^2 -2B*r + C = 0
/A a1 dup mul a2 dup mul add 1 sub def
/B r3 a1 b1 x3 sub mul sub
a2 b2 y3 sub mul sub def
/C b1 x3 sub dup mul b2 y3 sub dup mul add r3 dup mul sub def
/eps 0.000001 def
A abs eps lt
{/rone C B div 2 div def /rtwo rone def
gsave 0 30 moveto (A < .000001) show grestore}%warning
{/rone B A div dup dup mul C A div sub sqrt add def
/rtwo B A div dup dup mul C A div sub sqrt sub def}
ifelse
/r rone def x y rone
/r rtwo def x y rtwo
end} def
/Apollonius2 load 0 68 dict put
/arrowdict 14 dict def %From PS BLUebook
arrowdict begin
/mtrx matrix def
end
/arrow
{arrowdict begin
/headlength exch def
/halfheadthickness exch 2 div def
/halfthickness exch 2 div def
/tipy exch def /tipx exch def
/taily exch def /tailx exch def
/dx tipx tailx sub def
/dy tipy taily sub def
/arrowlength dx dx mul dy dy mul add sqrt def
/angle dy dx atan def
/base arrowlength headlength sub def
/savematrix mtrx currentmatrix def
tailx taily translate
angle rotate
0 halfthickness neg moveto
base halfthickness neg lineto
base halfheadthickness neg lineto
arrowlength 0 lineto
base halfheadthickness lineto
base halfthickness lineto
0 halfthickness lineto
closepath
savematrix setmatrix
end
}def
/astroide%n (>=32) ==> astroide
{/n exch def
0 1 n 1 sub{/t exch 360 mul n div def
t cos s 0 moveto 0 t sin s lineto}for
}bind def
/Bintree{% default index k; value oif kk on stack is height initial
E %draw East and add leave
/kk exch 2 div def
kk 8 gt {currentpoint N kk Bintree
moveto S kk Bintree}if
/kk kk 2 mul def}def %end Bintree
%auxiliaries
/N{0 kk rlineto}def
/E{gsave ntg k get 2 3 rmoveto show grestore
/k k 1 add def
60 0 rlineto%constant linelength East
}def
/W{kk neg 0 rlineto}def
/S{0 kk neg rlineto}def
/bintree{/k exch def%length of trunk (and leaves)
k 1 gt%draw trunk and 2 branches, T, and then anew by recursion with halfsize of trunk
{0 0 moveto 0 k rlineto k neg k moveto k k add 0 rlineto stroke%draw T
gsave
k neg k translate k 2 div bintree /k k 2 mul def
grestore
k k translate k 2 div bintree /k k 2 mul def
}if }def
/bolspira{bolspiradict begin
%mods: scaling radius r, atan yields degrees
/r 100 def
%scale
/a .2 def %spiral constant
/c .9 def
/p .7071 def %1/sqrt 2
/q p 1 c c mul sub sqrt mul def %p q projection numbers
/pi 3.14159 def
/r2d {180 pi div mul} def%conversion radials into degrees
/b 500 def%limit for the looping.
b neg 1 b{/n exch def
/s n pi mul 25 div def /t a s mul 1 atan def
/x s r2d cos t cos mul r mul def
/y s r2d sin t cos mul r mul def
/z t sin r mul neg def
p y x sub mul c z mul q x y add mul sub %u,v on stack
b neg n eq{moveto}{lineto}ifelse
}for
end} bind def
/bolspiradict 13 dict def
/boomh2%p (order)==> Binary Tree H-fractal, backtrack method
{/p exch def /p1 p 1 add def
/x1 p1 array def /x2 p1 array def /x3 p1 array def /x4 p1 array def
/y1 p1 array def /y2 p1 array def /y3 p1 array def /y4 p1 array def
/a .5 def
x1 0 0 put y1 0 0 put /d 1 def
draw
1 1 4 p 1 sub exp 1 sub
{/m exch def /d p def
{m 4 mod 0 eq{/m m 4 idiv def /d d 1 sub def}
{exit}ifelse
}loop
/dm1 d 1 sub def
x1 dm1 x2 dm1 get put
x2 dm1 x3 dm1 get put
x3 dm1 x4 dm1 get put
y1 dm1 y2 dm1 get put
y2 dm1 y3 dm1 get put
y3 dm1 y4 dm1 get put
draw
}for%m
}bind def
/draw{d 1 p{/j exch def
/x x1 j 1 sub get def /y y1 j 1 sub get def
/b a j exp def /c 1.5 a mul b mul def
x1 j x b add put y1 j y c add put
x2 j x b add put y2 j y c sub put
x3 j x b sub put y3 j y c add put
x4 j x b sub put y4 j y c sub put
x b sub s y s moveto x b add s y s lineto
x1 j get s y1 j get s moveto x2 j get s y2 j get s lineto
x3 j get s y3 j get s moveto x4 j get s y4 j get s lineto
}for%j
}bind def
/boom3%p (order)==> Trinary Tree fractal
{/p exch def /t p 1 add array def /a .4 def
0 1 p{/m exch def
0 1 3 m exp 1 sub{/n exch def
/n1 n def
1 1 m {/l exch def
t l n1 3 mod put /n1 n1 3 idiv def
}for%l
/x 0 def /y 0 def
1 1 m {/k exch cvi def
/f 120 t k get mul def
/x x f cos a k 1 sub exp mul add def
/y y f sin a k 1 sub exp mul add def
}for%k
x s y s moveto x a m exp add s y s lineto
x s y s moveto x .5 a m exp mul sub s y .8660254 a m exp mul add s lineto
x s y s moveto x .5 a m exp mul sub s y .8660254 a m exp mul sub s lineto
}for%n
}for%m
}bind def
/cat%created in MP. cgl 1996
{gsave
3 4 translate
newpath 178.50075 50 moveto
178.50075 66.10077 167.60909 79.62463 153.4761 87.70062 curveto
133.5853 99.0668 110.38673 102.00043 87.5 102.00043 curveto
64.61327 102.00043 41.4147 99.0668 21.5239 87.70062 curveto
7.39091 79.62463 -3.50075 66.10077 -3.50075 50 curveto
-3.50075 33.89923 7.39091 20.37537 21.5239 12.29938 curveto
41.4147 0.9332 64.61327 -2.00043 87.5 -2.00043 curveto
110.38673 -2.00043 133.5853 0.9332 153.4761 12.29938 curveto
167.60909 20.37537 178.50075 33.89923 178.50075 50 curveto closepath fill
1 setgray
newpath 171.50058 48.74992 moveto
171.50058 62.83809 161.97037 74.67148 149.60402 81.73796 curveto
132.19955 91.68336 111.90083 94.25029 91.87494 94.25029 curveto
71.84904 94.25029 51.55032 91.68336 34.14586 81.73796 curveto
21.77951 74.67148 12.24928 62.8381 12.24928 48.74992 curveto
12.24928 34.66174 21.77951 22.82837 34.14586 15.76189 curveto
51.55032 5.81648 71.84904 3.24956 91.87494 3.24956 curveto
111.90083 3.24956 132.19955 5.81648 149.60402 15.76189 curveto
161.97037 22.82837 171.50058 34.66176 171.50058 48.74992 curveto closepath fill
0 setgray 0 5 dtransform truncate idtransform setlinewidth pop [] 0 setdash
1 setlinejoin 10 setmiterlimit
newpath 175 19.9997 moveto
175 26.74814 169.28001 31.61461 162.96902 34.49959 curveto
153.08626 39.01736 142.1034 39.99939 131.25 39.99939 curveto
120.3966 39.99939 109.41374 39.01736 99.53098 34.49959 curveto
93.21999 31.61461 87.5 26.74814 87.5 19.9997 curveto
87.5 13.25125 93.21999 8.38478 99.53098 5.4998 curveto
109.41374 0.98203 120.3966 0 131.25 0 curveto
142.1034 0 153.08626 0.98203 162.96902 5.4998 curveto
169.28001 8.38478 175 13.25125 175 19.9997 curveto closepath stroke
newpath 8.75053 55.0003 moveto
21.875 33.29926 65.625 33.29926 87.5 50 curveto
88.14128 50.4896 88.77539 49.08981 87.5 47.99957 curveto
65.625 29.29993 21.875 25.3006 8.75053 40.00092 curveto
0.87357 48.82367 4.24365 62.45233 8.75053 55.0003 curveto closepath fill
newpath 49.46408 38.05536 moveto
49.46408 68.05566 lineto
49.46408 70.3895 45.96333 70.3895 45.96333 68.05566 curveto
45.96333 57.651 43.56857 47.38593 38.96451 38.05536 curveto
38.96451 38.05536 lineto closepath fill
newpath 175 100 moveto
149.68242 100 122.35257 99.99756 100.62447 89.99939 curveto
93.93379 86.92068 87.5 82.13274 87.5 75 curveto
87.5 67.86159 93.90027 63.02559 100.62447 60.00061 curveto
118.40366 52.00238 149.7619 52.00043 175 52.00043 curveto
176.3326 52.00043 176.3326 53.99933 175 53.99933 curveto
148.87889 53.99933 117.6357 54.00275 100.62447 67.99927 curveto
98.37648 69.84888 96.25053 72.11244 96.25053 75 curveto
96.25053 77.88683 98.38483 80.14291 100.62447 82.00073 curveto
119.90677 97.99567 148.75916 97.99957 175 97.99957 curveto
176.33362 97.99957 176.33362 100 175 100 curveto closepath fill
0 3 dtransform truncate idtransform setlinewidth pop
gsave 105.00107 75 translate newpath 10 3.75 moveto
10 4.8219 9.48297 5.82532 8.62503 6.46878 curveto
7.59303 7.24277 6.29 7.5 5 7.5 curveto
3.71 7.5 2.40697 7.24277 1.37497 6.46878 curveto
0.51703 5.82532 0 4.8219 0 3.75 curveto
0 2.6781 0.51703 1.67468 1.37497 1.03122 curveto
2.40697 0.25723 3.71 0 5 0 curveto
6.29 0 7.59303 0.25723 8.62503 1.03122 curveto
9.48297 1.67468 10 2.6781 10 3.75 curveto closepath stroke grestore
gsave
138.24883 75 translate
newpath
10 3.75 moveto
10 4.8219 9.48297 5.82532 8.62503 6.46878 curveto
7.59303 7.24277 6.29 7.5 5 7.5 curveto
3.71 7.5 2.40697 7.24277 1.37497 6.46878 curveto
0.51703 5.82532 0 4.8219 0 3.75 curveto
0 2.6781 0.51703 1.67468 1.37497 1.03122 curveto
2.40697 0.25723 3.71 0 5 0 curveto
6.29 0 7.59303 0.25723 8.62503 1.03122 curveto
9.48297 1.67468 10 2.6781 10 3.75 curveto closepath stroke
grestore
0 2 dtransform truncate idtransform setlinewidth pop 1 setlinecap
newpath
1.25 setlinewidth
131.25 75 moveto
131.25 19.9997 lineto
58.2737 19.9997 lineto stroke
newpath
126.87607 75 moveto
126.87607 22.50061 lineto
58.2737 22.50061 lineto stroke
newpath
122.49947 75 moveto
122.49947 25 lineto
58.2737 25 lineto stroke
grestore}def
/cadd{% z1 z2 ==> z1 + z2
3 -1 roll add
3 1 roll add exch
%/auxy exch def /auxx exch def
%auxy add exch auxx add exch
} def
/char 1 string def
/csub{% z1 z2 ==> z1 - z2
3 -1 roll sub neg
3 1 roll sub neg exch
} def
/cdivdict 16 dict def
/cdiv %a b c d as complex numbers
%==> e f as quotient e+if = (a+ib)/(c+id)
{cdivdict begin
/d exch def /c exch def /b exch def /a exch def
c abs d abs gt {/a a c div def /b b c div def /d d c div def
/factor 1 d dup mul add def
/e a b d mul add factor div def
/f b a d mul sub factor div def}
{/a a d div def /b b d div def /c c d div def
/factor 1 c dup mul add def
/e a c mul b add factor div def
/f b c mul a sub factor div def}ifelse
e f
end}def
/centerdash
{0 begin /pattern exch def
/pathlen pathlength def
/patternlength 0 def
pattern
{ patternlength add /patternlength exch def
} forall
pattern length 2 mod 0 ne
{ /patternlength patternlength 2 mul def } if
/first pattern 0 get def
/last patternlength first sub def
/n pathlen last sub cvi patternlength idiv def
/endpart pathlen patternlength n mul sub
last sub 2 div def
/offset first endpart sub def
pattern offset setdash
end } def
/centerdash load 0 9 dict put
%/pathlen {pathlength} def
/centershow{%string --> show string centered
gsave dup stringwidth pop 2 div neg 0 rmoveto show grestore} def
/centersquare
{
newpath
.5 .5 moveto -.5 .5 lineto
-.5 -.5 lineto .5 -.5 lineto
closepath
} def
%/censhow% show string centralized, is already incorporated in PS-2
%{gsave
%dup stringwidth pop -2 div 0 rmoveto show
%grestore} def
/circleinversiondict 30 dict def
/circleinversion % M, R midpoint and radius of to be inverted circle
%m=(mx, my) r midpoint and radius of inversion circle
% ==>
%mi (xi,yi), ri midpoint and radius of inverted circle
{circleinversiondict begin
/r exch def /y exch def /x exch def
/R exch def /Y exch def /X exch def
/Xmx X x sub def
/Ymy Y y sub def
%/lXYmxy Xmx Ymy size def
%diametrical boundary points on line m--M intersected with to be inverted circle
/phi Ymy Xmx atan def
/bp1{/x1 phi cos R mul Xmx add def %X add def
/y1 phi sin R mul Ymy add def %Y add def
x1 y1}def
/bp2{/x2 Xmx phi cos R mul sub def
/y2 Ymy phi sin R mul sub def
x2 y2}def
bp1 0 0 r pointinversion
/yi exch def /xi exch def
bp2 0 0 r pointinversion
/py exch def /px exch def
/yi py yi add .5 mul def /xi px xi add .5 mul def
/ri px xi sub py yi sub size def
/xi xi x add def /yi yi y add def %translate back
xi yi ri
end
} def
/circleorthogonaltotwocircles%Purpose: find a circle orthogonal to 2 circles and passes through p
%x1 y1 r1: center and radius circle 1
%x2 y2 r2: center and radius circle 2
%px py: coordinates external point p
%==>
%mx my r: center and radius orthogonal circle
{0 begin gsave
/py exch def /px exch def /p {px py} def
/r2 exch def /y2 exch def /x2 exch def
/r1 exch def /y1 exch def /x1 exch def
p x1 y1 r1 pointinversion /pi1y exch def /pi1x exch def
pi1x pi1y p middleperpendicularvar /pi1oy exch def /pi1ox exch def /p1oy exch def /p1ox exch def
p x2 y2 r2 pointinversion /pi2y exch def /pi2x exch def
pi2x pi2y p middleperpendicularvar /pi2oy exch def /pi2ox exch def /p2oy exch def /p2ox exch def
pi1ox pi1oy p1ox p1oy pi2ox pi2oy p2ox p2oy intersect /my exch def /mx exch def
%auxlin
%p1ox p1oy moveto pi1ox pi1oy lineto mx my lineto stroke
%p2ox p2oy moveto pi2ox pi2oy lineto stroke
/r px mx sub py my sub size def
mx my r
grestore
end} def %end circleorthogonaltotwocircles
/circleorthogonaltotwocircles load 0 25 dict put
/circleatalphadict 20 dict def
/circleatalpha{%Purpose: construct circle which
%cuts circle C{r(0,0)} at angle and passes through P
%Looked for center > r
%px r alpha rmax: coordinate P at x axis, radius main circle, angle, maximum r
%==>
%coordinate of center along x-axis, radius, interation cnt, angle: mx r cnt angle
circleatalphadict begin
/rmax exch def /alpha exch def /r exch def /px exch def
%bounds for (abscis of) center of circle
/mxr rmax def /mxl r def
%iteration prerequisites
/nmax 25 def %maximum number of interations (safety)
/eps 0.001 def %required absolute precision
/cnt 0 def %maintains number of iterations
%iteration
1 1 nmax{/cnt cnt 1 add def
/mx mxr mxl add 2 div def%bisection
/ri mx px sub def %radius of circle through (px, 0), center (mx,0)
%intersection point as function of ri
/r21 {ri r sub } def /mr21 {ri r add 2 div } def
/xs {mx 2 div r21 mr21 mul mx div sub} def
/ys {r xs sub r xs add mul sqrt } def
/phi ys xs atan def
/psi ys mx xs sub atan def
/angle 180 phi sub psi sub def
angle alpha gt
{/mxr mx def}
{/mxl mx def} ifelse
mxr mxl sub abs eps lt {exit} if
}repeat
mx ri cnt angle
end}def
/circtextdict 16 dict def
circtextdict begin
/findhalfangle
{ stringwidth pop 2 div
2 xradius mul pi mul div 360 mul
} def
/cm { 72 mul 2.52 div} def
/inch {72 mul } def
/outsideplacechar
{ /char exch def
/halfangle char findhalfangle def
gsave
halfangle neg rotate
radius 0 translate
-90 rotate
char stringwidth pop 2 div neg 0 moveto
char show
grestore
halfangle 2 mul neg rotate
} def
/insideplacechar
{ /char exch def
/halfangle char findhalfangle def
gsave
halfangle rotate
radius 0 translate
90 rotate
char stringwidth pop 2 div neg 0 moveto
char show
grestore
halfangle 2 mul rotate
} def
% /pi 3.1415923 def
end
/circumscribed
%Purpose: Calculate circumscribed circle given three disjunct circles
%x1 y1 r1, x2 y2 r2, x3 y3 r3 centerss and radii of three (disjunt) circles
%==>
%x y r midpoint and radius of the inscribed circle
{0 begin
/r3 exch def /y3 exch def /x3 exch def
/r2 exch def /y2 exch def /x2 exch def
/r1 exch def /y1 exch def /x1 exch def
%auxiliary data
/x21 x2 x1 sub def /x31 x3 x1 sub def /x32 x3 x2 sub def
/y21 y2 y1 sub def /y31 y3 y1 sub def /y32 y3 y2 sub def
/r21 r2 r1 sub def /r31 r3 r1 sub def /r32 r3 r2 sub def
/mx21 x2 x1 add 2 div def /mx31 x3 x1 add 2 div def /mx32 x3 x2 add 2 div def
/my21 y2 y1 add 2 div def /my31 y3 y1 add 2 div def /my32 y3 y2 add 2 div def
/mr21 r2 r1 add 2 div def /mr31 r3 r1 add 2 div def /mr32 r3 r2 add 2 div def
/g21 x21 mx21 mul y21 my21 mul add r21 mr21 mul sub def
/g32 x32 mx32 mul y32 my32 mul add r32 mr32 mul sub def
%exchange rows if |a21|> |a11| ie |x32| > |x21|
x32 abs x21 abs gt
{/aux x32 def /x32 x21 def /x21 aux def
/aux y32 def /y32 y21 def /y21 aux def
/aux r32 def /r32 r21 def /r21 aux def
/aux g32 def /g32 g21 def /g21 aux def
%gsave 0 30 moveto (rows exchanged) H12pt setfont show grestore
} if
%express equations for x, y in r
/p x32 x21 div def
/a22 y32 p y21 mul sub def
/a2 r32 p r21 neg mul add a22 div def
/b2 g32 p g21 mul sub a22 div def
/a1 a2 y21 mul r21 sub neg x21 div def
/b1 g21 y21 b2 mul sub x21 div def
/x {a1 r mul b1 add} def
/y {a2 r mul b2 add} def
%coefficients of quadratic equatio A*r^2 -2B*r + C = 0
/A a1 dup mul a2 dup mul add 1 sub def
/B r3 neg a1 b1 x3 sub mul sub
a2 b2 y3 sub mul sub def
/C b1 x3 sub dup mul b2 y3 sub dup mul add r3 neg dup mul sub def
/eps 0.000001 def
A abs eps lt
{/r C B div 2 div def
gsave 0 30 moveto (A < .000001) show grestore}%warning
{/r B A div dup dup mul C A div sub sqrt add def}
ifelse
x y r
}def
/circumscribed load 0 65 dict put
/crlf%next line
{currentpoint 13 sub
exch pop LM exch moveto} def
/cm { 72 mul 2.52 div} def
/closepathproc
{ firstx firsty linetoproc
firstx firsty movetoproc
} def
/ConcatStrings % (s1) (s2) => (s1s2)
{% courtesy acumenjournal dec 2003
dup length % => (s1) (s2) s2len
2 index length % => (s1) (s2) s2len s1len
add string % => (s1) (s2) (s1s2)
dup /NullEncode % => (s1) (s2) (s1s2) (s1s2) /NullEncode
filter % => (s1) (s2) (s1s2) fobj
dup 5 -1 roll % => (s2) (s1s2) fobj fobj (s1)
writestring % => (s2) (s1s2) fobj
3 -1 roll % => (s1s2) fobj (s2)
writestring % => (s1s2) fobj
%closefile % => (s1s2) Q.E.D.
} bind def
/censhow{%Horizontally and vertically centered
%stack: string
dup stringwidth
-2 div exch -2 div exch rmoveto
show} def
/curvetoproc
{ (ERROR: No curveto's after flattenpath!) print
}
def
%Insert names of points, precede by dot to mark the point
/dotsandnames{%[ str,..., str]==>
%str is a name, which stands for a pair, such as in pair moveto
{dup cvn load exec moveto (.) H15pt setfont censhow
H10pt setfont show}forall
}def
/draak %dragon curve with angle A and order p, global scaling s
%angle p ==> dragon curve
{/p exch def /b 180 3 -1 roll sub def%angle B
/h 2 p -2 div exp s def %size piece scaled
/s 0 def
0 0 moveto h 0 lineto
1 1 2 p exp 1 sub{%for n
/m exch def
{m cvi 2 mod 0 eq {/m m 2 div def}{exit}ifelse}loop
m cvi 4 mod 1 eq {/d 1 def}{/d -1 def}ifelse
/s s d sub def
h s b mul cos mul h s b mul sin mul rlineto
}for %n
}def
/dragon %dragon curve of order p, scaling s, initialized in dictionary
%p ==> dragon curve
{dragondict begin /p exch def
/h 2 p -2 div exp s def %size piece scaled
0 0 moveto .8 h mul 0 lineto /dh 0.2824 h mul def /h .6 h mul def
1 1 2 p exp 1 sub{%for n
/m exch def
{m cvi 2 mod 0 eq {/m m 2 div def}{exit}ifelse}loop
m cvi 4 mod 1 eq {/d -45 def}{/d 45 def}ifelse
d rotate dh 0 rlineto d rotate h 0 rlineto %`rounded' corner
}for %n
end}def
/dragondict 8 dict def
dragondict begin /s {50 mul} def end %initial scaling of line piece
/DrawPieChart
{ PieDict begin
/radius exch def
/ycenter exch def /xcenter exch def
/PieArray exch def
/labelps exch def /titleps exch def
/title exch def
gsave
xcenter ycenter translate
/Helvetica findfont titleps scalefont setfont
title stringwidth pop 2 div neg radius neg
titleps 3 mul sub moveto
title show
/Helvetica findfont labelps scalefont setfont
/numslices PieArray length def
/slicecnt 0 def
/curangle 0 def
PieArray
{ /slicearray exch def
slicearray aload pop
/percent exch def
/label exch def
/perangle percent 360 mul def
/slicecnt slicecnt 1 add def
label curangle curangle perangle add
numslices slicecnt findgray DrawSlice
/curangle curangle perangle add def
} forall
grestore
end
} def
/dwirlingsquares%cgl Feb 1997
{0 begin
/r 200 def
/hs r 15 sin mul def /s 2 hs mul def
/rotsq{hs 1 sub 0 moveto
4{90 rotate hs 1 sub 0 lineto}repeat
closepath fill
}def
/ring{12{gsave r 0 translate
rotsq
grestore 30 rotate
}repeat
}def
/rs r hs add 3 add def /mrs rs neg def
/frame{rs mrs moveto rs rs lineto
mrs rs lineto mrs mrs lineto
closepath
}def
/frame{rs 0 moveto
0 0 rs 0 360 arc
closepath
}def
/f r hs sub r div 15 cos mul def
frame 0 setgray fill
1 setgray
12{ring f f scale 15 rotate
}repeat
end} def %end dwirlingsquares
/dwirlingsquares load 0 10 dict put
/ellipsedict 8 dict def
ellipsedict /mtrx matrix put
/ellipse % beginangle endangle==>ellipse arc
{ellipsedict begin
/endangle exch def
/startangle exch def
/yrad exch def
/xrad exch def
/y exch def
/x exch def
/savematrix matrix currentmatrix def
x y translate
xrad yrad scale
0 0 1 startangle endangle arc
savematrix setmatrix
end
}def
%Courtesy AcumenJournal April 2005, John Deubert
errordict begin % Put errordict on the dict stack
/handleerror % Define handleerror:
{ $error begin % Put $error on the dict stack
newerror { % Is neweerror true?
(*** PostScript Error ***) = % Yes: emit error msg
(Error: ) print errorname = % Print error name
(Offending command: ) print /command load ==
(Operand stack: ) = % Print a label
clear % Clear the operand stack
ostack aload pop % Unload ostack
count { % Start of repeat loop
(\t) print == % Print item to %stdout
} repeat % Repeat for each item
flush % Flush %stdout
/newerror false def % Reset newerror
} if
end % Remove $error from the dict stack
} bind def % End of handleerror definition
/dhandleerror /handleerror load def % accommodate Distiller
end % Remove errordict from dict stack
/epicycle%a (rational) r (radius smaller circle) ==> epicycle
{/r exch def/a exch def
1 r add s 0 moveto
1 dup 3600{/t exch def
t cos r a t mul cos mul add s
t sin r a t mul sin mul add s lineto}for
}bind def
% Program ---the script---
%
%/s {60 mul} def
%0 0 1 s 0 360 arc stroke
%11 7 div .61 epicycle stroke showpage
/equalcirclesintersection% Purpose
% Intersection points of two circles with equal radii
%x1 y2 x2 y2 r: centers of circles and radius
%==>
%s1x s1y s2x s2y: two intersection points
{0 begin
/r exch def /y2 exch def /x2 exch def /y1 exch def /x1 exch def
x1 y1 x2 y2 mean /ym exch def /xm exch def
gsave
%translate mean to origin
/x1 x1 xm sub def /y1 y1 ym sub def
/x2 x2 xm sub def /y2 y2 ym sub def
%rotate such that line between centers is x-axis
/angle y2 x2 atan def
x1 y1 angle neg rot /y1 exch def /x1 exch def
/s1x 0 def /s1y r dup mul x1 dup mul sub sqrt def
/s2x 0 def /s2y s1y neg def
s1x s1y angle rot /s1y exch ym add def /s1x exch xm add def
s2x s2y angle rot /s2y exch ym add def /s2x exch xm add def
s1x s1y s2x s2y
end}def
/equalcirclesintersection load 0 22 dict put
/escherknot%cgl 1996 (From MF source)
{gsave
5 5 scale
-21.65 12.5 moveto
-21.65 27.75 -13.78 42.5 0 42.5 curveto
13.78 42.5 21.65 27.75 21.65 12.5 curveto
21.65 -0.25 16.05 -12.19 6.58 -20.33 curveto stroke
0 -25 moveto
-13.20 -32.62 -29.92 -33.19 -36.81 -21.25 curveto
-43.70 -9.31 -34.85 4.88 -21.65 12.5 curveto
-10.61 18.87 2.53 20 14.32 15.87 curveto stroke
21.65 12.5 moveto
34.85 4.88 43.7 -9.31 36.81 -21.25 curveto
29.92 -33.19 13.2 -32.62 0 -25 curveto
-11.04 -18.63 -18.58 -7.8 -20.9 4.46 curveto stroke
-14.32 15.87 moveto
-12.43 23.59 -7.45 29.75 0 29.75 curveto
9.65 29.75 15.16 19.42 15.16 8.75 curveto
15.16 -2.08 9.38 -12.09 0 -17.5 curveto stroke
-6.58 -20.33 moveto
-14.21 -22.56 -22.04 -21.33 -25.76 -14.88 curveto
-30.59 -6.52 -24.4 3.41 -15.16 8.75 curveto
-5.78 14.16 5.78 14.16 15.16 8.75 curveto stroke
20.9 4.46 moveto
26.65 -1.03 29.49 -8.42 25.76 -14.88 curveto
20.94 -23.23 9.24 -22.84 0 -17.50 curveto
-9.38 -12.09 -15.16 -2.08 -15.16 8.75 curveto stroke
grestore } def
/eschertriangledict 1 dict def
/eschertriangle%cgl 1996? Revised 2010
{eschertriangledict begin gsave
%0 0 moveto 420 0 lineto
%420 790 lineto 0 790 lineto closepath
200 400 translate
%0.075 0 0 0 setcmykcolor fill
/p {50 68} def
3{p moveto p neg lineto
-120 rotate
p lineto
120 rotate
currentpoint 2 div neg lineto
currentpoint 3 sqrt mul sub 0 lineto
120 rotate}repeat
blue stroke
grestore end }def
%/eschertriangle load 0 1 dict put
/factorial%natural number n-- n!
{1 exch
-1 2 {mul}for
}def
/ferndict 13 dict def
/fern%Author: Barnsley (1988): Fractals Everywhere. AP. (In PS by cgl)
{ferndict begin gsave 100 100 translate
90 rotate % does not work!
/Courier findfont 7 scalefont setfont
/s 10 def % scaling was 25
/reus 2 31 exp 1 sub def
/up 3 def %Array of mapping functions M [0..up]
/M[{ 0
.16 y mul}
{ .85 x mul -.04 y mul add
.04 x mul .85 y mul add 1.6 add}
{ .2 x mul -.26 y mul add
.23 x mul .22 y mul add 1.6 add}
{-.15 x mul .28 y mul add
.26 x mul .24 y mul add .44 add}
]def
/p[.04 .78 .89 1]def %accumulated probabilities
/thresholdk{reus p k get mul}def
/S{%loop maximum on stack
{/r rand def %compact `nested ifs'
0 1 up{/k exch def
r thresholdk lt {M k get exec
/y exch def /x exch def
exit}if
}for %end nested ifs
x s mul y s mul moveto (.) show
}repeat
}def
/x 0 def /y 0 def
10 srand 32768 S stroke
grestore end}def
%/fern load 0 13 dict put
/fractiondict 5 dict def
/fractionshow
{ fractiondict begin
/denominator exch def
/numerator exch def
/regularfont currentfont def
/fractionfont currentfont [.65 0 0 .6 0 0]
makefont def
gsave
newpath
0 0 moveto
(1) true charpath
flattenpath pathbbox
/height exch def pop pop pop
grestore
0 .4 height mul rmoveto
fractionfont setfont numerator show
0 .4 height mul neg rmoveto
regularfont setfont (\244) show
fractionfont setfont denominator show
regularfont setfont
end
} def
/gentwocirclesintersectiondict 30 dict def
/gentwocirclesintersection{%
%x1 y1 r1: centre and radius circle1
%x2 y2 r2: centre and radius circle2
%==>
%s1x s1y s2x s2y: intersection points
gentwocirclesintersectiondict begin gsave
/Br exch def /By exch def /Bx exch def
/Ar exch def /Ay exch def /Ax exch def
Ar Br lt %exchange:A biggest circle
{0 120 moveto (interchange of circles) show
/aux Ax def /Ax Bx def /Bx aux def
/aux Ay def /Ay By def /By aux def
/aux Ar def /Ar Br def /Br aux def}if
/Bsx Bx Ax sub def /Bsy By Ay sub def%shift (biggest) A -> origin
%/Asx 0 def /Asy 0 def
/phi Bsy Bsx atan def
/d Bsx Bsy size def
/eps 0.0001 def
%auxlin 0 0 moveto Bsx Bsy lineto stroke
%Bsx Bsy phi neg rot /Bsyr exch def /Bsxr exch def
%auxlin 0 0 moveto Bsxr Bsyr lineto stroke
0 140 moveto (Phi=) show phi nstr cvs show
d Ar Br add sub eps gt { 0 140 moveto (No intersection points in gentwocirclesintersection: too far apart) show
(No intersection points in gentwocirclesintersection: too far apart) print
0 0 0 0}if
Ar Br sub d sub eps gt { 0 160 moveto (No intersection points in gentwocirclesintersection: inside circle) show
(No intersection points in gentwocirclesintersection: inside circle) print
0 0 0 0}
{Ar Br sub d sub abs eps le %internal tangent case
Ar Br add d sub abs eps le or %external tangent case
{Ar 0 phi rot 2 copy} %both points are equal
{Ar Br d twocirclesintersection /s1y exch def /s1x exch def /s2y exch def /s2x exch def
s1x s1y phi rot /s1y exch Ay add def /s1x exch Ax add def
s2x s2y phi rot /s2y exch Ay add def /s2x exch Ax add def
s1x s1y s2x s2y
}ifelse
}ifelse
grestore
end} def
%gradientfill2 from AcumenJournal 48 2007
/GradientFill2 % x0 y0 x1 y1 r0 g0 b0 r1 g1 b1 => ---
{ gsave
clip
8 dict begin % Assemble a Type 2 shading dictionary
/ShadingType 2 def
/ColorSpace [ /DeviceRGB ] def
5 dict begin % Create the function dictionary
/FunctionType 2 def
/Domain [ 0 1 ] def
/N 1 def
3 array astore % r1 g1 b1 become the C1 array
/C1 exch def
3 array astore % r0 g0 b0 become the C0 array
/C0 exch def
/Function currentdict end def
4 array astore % x0 y0 x1 y1 go into the Coords array
/Coords exch def
currentdict shfill
end
grestore
newpath
} bind def
/Hfractal%assumed on stack 128 or something like that, the depth
%cgl, aug 2009. Confer Adobe blue book, fractal arrow
{/kxyz exch def
gsave drawaux /lw lw .9 mul def lw setlinewidth %decrease linewidth
/kxyz kxyz 2 mul 3 div def
kxyz 1 gt { 90 rotate kxyz Hfractal
-180 rotate kxyz Hfractal}if
/kxyz kxyz 3 mul 2 div def
/lw lw .9 div def lw setlinewidth
grestore}def%end Hfractal
%Auxiliary in Hfractal
/drawaux{0 kxyz rlineto
currentpoint stroke translate
0 0 moveto}def
/inch {72 mul} def
/inproduct{%p q r u v w => pu+qv+rw
/w exch def /v exch def /u exch def
/r exch def /q exch def /p exch def
p u mul q v mul r w mul add add
}def
/inscribed
%Purpose: Calculate inscribed circle given three disjunct circles
%x1 y1 r1, x2 y2 r2, x3 y3 r3 midpoints and radii of three (disjunt) circles
%==>
%x y r midpoint and radius of the inscribed circle
{0 begin
/r3 exch def /y3 exch def /x3 exch def
/r2 exch def /y2 exch def /x2 exch def
/r1 exch def /y1 exch def /x1 exch def
%auxiliary data
/x21 x2 x1 sub def /x31 x3 x1 sub def /x32 x3 x2 sub def
/y21 y2 y1 sub def /y31 y3 y1 sub def /y32 y3 y2 sub def
/r21 r2 r1 sub def /r31 r3 r1 sub def /r32 r3 r2 sub def
/mx21 x2 x1 add 2 div def /mx31 x3 x1 add 2 div def /mx32 x3 x2 add 2 div def
/my21 y2 y1 add 2 div def /my31 y3 y1 add 2 div def /my32 y3 y2 add 2 div def
/mr21 r2 r1 add 2 div def /mr31 r3 r1 add 2 div def /mr32 r3 r2 add 2 div def
/g21 x21 mx21 mul y21 my21 mul add r21 mr21 mul sub def
/g32 x32 mx32 mul y32 my32 mul add r32 mr32 mul sub def
%exchange rows if |a21|> |a11| ie |x32| > |x21|
x32 abs x21 abs gt
{/aux x32 def /x32 x21 def /x21 aux def
/aux y32 def /y32 y21 def /y21 aux def
/aux r32 def /r32 r21 def /r21 aux def
/aux g32 def /g32 g21 def /g21 aux def
%gsave 0 20 moveto (rows exchanged) show grestore
} if
%express equations for x and y in r
/p x32 x21 div def
/a22 y32 p y21 mul sub def
/a2 r32 neg p r21 mul add a22 div def
/b2 g32 p g21 mul sub a22 div def
/a1 a2 y21 mul r21 add neg x21 div def
/b1 g21 y21 b2 mul sub x21 div def
/x {a1 r mul b1 add} def
/y {a2 r mul b2 add} def
%coefficients of quadratic equatio A*r^2 -2B*r + C = 0
/A a1 dup mul a2 dup mul add 1 sub def
/B r3 a1 b1 x3 sub mul sub
a2 b2 y3 sub mul sub def
/C b1 x3 sub dup mul b2 y3 sub dup mul add r3 dup mul sub def
/eps 0.000001 def
A abs eps lt
{/r C B div 2 div def
gsave 0 30 moveto (A < .000001) show grestore}%warning
{/r B A div dup dup mul C A div sub sqrt add def}
ifelse
x y r
end} def
/inscribed load 0 65 dict put
/insidecircletext
{ circtextdict begin
/radius exch def /centerangle exch def
/ptsize exch def /str exch def
/xradius radius ptsize 3 div sub def
gsave
centerangle str findhalfangle sub rotate
str
{ /charcode exch def
( ) dup 0 charcode put insideplacechar
} forall
grestore
end
} def
/intersect {%p1 p2 p3 p4 -> x y
makecoef 7 3 roll
makecoef
solveit
}def
/kronkeldict 8 dict def
/kronkel % on stack the order; globals s, u, v, a, b, c, d
% ==> fractal island
% Author H.A Lauwerier, Fractals: Meetkundige figuren in eindeloze herhaling
% Transcriptor: Kees van der Laan, kisa1@xs4all.nl, April 2011
%The following three lines have to be provided as globals, adapted for your island
%in contrast with Lauwerier I introduced the scaling s in the base pattern.
%/s {50 mul} def %scale
%/u 4 def /a [ 1 s -1 s -1 s 1 s 1 s ] def /b [1 s 1 s -1 s -1 s 1 s] def%island shape
%/v 4 def /c [ 0 .3333 .5 .6667 ] def /d [0 0 .2887 0 ] def %model
{ kronkeldict begin %push kronkeldict on stack
/p exch def
/x u v p exp mul cvi array def /y u v p exp mul cvi array def%auxiliaries
%calculate coordinates corners `kronkel'
x 0 0 put y 0 0 put
x v p exp cvi 1 put y v p exp cvi 0 put
0 1 p 1 sub{/i exch def %for i
0 v p i sub exp v p exp 1 sub{/j exch def %for j
/m1 j v p i sub exp add def
/dx x m1 cvi get x j cvi get sub def
/dy y m1 cvi get y j cvi get sub def
1 1 v 1 sub{/k exch def %for k
/m2 j k v p i sub 1 sub exp mul add def
x m2 cvi dx c k get mul dy d k get mul sub x j cvi get add put
y m2 cvi dy c k get mul dx d k get mul add y j cvi get add put
}for%k
}for%j
}for%i
%create path for each side m of island
a 0 get b 0 get moveto
0 1 u 1 sub{/m exch def%for m
/da a m 1 add cvi get a m cvi get sub def
/db b m 1 add cvi get b m cvi get sub def
0 1 v p exp{/n exch def%for n
da x n cvi get mul db y n cvi get mul sub a m cvi get add
db x n cvi get mul da y n cvi get mul add b m cvi get add lineto
}for%n
}for%m
end}def
%/length % x y vector (x,y) ne (0,0) => length
%see later for overloading
%{0 begin
%/absy exch abs def /absx exch abs def
%absx absy gt {absx 1 absy absx div dup mul add sqrt mul}
% {absy 1 absx absy div dup mul add sqrt mul} ifelse
%end
%} def
%/length load 0 2 dict put
%Overloading operator
/PSlength {length} bind def % save old meaning
/lengthdict 5 dict def
lengthdict /arraytype {PSlength} put
lengthdict /dicttype {PSlength} put
lengthdict /stringtype {PSlength} put
lengthdict /integertype {size} put
lengthdict /realtype {size} put
/length {
lengthdict begin dup type exec end
} def
/levyfractal{dup 0 eq
{0 0 moveto s 0 rlineto stroke}
{1 sub /s s 1.4142 div def
gsave 45 rotate levyfractal grestore
s 1.4141 div dup translate
-45 rotate levyfractal
/s s 1.4142 mul def
1 add}ifelse
}def
/LevyLauwerier{/p exch def%order => Levy fractal %l global
0 0 moveto l 0 lineto %order 0
p 1 eq {0 l neg rlineto} %order 1, linpieces 0, 1
{0 %previous phi on stack
1 1 2 p exp 1 sub {%for%n, the number of the linepieces 1,2,...
0 exch %s n :s sum of bimals and n the linepiece number on stack
p{dup 2 mod 3 -1 roll add exch 2 idiv}repeat pop%discard n
4 mod 90 mul dup 3 1 roll sub rotate l 0 rlineto
}for%n
pop%discard phi
}ifelse stroke}def
/lineintersectscircle%
%x1 y1 x2 y2: points which specify the line
%mx my r: centre and radius of circle
{0 begin
/r exch def /my exch def /mx exch def
/y2 exch def /x2 exch def /y1 exch def /x1 exch def
/angle y1 y2 sub x1 x2 sub atan 90 sub def
%shift upper point, ie center of circle becomes 0 0
/y1 y1 my sub def /x1 x1 mx sub def
/lx x1 angle cos mul y1 angle sin mul add def%abcis rotated point
lx abs r lt{%cuts the circle
/yi r r mul lx dup mul sub sqrt def
/x1 lx def /y1 yi def /x2 x1 def /y2 y1 neg def
x1 y1 angle rot /y1 exch my add def /x1 exch mx add def
x2 y2 angle rot /y2 exch my add def /x2 exch mx add def
x1 y1 x2 y2
}{(No intersection point) show}ifelse
end
} def
/lineintersectscircle load 0 20 dict put
/lineinversion% x1 y1 x2 y2 the points which determine the line
% mx my r the centre and radius of the inversion circle
%==>
%mix miy ri midpoint and radius of the inverted line
{0 begin/eps .0001 def
/r exch def /my exch def /mx exch def
/y2 exch def /x2 exch def /y1 exch def /x1 exch def
/angle y1 y2 sub x1 x2 sub atan def
angle abs 90 sub abs eps lt
angle abs 270 sub abs eps lt or
{%special case: vertical line
%gsave 0 100 moveto (angle= ) show angle nstr cvs show grestore
x1 my mx my r pointinversion mx my mean /miy exch def /mix exch def
/ri mix mx sub miy my sub size def
}{angle abs 180 sub abs eps lt
angle abs 360 sub abs eps lt or
angle abs eps lt or
{%special case: horizontal line
%gsave 0 90 moveto (angle= ) show angle nstr cvs show grestore
mx y1 mx my r pointinversion mx my mean /miy exch def /mix exch def
/ri mix mx sub miy my sub size def
}{%general case
angle 180 gt {/angle angle 180 sub def} if%reduce to 0-180
/angle 90 angle sub def
%gsave 0 90 moveto (angle= ) show angle nstr cvs show grestore
/y1 y1 my sub def /x1 x1 mx sub def %shift point 1
x1 y1 angle rot pop /lx exch def
%lx 0 mx my r pointinversion mx my mean /miy exch def /mix exch def
lx abs eps lt{(Line through origin?) print}if %warning
/mix r dup mul lx div 2 div def /miy 0 def%center circle
/ri miy my sub mix mx sub size def %radius circle
%rotate back and shift
mix miy angle neg rot /miy exch my add def /mix exch mx add def
}ifelse
}ifelse
mix miy ri
end} def
/lineinversion load 0 25 dict put
/linepieceinversiondict 16 dict def
/linepieceinversion% x1 y1 x2 y2 the points which determine the line
% mx my r the centre and radius of the inversion circle
%==>
%path of inverted cirle arc
{linepieceinversiondict begin
/r exch def /my exch def /mx exch def
/y2 exch def /x2 exch def /y1 exch def /x1 exch def
x1 y1 x2 y2 mx my r lineinversion /ri exch def /miy exch def /mix exch def
%gsave mix miy ri 0 360 arc wanlin stroke grestore
x1 y1 mx my r pointinversion /y1 exch def /x1 exch def
x2 y2 mx my r pointinversion /y2 exch def /x2 exch def
/phi1 y1 miy sub x1 mix sub atan def
/phi2 y2 miy sub x2 mix sub atan def
%0 70 moveto (ri= ) show ri nstr cvs show
%0 80 moveto (phi2= ) show phi2 nstr cvs show
%0 90 moveto (phi1= ) show phi1 nstr cvs show
mix miy mul 0 gt
{x1 y1 moveto mix miy ri phi1 phi2 arc}
{x2 y2 moveto mix miy ri phi2 phi1 arc} ifelse
end} def
/linetoproc
{ /oldx newx def /oldy newy def
/newy exch def /newx exch def
/dx newx oldx sub def
/dy newy oldy sub def
/dist dx dup mul dy dup mul add sqrt def
dist 0 ne
{ /dsx dx dist div ovr mul def
/dsy dy dist div ovr mul def
oldx dsx add oldy dsy add transform
/cpy exch def /cpx exch def
/pathdist pathdist dist add def
{ setdist pathdist le
{ charcount str length lt
{setchar} {exit} ifelse }
{ /ovr setdist pathdist sub def
exit }
ifelse
} loop
} if
} def
/linetoproc load 0 13 dict put
/line{0 0 moveto 0 s lineto stroke}def
/spread{% value maxspread ==> new value
rand maxint div .5 sub 2 mul mul add }def
/linetree{line 0 s translate %draw the line and translate user space
1 sub dup 0 gt
{gsave 45 10 spread rotate .7071 .2 spread dup scale %transformed user space
linetree %do it again, Sam
grestore
-45 10 spread rotate .7071 .2 spread dup scale %transformed user space
linetree %do it again, Sam
}if 1 add
gsave 0 1 0 setrgbcolor line grestore
} def
/lissajous%n m ==> lissajous figure
{/m exch def /n exch def
0 0 moveto
0 1 360{/t exch def
n t mul sin s m t mul sin s lineto}for
}bind def
/LM 72 def%left margin
/logspiral%cgl logarithmic or grow spiral
{0 begin
gsave
350 400 translate
/Courier findfont 20 scalefont setfont
/a .00019 def /b .002 def /e 2.714 def
a 0 moveto
100 5 7110{/t exch def
/r a e b t mul exp mul def
r t cos mul % x on stack
r t sin mul % y on stack
lineto
}for
currentpoint /yc exch def /xc exch def
a 0 moveto
/a a 1.25 mul def
100 5 7110{/t exch def
/r a e b t mul exp mul def
r t cos mul % x on stack
r t sin mul % y on stack
lineto
}for
xc yc lineto
stroke
40 -40 moveto (Kees & Sveta) show
grestore
end}def
/logspiral load 0 10 dict put
/makecoef{%z1 z2 -> e a b
4 copy %x1 y1 x2 y2 x1 y1 x2 y2
4 -1 roll mul %x1 y1 x2 y2 y1 x2 (y2x1)
3 1 roll mul sub %x1 y1 x2 y2 (y2x1-y1x2)
5 1 roll 3 -1 roll sub
%(y2x1-y1x2) x1 x2 y2-y1
3 1 roll sub %(y2x1-y1x2) y2-y1 x1-x2
}def
/maxint 2147483647 def% 2^31 - 1
/mcsiercgl%==> Sierpinski triangle fractal
{/nmax 10000 def 22121943 srand
/c .5 def /x .5 def /y 0 def
nmax{/l 3 nrand mul floor def
l 0 eq{/e -.5 def /f -.247 def}if
l 1 eq{/e .5 def /f -.247 def}if
l 2 eq{/e 0 def /f .493 def}if
/x c x e sub mul e add def
/y c y f sub mul f add def
x s y s moveto (.) show
}repeat
}bind def
%
% Program ---the script---
%
%/nrand{rand 2147483647 div} def %normalized to [0,1)random
%/Courier 1 selectfont
%/s {100 mul} def
%mcsiercgl
%showpage
/mean{%p0 p1 on stack -> .5[p0, p1]
exch 4 -1 roll add .5 mul
3 1 roll add .5 mul}def
/middleperpendiculardict 8 dict def
/middleperpendicular{
% x1 y1 x2 y2 two points on stack
%==>
% point on perpendicular and foot of perpendicular
middleperpendiculardict begin
/y2 exch def /x2 exch def /y1 exch def /x1 exch def
%/xm x1 x2 add 2 div def /ym y1 y2 add 2 div def%middle
x1 y1 x2 y2 mean /ym exch def /xm exch def
%translate (xm, ym) to Origin , rotate 90 degrees, translate back
/aux y1 ym sub neg xm add def
/y1 x1 xm sub ym add def
aux y1 xm ym
end
} def
/mediation {% a b t ==> c
% c is weighted average of a and b; c = a * (1-t) + b * t
dup 1 exch sub 4 -1 roll mul
3 1 roll mul add
} bind def
/middleperpendicularvardict 10 dict def
/middleperpendicularvar{
% x1 y1 x2 y2 two points on stack
%==>
% point on perpendicular and foot of perpendicular
middleperpendicularvardict begin
/y2 exch def /x2 exch def /y1 exch def /x1 exch def
%/xm x1 x2 add 2 div def /ym y1 y2 add 2 div def%middle
x1 y1 x2 y2 mean /ym exch def /xm exch def
%translate (xm, ym) to Origin , rotate 90 degrees, translate back
/aux y1 ym sub neg xm add def
/y1 x1 xm sub ym add def
aux y1 %xm ym
/aux y2 ym sub neg xm add def
/y2 x2 xm sub ym add def
aux y2
end
} def
/mink{/p exch def%order, global l length of initial line
/a [ 0 1 0 3 3 0 1 0] def
/t p array def 0 0 moveto
/h l 4 p exp div def
0 1 8 p exp 1 sub{/m exch def
0 1 p 1 sub{t exch m cvi 8 mod put /m m cvi 8 idiv def}for
/s 0 def
0 1 p 1 sub{/s a t 4 -1 roll get get s add cvi 4 mod def}for
s 0 eq { h 0 rlineto}if
s 1 eq { 0 h rlineto}if
s 2 eq { h neg 0 rlineto}if
s 3 eq { 0 h neg rlineto}if
}for stroke} def
/mm {72 25.4 div mul} def
/Mondrian
%birthday: ddmmyyyy, a number as seed for srand
%three numbers from the closed interval [0, 1], for the rgb-color values: red green blue
%number for the kind of frame (0=Square 1=Oval 2=Lozenge): 0, 1 or 2
%==>
%generated Mondrian-alike
{0 begin gsave %savety for not changing the graphics state outside
/form exch def
/b exch def /g exch def /r exch def /date exch def
date srand% start random generator with (birthday date) seed
100 50 translate
%wired-in parameters
/u 420 def /v u 1.618 mul def /hu u 2 div def /hv v 2 div def%BB of rectangle: 0 0 u v
/maxrandom 500 def /maxlength 20 def /maxwidth 3 def /eps 0.1 def
/hx {u unifrmdev} def
/hy {v unifrmdev} def
/l {maxlength unifrmdev}def
/w {maxwidth unifrmdev} def
/spread {2 unifrmdev mul }def %(0, 2)
%/spread {2 unifrmdev 1 add 2 div mul }def%(0.5, 1.5)
%/spread {2 unifrmdev 3 add 4 div mul }def%(0.75, 1.25)
/color{r 0 eq {eps}{r} ifelse spread
g 0 eq {eps}{g} ifelse spread
b 0 eq {eps}{b} ifelse spread} def
form 0 eq {/contour {0 0 moveto u 0 lineto u v lineto 0 v lineto closepath} def} if %square
form 1 eq {/contour {hu hv hu hv 0 360 ellipse} def} if %oval
form 2 eq {/contour {hu 0 moveto u hv lineto hu v lineto 0 hv lineto closepath} def} if%lozenge
%
gsave contour clip%random pattern will only show up in (is clipped to) contour
maxrandom{%draw pattern in loop confined to contour
/xaux hx def /yaux hy def%position in (0, u) x (0, v) rectangle
/laux l 2 div def
xaux laux sub yaux moveto xaux laux add yaux lineto w setlinewidth color setrgbcolor stroke%h-line
/xaux hx def /yaux hy def
/laux l 2 div def
xaux yaux laux sub moveto xaux yaux laux add lineto w setlinewidth color setrgbcolor stroke%v-line
}repeat
grestore %end clipping path
contour 7 setlinewidth r g b setrgbcolor stroke%original color od choice
H12pt setfont /nstr 8 string def %0 0 0 setrgbcolor
u 85 sub v 10 add moveto (RGB: ) show
r nstr cvs show ( ) show
g nstr cvs show ( ) show
b nstr cvs show
u 85 sub -20 moveto (Seed: ) show date nstr cvs show
grestore end}def%end Mondrian
/Mondrian load 0 26 dict put
/Mondriancmyk
%birthday: ddmmyyyy a number as seed
%cmykcolor values: c(yaan) m(agenta) y(ellow) and (blac)k
%number: 0=square 1=oval 2=lozenge
%==>
%generated Mondrian
{0 begin
gsave
/form exch def
/k exch def /y exch def /m exch def /c exch def
/date exch def
date srand% start random generator with (birthday date) seed
100 50 translate
%parameters
/u 425 def /v u 1.618 mul def %size of rectangle
/hu u 2 div def /hv v 2 div def
/maxrandom 500 def /maxlength 20 def /maxwidth 3 def %maximum parameters
/eps 0.1 def
%
form 0 eq {/contour {0 0 moveto u 0 lineto u v lineto 0 v lineto closepath} def} if %square
form 1 eq {/contour {hu hv hu hv 0 360 ellipse} def} if %oval
form 2 eq {/contour {hu 0 moveto u hv lineto hu v lineto 0 hv lineto closepath} def} if%lozenge
gsave %generate random pattern clipped to within contour
contour
clip
maxrandom{
/hx {u unifrmdev} def
/hy {v unifrmdev} def
/l {maxlength unifrmdev}def
/w {maxwidth unifrmdev} def
/spread {2 unifrmdev mul }def%(0, 2)
%/spread {2 unifrmdev 1 add 2 div mul }def%(0.5, 1.5)
%/spread {2 unifrmdev 2 add 4 div mul }def%(0.75, 1.25)
/color {c 0 eq {eps}{c} ifelse spread
m 0 eq {eps}{m} ifelse spread
y 0 eq {eps}{y} ifelse spread
k spread %0 eq {eps}{k} ifelse spread
} def
/x hx def /yaux hy def /laux l 2 div def
x laux sub yaux moveto x laux add yaux lineto w setlinewidth color setcmykcolor stroke%horizontal lines
/x hx def /yaux hy def /laux l 2 div def
x yaux laux sub moveto x yaux laux add lineto w setlinewidth color setcmykcolor stroke%vertical lines
}repeat
grestore
contour 7 setlinewidth c m y k setcmykcolor stroke
grestore
H12pt setfont /nstr 8 string def
c m y k setcmykcolor
u 40 sub v 70 add moveto (CMYK: ) show
c nstr cvs show ( ) show
m nstr cvs show ( ) show
y nstr cvs show ( ) show
k nstr cvs show ( ) show
u 10 sub 30 moveto (Seed: ) show date nstr cvs show
end}def%end Mondrian
/Mondriancmyk load 0 32 dict put
/mousetail
{gsave
/Times-Bold findfont 12 scalefont setfont
/crlf { .995 dup scale
currentpoint 12 sub exch pop 10 exch moveto } def
10 770 moveto
[ (Fury said to)
( a mouse, That)
( he met)
( in the )
( house,)
( `Let us)
( both go)
( to law:)
( I will)
( prosecute)
( you.)
( Come, I'll)
( take no)
( denial;)
( We must)
( have a)
( trial:)
( For)
( really)
( this)
( morning)
( I 've)
( nothing)
( to do.')
( Said the)
( mouse to)
( the cur,)
( `Such a)
( trial,)
( dear sir,)
( With no)
( jury or)
( judge,)
( would be)
( wasting)
( our breath.')
( `I'll be)
( judge)
( I'll be)
( jury,')
( Said)
( cunning)
( old Fury:)
( `I'll try)
( the whole)
( cause,)
( and)
( condemn)
( you)
( to)
( death.')]
{show crlf}
forall
grestore} def
/movetoproc
{ /newy exch def /newx exch def
/firstx newx def /firsty newy def
/ovr 0 def
newx newy transform
/cpy exch def /cpx exch def
} def
/movetoproc load 0 7 dict put
/ncircles
%n r the number of circles and radius of the ring
%=>
%-- ring of circles and inscribed and circumscribed cicle
{0 begin /r exch def /n exch def
gsave
/angle 180 n div def /2angle angle dup add def
/rc r angle sin mul def
n{newpath
0 r rc 0 360 arc stroke
2angle rotate}repeat
0 0 r rc add 0 360 arc stroke %circumscribed
0 0 r rc sub 0 360 arc stroke %inscribed
grestore end}def
/ncircles load 0 5 dict put
/nfactorial{ natural number n --- n! %more direct than in BLUebook
1 exch
-1 1{mul}for
}def
/nl{%dependent on font size
currentpoint 16 sub
exch pop
LM exch
moveto}
def
/newline{%dependent on font size
currentpoint 11 sub
exch pop LM exch moveto}def
/prtchar %stack code (BlueBook)
{ char 0 3 -1 roll put
char show}def
/PrintCodeandChar %stack code (BlueBook)
{dup prt-n
( ) show
prtchar newline}def
/prt-n{% stack: n
nstr cvs show }def
/square{0 0 moveto s 0 rlineto 0 s rlineto s neg 0 rlineto closepath stroke}def
/pythagoreantree{square %draw the square
1 sub dup 0 gt
{gsave 0 s translate 45 rotate .7071 dup scale %transformed user space
pythagoreantree %do it again, Sam
grestore
.5 s mul 1.5 s mul translate -45 rotate .7071 dup scale %transformed user space
pythagoreantree %do it again, Sam
}if 1 add } def
/origin { 0 0 } def
/ortho %lx ly point on left leg
%x y cornerpoint
%s size s
%==>
%ortho symbol drawn of size s
{0 begin
/s exch def
/y exch def /x exch def
/ly exch def /lx exch def
gsave x y translate
lx x sub ly y sub atan neg rotate
0 s moveto s s lineto s 0 lineto stroke
grestore
end
}def
/ortho load 0 5 dict put
/orthogonal % r phi1 phi2 on stack
%Purpose draw inner arc of orthogonal circle through (r cos phi1, r sin phi1) and (r cos phi2, r sin phi2)
{0 begin
/phi2 exch def /phi1 exch def /r exch def
/h r phi1 phi2 sub .5 mul cos div def%auxiliary
/xP {r phi1 cos mul r phi1 sin mul}def
/mphi12 phi1 phi2 add .5 mul def %mean
/xm12 h mphi12 cos mul def %x coord circlecentre
/ym12 h mphi12 sin mul def %y coord circle centre
/rm12 phi1 phi2 sub .5 mul dup sin exch cos div r mul def % r*tan.5(phi1-phi2) is radius
%0 0 moveto xm12 ym12 lineto stroke %bisectrice, end is center of d-line
%xm12 ym12 moveto 2 0 rmoveto (m) show
%
xP moveto xm12 ym12 rm12 phi1 90 add dup 180 phi1 sub phi2 add add arc stroke
end}
def
/orthogonal load 0 9 dict put
/orthocirclethroughp%Purpose; calculate the circle which passes through P
%and is ortogonal to given circle
%px py x y r: point and circle
%==>
%x y r: orthogonal circle
{orthocirclethroughpdict begin
/r exch def /y exch def /x exch def /py exch def /px exch def
px py x y r pointinversion /piy exch def /pix exch def
px py pix piy mean /y exch def /x exch def
x y x px sub y py sub size
end}def
/orthocirclethroughpdict 9 dict def
/oshow {true charpath stroke } def
/outproductdict 6 dict def
/outproduct{% p q r u v w => qw-rv, ru-pw, pv-qu
outproductdict begin
/w exch def /v exch def /u exch def
/r exch def /q exch def /p exch def
q w mul r v mul sub
r u mul p w mul sub
p v mul q u mul sub
end}def
/outsidecircletext
{ circtextdict begin
/radius exch def
/centerangle exch def
/ptsize exch def
/str exch def
/xradius radius ptsize 4 div add def
gsave
centerangle str findhalfangle add rotate
str
{ /charcode exch def
( ) dup 0 charcode put outsideplacechar
} forall
grestore
end
} def
/pathtextdict 26 dict def
/pathtext
{ pathtextdict begin
/offset exch def
/str exch def
/pathdist 0 def
/setdist offset def
/charcount 0 def
gsave
flattenpath
{movetoproc} {linetoproc}
{curvetoproc} {closepathproc }
pathforall
grestore
newpath
end
} def
pathtextdict begin
/movetoproc
{ /newy exch def /newx exch def
/firstx newx def /firsty newy def
/ovr 0 def
newx newy transform
/cpy exch def /cpx exch def
} def
/linetoproc
{ /oldx newx def /oldy newy def
/newy exch def /newx exch def
/dx newx oldx sub def
/dy newy oldy sub def
/dist dx dup mul dy dup mul add sqrt def
dist 0 ne
{ /dsx dx dist div ovr mul def
/dsy dy dist div ovr mul def
oldx dsx add oldy dsy add transform
/cpy exch def /cpx exch def
/pathdist pathdist dist add def
{ setdist pathdist le
{ charcount str length lt
{setchar} {exit} ifelse }
{ /ovr setdist pathdist sub def
exit }
ifelse
} loop
} if
} def
/curvetoproc
{ (ERROR: No curveto's after flattenpath!) print
} def
/closepathproc
{ firstx firsty linetoproc
firstx firsty movetoproc
} def
/setchar
{ /char str charcount 1 getinterval def
/charcount charcount 1 add def
/charwidth char stringwidth pop def
gsave
cpx cpy itransform translate
dy dx atan rotate
0 0 moveto char show
currentpoint transform
/cpy exch def /cpx exch def
grestore
/setdist setdist charwidth add def
} def
end
/pathlength
{flattenpath
/dist 0 def
{ /yfirst exch def /xfirst exch def
/ymoveto yfirst def /xmoveto xfirst def }
{ /ynext exch def /xnext exch def
/dist dist ynext yfirst sub dup mul
xnext xfirst sub dup mul add sqrt add def
/yfirst ynext def /xfirst xnext def }
{}
{ /ynext ymoveto def /xnext xmoveto def
/dist dist ynext yfirst sub dup mul
xnext xfirst sub dup mul add sqrt add def
/yfirst ynext def /xfirst xnext def }
pathforall
dist
} def
%/pathlength load 0 25 dict put%not necessary, just load the def
/setchar
{ /char str charcount 1 getinterval def
/charcount charcount 1 add def
/charwidth char stringwidth pop def
gsave
cpx cpy itransform translate
dy dx atan rotate
0 0 moveto char centershow
currentpoint transform
/cpy exch def /cpx exch def
grestore
/setdist setdist charwidth add def
} def
%/setchar load 0 5 dict put %not necessary
/octaederincube%cgl 2009 (symmetric in projection, with arrays)
{0 begin
/ptpa{/vec exch def %Stack [ px py pz ] -> (x, y) pair
vec 0 get -.6 mul vec 1 get .8 mul add
-4 vec 0 get mul -3 vec 1 get mul add 12 vec 2 get mul add 13 div}def
%Coordinates from center of gravity, so edge is 2r
/r 100 def /mr r neg def %size of cube, edge 2r
/u1 [ r mr r] def /u2 [ r r r] def /u3 [ mr r r] def /u4 [ mr mr r] def
/b1 [ r mr mr] def /b2 [ r r mr] def /b3 [ mr r mr] def /b4 [ mr mr mr] def
%
/cube{u1 ptpa moveto u2 ptpa lineto u3 ptpa lineto u4 ptpa lineto closepath
b1 ptpa moveto b2 ptpa lineto b3 ptpa lineto b4 ptpa lineto closepath
%edges (vertical)
u1 ptpa moveto b1 ptpa lineto
u2 ptpa moveto b2 ptpa lineto
u3 ptpa moveto b3 ptpa lineto
u4 ptpa moveto b4 ptpa lineto}def
cube gsave [3 5]6 setdash stroke grestore %ordinary cube dashed
/o1 [r 0 0]def /o2 [0 r 0]def /o3 [mr 0 0]def /o4 [0 mr 0]def
/o5 [0 0 r]def /o6 [0 0 mr]def
/octaeder{o1 ptpa moveto o2 ptpa lineto o3 ptpa lineto o4 ptpa lineto closepath
o5 ptpa moveto o1 ptpa lineto
o5 ptpa moveto o2 ptpa lineto
o5 ptpa moveto o3 ptpa lineto
o5 ptpa moveto o4 ptpa lineto
o6 ptpa moveto o1 ptpa lineto
o6 ptpa moveto o2 ptpa lineto
o6 ptpa moveto o3 ptpa lineto
o6 ptpa moveto o4 ptpa lineto}def
newpath
gsave
9 setlinewidth 1 setlinecap 1 setlinejoin
octaeder 0 0.5 0 setrgbcolor stroke
grestore
0.5 0.5 0.5 setrgbcolor
%x-y-z coordinate axis
/ptp{/z exch def/y exch def/x exch def
x -.6 mul y .8 mul add
-4 x mul -3 y mul add 12 z mul add 13 div}def
/Times-Roman findfont 14 scalefont setfont
/r r 3 mul def /mr r neg def
mr 0 0 ptp moveto
r 0 0 ptp lineto 4 -12 rmoveto (x) show
0 mr 0 ptp moveto
0 r 0 ptp lineto 0 -12 rmoveto (y) show
0 0 mr ptp moveto
0 0 r ptp lineto 6 -12 rmoveto (z) show
[3 5]6 setdash stroke
end }def %octaederincube
/octaederincube load 0 32 dict put
/PieDict 24 dict def
PieDict begin
/DrawSlice
{ /grayshade exch def
/endangle exch def
/startangle exch def
/thelabel exch def
newpath 0 0 moveto
0 0 radius startangle endangle arc
closepath
1.415 setmiterlimit
gsave
grayshade setgray
fill
grestore
stroke
gsave
startangle endangle add 2 div rotate
radius 0 translate
newpath
0 0 moveto labelps .8 mul 0 lineto stroke
labelps 0 translate
0 0 transform
grestore
itransform
/y exch def /x exch def
x y moveto
x 0 lt
{ thelabel stringwidth pop neg 0 rmoveto }
if
y 0 lt { 0 labelps neg rmoveto }if
thelabel show
} def
/findgray
{ /i exch def /n exch def
i 2 mod 0 eq
{ i 2 div n 2 div round add n div }
{ i 1 add 2 div n div }
ifelse
} def
end
/pi 3.1415923 def
/pidecimals%cgl Macrh 2010. Programming pearl BachoTeX2010
{gsave blue
/Helvetica findfont 22 scalefont setfont
gsave%wanted to rotate 90, but that did not work, so kludged around with 89.9
0 0 moveto 89.9 rotate (3) show 1 0 rmoveto
(.) show -1 0 rmoveto -10 rotate .995 dup scale
{pop pop -10 rotate 3 0 rmoveto .995 dup scale}
(14159265358979323846264338327950288419716939937510582097494459230781640628620899862803482534211706798214808651328230664709384460955058223172535940812848111745028410270193852110555964462294895493038196442881097566593344612847564823378678316527120190914564856692346034861045432664821339360726024914127372458700660631558817488152092096282925409171536436789259036001133053054882046652138414695194151160943305727036575959195309218611738193261179...) kshow
grestore
/Symbol findfont 26 scalefont setfont
80 3 moveto (p) show
grestore}def
%Consult Wolfram knowledgebase for many decimals
%Already included earlier
%/PSlength {length} bind def % save old meaning
%/lengthdict 5 dict def
%lengthdict /arraytype {PSlength} put
%lengthdict /dicttype {PSlength} put
%lengthdict /stringtype {PSlength} put
%lengthdict /integertype {size} put
%lengthdict /realtype {size} put
%/length {lengthdict begin dup type exec end} def
/plus%marker for point x y on stack
{0 begin
/y exch def /x exch def
gsave
x y translate
-2 0 moveto 2 0 lineto stroke
0 -2 moveto 0 2 lineto stroke
grestore
end
}def
/plus load 0 2 dict put
/pointinversion%Px,Py: point to be inverted
%mx, my, r : center and radius of inversion circle
%==>
%px, py: inverted point
{0 begin
/r exch def /my exch def /mx exch def
/Py exch def /Px exch def
/Px Px mx sub def /Py Py my sub def%shift origin to center I circle
/factor r Px Py size div dup mul def
/px mx factor Px mul add def /py my factor Py mul add def
px py
end
} def
/pointinversion load 0 10 dict put
%Correction feb2011
/ptp{% point x y z ==> x' y'
% use: /pair { x y z ptp } def
%parameters: phi, theta viewing angles
%coordinate system xyz: x to yuo y right z up, right turning
ptpdict begin
/z exch def/y exch def/x exch def
x phi sin mul neg y phi cos mul add
x phi cos mul theta sin mul neg y phi sin mul theta sin mul sub
z theta cos mul add
end}bind def
/ptpdict 3 dict def
/ptpf{% with fixed, pleasant viewing angles
ptpfdict begin
/z exch def/y exch def/x exch def
-0.6 x mul 0.8 y mul add
-4 x mul -3 y mul add
12 z mul add 13 div
end}bind def
/ptpfdict 3 dict def
/sq {0 0 moveto s 0 rlineto 0 s rlineto s neg 0 rlineto closepath stroke} def
/pythsq{%Global variables: s phi cosphi sinphi
%on stack integer (depth>=1)
sq %draw the square
1 sub dup 0 gt
{gsave
0 s translate phi rotate cosphi dup scale pythsq
grestore
s cosphi dup mul mul s sinphi cosphi mul mul s add translate
phi 90 sub rotate sinphi dup scale pythsq
}if 1 add}def
/pythsqsym{sq %draw the square
depth 0 gt
{gsave 0 s translate 45 rotate .7071 dup scale %transformed user space
down pythsqsym up %do it again, Sam
grestore
.5 s mul 1.5 s mul translate -45 rotate .7071 dup scale %transformed user space
down pythsqsym up %do it again, Sam
}if}def
/pythtree
{gsave /k exch def
0 k rlineto currentpoint stroke translate 0 0 moveto
k 1 gt{-45 rotate k 2 div pythtree /k k 2 mul def
90 rotate k 2 div pythtree /k k 2 mul def}if
grestore} def
/l {0 0 moveto 0 s rlineto stroke} def
%/l {0 0 moveto 0 s rlineto stroke} def
/down{/depth depth 1 sub def}def /up{/depth depth 1 add def}def
/pythtreesymold{l %draw the line %******** OLD *********
depth 0 gt
{0 s translate .7071 dup scale
gsave
45 rotate
down pythtreesymold up %play it again, Sam
grestore
-45 rotate
down pythtreesymold up %play it again, Sam
}if}def
/down{/depth depth 1 sub def}def /up{/depth depth 1 add def}def
/pythtreesym{l %draw the line
depth 0 gt
{0 s translate .7071 dup scale
gsave
45 rotate
down pythtreesym up %play it again, Sam
grestore
-45 rotate down pythtreesym up %play it again, Sam
}if}def
/PYTHB1{%Pythagoras Tree a la Lauwerier in PS
%auxiliaries
/Left{0 .5 s mul translate
45 rotate
c c scale
0 s translate}def
/Right{0 .5 s mul translate
-45 rotate
c c scale
0 s translate}def
/c .7010 def %1/sqrt2 scaling constant
/drawsquare{-.5 s mul dup s s rectstroke
0 0 moveto /l l 1 add def l ( ) cvs centershow }def
%
/p exch def /A p 1 add array def
0 1 p{/m exch def
2 m exp 1 2 m 1 add exp 1 sub{%2^m 1 2^(m+1)-1
/n exch def
gsave
0 1 m 1 sub{/k exch def %store binary representation of n in A
A m k sub cvi n cvi 2 mod put /n n cvi 2 idiv def
}for%binary digits of n into A
%transform user space
1 1 m{A exch get 0 eq {Left}{Right}ifelse}for
drawsquare
grestore
}for%n
}for%m
} bind def
/radical%Purpose: draw circle orthogonal to three distinct circles, the radicaL circle
%x1 y1 r1: centre and radius of first circle
%x2 y2 r2: centre and radius of first circle
%x3 y3 r3: centre and radius of first circle
%==>
%x y r: centre and radius of radical circle
{0 begin
/Ar exch def /Ay exch def /Ax exch def
/Br exch def /By exch def /Bx exch def
/Cr exch def /Cy exch def /Cx exch def
/A {Ax Ay} def /B {Bx By} def /C {Cx Cy} def
/eps .0001 def
gsave
%conjugate pair with C
A Ar
B Br
C Cr neg Apollonius /r1 exch def /y1 exch def /x1 exch def
gsave auxlin
%newpath x1 y1 r1 0 360 arc stroke
%x1 y1 plus
%C moveto x1 y1 lineto stroke
C x1 y1 x1 y1 r1 lineintersectscircle /sc1y exch def /sc1x exch def /sc2y exch def /sc2x exch def
%selection intersection point
/h1 x1 sc1x sub y1 sc1y sub size def
/h2 x1 sc2x sub y1 sc2y sub size def
h1 r1 sub abs eps lt {/Cs1x sc2x def /Cs1y sc2y def} {/Cs1x sc1x def /Cs1y sc1y def} ifelse
%x1 y1 moveto Cs1x Cs1y lineto stroke
%
A Ar neg
B Br neg
C Cr Apollonius /r2 exch def /y2 exch def /x2 exch def
auxlin
%newpath x2 y2 r2 0 360 arc stroke
%x2 y2 plus
%C moveto x2 y2 lineto stroke
C x2 y2 x2 y2 r2 lineintersectscircle /sc1y exch def /sc1x exch def /sc2y exch def /sc2x exch def
%selection intersection point
/h1 x2 sc1x sub y2 sc1y sub size def
/h2 x2 sc2x sub y2 sc2y sub size def
h1 r2 sub abs eps lt {/Cs2x sc2x def /Cs2y sc2y def} {/Cs2x sc1x def /Cs2y sc1y def} ifelse
grestore
gsave Auxlin
%Cs1x Cs1y moveto Cs2x Cs2y lineto stroke %line through tangent points
grestore
%conjugate pair with B
A Ar
B Br neg
C Cr Apollonius /r1 exch def /y1 exch def /x1 exch def
gsave auxlin
%newpath x1 y1 r1 0 360 arc stroke
%x1 y1 plus
%B moveto x1 y1 lineto stroke
B x1 y1 x1 y1 r1 lineintersectscircle /sb1y exch def /sb1x exch def /sb2y exch def /sb2x exch def
%selection intersection point
/h1 x1 sb1x sub y1 sb1y sub size def
/h2 x1 sb2x sub y1 sb2y sub size def
h1 r1 sub abs eps lt {/Bs1x sb2x def /Bs1y sb2y def} {/Bs1x sb1x def /Bs1y sb1y def} ifelse
%x1 y1 moveto Bs1x Bs1y lineto stroke
%
A Ar neg
B Br
C Cr neg Apollonius /r2 exch def /y2 exch def /x2 exch def
auxlin
%newpath x2 y2 r2 0 360 arc stroke
%x2 y2 plus
%B moveto x2 y2 lineto stroke
B x2 y2 x2 y2 r2 lineintersectscircle /sb1y exch def /sb1x exch def /sb2y exch def /sb2x exch def
%selection intersection point
/h1 x2 sb1x sub y2 sb1y sub size def
/h2 x2 sb2x sub y2 sb2y sub size def
h1 r2 sub abs eps lt {/Bs2x sb2x def /Bs2y sb2y def} {/B2x sb1x def /Bs2y sb1y def}ifelse
grestore
gsave Auxlin
%Bs1x Bs1y moveto Bs2x Bs2y lineto stroke %line through tangent points
grestore
%centre radical circle
Bs1x Bs1y Bs2x Bs2y Cs1x Cs1y Cs2x Cs2y intersect /rady exch def /radx exch def
gsave auxlin
%Bs1x Bs1y moveto radx rady lineto Cs1x Cs1y lineto stroke
/h1 Bs1x radx sub Bs1y rady sub size def
/h2 Bs2x radx sub Bs2y rady sub size def
%wanlin
/radr h1 h2 mul sqrt def
radx rady radr
grestore
end}def
/radical load 0 68 dict put
/reencsmalldict 12 dict def
/ReEncodeSmall
{ reencsmalldict begin
/newcodesandnames exch def
/newfontname exch def
/basefontname exch def
/basefontdict basefontname findfont def
/newfont basefontdict maxlength dict def
basefontdict
{ exch dup /Encoding eq
{ exch dup length array copy
newfont 3 1 roll put }
{ exch newfont 3 1 roll put }
ifelse
} forall
newfont /FontName newfontname put
newcodesandnames aload pop
newcodesandnames length 2 idiv
{ newfont /Encoding get 3 1 roll put }
repeat
newfontname newfont definefont pop
end
} def
/rot
%x y phi: point and angle of rotation (counterclock-wise)
%==>
%x y coordinates of point after rotation
{ rotdict begin
/phi exch def /y exch def /x exch def
/xaux x phi cos mul y phi sin mul sub def
/y x phi sin mul y phi cos mul add def
/x xaux def
x y
end
} def
%Explanation
%x'=rcos(phi+theta)=r(cos(phi)cos(theta)-sin(phi)sin(theta))
%y'=rsin(phi+theat)=r(cos(phi)sin(theta)+sin(phi)sin(theta))
%=>
%/x'\ / cos(phi) -sin(phi) \ /x\
%| |= | | | |
%\y'/ \ sin(phi) cos(phi) / \y/
/rotdict 6 dict def
/RUSvec [%Russian keybord a la MS word etc %Cyrillic 33 letters
8#101 /afii10038 8#141 /afii10086 %key A a --> cyrillic letter f
8#102 /afii10026 8#142 /afii10074 %... B b --> cyrillic letter i
8#103 /afii10035 8#143 /afii10083 % C c --> cyrillic letter es
8#104 /afii10019 8#144 /afii10067 % D c --> cyrillic letter ve
8#105 /afii10037 8#145 /afii10085 % E e --> cyrillic letter u
8#106 /afii10017 8#146 /afii10065 % F c --> cyrillic letter a
8#107 /afii10033 8#147 /afii10081 % G g --> cyrillic letter pe
8#110 /afii10034 8#150 /afii10082 % H h --> cyrillic letter er
8#111 /afii10042 8#151 /afii10090 % I i --> cyrillic letter sha
8#112 /afii10032 8#152 /afii10080 % J j --> cyrillic letter o
8#113 /afii10029 8#153 /afii10077 % K k --> cyrillic letter el
8#114 /afii10021 8#154 /afii10069 % L l --> cyrillic letter de
8#115 /afii10046 8#155 /afii10094 % M m --> cyrillic letter soft sign
8#116 /afii10036 8#156 /afii10084 % N n --> cyrillic letter te
8#117 /afii10043 8#157 /afii10091 % O 0 --> cyrillic letter shcha
8#120 /afii10025 8#160 /afii10073 % P p --> cyrillic letter ze
8#121 /afii10027 8#161 /afii10075 % Q q --> cyrillic letter short i
8#122 /afii10028 8#162 /afii10076 % R r --> cyrillic letter ka
8#123 /afii10045 8#163 /afii10093 % S s --> cyrillic letter yeru
8#124 /afii10022 8#164 /afii10070 % T t --> cyrillic letter ie
8#125 /afii10020 8#165 /afii10068 % U u --> cyrillic letter ghe
8#126 /afii10030 8#166 /afii10078 % V v --> cyrillic letter em
8#127 /afii10040 8#167 /afii10088 % W w --> cyrillic letter tse
8#130 /afii10041 8#170 /afii10089 % X x --> cyrillic letter che
8#131 /afii10031 8#171 /afii10079 % Y y --> cyrillic letter en
8#132 /afii10049 8#172 /afii10097 % Z z --> cyrillic letter ya
8#173 /afii10039 8#133 /afii10087 % { [ --> cyrillic letter X
8#175 /afii10044 8#135 /afii10092 % } ] --> cyrillic letter hard sign
8#176 /afii10023 8#140 /afii10071 % ~ ` --> cyrillic letter io
8#42 /afii10047 8#47 /afii10095 % " ' --> cyrillic letter e
8#74 /afii10018 8#54 /afii10066 % < , --> cyrillic letter be
8#76 /afii10048 8#56 /afii10096 % > . --> cyrillic letter yu
8#72 /afii10024 8#73 /afii10072 % : ; --> cyrillic letter zhe
8#44 /semicolon 8#136 /colon % $ ^ --> semicolon colon
8#43 /afii61352 8#46 /question % # & --> numero sign question mark
8#77 /period 8#57 /comma % ? / --> period comma
] def
/s {scalingfactor mul} def /scalingfactor 1 def
/scshowdict 3 dict def
/scshow
{ scshowdict begin
gsave
currentfont [.9 0 0 findscscale 0 0] makefont
setfont
show
currentpoint
grestore
moveto
end
} def
scshowdict begin
/findscscale
{ gsave
newpath
0 0 moveto
(X) true charpath
flattenpath
pathbbox /capheight exch def pop pop pop
newpath
0 0 moveto
(x) true charpath
flattenpath
pathbbox /xheight exch def pop pop pop
grestore
xheight capheight xheight sub 3 div add
capheight div
} def
end
/Schroefer{0 begin
/flipflop true def
/s 5 def %BB for 1 with s=5
/drawgc{gsave
r c translate
r abs 5 div s add
c abs 5 div s add scale
0 0 1 0 360 arc
fill
grestore}def%end drawgc
/indices [30 21 14 9 5 2 0
-2 -5 -9 -14 -21 -30] def
indices{/r exch s mul def
gsave indices{/c exch s mul def
flipflop{drawgc}if
/flipflop flipflop not def
}forall
grestore
}forall
-38 s mul dup moveto
0 76 s mul rlineto
76 s mul 0 rlineto
0 -76 s mul rlineto
closepath 5 setlinewidth stroke
end}def%end Schroefer
/Schroefer load 0 8 dict put
% Shell sort in PostScript
% Copyright (c) 2002 by Alex Cherepanov. All rights reserved.
% Distributed under GPL, http://www.gnu.org/licenses/gpl.txt
%
% Shell sort procedure based on compare and exchange operation
% < i > < j > exch_less <bool> compares keys at positions i and j
% exchange if not in order, retutn *i<*j
% <len> is the number of elements
%
/shellsort % {} len -> -
{ dup dup 2 idiv % {} len m p
{ dup 0 eq { exit } if
exch % {} len p m
15 le { dup 2 idiv } { dup } ifelse
16#fffffffe and 1 add % {} len p m'
1 1 4 index 3 index sub % {} len p m' 1 1 len-_m
{ 1 index neg 1 % {} len p m' is -m 1
{ 1 sub % {} len p m' ii-1
2 copy add % {} len p m' ii-1 m+ii-1
5 index exec
{ exit
}
if
}
for
}
for
exch 2 idiv % {} len m' p'
}
loop
pop pop pop pop % -
} bind def
%
% Sample unsorted array
%
/sample_array [ 1 8 76 3 7 0 7 8 55 86 5 58 57 55 3 6 9 6 66 4 3 4 8 65 8 8 55
4 5 88 55 3 6 7 44 5 7 4 7 43 3 ] def
%
% Sample array compare and exchange
% The elements at positions i and j are compared and exchanged
%
% if (*i<*j)
% return true
% (*i,*j) = (*j,*i)
% return false
%
/array_exch_less % i j -> bool
{ 6 index 3 1 roll % [] i j % get the element just below {exch}
2 index exch % [] i [] j
4 copy % [] i [] j [] i [] j
get % [] i [] j [] i *j
3 1 roll get % [] i [] j *j *i
2 copy ge % [] i [] j *j *i *i<*j
{ pop pop pop pop pop pop //true
}
{ exch % [] i [] j *i *j
4 1 roll % [] i *j [] j *i
put put //false
}
ifelse
} bind def
%
% Sort the array
%
/array_sort % [unsorted] -> [sorted]
{ //array_exch_less 1 index length shellsort
} bind def
%
% Print the sorted array
%
%Example of use
%sample_array array_sort == %result in %stdout
%objecten laten zien oa waarden van gevonden grootheden
/showobject{ nstr cvs show } bind def
/sierpinski%p (order)==> Sierpinski triangle fractal
{/p exch def /t p 1 add array def /a 1.7320508 def
1.415 setmiterlimit
0 1 p{/m exch def
0 1 3 m exp 1 sub{/n exch def
/n1 n cvi def
0 1 m 1 sub{/l exch def
t l n1 3 mod put /n1 n1 3 idiv def
}for%l
/x 0 def /y 0 def
0 1 m 1 sub{/k exch def
/x x 4 t k get mul 1 add 30 mul cos 2 k exp div add def
/y y 4 t k get mul 1 add 30 mul sin 2 k exp div add def
}for%k
/u1 x a 2 m 1 add exp div add def /u2 x a 2 m 1 add exp div sub def
/v1 y 1 2 m 1 add exp div sub def /v2 y 1 2 m exp div add def
u1 s v1 s moveto x s v2 s lineto u2 s v1 s lineto u1 s v1 s lineto
}for%n
}for%m
}bind def
/size %x y => sqrt(x^2+y^2)
{abs dup 3 -1 roll abs dup 3 1 roll % |y| |x| |y| |x|
le {% |y|<=|x| S: |y| |x|
dup 3 1 roll
div dup mul 1 add sqrt mul}
{% |x| < |y|
exch dup 3 1 roll % | y| |x| |y|
div % |y| |x|/|y|
dup mul 1 add sqrt mul }ifelse
}def
%Straightforward version without guarding against intermediate overflow
%/size %x y => sqrt(x^2+y^2)
%{0 begin /y exch def /x exch def
%y dup mul x dup mul add sqrt
%end}def
/size load 0 2 dict put
/setchar
{ /char str charcount 1 getinterval def
/charcount charcount 1 add def
/charwidth char stringwidth pop def
gsave
cpx cpy itransform translate
dy dx atan rotate
0 0 moveto char show
currentpoint transform
/cpy exch def /cpx exch def
grestore
/setdist setdist charwidth add def
} def
%/setchar load 0 5 dict put %not necessary
/solveit{%e a b f c d -> x y,
%intermediate p is pivot
%Equations: ax + by = e
% cx + dy = f
%pivot handling %e a b f c d
1 index abs %e a b f c d |c|
5 index abs %e a b f c d |c| |a|
gt {6 3 roll} if %exchange `equations'
%stack: e a b f c d or f c d e a b,
%first is in comments below
exch 4 index %e a b f d c a
div %e a b f d p
6 -1 roll dup 6 1 roll 3 1 roll
%a e b f e d p
4 index exch %a e b f e d b p
dup 4 1 roll %a e b f e p d b p
mul sub %a e b f e p (d-b.p)
4 1 roll mul sub exch div
%a e b (f-e.p)/(d-b.p) = a e b y
dup 5 1 roll mul sub exch div exch
%stack: x y
}def
/solve22 {solveit} def
/solve33{0 begin
%Purpose: Solve x y r from
%/x11 x12 x13\ /x\ /rh1\
%|x21 x22 x23 | | y| = |rh2|
%\x31 x32 x33 / \r / \rh3/
%Input stack
%rh1 x11 x12 x13
%rh2 x21 x22 x23
%rh3 x31 x32 x33
%==>
%solution determinant x y r
/x33 exch def /x32 exch def /x31 exch def /rh3 exch def
/x23 exch def /x22 exch def /x21 exch def /rh2 exch def
/x13 exch def /x12 exch def /x11 exch def /rh1 exch def
%calculation determinant
/determinant x11 x22 x33 mul x23 x32 mul sub mul
x12 x21 x33 mul x23 x31 mul sub mul sub
x13 x21 x32 mul x22 x31 mul sub mul add def
%elimination last column, bottom up, to keep x,y as unknowns of 2X2-system
%make x33 biggest element, the pivot by exchanging rows
/max x33 abs def
x13 abs max gt {/max x13 abs def} if
x23 abs max gt {/max x23 abs def} if
x13 abs max eq {%exchange row 1 and 3
%10 -40 moveto (row 13 exchanged) show
/aux x11 def /x11 x31 def /x31 aux def
/aux x12 def /x12 x32 def /x32 aux def
/aux x13 def /x13 x33 def /x33 aux def
/aux rh1 def /rh1 rh3 def /rh3 aux def} if
x23 abs max eq {%exchange row 2 and 3
%10 -52 moveto (row 23 exchanged) show
/aux x21 def /x21 x31 def /x31 aux def
/aux x22 def /x22 x32 def /x32 aux def
/aux x23 def /x23 x33 def /x33 aux def
/aux rh2 def /rh2 rh3 def /rh3 aux def} if
%subtract row 3 times f from row 1
/f x13 x33 div def %x13/x33
/x11 x11 f x31 mul sub def %x11:=x11 - f*x31
/x12 x12 f x32 mul sub def %x12:=x12 - f*x32
/rh1 rh1 f rh3 mul sub def %rh1:=rh1 - f*rh3
%subtract row 3 times f from row 2
/f x23 x33 div def %x23/x33
/x21 x21 f x31 mul sub def %x21:=x21 - f*x31
/x22 x22 f x32 mul sub def %x22:=x22 - f*x32
/rh2 rh2 f rh3 mul sub def %rh2:=rh2 - f*rh3
%solve 2X2 subsystem
%gsave
%40 100 translate
%10 0 moveto (x11=) show x11 nstr cvs show
% ( x12=) show x12 nstr cvs show
% ( rh1=) show rh1 nstr cvs show
%10 -12 moveto (x21=) show x21 nstr cvs show
% ( x22=) show x22 nstr cvs show
% ( rh2=) show rh2 nstr cvs show
%10 -24 moveto (x31=) show x31 nstr cvs show
% ( x32=) show x32 nstr cvs show
% ( x33=) show x33 nstr cvs show
% ( rh3=) show rh3 nstr cvs show
%grestore
% / x11 x12 \ /x\ /rh1\
%| | | | = | |
% \ x21 x22 / \y/ \rh2/
rh1 x11 x12
rh2 x21 x22 solve22 /y exch def /x exch def
/rxy rh3
x31 x mul x32 y mul add sub
x33 div def
%
determinant x y rxy
end} def
/solve33 load 0 53 dict put
/maxint 2147483647 def%2^31-1
/spline{0 0 moveto 0 .1 s mul spread .33 s mul
0 .1 s mul spread .66 s mul
0 s curveto stroke}def
/spread{% value maxspread ==> new value
rand maxint div .5 sub 2 mul mul add dup =}def
/splinetree{spline 0 s translate %draw the line and translate user space
1 sub dup 0 gt
{gsave 45 15 spread rotate .7071 .2 spread dup scale %transformed user space
splinetree %do it again, Sam
grestore
-45 15 spread rotate .7071 .2 spread dup scale %transformed user space
splinetree %do it again, Sam
}if 1 add
gsave 0 1 0 setrgbcolor spline grestore
} def
/starside{72 0 lineto
currentpoint translate
-144 rotate}def
/star5 %stack: x y (Star from the Blue book)
{moveto
currentpoint translate
4{starside}repeat
closepath
gsave
.5 setgray fill
grestore
stroke}def
/starfractal%reduction angle p (=order) v(ertices) ==> starfractal %H A Lauwerier Fractals
{starfractaldict begin
/v exch cvi def /p exch def /a exch def /r exch def
0 0 moveto
0 1 v 1 add v p 1 sub exp mul 1 sub
{/n exch cvi def
/m n def /f 0 def
{m v mod 0 ne f p 1 sub ge or
{exit}
{/f f 1 add def /m m v idiv def}
ifelse
}loop
r p f sub 1 sub exp s 0 rlineto
a rotate
}for %n
end} bind def
/starfractaldict 8 dict def
%example of use 5-starfractal:
%/s {300 mul}def
%.3 144 3 4 starfractal stroke
/threepointscircle% P, Q, R on stack
%==>
%center and radius
{threepointscircledict begin
/Ry exch def /Rx exch def /Qy exch def /Qx exch def /Py exch def /Px exch def
Px Py Qx Qy middleperpendicular /p1y exch def /p1x exch def /p2y exch def /p2x exch def
Qx Qy Rx Ry middleperpendicular /q1y exch def /q1x exch def /q2y exch def /q2x exch def
p1x p1y p2x p2y q1x q1y q2x q2y intersect /y exch def /x exch def
%p1x p1y moveto p1x -.5 mul p1y -.5 mul lineto stroke
%q1x q1y moveto q1x -.5 mul q1y -.5 mul lineto stroke
/r Px x sub Py y sub size def
x y r
end
}def
/threepointscircledict 15 dict def
/tOnSplinedict 17 dict def
/tOnSpline{% Purpose: t on spline a0,a1,a2,a3 ==> x y
% implementation of the De Casteljau's algorithm by Piotr Strzelczyk
%
% t: value in [0,1]
% a0 a1 a2 a3: point pairs which characterize the spline
%
% in MF lingo: given pairs a0, a1, a2, a3, and a real number t, 0<=t<=1;
% we want to compute t[t[t[a0,a1],t[a1,a2]],t[t[a1,a2],t[a2,a3]]]
% ==>
% x(t) y(t)
tOnSplinedict % look up the name and push the dictionary on the operand stack
begin % and move tOnSplinedict dictionary from the operand stack to the d-stack
/a3y exch def /a3x exch def
/a2y exch def /a2x exch def
/a1y exch def /a1x exch def
/a0y exch def /a0x exch def
/t exch def
/a01x a0x a1x t mediation def /a01y a0y a1y t mediation def
/a12x a1x a2x t mediation def /a12y a1y a2y t mediation def
/a23x a2x a3x t mediation def /a23y a2y a3y t mediation def
/a012x a01x a12x t mediation def /a012y a01y a12y t mediation def
/a123x a12x a23x t mediation def /a123y a12y a23y t mediation def
a012x a123x t mediation a012y a123y t mediation
end% pop the tOnSplinedict dictionary off the d-stack
}def
/tOnSplineclassic{ %Purpose: t on spline (a0,a1,a2,a3) ==> x y
% t: value in [0,1]
% a0, a1, a2, a3: points which characterize the spline
% ==>
% x(t), y(t)
tOnSplinedict begin %local dictionary
/a3y exch def /a3x exch def
/a2y exch def /a2x exch def
/a1y exch def /a1x exch def
/a0y exch def /a0x exch def
/t exch def
/Ax a3x 3 a2x mul sub 3 a1x mul add a0x sub def
/Bx 3 a2x mul 6 a1x mul sub 3 a0x mul add def
/Cx 3 a1x mul 3 a0x mul sub def
/Dx a0x def
/Ay a3y 3 a2y mul sub 3 a1y mul add a0y sub def
/By 3 a2y mul 6 a1y mul sub 3 a0y mul add def
/Cy 3 a1y mul 3 a0y mul sub def
/Dy a0y def
Ax t mul Bx add t mul Cx add t mul Dx add
Ay t mul By add t mul Cy add t mul Dy add
end% pop the dictionary of the stack
}def
/drawline{0 0 moveto 0 s rlineto currentpoint stroke translate}def
/trinarytree{
1 sub dup 0 gt
{gsave drawline .475 dup scale %transformed user space
trinarytree %do it again, Sam
grestore
gsave 120 rotate drawline .475 dup scale %transformed user space
trinarytree %do it again, Sam
grestore
gsave 240 rotate drawline .475 dup scale %transformed user space
trinarytree %do it again, Sam
grestore
}if 1 add } def
/twoconjcircles2invcircle
%Ax Ay Ar: first circle
%Bx By Br: second conjugate cirlce
%==>
%Ix Iy Ir: centre and radius of inversion circle
{0 begin gsave
/R exch def /By exch def /Bx exch def
/r exch def /Ay exch def /Ax exch def
/By By Ay sub def /Bx Bx Ax sub def%translate A -> origin
/d Bx By size def
/phi By Bx atan def
0 100 moveto (Phi=) phi nstr cvs show
/Ix d r mul R r sub div def
/Ir Ix r add Ix d add R sub mul sqrt def %radius of inversion circle
Ix neg 0 phi rot /Iy exch Ay add def /Ix exch Ax add def
Ix Iy Ir
grestore end} def
/twoconjcircles2invcircle load 0 15 dict put
/twocirclesintersection%Purpose
%Intersection points of two circles along x-axis
%r1 r2 d: radii circles (Cr1(0,0) and Cr2(d,0)
%==>
%s1x s1y s2x s2y: two intersection points
{0 begin
/d exch def /r2 exch def /r1 exch def
r1 r2 add d lt
{(No intersection points) print}%message
{/s r1 r2 add d add 2 div def
/h 2 d div s s d sub mul s r1 sub mul s r2 sub mul sqrt mul def
/sx r1 dup mul h dup mul sub sqrt def
sx h sx h neg}
ifelse
end}def
/twocirclesintersection load 0 7 dict put
/twocircles2inversioncircle%special case
%r: first circle Cr(0, 0)
%d R: second cirlce CR(d, 0)
%==>
%x r: inversion circle Cr(x, 0)
{0 begin
/R exch def /d exch def /r exch def
/Ix d r mul R r sub div def
/ri Ix r add Ix d add R sub mul sqrt def %radius of inversion circle
Ix neg ri
end} def
/twocircles2inversioncircle load 0 5 dict put
/twopointsincircle
%P1x P1y P2x P2y: points within the circle
%r : radius of inversion circle (at origin)
%==>
% x y r center and radius of orthogonal cirlce
{0 begin
/r exch def
/Py exch def /Px exch def /Qy exch def /Qx exch def
/P {Px Py}def /Q {Qx Qy}def
P 0 0 r pointinversion /py exch def /px exch def
Q 0 0 r pointinversion /qy exch def /qx exch def
P px py middleperpendicular /pmy exch def /pmx exch def /py exch def /px exch def
Q qx qy middleperpendicular /qmy exch def /qmx exch def /qy exch def /qx exch def
pmx pmy px py qmx qmy qx qy intersect /y exch def /x exch def
/r Px x sub Py y sub size def
x y r
end
}def
/twopointsincircle load 0 21 dict put
/unifrmdev
%number: bound of the random number to be generation [0, number)
%==>
%number: next number of the pseudo random number sequence
{rand reus div mul
}def
/vshowdict 4 dict def
/vshow
{ vshowdict begin
/thestring exch def
/lineskip exch def
thestring
{
/charcode exch def
/thechar ( ) dup 0 charcode put def
0 lineskip neg rmoveto
gsave
thechar stringwidth pop 2 div neg 0 rmoveto
thechar show
grestore
} forall
end
} def
/wedge
{ newpath
0 0 moveto
1 0 translate
15 rotate
0 15 sin translate
0 0 15 sin -90 90 arc
closepath
} def
/wervel%
{/square {-1 s -1 s 2 s 2 s rectstroke} def
/s {100 mul} def
/b 12 6.2831 div def
/c 1 b sin b cos add div def
64{square
b rotate
c c scale}repeat
}def
/wikkel%Title evolvente H A Lauwerier Fractals
{/a 50 def%choice radius cirkel
a 0 moveto 0 0 a 0 360 arc
a 0 moveto
0 10 270{/phi exch def /phirad phi 6.2831 360 div mul def
/x a phi cos phirad phi sin mul add mul def
/y a phi sin phirad phi cos mul sub mul def x y lineto
phi 30 mod 0 eq {phi cos a mul phi sin a mul moveto x y lineto}if
}for
} bind def
/square {0 0 moveto s 0 rlineto 0 s rlineto s neg 0 rlineto closepath stroke} def
/Xmastree{%Global variables: s phi cosphi sinphi
%on stack integer (depth>=1)
square %draw the square
1 sub dup 0 gt
{gsave /phi 90 phi sub def
0 s translate phi rotate phi cos dup scale Xmastree
grestore
s phi cos dup mul mul s phi sin phi cos mul mul s add translate
phi 90 sub rotate phi sin dup scale Xmastree
/phi 90 phi sub def
}if 1 add
}def
/yinyang
{100 100 translate
/R 25 def /hR R 2 div def
/mR R neg def /mhR hR neg def
/r R 5 div def /mr r neg def
/circle {translate % center on stack
r 0 moveto 0 0 r 0 360 arc
}def
0 mR moveto 0 0 R 270 90 arc
0 hR hR 90 270 arcn
0 mhR hR 90 270 arc
fill
R 0 moveto 0 0 R 0 360 arc
stroke
gsave 0 hR circle fill grestore
gsave 0 mhR circle
1 setgray fill
grestore}def
%%Trailer
count {pop} repeat
%%EOF
%end PS.lib
%/PSlength {length} bind def % save old meaning
%/lengthdict 5 dict def
%lengthdict /arraytype {PSlength} put
%lengthdict /dicttype {PSlength} put
%lengthdict /stringtype {PSlength} put
%lengthdict /integertype {size} put
%lengthdict /realtype {size} put
%/length {lengthdict begin dup type exec end} def