
.
Ho trovato questa animazione sul web e mi sono divertito a riprodurla in basic.
Moderatori: Gianfranco, Bruno
Questo forum è una sezione del PORTALE DI BASE CINQUE
Codice: Seleziona tutto
input "Input ratio (1=golden, 2=silver, 3=bronze, ...)", z
z=int(z)
if z<0 | z>10 then z=1
l=12
ci=50
di=200*sqr(z)
a=pi()/3
bi=pi()/4
fi=(sqr(z^2+4)+z)/2
sfi=2/((z-2)+sqr(z^2+4))
dim c[l+1,2]
dim t[2]
dim qxy[8]
GR.OPEN ,,,,,1
inizio:
s=100
for as= -s to s
a = pi()*as/s
if abs(as)>s/2 & mod(as,3)<>0 & abs(as)<s then f_n.continue
if abs(as)<s/2 & abs(as)>s/5 & mod(as,2)<>0 then f_n.continue
GR.COLOR ,0,255,0,0
gr.circle p, ci+di*(sfi+1-1/z), ci+di*(sfi+1-1/z), di*sqr(2)/z
GR.COLOR ,90,90,90,0
c[1,1] = ci
c[1,2] = ci
d=di
b=bi
for i= 1 to l
c[i+1,1] = c[i,1]+sqr(2)*d*cos(b)
c[i+1,2] = c[i,2]+sqr(2)*d*sin(b)
xm=(c[i,1]+c[i+1,1])/2
ym=(c[i,2]+c[i+1,2])/2
xd=xm-c[i,1]
yd=ym-c[i,2]
if a<>0 then
xc=xm+yd*tan(pi()/2-a/2)
yc=ym-xd*tan(pi()/2-a/2)
endif
array.load qx[], c[i,1], xm-yd, c[i+1,1], xm+yd, c[i,1]
array.load qy[], c[i,2], ym+xd, c[i+1,2], ym-xd, c[i,2]
for q=1 to 4
gr.line p, qx[q], qy[q], qx[q+1], qy[q+1]
qxy[2*q-1]=qx[q]
qxy[2*q]=qy[q]
next
LIST.CREATE n, List1
LIST.ADD.ARRAY List1, qxy[]
GR.COLOR 128, 128, 128, 128, 1
GR.POLY pt, List1
GR.COLOR ,0,0,255,0
if a=0 then
for v = ci to ci+di*(sfi+1) step 2
gr.point p, v, v
next
else
for v = 1 to 2
ux=qx[2*v-1]-xc: uy=qy[2*v-1]-yc
if ux>0 & uy>0 then t[v]=atan(uy/ux)
if ux<0 & uy>0 then t[v]=pi()-atan(uy/-ux)
if ux>0 & uy<0 then t[v]=2*pi()-atan(-uy/ux)
if ux<0 & uy<0 then t[v]=pi()+atan(uy/ux)
if uy=0 then
if ux>0 then t[v]=0 else t[v]=pi()
endif
if ux=0 then
if uy>0 then t[v]=pi()/2 else t[v]=3*pi()/2
endif
next
if t[1]<0.0000001 then
if a<0 then t[1]=0 else t[1]= 2*pi()
endif
if t[2]>6.283185 then
if a<0 then t[2]=0 else t[2]= 2*pi()
endif
if a<0 & t[1]>t[2] then t[2]=t[2]+2*pi()
if a>0 & t[2]>t[1] then t[1]=t[1]+2*pi()
r=sqr((ux)^2+(uy)^2)
t0=abs(t[1]-t[2])/(2*d)
if t[1]>t[2] then t0=-t0
for t=t[1] to t[2] step t0
gr.point p, xc+r*cos(t), yc+r*sin(t)
next
! print xc, yc, t[1], t[2]
endif
GR.COLOR ,90,90,90,0
d=d/fi
b=b-a
next
GR.RENDER
PAUSE 1000/s
if abs(as)=s/2 then
if z>1 & z<5 then
pause 250
GR.COLOR ,90,90,90,0
if as=-s/2 then
c[1,1] = ci+di
c[1,2] = ci+di*(fi+2-z)
b=bi+pi()
else
c[1,1] = ci+di*(fi+2-z)
c[1,2] = ci+di
b=bi-pi()
endif
d=di
for i= 1 to l
c[i+1,1] = c[i,1]+sqr(2)*d*cos(b)
c[i+1,2] = c[i,2]+sqr(2)*d*sin(b)
xm=(c[i,1]+c[i+1,1])/2
ym=(c[i,2]+c[i+1,2])/2
xd=xm-c[i,1]
yd=ym-c[i,2]
if a<>0 then
xc=xm+yd*tan(pi()/2-a/2)
yc=ym-xd*tan(pi()/2-a/2)
endif
array.load qx[], c[i,1], xm-yd, c[i+1,1], xm+yd, c[i,1]
array.load qy[], c[i,2], ym+xd, c[i+1,2], ym-xd, c[i,2]
for q=1 to 4
gr.line p, qx[q], qy[q], qx[q+1], qy[q+1]
qxy[2*q-1]=qx[q]
qxy[2*q]=qy[q]
next
d=d/fi
b=b-a
next
gr.render
pause 1000
else
pause 1000
end if
end if
if abs(as)=s then pause 1000
if as=0 then pause 250
gr.cls
next
goto inizio
Codice: Seleziona tutto
INPUT PROMPT "Input ratio (1=golden, 2=silver, 3=bronze, ...)": z
LET z=int(z)
IF z<0 OR z>10 THEN LET z=1
LET l=12
LET ci=50
LET di=200*sqr(z)
LET a=pi/3
LET bi=pi/4
LET fi=(sqr(z^2+4)+z)/2
LET sfi=2/((z-2)+sqr(z^2+4))
dim c(l+1,2)
dim t(2)
DIM qx(5)
DIM qy(5)
LET f$="D:\Setup\BASICEn\_prog\sezione\aurea"
SET WINDOW 0,1000,0,1000
10 !inizio
LET s=100
for as= -s to s
LET a = pi*as/s
IF ABS(as)>s/2 AND MOD(as,3)<>0 AND ABS(as)<s THEN GOTO 20
IF ABS(as)<s/2 AND ABS(as)>s/5 AND MOD(as,2)<>0 THEN GOTO 20
SET LINE COLOR 3
LET xc=ci+di*(sfi+1-1/z)
LET yc=ci+di*(sfi+1-1/z)
LET r=di*SQR(2)/z
FOR u=0 TO 2*PI STEP PI/50
PLOT LINES: xc+r*COS(u),yc+r*SIN(u);
NEXT u
PLOT LINES
LET c(1,1) = ci
LET c(1,2) = ci
LET d=di
LET b=bi
for i= 1 to l
LET c(i+1,1) = c(i,1)+sqr(2)*d*cos(b)
LET c(i+1,2) = c(i,2)+sqr(2)*d*sin(b)
LET xm=(c(i,1)+c(i+1,1))/2
LET ym=(c(i,2)+c(i+1,2))/2
LET xd=xm-c(i,1)
LET yd=ym-c(i,2)
if a<>0 then
LET xc=xm+yd*tan(pi/2-a/2)
LET yc=ym-xd*tan(pi/2-a/2)
end if
LET qx(1)=c(i,1)
LET qx(2)=xm-yd
LET qx(3)=c(i+1,1)
LET qx(4)=xm+yd
LET qx(5)=c(i,1)
LET qy(1)=c(i,2)
LET qy(2)=ym+xd
LET qy(3)=c(i+1,2)
LET qy(4)=ym-xd
LET qy(5)=c(i,2)
SET AREA COLOR "SILVER"
plot AREA: qx(1), qy(1); qx(2), qy(2); qx(3), qy(3); qx(4), qy(4)
SET LINE COLOR "GRAY"
FOR q=1 TO 4
PLOT LINES: qx(q), qy(q); qx(q+1), qy(q+1)
NEXT Q
PLOT LINES
SET LINE COLOR 2
IF a=0 THEN
FOR v = ci TO ci+di*(sfi+1) STEP 2
PLOT lineS: v, v
NEXT V
else
for v = 1 to 2
LET ux=qx(2*v-1)-xc
LET uy=qy(2*v-1)-yc
if ux>0 AND uy>0 then LET t(v)=atn(uy/ux)
IF ux<0 AND uy>0 THEN LET t(v)=PI-atn(uy/(-ux))
IF ux>0 AND uy<0 THEN LET t(v)=2*PI-atn(-uy/ux)
IF ux<0 AND uy<0 THEN LET t(v)=PI+atn(uy/ux)
if uy=0 then
if ux>0 then LET t(v)=0 else LET t(v)=pi
end if
if ux=0 then
if uy>0 then LET t(v)=pi/2 else LET t(v)=3*pi/2
end if
next V
if t(1)<0.0000001 then
if a<0 then LET t(1)=0 else LET t(1)= 2*pi
end if
if t(2)>6.283185 then
if a<0 then LET t(2)=0 else LET t(2)= 2*pi
end if
if a<0 AND t(1)>t(2) then LET t(2)=t(2)+2*pi
if a>0 AND t(2)>t(1) then LET t(1)=t(1)+2*pi
LET r=sqr((ux)^2+(uy)^2)
LET t0=abs(t(1)-t(2))/(2*d)
if t(1)>t(2) then LET t0=-t0
FOR u=t(1) TO t(2) STEP t0
PLOT lineS: xc+r*COS(u), yc+r*SIN(u)
NEXT U
END IF
SET LINE COLOR "GRAY"
LET d=d/fi
LET b=b-a
next I
WAIT DELAY 1/s
IF ABS(as)=s/2 THEN
if z>1 AND z<5 then
WAIT DELAY .25
SET LINE COLOR "GRAY"
if as=-s/2 then
LET c(1,1) = ci+di
LET c(1,2) = ci+di*(fi+2-z)
LET b=bi+pi
else
LET c(1,1) = ci+di*(fi+2-z)
LET c(1,2) = ci+di
LET b=bi-pi
end if
LET d=di
for i= 1 to l
LET c(i+1,1) = c(i,1)+sqr(2)*d*cos(b)
LET c(i+1,2) = c(i,2)+sqr(2)*d*sin(b)
LET xm=(c(i,1)+c(i+1,1))/2
LET ym=(c(i,2)+c(i+1,2))/2
LET xd=xm-c(i,1)
LET yd=ym-c(i,2)
if a<>0 then
LET xc=xm+yd*tan(pi/2-a/2)
LET yc=ym-xd*tan(pi/2-a/2)
end if
LET qx(1)=c(i,1)
LET qx(2)=xm-yd
LET qx(3)=c(i+1,1)
LET qx(4)=xm+yd
LET qx(5)=c(i,1)
LET qy(1)=c(i,2)
LET qy(2)=ym+xd
LET qy(3)=c(i+1,2)
LET qy(4)=ym-xd
LET qy(5)=c(i,2)
FOR q=1 TO 4
PLOT LINES: qx(q), qy(q); qx(q+1), qy(q+1)
NEXT Q
PLOT LINEs
LET d=d/fi
LET b=b-a
NEXT i
WAIT DELAY 1
ELSE
WAIT DELAY 1
END IF
END IF
IF ABS(as)=s THEN WAIT DELAY 1
IF as=0 THEN WAIT DELAY .25
gsave f$ & right$("00" & STR$(as+s),3) & ".gif"
CLEAR
20 !fine
NEXT AS
END