Penrose Seasons Greetings
- To: mathgroup at smc.vnet.net
- Subject: [mg31862] Penrose Seasons Greetings
- From: wself at msubillings.edu (Will Self)
- Date: Fri, 7 Dec 2001 05:57:01 -0500 (EST)
- Sender: owner-wri-mathgroup at wolfram.com
A Penrose Seasons Greetings to everyone! Start a new Mathematica
session, copy the code below, paste it into a new notebook, and
evaluate the notebook. You can drag the resulting picture to make it
bigger. On an older computer, perhaps change the final 6 to 4, at
least to begin with. Email me if you would like to have a notebook
with comprehensible version of the code. --Will Self
(**** copy and paste below this line ****)
(c=N@GoldenRatio;z=Pi/5.;pi=N@Pi;gr=Graphics;
x=Cos;y=Sin;f=RGBColor[1,0,0];g=RGBColor[0,.8,0];
c1=x[z];s1=y[z];c2=x[2z];s2=y[2z];o={0,0};
p[1]={1,0};q[1]={1+c2,s2};r[1]={c2,s2};
s[1]={1,0};t[1]={1-c1,s1};u[1]={-c1,s1};
b[co_,ce_,rs_,rb_,a1_,a2_]:={co,
Polygon[Join[{ce+rs{x[a1],y[a1]}},{ce+rb{x[a1],y[a1]}},
Table[ce+rb{x[t],y[t]},{t,a1,a2,.1}],
{ce + rb{x[a2],y[a2]}},{ce+rs{x[a2],y[a2]}},
Table[ce+rs{x[t],y[t]},{t,a2,a1,-.1}]]]};
aL[1]=gr[{b[f,{0,0},.68,.96,0.,z+.02],
b[g,{0,0},.44,.71,0.,z+.02]}];
aU[1]=gr[{b[f,{0,0},.68,.96,z-.02,2z],
b[g,{0,0},.44,.71,z-.02,2z]}];
bL[1]=gr[{b[f,{1,0},.68,.96,pi-z/2,pi],
b[g,{1,0},.44,.71,pi-z/2,pi]}];
bU[1]=gr[{b[f,u[1],.68,.96,-z,-z/2],
b[g,u[1],.44,.71,-z,-z/2]}];
m[ob_,an_,di_]:=ob/.{xx_?NumberQ,yy_?NumberQ}->
di+{x[an]xx-y[an]yy,y[an]xx+x[an]yy};
p[n_]:=c*p[n-1];q[n_]:=c*q[n-1];r[n_]:=c*r[n-1];
s[n_]:=c*s[n-1];t[n_]:=c*t[n-1];u[n_]:=c*u[n-1];
aL[n_]:=aL[n]={m[aU[n-1],pi,q[n-1]],
m[bU[n-1],z/2-pi/2,p[n-1]],m[aL[n-1],pi+z,q[n]]};
aU[n_]:=aU[n]={m[aL[n-1],pi,q[n-1]],
m[bL[n-1],0,r[n-1]],m[aU[n-1],4z,q[n]]};
bL[n_]:=bL[n]={m[bL[n-1],pi/2+z/2,p[n]-p[n-1]],
m[aL[n-1],-2z,t[n]]};
bU[n_]:=bU[n]={m[bU[n-1],-pi/2-z/2,u[n]-u[n-1]],
m[aU[n-1],4z,t[n]]};
cc[n_]:={m[{aL[n],aU[n]},pi,q[n]],m[{bL[n],bU[n]},0,r[n]]};
pp[ob_]:=Show[{ob,m[ob,2z,o],m[ob,4z,o],m[ob,6z,o],m[ob,8z,o]},
AspectRatio->Automatic];
pp[cc[6]];)
(******** down to here ********)