Sezione aurea
Moderatori: Gianfranco, Bruno
Questo forum è una sezione del PORTALE DI BASE CINQUE
Sezione aurea
.
Ho trovato questa animazione sul web e mi sono divertito a riprodurla in basic.
[Sergio] / $17$
-
- Supervisore del sito
- Messaggi: 1720
- Iscritto il: ven mag 20, 2005 9:51 pm
- Località: Sestri Levante
- Contatta:
Re: Sezione aurea
Bellissimo lavoro Sergio.
Sapevo che col Decimal BASIC si può salvare la finestra grafica, ma non sapevo che si possono anche creare GIF animate. Ottima notizia!
A questo punto, la domanda sorge spontanea: come hai fatto?
Sapevo che col Decimal BASIC si può salvare la finestra grafica, ma non sapevo che si possono anche creare GIF animate. Ottima notizia!
A questo punto, la domanda sorge spontanea: come hai fatto?
Pace e bene a tutti.
Gianfranco
Gianfranco
Re: Sezione aurea
Grazie Gianfranco, purtroppo devo precisare che non ho usato Decimal Basic.
Ho utilizzato un"app: BASIC! per Android, che ha funzionalità grafiche più avanzate, poi ho catturato l'animazione sullo schermo con un'altra app, quindi ho tagliato il filmato con un'altra app ancora e alla fine ho creato la gif animata con una quarta app.
Sono curioso di vedere se riesco a riprodurre l'effetto anche in Decimal Basic.
Il programma permatte di realizzare l'animazione anche con le serzioni argentea, bronzea, ecc...
Ecco uno screenshot Vi lascio anche il listato, il codice non è ottimizzato perché programmare con il tablet non è molto pratico.
Ho utilizzato un"app: BASIC! per Android, che ha funzionalità grafiche più avanzate, poi ho catturato l'animazione sullo schermo con un'altra app, quindi ho tagliato il filmato con un'altra app ancora e alla fine ho creato la gif animata con una quarta app.
Sono curioso di vedere se riesco a riprodurre l'effetto anche in Decimal Basic.
Il programma permatte di realizzare l'animazione anche con le serzioni argentea, bronzea, ecc...
Ecco uno screenshot Vi lascio anche il listato, il codice non è ottimizzato perché programmare con il tablet non è molto pratico.
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
[Sergio] / $17$
Re: Sezione aurea
Ho convertito il programma in Decimal Basic, ecco il listato
Con la funzione GSAVE ho salvato la sequenza di immagini, dopo le ho ritagliate con programma di grafica (ho usato Xn View MP che è un image browser ma ha anche funzioni per operare su gruppi di immagini) e poi ho creato la gif con un software apposito (PhotoScape X)
Questo è il risultato
.
.
Se il quadrato più grande ha lato 1, qual è il raggio del cerchio?
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
Questo è il risultato
.
.
Se il quadrato più grande ha lato 1, qual è il raggio del cerchio?
[Sergio] / $17$