I'm trying to convert this ZX Spectrum BASIC Code into Purebasic:
Code: Select all
10 FOR g=0 TO 300: RESTORE 30: LET spheres=1: IF spheres THEN DIM c(spheres,3): DIM r(spheres): DIM q(spheres)
20 FOR k=1 TO spheres: READ c(k,1),c(k,2),c(k,3),r: LET r(k)=r: LET q(k)=r*r: NEXT k
30 DATA 0.3+0.5*SIN (2*PI*g/60),-0.6,1.5+0.5*COS (2*PI*g/75),0.4: REM 2+0.5*COS (2*PI*g/50)
40 REM DATA 0.9/10,-1/10,4,0.1
50 FOR i=0 TO 175: FOR j=0 TO 255
60 LET x=0.3: LET y=-0.5: LET z=0
70 LET dx=j-128: LET dy=88-i: LET dz=300: LET dd=dx*dx+dy*dy+dz*dz
80 GO SUB 100: NEXT j: NEXT i
90 SAVE STR$ g SCREEN$ : CLS : NEXT g: STOP
100 LET n=-(y>=0 OR dy<=0): IF NOT n THEN LET s=-y/dy
110 FOR k=1 TO spheres
120 LET px=c(k,1)-x: LET py=c(k,2)-y: LET pz=c(k,3)-z
130 LET pp=px*px+py*py+pz*pz
140 LET sc=px*dx+py*dy+pz*dz
150 IF sc<=0 THEN GO TO 200
160 LET bb=sc*sc/dd
170 LET aa=q(k)-pp+bb
180 IF aa<=0 THEN GO TO 200
190 LET sc=(SQR bb-SQR aa)/SQR dd: IF sc<s OR n<0 THEN LET n=k: LET s=sc
200 NEXT k
210 IF n<0 THEN RETURN
220 LET dx=dx*s: LET dy=dy*s: LET dz=dz*s: LET dd=dd*s*s
230 LET x=x+dx: LET y=y+dy: LET z=z+dz
240 IF n=0 THEN GO TO 300
250 LET nx=x-c(n,1): LET ny=y-c(n,2): LET nz=z-c(n,3)
270 LET l=2*(dx*nx+dy*ny+dz*nz)/q(n)
280 LET dx=dx-nx*l: LET dy=dy-ny*l: LET dz=dz-nz*l
290 GO TO 100
300 FOR k=1 TO spheres
310 LET u=c(k,1)-x: LET v=c(k,3)-z: IF u*u+v*v<=q(k) THEN RETURN
320 NEXT k
330 IF (x-INT x>.6)<>(z-INT z>.6) THEN PLOT j,i
340 RETURN
Code: Select all
#width=256
#height=178
OpenWindow(0,0,0,#width,#height,"SpecRayTrace")
CreateImage(0,#width,#height)
ImageGadget(0, 0, 0, #width, #height, ImageID(0))
EnableExplicit
Global.f r,x,y,z
Global.f dx,dy,dz
Global.f dd,s
Global.f px,py,pz,pp,sc,bb,aa,u,v
Global.f nx,ny,nz,l
Global.i g,i,j,spheres,k
Global.i n
Global.f Dim arr(5)
For g=0 To 200
Delay(1000)
StartDrawing(ImageOutput(0))
Box(0,0,#width,#height,#Black)
spheres=1:
If spheres
Dim c.f(spheres,4)
Dim r.f(spheres)
Dim q.f(spheres)
EndIf
arr(1)=0.3+0.5*Sin(2*#PI*g/40)
arr(2)-0.6
arr(3)=1.5+1*Cos (2*#PI*g/50)
arr(4)=0.4
For k=1 To spheres
c(k,1)=arr(1)
c(k,2)=arr(2)
c(k,3)=arr(3)
r=arr(4)
r(k)=r
q(k)=r*r
Next k
For i=0 To #height-1
For j=0 To #width-1
x=0.3
y=-0.5
z=0
dx=j-#width/2
dy=#height/2-i
dz=#width*6/5
dd=dx*dx+dy*dy+dz*dz
Gosub onehundred
Next j
Next i
StopDrawing()
SetGadgetState(0,ImageID(0))
Next g
End
onehundred:
n=-Bool((y>=0) Or (dy<=0))
If Not n
s=-y/dy
EndIf
For k=1 To spheres
px=c(k,1)-x
py=c(k,2)-y
pz=c(k,3)-z
pp=px*px+py*py+pz*pz
sc=px*dx+py*dy+pz*dz
If sc<=0
Goto twohundred
EndIf
bb=sc*sc/dd
aa=q(k)-pp+bb
If aa<=0
Goto twohundred
EndIf
sc=(Sqr( bb)-Sqr(aa)/Sqr(dd))
If sc<s Or n<0
n=k
s=sc
EndIf
twohundred:
Next k
If n<0
Return
EndIf
dx=dx*s
dy=dy*s
dz=dz*s
dd=dd*s*s
x=x+dx
y=y+dy
z=z+dz
If n=0
Goto threehundred
EndIf
nx=x-c(n,1)
ny=y-c(n,2)
nz=z-c(n,3)
l=2*(dx*nx+dy*ny+dz*nz)/q(n)
dx=dx-nx*l
dy=dy-ny*l
dz=dz-nz*l
Goto onehundred
threehundred:
For k=1 To spheres
u=c(k,1)-x
v=c(k,3)-z
If u*u+v*v<=q(k)
Return
EndIf
Next k
If Bool(x-Int(x)>0.5) <> Bool(z-Int(z)>0.5)
Plot(j,#height-i-1,#White)
EndIf
Return
This will look great on Purebasic as I said, we can add colour etc.
It's the old chequerboard/mirror sphere raytracing example.
Please help if you can.
It is very close to being correct.
There is probably one or two small differences.
