diff options
Diffstat (limited to 'graphics/pstricks/contrib/pst-fractal/dvips/pst-fractal.pro')
-rw-r--r-- | graphics/pstricks/contrib/pst-fractal/dvips/pst-fractal.pro | 953 |
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 |