path: root/Master/texmf-dist/tex/generic/pst-fractal/pst-fractal.tex

%%
%% This is file `pst-fractal.tex',
%%
%% IMPORTANT NOTICE:
%%
%% Package `pst-fractal.tex'
%%
%% Herbert Voss <voss _at_ pstricks dot 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 Julia and
%%       Mandelbrot sets as well as Sierpinski, ...
%%
\csname PSTfractalLoaded\endcsname
\let\PSTfractalLoaded\endinput
\ifx\PSTricksLoaded\endinput\else\input pstricks.tex\fi
\ifx\PSTricksAddLoaded\endinput\else\input pstricks-add.tex\fi
\ifx\PSTXKeyLoaded\endinput\else\input pst-xkey \fi
%
\def\fileversion{0.04}
\def\filedate{2007/05/15}
\message{`PST-fractal' v\fileversion, \filedate\space (hv)}
%
\edef\PstAtCode{\the\catcode`\@} \catcode`\@=11\relax
\pst@addfams{pst-fractal}
\pstheader{pstricks-add.pro}
%\SpecialCoor
%
\newdimen\pst@fractal@xWidth
\define@key[psset]{pst-fractal}{xWidth}{\pssetlength\pst@fractal@xWidth{#1}}
\newdimen\pst@fractal@yWidth
\define@key[psset]{pst-fractal}{yWidth}{\pssetlength\pst@fractal@yWidth{#1}}
\psset[pst-fractal]{xWidth=1cm,yWidth=1cm}
\define@key[psset]{pst-fractal}{type}{\def\pst@fractal@type{#1}}
\psset[pst-fractal]{type=Julia}% or type=Mandel
\def\pst@fractal@Julia{Julia}\def\pst@fractal@Mandel{Mandel}
\define@key[psset]{pst-fractal}{baseColor}{\pst@getcolor{#1}\pst@fractal@baseColor}
\psset[pst-fractal]{baseColor=white}
%
\define@key[psset]{pst-fractal}{cx}{\def\pst@fractal@cx{#1 }}
\define@key[psset]{pst-fractal}{cy}{\def\pst@fractal@cy{#1 }}
\define@key[psset]{pst-fractal}{dIter}{\def\pst@fractal@dIter{#1 }}
\psset[pst-fractal]{cx=0,cy=0,dIter=1}
\define@key[psset]{pst-fractal}{maxIter}{\pst@checknum{#1}\pst@fractal@maxIter}
\define@key[psset]{pst-fractal}{maxRadius}{\pst@checknum{#1}\pst@fractal@maxRadius}
\psset[pst-fractal]{maxIter=255,maxRadius=100}
\define@key[psset]{pst-fractal}{plotpoints}{\pst@checknum{#1}\pst@fractal@plotpoints}
\psset[pst-fractal]{plotpoints=2000}
%
\define@key[psset]{pst-fractal}{angle}{\pst@getangle{#1}\pst@fractal@angle}
\define@key[psset]{pst-fractal}{c}{\pst@checknum{#1}\pst@fractal@c}
\psset[pst-fractal]{angle=0,c=5}
%
\define@key[psset]{pst-fractal}{scale}{\pst@getscale{#1}\pst@fractal@scale%
    \let\pst@fractal@Xscale\pst@tempg}
\psset[pst-fractal]{scale=1}
%
\def\pst@fractal@radius{0.001 }
%
\newdimen\pst@fractal@Radius
\define@key[psset]{pst-fractal}{Radius}{\pssetlength\pst@fractal@Radius{#1}}
\define@boolkey[psset]{pst-fractal}[Pst@fractal@]{Color}[true]{}
\psset[pst-fractal]{Radius=5cm,Color=false}
%
%===========================================================
%
\def\psfractal{\pst@object{psfractal}}
\def\psfractal@i{\@ifnextchar({\psfractal@ii}{\psfractal@ii(-1,-1)}}%
\def\psfractal@ii(#1){\@ifnextchar({\psfractal@iii(#1)}{\psfractal@iii(#1)(1,1)}}% 
\def\psfractal@iii(#1)(#2){%
  \begin@SpecialObj
  \psset{unit=1pt}
  \pst@getcoor{#1}\pst@temp@A
  \pst@getcoor{#2}\pst@temp@B
  \pspicture(\pst@fractal@xWidth,\pst@fractal@yWidth)%
  \addto@pscode{
    \pst@temp@A /MinY ED /MinX ED
    \pst@temp@B /MaxY ED /MaxX ED
    /MaxXPixel \pst@number\pst@fractal@xWidth def
    /MaxYPixel \pst@number\pst@fractal@yWidth def
    /rPixel 0.5 def
    /cx \pst@fractal@cx def
    /cy \pst@fractal@cy def 
    /totMaxIter \pst@fractal@maxIter\space \pst@fractal@dIter\space 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 {
      \ifx\pst@fractal@type\pst@fractal@Julia /x exch def \else /cx exch def /x 0.0 def \fi
      MinY dy MaxY {
        \ifx\pst@fractal@type\pst@fractal@Julia /y exch def \else /cy exch def /y 0.0 def \fi
	/iter 0 def
	/zx x def
	/zy y def
	/plot true def
	totMaxIter cvi {
	    zx dup mul zy dup mul add \pst@fractal@maxRadius\space 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 \pst@fractal@dIter add def
	    } ifelse
	} repeat
	plot{ 
	  \pst@usecolor\pst@fractal@baseColor 
	  x y putPixel
	}{  iter 400 add tx@addDict begin wavelengthToRGB 
	    Red Green Blue setrgbcolor end
            \ifx\pst@fractal@type\pst@fractal@Julia x y \else cx cy \fi
	    putPixel stroke
	}ifelse		% Plot point if point is in set
    } for
  } for
  }% end add@pscode
  \endpspicture% end box
  \end@SpecialObj% 
  \ignorespaces}
%
\def\psSier{\pst@object{psSier}}
\def\psSier@i(#1)(#2)(#3){{%
  \pst@getcoor{#1}\pst@temp@A
  \pst@getcoor{#2}\pst@temp@B
  \pst@getcoor{#3}\pst@temp@C
  \begin@SpecialObj%
  \addto@pscode{
    /Coor [ \pst@temp@A 
            \pst@temp@B 
	    \pst@temp@C ] def
    /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 
	\pst@usecolor\pslinecolor
	closepath
	stroke 
    } def
    /nCoor Coor length 2 div 0.5 add cvi def % # of dots
    drawFrame
    \pst@fractal@plotpoints\space cvi {
	rand nCoor mod 
	dup add newPosition   
    } repeat
  }% end add@pscode
  \end@SpecialObj%
}}
%
\def\psPhyllotaxis{\pst@object{psPhyllotaxis}}
\def\psPhyllotaxis@i{\@ifnextchar({\psPhyllotaxis@ii}{\psPhyllotaxis@ii(0,0)}}
\def\psPhyllotaxis@ii(#1){{%
  \pst@getcoor{#1}\pst@tempA
  \begin@SpecialObj%
  \addto@pscode{
  /c \pst@fractal@c def
  /angle \pst@fractal@angle dup 0 eq { pop 360 5 sqrt 1 add 2 div dup mul div } if def
  \pst@tempA translate
  \pst@fractal@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 \pst@fractal@maxIter cvi div 90 mul cos 0 setrgbcolor
      fill
    grestore
    stroke
  } for
  }% end add@pscode
  \end@SpecialObj%
}}
%
\def\pst@fractal@radius{0.001 }
\def\psFern{\pst@object{psFern}}
\def\psFern@i{\@ifnextchar({\psFern@ii}{\psFern@ii(0,0)}}
\def\psFern@ii(#1){{%
  \addbefore@par{linewidth=0.001pt,maxIter=20000,radius=0.001pt}%
  \pst@getcoor{#1}\pst@tempA%
  \begin@SpecialObj%
  \addto@pscode{
  \pst@tempA 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
    10 10 scale \pst@fractal@scale
    1 setlinecap
    \pst@number\pslinewidth SLW
    \pst@usecolor\pslinecolor
    0 0 % start point
    \pst@fractal@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 \pst@fractal@radius 0 360 arc
	stroke
    } repeat
  }% end add@pscode
  \end@SpecialObj%
}}
%
\def\psKochflake{\pst@object{psKochflake}}
\def\psKochflake@i{\@ifnextchar({\psKochflake@ii}{\psKochflake@ii(0,0)}}
\def\psKochflake@ii(#1){{%
  \addbefore@par{radius=0.25cm,maxIter=5}%
  \pst@getcoor{#1}\pst@tempA%
  \begin@SpecialObj%
  \addto@pscode{
  gsave
  \pst@tempA translate
  \pst@usecolor\pslinecolor
  10 10 scale \pst@fractal@scale
  \pst@number\pslinewidth 10 div \pst@fractal@Xscale div SLW
  45 rotate
  \pst@fractal@angle 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
  \pst@fractal@maxIter star
  }% end add@pscode
  \psk@fillstyle
  \addto@pscode{stroke}
  \end@SpecialObj%
}}
%
\def\psAppolonius{\pst@object{psAppolonius}}
\def\psAppolonius@i{\@ifnextchar({\psAppolonius@ii}{\psAppolonius@ii(0,0)}}
\def\psAppolonius@ii(#1){{%
  \addbefore@par{Radius=5cm,dIter=1,linewidth=0.1pt}%
  \pst@getcoor{#1}\pst@tempA%
  \begin@SpecialObj%
  \addto@pscode{
  /icount 380 def
  /setWaveColor {
    /icount icount dup 780 gt { pop 380 }{ \pst@fractal@dIter add } ifelse def
    tx@addDict begin icount wavelengthToRGB 
    Red Green Blue end setrgbcolor 
  } def
  gsave
  \pst@tempA translate
  \pst@usecolor\pslinecolor
  \pst@fractal@scale
  /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 
    \ifPst@fractal@Color
      gsave setWaveColor fill grestore \fi
    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
%
  \pst@number\pslinewidth SLW
  [ 0 0 \pst@number\pst@fractal@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
  }% end add@pscode
  \psk@fillstyle%
  \addto@pscode{stroke}%
  \end@SpecialObj%
}}
%
\def\psPTree{\pst@object{psPTree}}
\def\psPTree@i{\@ifnextchar({\psPTree@ii}{\psPTree@ii(0,0)}}
\def\psPTree@ii(#1){{%
  \addbefore@par{xWidth=1cm,Color=false}%
  \pst@getcoor{#1}\pst@tempA%
  \begin@SpecialObj%
  \addto@pscode{
  gsave
  \pst@tempA exch \pst@number\pst@fractal@xWidth 2 div sub exch translate
  \pst@usecolor\pslinecolor
  \pst@fractal@scale
  \pst@number\pslinewidth \pst@fractal@Xscale div SLW
  /sqrt2 1.41421356237310 def
  /limit 1.2 def
  /r 1 def /g 0 def /b 0 def
  /icount 380 def
  /setWaveColor {
    /icount icount dup 780 gt { pop 380 }{ \pst@fractal@dIter add } ifelse def
    tx@addDict begin icount wavelengthToRGB 
    Red Green Blue end setrgbcolor 
  } def
  /box { % stack: size
    newpath
    0 0 moveto
    dup 0 rlineto
    dup 0 exch rlineto
    dup 0.5 mul dup dup -1 mul exch rlineto
    -1 mul dup rlineto
    closepath
    \ifPst@fractal@Color
    setWaveColor fill
%      r g b setrgbcolor fill r g b /g exch def /r exch def /b exch def 
    \else stroke \fi 
    dup limit gt {
      gsave
        dup dup sqrt2 div exch 0 exch translate 45 rotate box
      grestore 
      gsave
        dup sqrt2 div exch 2 div dup 3 mul translate 315 rotate box
      grestore
    }{ pop } ifelse
  } def
  \pst@number\pst@fractal@xWidth box
  }% end add@pscode
  \end@SpecialObj%
}}
%
\def\psFArrow{\pst@object{psFArrow}}
\def\psFArrow@i{\@ifnextchar({\psFArrow@ii}{\psFArrow@ii(0,0)}}
\def\psFArrow@ii(#1)#2{{%
  \addbefore@par{linewidth=10pt,yWidth=5cm,maxIter=10,Color=false,scale=1,dIter=1}%
  \pst@getcoor{#1}\pst@tempA%
  \begin@SpecialObj%
  \addto@pscode{
  gsave
  \pst@tempA translate 0 0 moveto
  \pst@usecolor\pslinecolor
  \pst@fractal@scale
  /depth 0 def
  /depth++ { /depth depth 1 add def } def
  /depth-- { /depth depth 1 sub def } def
  /icount 380 def
  /setWaveColor {
    /icount icount dup 780 gt { pop 380 }{ \pst@fractal@dIter add } ifelse def
    tx@addDict begin icount wavelengthToRGB 
    Red Green Blue end setrgbcolor 
  } def
  /DoLine {		% print a vert. line
    0 \pst@number\pst@fractal@yWidth rlineto currentpoint  
%    gsave
    \ifPst@fractal@Color setWaveColor \fi
    stroke 
%    grestore
    translate 0 0 moveto 
  } def
  /FractArrow { 
    /sc exch def 
    gsave 
    sc dup scale
    \pst@number\pslinewidth SLW
    depth++ DoLine
    depth \pst@fractal@maxIter le { 
      135 rotate sc FractArrow
      -270 rotate sc FractArrow 
    } if
    depth-- 
    grestore
  } def
  \pst@fractal@angle rotate
  #2 FractArrow 
%  180 rotate #2 FractArrow
%  stroke
  }% end add@pscode
  \end@SpecialObj%
}}
%
%
\catcode`\@=\PstAtCode\relax
%
%% END: pst-fractal.tex
\endinput