path: root/Master/texmf-dist/dvips/pst-fractal/pst-fractal.pro

%% $Id: pst-fractal.pro 679 2017-12-04 21:41:23Z herbert $
%%
%% 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.06 / 2017-12-04  Herbert Voss <hvoss _at_ tug.org>
%
/tx@fractalDict 100 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 1 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  
	 ifCMYK { tx@addDict begin wavelengthToCMYK Cyan Magenta Yellow Black end setcmykcolor 
	 }{ tx@addDict begin 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
%
/Rot-90 {
  2 dict begin
  /y exch def /x exch def
  y
  x neg
  end
} def
%
/tx@SierpinskiCurve { %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  /Pi [1.5 cmunit 1 cmunit
     1 cmunit 0.5 cmunit
     1 cmunit -0.5 cmunit
     1.5 cmunit -1 cmunit ] def
%
  /P0 Pi def
  /coefficient 1 def
  3 {
    P0
    [
      0 2 Pi length 2 sub {/i exch def
        Pi i get Pi i 1 add get exch neg % Rot-90
      } for
    ]  /Pi exch def
    P0 Pi concatarray /P0 exch def
  } repeat
%
/P1 {[
  0 2 P0 length 2 sub {/i exch def
    P0 i get P0 i 1 add get % Rot-90
    -2 cmunit coefficient mul add exch
    -2 cmunit coefficient mul add exch
  } for
] } def
%
/P2 {[
  0 2 P0 length 2 sub {
    /i exch def
    P0 i get P0 i 1 add get exch neg % Rot-90
    2 cmunit coefficient mul add exch
   -2 cmunit coefficient mul add exch
   } for ]
} def
%
/P3 {[
  0 2 P0 length 2 sub {
    /i exch def
    P0 i get P0 i 1 add get neg exch neg exch % Rot-90 Rot-90
    2 cmunit coefficient mul add exch
    2 cmunit coefficient mul add exch
  } for
] } def
%
/P4 {[
   0 2 P0 length 2 sub {/i exch def
     P0 i get P0 i 1 add get neg exch % Rot-90 Rot-90 Rot-90
     -2 cmunit coefficient mul add exch
     2 cmunit coefficient mul add exch
   } for
] } def
  n@ 1 eq {/Sierpinsky P0 def}{
      n@ 1 sub {
        /Sierpinsky P1 P2 concatarray P3 concatarray P4 concatarray def
    /Tab1 [
      0 2 Sierpinsky length 2 sub {/i exch def
        Sierpinsky i 2 getinterval
      } for
    ] def
    /i@ Sierpinsky length 8 div 2.5 mul cvi def %
    /Sierpinsky2 [
      Tab1 length {
        Tab1 i@ get
        /i@ i@ 1 add def
        i@ Tab1 length ge {/i@ 0 def} if
      }repeat
    ] def
    /P0 [
      0 1 Sierpinsky2 length 1 sub {/i exch def
        Sierpinsky2 i get aload pop
      } for
    ] def
    /coefficient coefficient 2 mul def
    } repeat    
  } ifelse
%
    newpath
    Sierpinsky 0 get Sierpinsky 1 get moveto
      0 2 Sierpinsky length 2 sub {/i exch def
      i 2 div Npts ge {exit} if
      Sierpinsky i get Sierpinsky i 1 add get lineto
    } for
    Npts 4 n@ 1 add exp cvi ge { closepath } if
    useFill { gsave fillColor fill grestore } if 
%
    useLineStyle
} 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
%
/tx@Hugo { %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%Creator: Hugo M. Ayala'89, MIT
%    \pst@fractal@scale 
%    \pst@tempA 
%    \pst@fractal@maxIter, which is the depth
%    \pst@number\pslinewidth
%    { \pst@usecolor\pslinecolor }
/setColor ED
SLW
/depth ED  
translate
dup scale
2 setlinecap
setColor
%
/oldarrayx [0 540 72 72] def
/oldarrayy [0 396 720 72] def
%
/scl .1 def
%
realtime srand
/prorand { rand 32768 div 32768 div 1 sub scl mul} def
/findrow {8 mul 7 sub sqrt 1 add 2 div truncate} def
/findindex {dup 1 sub mul 2 div 1 add} def
/findcolumn {dup findrow findindex sub} def
/findnewrow {2 mul 1 sub} def
/findnewcolumn {2 mul} def
/findarraysize {dup 1 add mul 2 div 1 add} def
/findnumoflines {dup 1 sub mul 2 div 3 mul} def
/findnumpoints {dup 1 add mul 2 div} def
/gtol {2 exch exp 1 add} def
/fixangle {dup 180 ge {180 sub} if} def
/backangle {dup 180 ge {180 sub} {180 add} ifelse} def
/splitline { 
  tpx btx add 2 div /mdx exch def
  tpy bty add 2 div /mdy exch def
  tpy bty sub tpx btx sub atan
  90 add fixangle
  /lineangle exch def
  tpy bty sub dup mul
  tpx btx sub dup mul
  add sqrt /linelen exch def
  prorand linelen mul dup
  lineangle cos mul mdx add /mdx exch def
  lineangle sin mul mdy add /mdy exch def
} def
%
/findnewindex{ cvi /oldindex exch def
  oldindex findrow cvi dup /oldrow exch def
  findindex oldindex exch sub cvi /oldcolumn exch def
  oldrow findnewrow cvi dup /newrow exch def findindex
  oldcolumn findnewcolumn cvi dup /newcolumn exch def add
  cvi /newindex exch def
} def
%
/drawfractal {
  1 1 generation gtol 1 sub findnumpoints {
    cvi /topindex exch def
    topindex dup findcolumn exch findrow 1 add findindex add cvi
    /leftindex exch def
    leftindex 1 add cvi 
    /rightindex exch def
    /tpx oldarrayx topindex get def
    /tpy oldarrayy topindex get def
    /btx oldarrayx leftindex get def
    /bty oldarrayy leftindex get def
    /mdx oldarrayx rightindex get def
    /mdy oldarrayy rightindex get def
    tpx tpy moveto
    btx bty lineto
    mdx mdy lineto
    closepath stroke 
  } for
} def
%
1 1 depth {
  /generation exch def
  generation gtol findarraysize cvi dup array /newarrayx exch def
  array /newarrayy exch def
  1 1 generation 1 sub gtol findnumpoints {
    findnewindex
    newarrayx newindex
    oldarrayx oldindex get put
    newarrayy newindex
    oldarrayy oldindex get put
  } for
  1 1 generation 1 sub gtol 1 sub findnumpoints {
     findnewindex
     newcolumn newrow 2 add findindex add cvi dup
     /leftindex exch def 
     2 add cvi /rightindex exch def
     newcolumn newrow 1 add findindex add cvi
     /mindex exch def
     /tpx newarrayx newindex get def
     /tpy newarrayy newindex get def
     /btx newarrayx leftindex get def
     /bty newarrayy leftindex get def
     splitline
     newarrayx mindex mdx put
     newarrayy mindex mdy put
     mindex 1 add cvi /mindex exch def
     /btx newarrayx rightindex get def
     /bty newarrayy rightindex get def
     splitline
     newarrayx mindex mdx put
     newarrayy mindex mdy put
     /mindex leftindex 1 add cvi def
     /tpx newarrayx leftindex get def
     /tpy newarrayy leftindex get def
     splitline
     newarrayx mindex mdx put
     newarrayy mindex mdy put 
   } for
   /oldarrayx newarrayx def
   /oldarrayy newarrayy def
   7 generation sub 5 div setlinewidth
%   drawfractal showpage 
} for 
drawfractal  
} def  % end of /tx@Hugo
%
/FibonacciFractal {
  20 dict begin
  n@ 2 sub {
	/Fi F2 F1 concatstrings def
	/F1 F2 def
	/F2 Fi def
      } repeat
    /S Fi def
    /nS S length def % nombre de lettres
    0 1 nS 2 sub {/j exch def
      x1 y1 translate
      /x0 0 def /y0 0 def
      /k S j 1 getinterval cvi def
      k 0 eq {
	j 2 mod 0 eq {
          angle neg rotate
          tx  ty lineto
          currentpoint /y1 exch def /x1 exch def
          /flag 0 def
        }{
          angle rotate
          tx ty lineto
          currentpoint /y1 exch def /x1 exch def
          /flag 1 def
        } ifelse
      }{
	tx ty lineto
	currentpoint /y1 exch def /x1 exch def
	/flag 2 def
      } ifelse
    } for
    setLineColor
    stroke
    Pst@juxtaposition {
    x1 y1 translate
    flag 1 eq {-1 1 scale} if
    flag 2 eq {90 rotate 1 -1 scale } if
    0 0 moveto
    /x0 0 def /y0 0 def
    /F1 (1) def
    /F2 (0) def
    /x1 0 def /y1 1 cmunit def
    x1 y1 lineto
    n@ 3 sub{
      /Fi F2 F1 concatstrings def
      /F1 F2 def
      /F2 Fi def
    } repeat
    /S Fi def
    /nS S length def % nombre de lettres
    0 1 nS 2 sub {/j exch def
      x1 y1 translate
      /x0 0 def /y0 0 def
      /k S j 1 getinterval cvi def
      k 0 eq {
	j 2 mod 0 eq {
          -90 rotate
          tx  ty lineto
          currentpoint /y1 exch def /x1 exch def
        }{
          90 rotate
          tx ty lineto
          currentpoint /y1 exch def /x1 exch def
        } ifelse
      }{
	tx ty lineto
	currentpoint /y1 exch def /x1 exch def
      } ifelse
    } for
    ColorF
    stroke
    } if % end Pst@juxtaposition
    end
} def
%
/newFibonacciFractal {
  20 dict begin
  n@ 2 sub {
    /Fi F2 F1 concatstrings def
    /F1 F2 def
    /F2 Fi def
  } repeat
  % The Dense Fibonacci Word
  /DFW () def
  0 2 F2 length 2 sub {
    /i exch def
    /I F2 i 2 getinterval def
    I (00) eq {DFW (0) concatstrings /DFW  exch def } if
    I (01) eq {DFW  (1) concatstrings /DFW  exch def } if
    I (10) eq {DFW  (2) concatstrings /DFW  exch def } if
  } for
% morphismes
% newFibonacci
% 0->"", 1->1, 2->2
  /F2 DFW def
  /Fi () def
  0 1 F2 length 1 sub {
    /i exch def
    /I F2 i 1 getinterval def
    I (0) eq {Fi m@0 concatstrings /Fi exch def} if
    I (1) eq {Fi m@1 concatstrings /Fi exch def} if
    I (2) eq {Fi m@2 concatstrings /Fi exch def} if
  } for
  /S Fi def
  /nS S length def % nombre de lettres
  0 1 nS 1 sub {
    /j exch def
    x1 y1 translate
    /x0 0 def /y0 0 def
    /k S j 1 getinterval cvi def
    k 1 eq {angle neg rotate
      tx  ty lineto
      currentpoint /y1 exch def /x1 exch def
    } if
    k 2 eq { angle rotate
      tx  ty lineto
      currentpoint /y1 exch def /x1 exch def
    } if
    k 0 eq {
      tx  ty lineto
      currentpoint /y1 exch def /x1 exch def
    } if
  } for
  setLineColor
  stroke
  end
} def
%
/i-FibonacciFractal {
  20 dict begin
  /F0 (0) def
  /Fi () def
  i@ 1 sub { 
    Fi (0) concatstrings /Fi exch def
  } repeat
  Fi (1) concatstrings
  /F1 exch def
  n@ {
    F1 F0 concatstrings
    /Fi exch def
    /F0 F1 def
    /F1 Fi def
  } repeat
  /S Fi def
  0 0 translate
  0 0 moveto
  currentpoint /y0 exch def /x0 exch def
  0 1 cmunit lineto
  currentpoint /y1 exch def /x1 exch def
  /tx {x1 x0 sub} def
  /ty {y1 y0 sub} def
%
  /nS S length def % nombre de lettres
  0 1 nS 2 sub {
    /j exch def
    x1 y1 translate
    /x0 0 def /y0 0 def
  /k S j 1 getinterval cvi def
  k 0 eq {
    j 2 mod 0 eq {
              angle neg rotate
              tx  ty lineto
              currentpoint /y1 exch def /x1 exch def
    }{
              angle rotate
              tx ty lineto
              currentpoint /y1 exch def /x1 exch def
    } ifelse
  }{
    tx ty lineto
    currentpoint /y1 exch def /x1 exch def
   } ifelse
  } for
  setLineColor
  stroke
  end
} def
%
/k-FibonacciFractal {
  20 dict begin
  /f0 (0) def
  /fi (0) def
  k@ 2 sub {
    fi (0) concatstrings /fi exch def
  } repeat
  fi (1) concatstrings
  /f1 exch def
  /fi f1 def
  n@ 1 sub {
    k@ 1 sub { f1 fi concatstrings /f1 exch def } repeat
    f1 f0 concatstrings /f1 exch def
     /f0 fi def
    /fi f1 def
  } repeat
  /S f1 def
  t@x cmunit_1 28.45 mul t@y cmunit_1 28.45 mul translate
  0 0 moveto
  currentpoint /y0 exch def /x0 exch def
  0 1 cmunit lineto
  currentpoint /y1 exch def /x1 exch def
  /tx {x1 x0 sub} def
  /ty {y1 y0 sub} def
  /nS S length def % nombre de lettres
  0 1 nS 1 sub {/j exch def
  x1 y1 translate
  /x0 0 def /y0 0 def
  /k S j 1 getinterval cvi def
  k 0 eq {
  j 2 mod 0 eq {
              angle neg rotate
              tx  ty lineto
              currentpoint /y1 exch def /x1 exch def
              }
             {
              angle rotate
              tx ty lineto
              currentpoint /y1 exch def /x1 exch def
              }
             ifelse
} {
    tx ty lineto
    currentpoint /y1 exch def /x1 exch def
    } ifelse
  } for
  setLineColor
  stroke
  end
} def
%
/Biperiodic-FibonacciWords {
  20 dict begin
/f0 () def
/f1 (0) def
/f2 a@ 1 sub {(0) f0 concatstrings /f0 exch def} repeat f0 (1) concatstrings def
3 1 n@ {/i exch def
/fi () def
i 2 mod 0 eq {
 a@ { fi f2 concatstrings /fi exch def } repeat
 }{
 b@ { fi f2 concatstrings /fi exch def } repeat
 } ifelse
 fi f1 concatstrings /fi exch def
 /f1 f2 def
 /f2 fi def
} for
/S f2 def
t@x cmunit_1 28.45 mul t@y cmunit_1 28.45 mul translate
0 0 moveto
currentpoint /y0 exch def /x0 exch def
1 cmunit 0 cmunit lineto
currentpoint /y1 exch def /x1 exch def
/tx {x1 x0 sub} def
/ty {y1 y0 sub} def
/nS S length def % nombre de lettres
0 1 nS 1 sub {/j exch def
x1 y1 translate
/x0 0 def /y0 0 def
/k S j 1 getinterval cvi def
k 0 eq {
j 2 mod 0 eq {
              angle neg rotate
              tx  ty lineto
              currentpoint /y1 exch def /x1 exch def
              }
             {
              angle rotate
              tx ty lineto
              currentpoint /y1 exch def /x1 exch def
              }
             ifelse
} {
tx ty lineto
currentpoint /y1 exch def /x1 exch def
} ifelse
} for
    setLineColor
stroke
end
 }def
%
/InverseLR {
      1 dict begin
	/str exch def
	0 1 str length 1 sub {/i exch def
	  str i 1 getinterval (L) eq {str i (R) putinterval }{str i (L) putinterval }ifelse
	} for
	str
      end
} def
%
/FibonacciPolyominoes {
  20 dict begin
  gsave
  t@x  t@y translate
  /q0 () def
  /q1 (R) def
  /N n@ 3 mul 1 add def
  2 1 N {
    /n exch def
    n 3 mod 2 eq {/qi q1 q0 concatstrings def}
               {/qi q1 q0 InverseLR concatstrings def} ifelse
    /q0 q1 def
    /q1 qi def
  } for
  /q_1 q1 reversestring def
  /qii () def
  /Q 3 {qii q1 concatstrings /qii exch def } repeat 
    qii q_1 reversestring concatstrings def
% remarque
% identique /Q 4{qii q1 concatstrings /qii exch def} repeat qii def
  /tx {x1 x0 sub} def
  /ty {y1 y0 sub} def
  /y0 0 def /x0 0 def
  /x1 x0 0 cmunit add def /y1 y0 1 cmunit add def
  newpath
  x0 y0 moveto
  x1 y1 lineto
  0 1 Q length 1 sub {/i exch def
         x1 y1 translate
  Q i 1 getinterval (L) eq {
         90  rotate
         tx  ty lineto
         currentpoint /y1 exch def /x1 exch def
         }{
         90 neg rotate
         tx  ty lineto
         currentpoint /y1 exch def /x1 exch def
         }ifelse
       } for
  closepath
  setFillColor
  setLineColor
  grestore
  end
} def
%
/Rot2 { % Rot-90+translation
     2 dict begin
     /y exch neg def /x exch def
     y 2 n@ 1 add exp 1 sub add
     x neg 2 n@ exp 1 sub add
     end
   } def
/Trans1 {
  2 dict begin
  /y exch def /x exch def
  x
  y 2 n@ exp add
  end
} def
/Trans2 {
  2 dict begin
  /y exch def /x exch def
  x 2 n@ exp add
  y 2 n@ exp add
  end
} def
%
/HilbertFractal {
  /M0 [[0 0]  [0 1] [1 1] [1 0]] def
  /n@ 1 def
  N@ {
    /M1 [] def
    /M2 [] def
    /M3 [] def
    /M4 [] def
    0 1 M0 length 1 sub {/i exch def
    /M M0 i get def
    /Mt [
      0 2 M length 2 sub {
        /k exch def
        M k 2 getinterval
      } for
    ] def
    M1 [Mt {aload pop exch  } forall] concatarray /M1 exch def
    M2 [Mt {aload pop Trans1} forall] concatarray /M2 exch def
    M3 [Mt {aload pop Trans2} forall] concatarray /M3 exch def
    M4 [Mt {aload pop Rot2  } forall] concatarray /M4 exch def
    } for
    /n@ n@ 1 add def
    /M0 [M1 M2 M3  M4] def
  } repeat
% tableau des points
  /HilbertCurve [
    0 1 M0 length 1 sub {
      /i exch def
      /lePt M0 i get def
      0 2 lePt length 2 sub {
        /j exch def
	lePt j get cmunit
	lePt j 1 add get cmunit
      } for
    } for
  ] def
% le dessin de la courbe
  newpath
  0 0 moveto
  0 2 HilbertCurve length 2 sub {
    /i exch def
    i 2 div Npts ge {exit} if
    HilbertCurve i get
    HilbertCurve i 1 add get
    lineto
  } for
} def
%
end