Raytracing am CPC

[Devilmarkus]

Raytracing am CPC in BASIC.

Die Routine braucht auf einem echten CPC ~3 Stunden und 11 Minuten.

Ich empfehle einen Emulator mit guter Turbo-Funktion

Viel Spaß damit!

Code Select Expand

5 MODE 0:INK 0,0
10 DATA 1,2,5,11,14,20,23,26,3,6,15,25
12 FOR n%=1 TO 12:READ c%:INK n%,c%:NEXT n%
15 DATA 0,9,10,11,12
17 DIM cl%(5):FOR n%=1 TO 5:READ cl%(n%):NEXT n%
20 s%=4:DIM c(s%,3):DIM r(s%):DIM q(s%)
30 FOR k=1 TO s%:READ c(k,1),c(k,2),c(k,3),r:r(k)=r:q(k)=r*r:NEXT k
40 DATA -0.8,-1,3.2,0.7
45 DATA 0,-0.45,2,0.3
50 DATA 1.2,-0.7,2.5,0.5
55 DATA 0.4,-1,4,0.4
60 FOR i=0 TO 400 STEP 2:FOR j=0 TO 640 STEP 4
70 x=0.3:y=-0.5:z=0:ba%=3:dx=j-320:dy=200-i:dz=450:dd=dx*dx+dy*dy+dz*dz
80 GOSUB 100:NEXT j:NEXT i
90 GOTO 90
100 n=(y>=0 OR dy<=0):IF NOT n THEN s=-y/dy
110 FOR k=1 TO s%
120 px=c(k,1)-x:py=c(k,2)-y:pz=c(k,3)-z
130 pp=px*px+py*py+pz*pz
140 sc=px*dx+py*dy+pz*dz
150 IF sc<=0 THEN GOTO 200
160 bb=sc*sc/dd
170 aa=q(k)-pp+bb
180 IF aa<=0 THEN GOTO 200
190 sc=(SQR(bb)-SQR(aa))/SQR(dd):IF sc<s OR n<0 THEN n=k:s=sc
200 NEXT k
210 IF n<0 THEN r=1+(dy*dy/dd)*7:PLOT j,i,r:n=0:RETURN
220 dx=dx*s:dy=dy*s:dz=dz*s:dd=dd*s*s
230 x=x+dx:y=y+dy:z=z+dz
240 IF n=0 THEN GOTO 300
250 nx=x-c(n,1):ny=y-c(n,2):nz=z-c(n,3)
260 nn=nx*nx+ny*ny+nz*nz
270 l=2*(dx*nx+dy*ny+dz*nz)/nn
280 dx=dx-nx*l:dy=dy-ny*l:dz=dz-nz*l
290 GOTO 100
300 FOR k=1 TO s%
310 u=c(k,1)-x:v=c(k,3)-z: IF u*u+v*v<=q(k) THEN ba%=1
320 NEXT k
330 IF (x-INT(x)>0.5)=(z-INT(z)>0.5) THEN r=cl%(ba%) ELSE r=cl%(ba%+1)
335 PLOT j,i,r
340 RETURN

[TFM]

Da kann der Amiga mit einem lächerlichen Bällchen nicht dagegen anstinken. 

[LambdaMikel]

Toll! Selbst gemacht?!

[Devilmarkus]

Toll! Selbst gemacht?!

Vom BBC Micro umgeschrieben

[Devilmarkus]

Mit Dithering:

Code Select Expand

