Superfici 3D – Amiga – AmigaBASIC

Rivista: Commodore Professional – Numero: 1 – Anno 1987- Listato di: N/A

Francesco Sblendorio torna di nuovo protagonista di RetroLiPS con un altro listato per un computer a 16 bit, il Commodore Amiga.

Superfici 3D é un programma interamente scritto in AmigaBasic che permette di disegnare immagini tridimensionali sullo schermo del vostro Amiga e di cambiarne i colori a run-time.

Francesco aveva giá digitato il listato anni fa, ma é riuscito a recuperare informazioni relative alla rivista grazie a Stefano Benedetti che ha procurato le immagini delle pagine.

Il listato originale é stato pubblicato sulla rivista inglese Commodore Professional Numero 1di Agosto-Settembre 1987 – pag. 30.

Titolo: Superfici 3D
Piattaforma: Commodore Amiga
Linguaggio: AmigaBASIC
Versione originale: N/A
Pubblicazione: Commodore Professional Nr. 1 – Agosto-Settembre 1987
Anno: 1987
Trascrizione: Francesco Sblendorio
Anno: 2022
Download: Superfici3D.zip contenente il file Superfici3D.ADF
Note: Il gioco funziona con l’AmigaBasic di Microsoft.

Istruzioni
Per cambiare il disegno del grafico, dovete modificare la formula FNz(x,y) definita nella procedura Equation:
DEF FNz(x,y)=SIN(x^2+3y^2)/(x^2+y^2)+(x^2+5y^2)EXP(1-x^2-y^2)/2
‘DEF FNz(x,y)=(x^2+5y^2)EXP(1-x^2-y^2)/2-SIN(3x^2+y^2)/(x^2+y^2)
‘DEF FNz(x,y)=(SIN(4x^2+y^2)+2SIN(x+y))/(4x^2+y^2)
‘DEF FNz(x,y)=SQR(ABS(xy))
Potete usare una delle 4 giá definite, oppure digitarne una nuova voi stessi. Buon divertimento!

Oltre a modificare l’aspetto del grafico e i colori dello stesso, é possibile anche variare il dettaglio del disegno modificando i valori delle variabili m ed n. Queste sono settate di default a 31, prima immagine, ma settandole a 50, seconda immagine, il grafico risulterá molto piú definito. Non esagerate, oppure incorrerete in un errore di Out of Memory…

Qui di seguito trovate il codice ottimizzato per essere copiato su un file di testo ed essere scritto su un file ADF utilizzando il programma ADF Opus.

Se invece siete ansiosi di provare il programma su un Amiga reale o su un emulatore, suggerisco WinUAE, scaricate il file Superfici3D.zip contenente il file Superfici3D.ADF (creato da Francesco Sblendorio) e lanciate il file Superfici3D.bas.

PS – Se incontrate difficoltá ad utilizzare ADF Opus, WinUAE o l’AmigaBASIC, scriveteci: saremo lieti di aiutarvi!

Attenzione – Ci siamo resi conto che nel listato i caratteri ‘>’ e ‘<‘ potrebbero venir sostituiti dai rispettivi encoding html ‘&gt’ e ‘&lt’. Nel caso, sostituite questi valori nel listato prima di copiarlo sull’emulatore.

Listato: Superfici 3D – Commodore Amiga – AmigaBASIC

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
CLEAR,25000:CLEAR,60000&

DEFINT i,j

pi=3.1415927# : e=2.7182818#

m=31 : n=31        ' dimensione del reticolo = m*n

res=1              ' risoluzione: 1=640*200, 2=640*400

gt=1               ' tipo di figura: 1=estimate 2=reale

asp=1              ' relazione x/y della figura (solitamente gt=1)

h=150              ' fattore di altezza (solamente per gt=1)

theta=30:phi=20    ' angoli d'osservazione in gradi (solamente per gt=2) 

d=100              ' distanza dal centro della figura (solamente per gt=2)

