%%
%% 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.02 / 2010-02-10 Herbert Voss <hvoss _at_ tug.org>
%
/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@fractal@scale
% \pst@tempA
% \pst@fractal@maxIter
% \pst@fractal@radius
% \pst@number\pslinewidth
% { \pst@usecolor\pslinecolor }
/setColor ED
SLW
/radius ED
/maxIter ED
translate
dup scale
/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