5 MODE 0:INK 0,0:xm=4:ym=2
10 DATA 1,2,5,11,14,20,23,26,3,6,15,25
12 FOR n%=1 TO 12:READ c%:INK n%,c%:NEXT n%
15 DATA 0,9,10,11,12
17 DIM cl%(5):FOR n%=1 TO 5:READ cl%(n%):NEXT n%
20 s%=4:DIM c(s%,3):DIM r(s%):DIM q(s%)
30 FOR k=1 TO s%:READ c(k,1),c(k,2),c(k,3),r:r(k)=r:q(k)=r*r:NEXT k
40 DATA -0.8,-1,3.2,0.7
45 DATA 0,-0.45,2,0.3
50 DATA 1.2,-0.7,2.5,0.5
55 DATA 0.4,-1,4,0.4
60 FOR i=0 TO 400 STEP ym:FOR j=0 TO 640 STEP xm
70 x=0.3:y=-0.5:z=0:ba%=3:dx=j-320:dy=200-i:dz=450:dd=dx*dx+dy*dy+dz*dz
80 GOSUB 100:NEXT j:NEXT i
90 GOTO 90
100 n=(y>=0 OR dy<=0):IF NOT n THEN s=-y/dy
110 FOR k=1 TO s%
120 px=c(k,1)-x:py=c(k,2)-y:pz=c(k,3)-z
130 pp=px*px+py*py+pz*pz
140 sc=px*dx+py*dy+pz*dz
150 IF sc<=0 THEN GOTO 200
160 bb=sc*sc/dd
170 aa=q(k)-pp+bb
180 IF aa<=0 THEN GOTO 200
190 sc=(SQR(bb)-SQR(aa))/SQR(dd):IF sc<s OR n<0 THEN n=k:s=sc
200 NEXT k
210 IF n<0 THEN r=1+INT((dy*dy/dd)*15):GOSUB 1000:PLOT j,i,r:n=0:RETURN
220 dx=dx*s:dy=dy*s:dz=dz*s:dd=dd*s*s
230 x=x+dx:y=y+dy:z=z+dz
240 IF n=0 THEN GOTO 300
250 nx=x-c(n,1):ny=y-c(n,2):nz=z-c(n,3)
260 nn=nx*nx+ny*ny+nz*nz
270 l=2*(dx*nx+dy*ny+dz*nz)/nn
280 dx=dx-nx*l:dy=dy-ny*l:dz=dz-nz*l
290 GOTO 100
300 FOR k=1 TO s%
310 u=c(k,1)-x:v=c(k,3)-z: IF u*u+v*v<=q(k) THEN ba%=1
320 NEXT k
330 IF (x-INT(x)>0.5)=(z-INT(z)>0.5) THEN r=cl%(ba%) ELSE r=cl%(ba%+1)
335 PLOT j,i,r
340 RETURN
1000 l=((j/xm)+(i/ym)) MOD 2
1010 IF r=2 AND l=0 THEN r=1:RETURN
1020 IF r=2 AND l=1 THEN r=2:RETURN
1030 IF r=3 THEN r=2:RETURN
1040 IF r=4 AND l=0 THEN r=2:RETURN
1050 IF r=4 AND l=1 THEN r=3:RETURN
1060 IF r=5 THEN r=3:RETURN
1070 IF r=6 AND l=0 THEN r=3:RETURN
1080 IF r=6 AND l=1 THEN r=4:RETURN
1090 IF r=7 THEN r=4:RETURN
1100 IF r=8 AND l=0 THEN r=4:RETURN
1110 IF r=8 AND l=1 THEN r=5:RETURN
1120 IF r=9 THEN r=5:RETURN
1130 IF r=10 AND l=0 THEN r=5:RETURN
1140 IF r=10 AND l=1 THEN r=6:RETURN
1150 IF r=11 THEN r=6:RETURN
1160 IF r=12 AND l=0 THEN r=6:RETURN
1170 IF r=12 AND l=1 THEN r=7:RETURN
1180 IF r=13 THEN r=7:RETURN
1190 IF r=14 AND l=0 THEN r=7:RETURN
1200 IF r=14 AND l=1 THEN r=8:RETURN
1210 IF r=15 THEN r=8:RETURN
1220 RETURN

[TFM]

Es wird immer besser! Jetzt fehlt's nur noch für den 6128Plus und den Greeny-Screeny.

Und dann kommen wir langsam an den Punkt, an dem sich eine Konvertierung in Z80 Assembler lohnt. 

[Axel]

Und die paar Zeilen Code machen so eine geile Grafik?  Wow!