lox=-3 : hix=3     ' limiti alto e basso nella direzione x

loy=-3 : hiy=3     ' limiti alto e basso nella direzione y

Equation:

DEF FNz(x,y)=SIN(x^2+3*y^2)/(x^2+y^2)+(x^2+5*y^2)*EXP(1-x^2-y^2)/2

'DEF FNz(x,y)=(x^2+5*y^2)*EXP(1-x^2-y^2)/2-SIN(3*x^2+y^2)/(x^2+y^2)

'DEF FNz(x,y)=(SIN(4*x^2+y^2)+2*SIN(x+y))/(4*x^2+y^2)

'DEF FNz(x,y)=SQR(ABS(x*y))

theta=theta*pi/180 : phi=phi*phi/180  ' conversione: gradi in radianti

a=d*COS(phi)*COS(theta)

b=d*COS(phi)*SIN(theta)

c=d*SIN(phi)

GOSUB Check

DIM xc(m+1,n+1),yc(m+1,n+1)

tx=(hix-lox)/m : ty=(hiy-loy)/n

CLS : PRINT : PRINT "Si stanno calcolando i valori..."

LOCATE 4,7 : PRINT m+1

IF gt=1 THEN GOSUB Estimate : ELSE GOSUB True

Draw:

IF res=2 THEN SCREEN 1,640,400,2,4 : WINDOW 2,"GRAPH",,14,1:ELSE CLS

DIM v(15),rgb(3,2) : p=0

Rc:

FOR c=0 TO 3

  READ r,g,b 

  PALETTE c,r,g,b

  rgb(c,0)=r : rgb(c,1)=g : rgb(c,2)=b

NEXT

DATA 0,0,0,.14,.14,.14,0,0,0,0,0,1

COLOR 2,3

FOR x=dfx TO dtx STEP sx

  FOR y=dfy TO dty STEP sy

    x1=xc(x,y) : x2=xc(x,y+1) : x3=xc(x+1,y+1) : x4=xc(x+1,y)

    y1=yc(x,y) : y2=yc(x,y+1) : y3=yc(x+1,y+1) : y4=yc(x+1,y)

    AREA (x1,y1) : AREA (x2,y2) : AREA (x3,y3) : AREA (x4,y4) : AREAFILL

    LINE (x1,y1)-(x2,y2),3

    LINE (x2,y2)-(x3,y3),3

    LINE (x3,y3)-(x4,y4),3

    LINE (x4,y4)-(x1,y1),3

  NEXT

NEXT

Colors:

FOR n=0 TO 15

  v(n)=11+7.54*n

NEXT

col=0 : x1=11 : x2=11 : x3=11

IF res=1 THEN WINDOW 3,"COLORI",(0,0)-(130,50),18,-1

IF res=2 THEN WINDOW 3,"COLORI",(0,0)-(130,50),18,1

WINDOW OUTPUT 3

PRINT "R" : PRINT "G" : PRINT "B" : PRINT : PRINT"C"

LINE (0,0)-(130,0) : LINE (0,8)-(130,8)

LINE (0,16)-(130,16) : LINE (0,24)-(130,24)

LINE (10,0)-(10,50) : LINE (11,25)-(40,50),0,BF

LINE (40,25)-(70,50),1,BF : LINE (70,25)-(100,50),2,BF

LINE (100,25)-(130,50),3,BF : LINE (11,1)-(19,7),3,BF

LINE (11,9)-(19,15),3,BF : LINE (11,17)-(19,23),3,BF

i=20 : LINE (20,32)-(30,42),1,BF

MENU 1,0,1,"Action" : MENU 1,1,1,"Quit"

MENU 2,0,0,"" : MENU 3,0,0,"" : MENU 4,0,0,""

MENU ON

Loop:

IF MENU(0)=1 AND MENU(1)=1 THEN

  WINDOW CLOSE 3 : MENU RESET : WINDOW CLOSE 2 : SCREEN CLOSE 1 : STOP

