summaryrefslogtreecommitdiff
path: root/graphics/pstricks/contrib/pst-fractal/dvips/pst-fractal.pro
diff options
context:
space:
mode:
Diffstat (limited to 'graphics/pstricks/contrib/pst-fractal/dvips/pst-fractal.pro')
-rw-r--r--graphics/pstricks/contrib/pst-fractal/dvips/pst-fractal.pro953
1 files changed, 953 insertions, 0 deletions
diff --git a/graphics/pstricks/contrib/pst-fractal/dvips/pst-fractal.pro b/graphics/pstricks/contrib/pst-fractal/dvips/pst-fractal.pro
new file mode 100644
index 0000000000..fcdc69bb99
--- /dev/null
+++ b/graphics/pstricks/contrib/pst-fractal/dvips/pst-fractal.pro
@@ -0,0 +1,953 @@
+%% $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 \ No newline at end of file