diff options
author | Karl Berry <karl@freefriends.org> | 2007-09-26 17:54:09 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2007-09-26 17:54:09 +0000 |
commit | 8286e8f8443b365625bc4b24a1abc456129738ff (patch) | |
tree | 868826acd057768d68c23a794d737fef1486e80a /Master/texmf-dist/dvips/pst-fractal | |
parent | e681b05dbd6ec04a81ce0d7eb73de747c1a3113e (diff) |
pst-fractal 0.0.5 (25sep07)
git-svn-id: svn://tug.org/texlive/trunk@5050 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/texmf-dist/dvips/pst-fractal')
-rw-r--r-- | Master/texmf-dist/dvips/pst-fractal/pst-fractal.pro | 329 |
1 files changed, 329 insertions, 0 deletions
diff --git a/Master/texmf-dist/dvips/pst-fractal/pst-fractal.pro b/Master/texmf-dist/dvips/pst-fractal/pst-fractal.pro new file mode 100644 index 00000000000..041b7122890 --- /dev/null +++ b/Master/texmf-dist/dvips/pst-fractal/pst-fractal.pro @@ -0,0 +1,329 @@ +%% +%% This is file `pst-fractal.pro', +%% +%% IMPORTANT NOTICE: +%% +%% Package `pst-fractal' +%% +%% Herbert Voss <voss _at_ PSTricks.de> +%% +%% This program can be redistributed and/or modified under the terms +%% of the LaTeX Project Public License Distributed from CTAN archives +%% in directory macros/latex/base/lppl.txt. +%% +%% DESCRIPTION: +%% `pst-fractal' is a PSTricks package to draw fractal objects +%% +%% +%% version 0.01 / 2007-05-14 Herbert Voss <voss _at_ PSTricks.de> +% +/tx@fractalDict 20 dict def +tx@fractalDict begin +% +/tx@Fractal { +% \pst@temp@A +% \pst@temp@B +% \pst@number\pst@fractal@xWidth +% \pst@number\pst@fractal@yWidth +% \pst@fractal@cx +% \pst@fractal@cy +% \pst@fractal@maxIter +% \pst@fractal@dIter +% \pst@fractal@maxRadius +% {\pst@usecolor\pst@fractal@baseColor} +% \ifx\pst@fractal@type\pst@fractal@Julia true \else false \fi +% \ifPst@CMYK true \else false \fi +% tx@fractalDict begin tx@Fractal end + /ifCMYK ED + /ifJulia ED + /baseColor ED + /maxRadius ED + /dIter ED + /maxIter ED + /cy ED + /cx ED + /MaxYPixel ED + /MaxXPixel ED + /MaxY ED /MaxX ED + /MinY ED /MinX ED + /rPixel 0.5 def + /totMaxIter maxIter dIter mul def +% + /DX MaxX MinX sub def + /DY MaxY MinY sub def + /dx DX MaxXPixel div def /dy DY MaxYPixel div def +% + /convertX { MinX sub DX sub dx div } def % user -> pt + /convertY { MinY sub dy div } def % user -> pt + /convertXY { convertY exch convertX exch } def +% + /putPixel {% x y auf dem Stack in Benutzerkoordinaten + convertXY + rPixel 0 360 arc fill + } def +% + MinX dx MaxX { + ifJulia { /x exch def }{ /cx exch def /x 0.0 def } ifelse + MinY dy MaxY { + ifJulia { /y exch def }{ /cy exch def /y 0.0 def } ifelse + /iter 0 def + /zx x def + /zy y def + /plot true def + totMaxIter cvi { + zx dup mul zy dup mul add maxRadius gt { + /plot false def + exit + }{% Calculate next value + 2 zx zy mul mul cy add + /zx zx dup mul zy dup mul sub cx add def + /zy exch def + /iter iter dIter add def + } ifelse + } repeat + plot{ + baseColor x y putPixel + }{ iter 400 add tx@addDict begin + ifCMYK { wavelengthToCMYK Cyan Magenta Yellow Black end setcmykcolor + }{ wavelengthToRGB Red Green Blue end setrgbcolor } ifelse + ifJulia { x y }{ cx cy } ifelse + putPixel stroke + }ifelse % Plot point if point is in set + } for + } for +} def +% +/tx@Sierpinski { %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% \pst@temp@A +% \pst@temp@B +% \pst@temp@C +% { \pst@usecolor\pslinecolor } +% \pst@fractal@plotpoints + /plotpoints ED + /setColor ED + /Coor ED + /Sx 0 def /Sy 0 def + /putPixel { 0.5 0 360 arc stroke } def % x y on stack + /newPosition { % point # on stack + Coor exch 2 getinterval aload pop + /y exch def /x exch def + x Sx sub 2 div Sx add /Sx exch def + y Sy sub 2 div Sy add /Sy exch def + Sx Sy putPixel + } def + /drawFrame { + Coor aload pop + newpath + moveto + nCoor 1 sub { lineto } repeat % n-1 times + gsave 0.9 setgray fill grestore + setColor + closepath + stroke + } def + /nCoor Coor length 2 div 0.5 add cvi def % # of dots + drawFrame + plotpoints cvi { + rand nCoor mod + dup add newPosition + } repeat +} def +% +/tx@Phyllotaxis { %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% \pst@tempA +% \pst@fractal@c +% \pst@fractal@angle +% \pst@fractal@maxIter CMYK + /ifCMYK ED + /maxIter ED + /fractalAngle ED + /c ED + translate + /angle fractalAngle dup 0 eq { pop 360 5 sqrt 1 add 2 div dup mul div } if def + maxIter cvi -1 0 { + angle rotate + 0 0 moveto + dup sqrt c mul c lineto + c c neg rlineto + c neg dup rlineto + closepath + gsave + 1 exch maxIter cvi div 90 mul cos 0 + ifCMYK { tx@addDict begin RGBtoCMYK end setcmykcolor }{ setrgbcolor } ifelse + fill + grestore + stroke + } for +} def +% +/tx@Fern { %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% \pst@tempA +% \pst@fractal@scale +% \pst@fractal@maxIter +% \pst@fractal@radius +% \pst@number\pslinewidth +% { \pst@usecolor\pslinecolor } + /setColor ED + SLW + /radius ED + /maxIter ED + 10 10 scale + translate + /m1 [ 0.00 0.00 0.00 0.16 0.00 0.00 ] def + /m2 [ 0.85 -0.04 0.04 0.85 0.00 1.60 ] def + /m3 [ 0.20 0.23 -0.26 0.22 0.00 1.60 ] def + /m4 [ -0.15 0.26 0.28 0.24 0.00 0.44 ] def + 1 setlinecap + setColor + 0 0 % start point + maxIter cvi { + % get a transformation matrix probabilistically + /r rand 100 mod def + r 1 lt { /m m1 def }{ r 86 lt + { /m m2 def }{ r 93 lt { + /m m3 def }{ /m m4 def } ifelse } ifelse } ifelse + % Make a linear transformation, then + % plot a point at current location + m transform 2 copy radius 0 360 arc + stroke + } repeat +} def +% +/tx@Kochflake { %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% \pst@tempA +% { \pst@usecolor\pslinecolor } +% \pst@fractal@scale +% \pst@fractal@angle +% CLW +% \pst@fractal@maxIter + /maxIter ED + 10 10 scale + 45 rotate + /side { + dup 0 gt { + 1 sub 1 3 div dup scale side 60 rotate side + -120 rotate side 60 rotate side 3 dup scale 1 add + }{ 1 1 rlineto 1 1 translate } ifelse + } def + /star { + dup currentlinewidth 1 1 + 4 -1 roll { pop 3 div } for + setlinewidth + 0 0 moveto + side -120 rotate side -120 rotate side + pop + closepath + } def + maxIter star +} def +% +/tx@Appolonius { %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% \pst@fractal@dIter +% \pst@number\pst@fractal@Radius +% \ifPst@fractal@Color true \else false \fi +% \ifPst@CMYK true \else false \fi +% gsave +% \pst@tempA translate +% \pst@usecolor\pslinecolor +% \pst@fractal@scale +% \pst@number\pslinewidth SLW +% + /ifCMYK ED + /ifColor ED + /Radius ED + /dIter ED + /icount 380 def + /setWaveColor { + /icount icount dup 780 gt { pop 380 }{ dIter add } ifelse def + tx@addDict begin icount + ifCMYK { wavelengthToCMYK Cyan Magenta Yellow Black end setcmykcolor + }{ wavelengthToRGB Red Green Blue end setrgbcolor } ifelse + } def + /collect { [ 4 1 roll ] } def + /nget { exch dup 3 1 roll exch get } def + /polydup { 1 add [ exch 1 roll ] aload aload pop } def + /circle { aload pop newpath 0 360 arc closepath + ifColor { gsave setWaveColor fill grestore } if + stroke } def + /inverse { + aload 4 1 roll 3 1 roll dup mul exch dup mul add exch dup mul sub + dup 0 eq not {1 exch div} if + exch + aload pop + 4 -1 roll dup 5 1 roll mul 3 1 roll + 4 -1 roll dup 5 1 roll mul 3 1 roll + 4 -1 roll dup 5 1 roll mul 3 1 roll + 4 -1 roll pop + dup 0 lt {neg} if + collect + } def + /between { + collect + 0 nget 2 get exch 1 nget 2 get exch 3 1 roll + lt {aload pop 3 1 roll exch 3 -1 roll collect} if + 0 nget 2 get exch 2 nget 2 get exch 3 1 roll + lt {aload pop 3 -1 roll exch 3 1 roll collect} if + 1 nget 0 get exch 2 nget 2 get exch + 2 nget 0 get exch 1 nget 2 get exch + 1 nget 2 get exch 2 nget 2 get exch + 7 1 roll add 5 1 roll mul 3 1 roll mul add exch div + /xdisp exch def + 1 nget 1 get exch 2 nget 2 get exch + 2 nget 1 get exch 1 nget 2 get exch + 1 nget 2 get exch 2 nget 2 get exch + 7 1 roll add 5 1 roll mul 3 1 roll mul add exch div + /ydisp exch def + 0 nget aload pop 3 1 roll ydisp sub 3 1 roll xdisp sub 3 1 roll + collect + inverse dup + /first exch def + /second exch def + 1 nget 1 get exch 2 nget 1 get exch 3 1 roll sub /xvect exch def + 2 nget 0 get exch 1 nget 0 get exch 3 1 roll sub /yvect exch def + xvect dup mul yvect dup mul add sqrt + dup 0.0 eq not { first 2 get 2 mul exch div} if + dup xvect mul /xvect exch def + yvect mul /yvect exch def + first aload pop 3 1 roll yvect add 3 1 roll xvect add 3 1 roll + collect + inverse /first exch def + second aload pop 3 1 roll yvect sub 3 1 roll xvect sub 3 1 roll + collect + inverse /second exch def + first second + first 2 get second 2 get sub + 0 gt { exch } if + pop + aload pop + 3 1 roll ydisp add 3 1 roll xdisp add 3 1 roll collect + exch pop + } def + /appol { + aload pop 3 polydup between + dup circle + 2 nget CLW gt { 1 1 3 { pop 3 polydup collect 5 1 roll 4 -1 roll } for } if + pop pop pop pop + } def + /inside { + /temp exch def + 0 120 240 { + /angle exch def + temp aload pop + 3 sqrt 2 div 1 add div + /radius exch def + angle sin radius mul + angle cos radius mul + exch 4 -1 roll add + 3 1 roll add + radius 3 sqrt 2 div mul + collect + } for + } def +% + [ 0 0 Radius ] dup inside 4 polydup + 1 1 4 { pop circle } for + 1 1 4 { pop 3 polydup collect 5 1 roll 4 1 roll } for + pop pop pop pop { count 0 eq { exit } if appol } loop +} def +% +end |