END IF

x=MOUSE(1) : y=MOUSE(2) : IF MOUSE(0)>=0 THEN c1=1 : c2=1 : c3=1 : GOTO Loop

IF x>10 AND x<131 THEN IF y>24 AND y<51 THEN Getcol : ELSE GOTO Check1

GOTO Loop

Check1:

arg=.1260504*x-1.386551 : IF y<1 OR y>7 OR c1=0 THEN Check2

LINE (11,1)-(130,7),0,BF : LINE (v(arg),1)-(v(arg)+8,7),3,BF : x1=v(arg)

rgb(col,0)=arg/15 : PALETTE col,rgb(col,0),rgb(col,1),rgb(col,2)

c1=1 : c2=0 : c3=0 : GOTO Loop

Check2:

IF y<9 OR y>15 OR c2=0 THEN Check3

LINE (11,9)-(130,15),0,BF : LINE (v(arg),9)-(v(arg)+8,15),3,BF : x2=v(arg)

rgb(col,1)=arg/15 : PALETTE col,rgb(col,0),rgb(col,1),rgb(col,2)

c1=0 : c2=1 : c3=0 : GOTO Loop

Check3:

IF y<17 OR y>23 OR c3=0 THEN Loop

LINE (11,17)-(130,23),0,BF : LINE (v(arg),17)-(v(arg)+8,23),3,BF : x3=v(arg)

rgb(col,2)=arg/15 : PALETTE col,rgb(col,0),rgb(col,1),rgb(col,2)

c1=0 : c2=0 : c3=1 : GOTO Loop

Getcol:

LINE (i,32)-(i+10,42),col,BF

IF x<40 THEN i=20 : LINE (i,32)-(30,42),1,BF : col=0 : GOTO Nst

IF x<70 THEN i=50 : LINE (i,32)-(60,42),2,BF : col=1 : GOTO Nst

IF x<100 THEN i=80 : LINE (i,32)-(90,42),3,BF : col=2 : GOTO Nst

i=110 : LINE (i,32)-(120,42),0,BF : col=3

Nst:

LINE (11,1)-(130,23),0,BF : LINE (10,8)-(130,8) : LINE (10,16)-(130,16)

c=1

FOR n=0 TO 2 : t1=111*rgb(col,n)+11

  LINE (t1,c)-(t1+8,c+6),3,BF : c=c+8

NEXT

GOTO Loop

Check:

m=INT(m) : n=INT(n)

asp=ABS(asp) : h=ABS(h)

IF res<>1 AND res<>2 THEN res=1

IF res=1 THEN ht=186 : hht=93

IF res=2 THEN ht=386 : hht=193

IF lox>hix THEN SWAP lox,hix

IF loy>hiy THEN SWAP loy,hiy

dfx=1 : dtx=m : sx=1 : dfy=1 : dty=n : sy=1

IF gt<>2 THEN gt=1

IF res<>2 THEN res=1

IF gt=2 THEN

  IF a<0 THEN dfx=m : dtx=1 : sx=-1

  IF b<0 THEN dfy=n : dty=1 : sy=-1

END IF

RETURN

Estimate:

m1=310/m : m2=160/m : n1=310/n : n2=160/n : rd=180/pi

x=240/SQR(1+asp^2) : y=240*asp/SQR(1+asp^2)

spx=310+.8886207*(x-y) : spy=hht-.4586429*(x+y)

x1=1.777241*x/m : x2=1.777241*y/n : y1=.9172858*x/m : y2=.9172858*y/n

i=0 : x=lox-tx

WHILE i<m+1

  i=i+1 : LOCATE 5,7 : PRINT i;

  x=x+tx : j=0 : y=loy-ty

  WHILE j<n+1

    j=j+1

    y=y+ty

    xc(i,j)=(spx+x2*j-x1*i)

    yc(i,j)=spy+y2*j+y1*i-h*FNz(x,y)

    IF yc(i,j)<smin THEN smin=yc(i,j)

    IF yc(i,j)>smax THEN smax=yc(i,j)

  WEND

