PureBasic Forums - English

Posted: **Fri Nov 24, 2023 11:28 pm**

This ZX Spectrum code is a very impressive mirror sphere raytracing example, and it will look good in Purebasic, as we can make the resolution greater.

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

I have it mostly done, I have just run into a little problem somewhere and I can't see where in my Purebasic code:

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

I have kept the GOTO and GOSUB numbers as the same Text-label for ease of browsing. I tried to keep to the Spectrum code as much as possible.

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.

Posted: **Sat Nov 25, 2023 4:24 pm**

Note that :

arr(2) = -0.6

It stays the three lines commented, and so, starting by ';', which must be converted.

Code: Select all

SAVE STR$ G SCREEN$

Code: Select all

CLS

Code: Select all

PLOT J,I

Code: Select all

Define.d r, x , y, z,dx,dy,dz,dd, s,px,py,pz,pp,sc,bb,aa
Define.d nx,ny,nz,L,u,v
Define.i spheres, g, k, i, j
FOR g=0 TO 300
  spheres=1
  IF spheres
    DIM c.d(spheres,3)
    DIM r.d(spheres)
    DIM q.d(spheres)
  EndIf
  FOR k=1 TO spheres
    c(k,1) = 0.3+0.5*SIN (2*PI*g/60)
    c(k,2) = -0.6
    c(k,3) = 1.5+0.5*COS (2*PI*g/75)
    r = 0.4
    r(k)=r
    q(k)=r*r
  NEXT k
  FOR i=0 TO 175
    FOR j=0 TO 255
      x=0.3
      y=-0.5
      z=0
      dx=j-128
      dy=88-i
      dz=300
      dd=dx*dx+dy*dy+dz*dz
      GOSUB Lab100
    NEXT j
  NEXT i
  ; 90 SAVE STR$ g SCREEN$
  ; CLS
NEXT g
End

Lab100:
  n= Bool(y>=0 OR dy<=0)
  IF n = 0
    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
      Break
    EndIf
    bb=sc*sc/dd
    aa=q(k)-pp+bb
    IF aa<=0
      Break
    EndId
    sc=(SQR(bb)-SQR(aa) )/SQR (dd)
    IF sc<s OR n<0
      n=k
      s=sc
    EndIf
  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
    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 Lab100
  EndIf
  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 (x-INT(x)>0.6)<>(z-INT(z)>0.6)
    ;PLOT j,i
  EndIf
  RETURN

Posted: **Sat Nov 25, 2023 7:06 pm**

I got it correctly converted.

And speed optimizations welcome, it doesn't run very fast.

Code: Select all

#width=800
#height=600
OpenWindow(0,500,0,#width,#height,"PBRayTrace")
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 1000
  StartDrawing(ImageOutput(0))
  
  Box(0,0,#width,#height,#Black)
  ;Box(0,0,#width,#height/5,#white)
  spheres=1
  If spheres =1
    
    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;+0.1*Sin(2*#PI*g/20)
  arr(3)=3+2.6*Cos (2*#PI*g/39)
  arr(4)=0.4
  
  For k=1 To spheres
    
    c(k,1)=arr(1)
    c(k,2)=arr(2)
    c(k,3)=arr(3)
   ; Debug c(k,1)
   ; Debug c(k,2)
   ; Debug c(k,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-Round(x,#PB_Round_Down))>0.6) <> Bool((z-Round(z,#PB_Round_Down))>0.6)
  Plot(j,#height-i-1,#White)

EndIf

Return

Posted: **Sat Nov 25, 2023 7:22 pm**

Nice!
It's fast enough without debugger, using c backend+ optimizations. (no window event handling though, and it's a must.)

Code: Select all

;after line 71
define event.i
onehundred:
Repeat
  event=WindowEvent()
  If event=#PB_Event_CloseWindow : End : EndIf
Until event = 0

Posted: **Sun Nov 26, 2023 1:28 am**

miso wrote: Sat Nov 25, 2023 7:22 pm Nice!
It's fast enough without debugger, using c backend+ optimizations. (no window event handling though, and it's a must.)
Code: Select all
;after line 71
define event.i
onehundred:
Repeat
  event=WindowEvent()
  If event=#PB_Event_CloseWindow : End : EndIf
Until event = 0

Yeah, I get the requirement for window handling. I intended to include that later.

What do you mean about without debugger, using c backend+ optimizations? Is that a way to make it run faster? I have been posting here for a while, but to be honest, I do not know about optimizations in this language. Thanks for the help.

Posted: **Sun Nov 26, 2023 6:30 am**

1: without debugger
you have an icon on the ide to switch on/off the debugger.

2: c backend
in the ide, in the compiler options, you can choose in which compiling mode you want to work :
* C compiler
* ASM compiler

3: optimizer
in the compiler options, you have an optimizer option you can activate.

Posted: **Sun Nov 26, 2023 7:40 am**

matalog wrote: Sun Nov 26, 2023 1:28 amWhat do you mean about without debugger

Put "DisableDebugger" as the first line of your code and see the difference.

Posted: **Sun Nov 26, 2023 8:13 am**

I have been posting here for a while, but to be honest, I do not know about optimizations in this language.

That's because it's a new feature arrived with the c backend compiler. Using it, the gcc generates an optimized executable, that intended to run faster.
Not default, because the compile time is significantly increased when used. So Fred's advice is to keep off while coding and testing, switch on when generating the final product. Its toggle button is in the compiler options menu, you set it to the project with active tab in your PB ide, and remembers the settings for that particular work.

Posted: **Sat Dec 02, 2023 10:50 pm**

I don't seem to have any C Backend Options in compiler options. V6.03.

Do they have to be installed seperately?

Posted: **Sun Dec 03, 2023 1:18 am**

You still have to add the c-compiler (pbcompilerc) to the selectable compilers

Menu -> Preferences -> Compiler

PureBasic Forums - English

Conversion from ZX Spectrum BASIC to Purebasic

Conversion from ZX Spectrum BASIC to Purebasic

Re: Conversion from ZX Spectrum BASIC to Purebasic

Re: Conversion from ZX Spectrum BASIC to Purebasic

Re: Conversion from ZX Spectrum BASIC to Purebasic

Re: Conversion from ZX Spectrum BASIC to Purebasic

Re: Conversion from ZX Spectrum BASIC to Purebasic

Re: Conversion from ZX Spectrum BASIC to Purebasic

Re: Conversion from ZX Spectrum BASIC to Purebasic

Re: Conversion from ZX Spectrum BASIC to Purebasic

Re: Conversion from ZX Spectrum BASIC to Purebasic