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 <hvoss _at_ tug.org>
%%
%% 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.06}
\def\filedate{2010/02/10}
\message{`PST-fractal' v\fileversion, \filedate\space (hv)}
%
\edef\PstAtCode{\the\catcode`\@} \catcode`\@=11\relax
\pst@addfams{pst-fractal}
\pstheader{pst-fractal.pro}
%\SpecialCoor
%
\newdimen\pst@fractal@xWidth
\define@key[psset]{pst-fractal}{xWidth}[1cm]{\pssetlength\pst@fractal@xWidth{#1}}
\newdimen\pst@fractal@yWidth
\define@key[psset]{pst-fractal}{yWidth}[1cm]{\pssetlength\pst@fractal@yWidth{#1}}
\psset[pst-fractal]{xWidth=1cm,yWidth=1cm}
\define@key[psset]{pst-fractal}{type}[Julia]{\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}[white]{\pst@getcolor{#1}\pst@fractal@baseColor}
\psset[pst-fractal]{baseColor=white}
%
\define@key[psset]{pst-fractal}{cx}[0]{\def\pst@fractal@cx{#1 }}
\define@key[psset]{pst-fractal}{cy}[0]{\def\pst@fractal@cy{#1 }}
\define@key[psset]{pst-fractal}{dIter}[1]{\def\pst@fractal@dIter{#1 }}
\psset[pst-fractal]{cx=0,cy=0,dIter=1}
\define@key[psset]{pst-fractal}{maxIter}[255]{\pst@checknum{#1}\pst@fractal@maxIter}
\define@key[psset]{pst-fractal}{maxRadius}[100]{\pst@checknum{#1}\pst@fractal@maxRadius}
\psset[pst-fractal]{maxIter=255,maxRadius=100}
\define@key[psset]{pst-fractal}{plotpoints}[2000]{\pst@checknum{#1}\pst@fractal@plotpoints}
\psset[pst-fractal]{plotpoints=2000}
%
\define@key[psset]{pst-fractal}{angle}[0]{\pst@getangle{#1}\pst@fractal@angle}
\define@key[psset]{pst-fractal}{c}[5]{\pst@checknum{#1}\pst@fractal@c}
\newdimen\pst@fractal@minWidth
\define@key[psset]{pst-fractal}{minWidth}[1pt]{\pssetlength\pst@fractal@minWidth{#1}}
\psset[pst-fractal]{angle=0,c=5,minWidth=1pt}
%
\define@key[psset]{pst-fractal}{scale}[1]{\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}[5cm]{\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 
    \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 ^^J%
    tx@fractalDict begin tx@Fractal end ^^J%
  }% end add@pscode
  \endpspicture% end box
  \end@SpecialObj% 
  \ignorespaces}
%
\def\psSier{\pst@object{psSier}}
\def\psSier@i(#1){\@ifnextchar({\psSier@ii(#1)}{\psSier@iii(#1)}}
\def\psSier@ii(#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{
    [ \pst@temp@A \pst@temp@B \pst@temp@C ]  ^^J%
    { \pst@usecolor\pslinecolor } ^^J%
    \pst@fractal@plotpoints ^^J%
    tx@fractalDict begin tx@Sierpinski end ^^J%
  }% end add@pscode
  \end@SpecialObj%
}}
\def\psSier@iii(#1)#2#3{%
  \pst@getcoor{#1}\pst@tempA
  \pst@getlength{#2}\pst@tempB
  \begin@OpenObj%
  \addto@pscode{
    /sierpy { 
      dup 1 ge 
       { 1 sub gsave 0.5 dup scale dup sierpy
         1 0 translate dup sierpy
        -0.5 0.8660254 translate dup sierpy grestore
       }{newpath 
         0 0 moveto 
         1 0 lineto 0.5 0.8660254 lineto closepath 
         gsave \pst@usecolor\pslinecolor 
         fill grestore } ifelse pop
    } def
    \pst@tempA\space translate
    \pst@tempB\space dup scale
    0 setlinewidth
    0 0 moveto 1 0 lineto 0.5 0.8660254 lineto 0 setlinewidth closepath 
    gsave \pst@usecolor\psfillcolor fill grestore stroke
    #3 sierpy }%
  \end@OpenObj%
}
%
%
\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{
    \pst@tempA
    \pst@fractal@c
    \pst@fractal@angle
    \pst@fractal@maxIter
    \ifPst@CMYK true \else false \fi ^^J%
    tx@fractalDict begin tx@Phyllotaxis end ^^J%
  }% 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{scale=10,linewidth=0.001pt,maxIter=20000,radius=0.001pt}%
  \pst@getcoor{#1}\pst@tempA%
  \begin@SpecialObj%
  \addto@pscode{
    \pst@fractal@Xscale 
    \pst@tempA 
    \pst@fractal@maxIter
    \pst@fractal@radius
    \pst@number\pslinewidth
    { \pst@usecolor\pslinecolor }
    tx@fractalDict begin tx@Fern end 
  }% 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 ^^J%
    \pst@tempA translate
    \pst@usecolor\pslinecolor 
    \pst@fractal@angle rotate ^^J%
    \pst@number\pslinewidth 10 div \pst@fractal@Xscale div SLW ^^J%
    \pst@fractal@maxIter ^^J%
    tx@fractalDict begin ^^J%
      \pst@fractal@scale ^^J%
      tx@Kochflake end ^^J%
  }% end add@pscode
  \psk@fillstyle
  \addto@pscode{stroke grestore }
  \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{
    \pst@fractal@dIter
    \pst@number\pst@fractal@Radius
    \ifPst@fractal@Color true \else false \fi
    \ifPst@CMYK true \else false \fi ^^J%
    tx@fractalDict begin ^^J%
    gsave ^^J%
    \pst@tempA translate ^^J%
    \pst@usecolor\pslinecolor
    \pst@fractal@scale
    \pst@number\pslinewidth SLW ^^J%
    tx@Appolonius end ^^J%
  }% end add@pscode
  \psk@fillstyle%
  \addto@pscode{stroke grestore}%
  \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,c=0.5}%
  \pst@getcoor{#1}\pst@tempA%
  \begin@SpecialObj%
  \addto@pscode{
  gsave ^^J%
  \pst@tempA exch \pst@number\pst@fractal@xWidth 2 div sub exch translate ^^J%
  \pst@usecolor\pslinecolor
  \pst@fractal@scale
  \pst@number\pslinewidth \pst@fractal@Xscale div SLW ^^J%
  /sqrt2 1.41421356237310 def ^^J%
  /minWidth \pst@number\pst@fractal@minWidth 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 ^^J%
    tx@addDict begin icount ^^J%
    \ifPst@CMYK wavelengthToCMYK Cyan Magenta Yellow Black end setcmykcolor  ^^J%
    \else wavelengthToRGB Red Green Blue end setrgbcolor \fi ^^J%
  } def ^^J%
  /Alpha1 { .5 1 \pst@fractal@c sub atan } bind def 
  /Alpha2 { .5 \pst@fractal@c atan } bind def 
  /box { \@percentchar stacksize ^^J 	%  width on stack
    /w ED
    newpath  				%
    0 0 moveto 				%   
    w 0 rlineto 			% w 0 move right
    0 w rlineto 			% 0 w move up
    w neg \pst@fractal@c mul w 0.5 mul % -c*w 0.5*w
    rlineto 				% move left up
    w \pst@fractal@c 1 sub mul   	% -(1-c)*w
    w -0.5 mul rlineto			% -(1-c)*w -0.5w move left down	
    closepath 				% close
    \ifPst@fractal@Color
    setWaveColor fill  ^^J%
%      r g b setrgbcolor fill r g b /g exch def /r exch def /b exch def 
    \else stroke \fi  %
    w minWidth gt { 			% w w limit gt
      gsave %
        0 w translate 
	Alpha1 rotate 
	w dup 0.5 mul 1 \pst@fractal@c sub w mul Pyth box % one w to leave on stack
      grestore 
      gsave 
        dup dup dup 			% w w w w
        1 \pst@fractal@c sub mul 	% w w w w*(1-c)
	exch 1.5 mul 			% w w w*(1-c) w*1.5
	translate			% w w 
	360 Alpha2 sub rotate 
	0.5 mul exch \pst@fractal@c mul Pyth box 
      grestore 
    } if
  } def 
  \pst@number\pst@fractal@xWidth box ^^J%
  }% 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 ^^J%
  \pst@tempA translate 0 0 moveto ^^J%
  \pst@usecolor\pslinecolor ^^J%
  \pst@fractal@scale ^^J%
  /depth 0 def ^^J%
  /depth++ { /depth depth 1 add def } def ^^J%
  /depth-- { /depth depth 1 sub def } def ^^J%
  /icount 380 def ^^J%
  /setWaveColor { ^^J%
    /icount icount dup 780 gt { pop 380 }{ \pst@fractal@dIter add } ifelse def ^^J%
    tx@addDict begin icount  ^^J%
    \ifPst@CMYK wavelengthToCMYK Cyan Magenta Yellow Black end setcmykcolor   ^^J%
    \else wavelengthToRGB Red Green Blue end setrgbcolor \fi ^^J%
  } def ^^J%
  /DoLine {		\@percentchar print a vert. line ^^J%
    0 \pst@number\pst@fractal@yWidth rlineto currentpoint   ^^J%
    \ifPst@fractal@Color setWaveColor \fi ^^J%
    stroke  ^^J%
    translate 0 0 moveto  ^^J%
  } def ^^J%
  /FractArrow {  ^^J%
    /sc exch def ^^J% 
    gsave  ^^J%
    sc dup scale ^^J%
    \pst@number\pslinewidth SLW ^^J%
    depth++ DoLine ^^J%
    depth \pst@fractal@maxIter le {  ^^J%
      135 rotate sc FractArrow ^^J%
      -270 rotate sc FractArrow ^^J% 
    } if ^^J%
    depth--  ^^J%
    grestore ^^J%
  } def ^^J%
  \pst@fractal@angle rotate ^^J%
  #2 FractArrow  ^^J%
%  180 rotate #2 FractArrow
%  stroke
  }% end add@pscode
  \end@SpecialObj%
}}
%
%
\catcode`\@=\PstAtCode\relax
%
%% END: pst-fractal.tex
\endinput