WEND

IF smax<ht AND smin>0 THEN RETURN

avg=(smax+smin)/2 : smax=smax-avg : smin=smin-avg : mult=ht/(smax-smin)

FOR x=1 TO m+1

  FOR y=1 TO n+1

    yc(x,y)=mult*(yc(x,y)-avg)+hht

  NEXT

NEXT

RETURN

True:

DEF FNc(a,b,c,x,y,z)=(x*(b*(b-y)+c*(c-z))+(x-a)*(b*y+c*z))/d

DEF FNang(x,y,z)=(px*x+py*y+pz*z)/(dp*SQR(x^2+y^2+z^2))

px=FNc(a,b,c,0,0,10)

py=FNc(b,a,c,0,0,10)

pz=FNc(c,b,a,10,0,0)

dp=SQR(px^2+py^2+pz^2)

i=0 : x=lox-tx

WHILE i<m+1

  i=i+1 : LOCATE 5,7 : PRINT i

  x=x+tx : j=0 : y=loy-ty

  WHILE j<n+1

    j=j+1

    y=y+ty

    xc(i,j)=FNz(x,y) : sum=sum+xc(i,j)

  WEND

WEND

avg=sum/((m+1)*(n+1)) : ym=loy-ty-(loy+hiy)/2

i=0 : x=lox-tx-(lox+hix)/2

WHILE i<m+1

  i=i+1 : LOCATE 6,7 : PRINT i

  x=x+tx : j=0 : y=ym

  WHILE j<n+1

    j=j+1 : y=y+ty : z=xc(i,j)-avg

    d=a*(a-x)+b*(b-y)+c*(c-z)

    xc=FNc(a,b,c,x,y,z)

    yc=FNc(b,a,c,y,x,z)

    zc=FNc(c,b,a,z,y,x)

    rad=SQR(xc^2+yc^2+zc^2)

    s=1

    IF SGN(a)<>SGN(yc*pz-zc*py) THEN

      s=-1

    ELSEIF SGN(b)<>SGN(zc*px-xc*pz) THEN

      s=-1

    ELSEIF SGN(c)<>SGN(xc*py-yc*px) THEN 

      s=-1

    END IF

    cs=FNang(xc,yc,zc) : sn=SQR(1.00001-cs^2)

    xc(i,j)=s*rad*sn : yc(i,j)=-rad*cs

    IF xc(i,j)>xmax THEN xmax=xc(i,j)

    IF xc(i,j)<xmin THEN xmin=xc(i,j)

    IF yc(i,j)>ymax THEN ymax=yc(i,j)

    IF yc(i,j)<ymin THEN ymin=yc(i,j)

  WEND

WEND

ax=(xmax+xmin)/2

ay=(ymax+ymin)/2

IF res=1 THEN

  hzy=93

  IF ((ymax-ymin)/(xmax-xmin))>(6.75/10.25) THEN

    my=168/(ymax-ymin) : mx=168/(ymax-ymin)*2.200899

  ELSE

    my=602/(xmax-xmin)/2.200899 : mx=602/(xmax-xmin)

  END IF

ELSE

  hzy=193

  IF ((ymax-ymin)/(xmax-xmin))>(6.875/10.25) THEN

    my=368/(ymax-ymin) : mx=368/(ymax-ymin)*1.092089

  ELSE

    my=602/(xmax-xmin)/1.092089 : mx=602/(xmax-xmin)

  END IF

END IF

FOR x=1 TO m+1

  FOR y=1 TO n+1

    xc(x,y)=315+mx*(xc(x,y)-ax)

    yc(x,y)=hzy+my*(yc(x,y)-ay)

  NEXT

NEXT

RETURN