Graphics Fun

[Rod]

By any chance does anyone have ray tracing code, we have seen swirls and such which are awesome but some old school raytraced glass spheres on a checkred background would be really nice to see.

[plus]

Well if you want to take a shot at translating SpecBas here is a real beauty!
retrobasic.allbasic.info/index.php?topic=721.0

[marshawn]

That is an amazing site, bplus!

Hahahaha retrobasic.allbasic.info/index.php?topic=727.0

[tsh73]

That is an amazing site,

Well, we are still here and kicking. Those forum are closed in 2019.
(and I have no idea why they mention JB being "commercial").

[plus]

Feb 26, 2022 9:30:01 GMT tsh73 said:

That is an amazing site,

Well, we are still here and kicking. Those forum are closed in 2019.
(and I have no idea why they mention JB being "commercial").

Yeah still here! That commercial thing sounds like cranky Aurel because you buy Liberty Basic that makes JB commercial being a sampler for LB.

[Rod]

Progress. The color rendering isn't correct just yet and I have the same int() bug the author had, but way cool!


   'ported from Specbas example coded by ZXDunny
   'origins in ZX Spectrum code
   WindowWidth = 800
   WindowHeight = 600
   open "RayTrace" for graphics_nsb as #g
   #g "down ; trapclose [quit]"



   read spheres
   dim c(spheres,3),r(spheres),q(spheres),cl(4)
   scrw=WindowWidth
   scrh=WindowHeight
   w=scrw/2
   h=scrh/2
   s=0
   cl$(1)="brown"
   cl$(2)="darkblue"
   cl$(3)="yellow"
   cl$(4)="blue"
   for k=1 to spheres
       read a,b,c,d
       c(k,1)=a
       c(k,2)=b
       c(k,3)=c
       r=d
       r(k)=r
       q(k)=r*r
   next k

   for i=1 to scrh
       for j=0 to scrw-1
           x=0.3:y=-0.5:z=0:ba=3
           dx=j-w:dy=h-i:dz=(scrh/480)*600
           dd=dx*dx+dy*dy+dz*dz
           [recursion]
           scan
           n=(y>=0 or dy<=0)*-1
           if n=0 then s=(y/dy)*-1
           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 then goto [donek]
               bb=sc*sc/dd
               aa=q(k)-pp+bb
               if aa<=0 then goto [donek]
               sc=(sqr(bb)-sqr(aa))/sqr(dd)
               if sc<s or n<0 then n=k:s=sc
               [donek]
           next k
           if n<0 then
               #g "color ";48+(dy*dy/dd)*208;" ";48+(dy*dy/dd)*208;" ";48+(dy*dy/dd)*208
               #g "set ";j;" ";scrh-i
               goto [donej]
           end if
           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 then
               nx=x-c(n,1):ny=y-c(n,2):nz=z-c(n,3)
               nn=nx*nx+ny*ny+nz*nz
               l=2*(dx*nx+dy*ny+dz*nz)/nn
               dx=dx-nx*l:dy=dy-ny*l:dz=dz-nz*l
               goto [recursion]
           end if
           for k=1 to spheres
               u=c(k,1)-x
               v=c(k,3)-z
               if u*u+v*v<=q(k) then ba=1 : exit for
           next k
           if (x-int(x)>.5)=(z-int(z)>.5) then
               #g "color ";cl$(ba)
           else
               #g "color ";cl$(ba+1)
           end if
           #g "set ";j;" ";scrh-i
       [donej]
       next j
   next i
   wait

   [quit]
   close #g
   end

   data 6
   data -0.3,-0.8,3,0.6
   data 0.9,-1.4,3.5,0.35
   data 0.7,-0.45,2.5,0.4
   data -0.5,-0.3,1.5,0.15
   data 1.0,-0.2,1.5,0.1
   data -0.1,-0.2,1.25,0.2


[plus]

Fabulous start Rod!

I got stuck on Rainbow  But we've done that here I remember!

If spheres reflect everything just need dark blue sky getting lighter and lighter to the horizon of checkered ground.

[plus]

Well thanks to Rod's excellent start:

   WindowWidth = 800
   WindowHeight = 600
   open "RayTrace" for graphics_nsb as #g
   #g "down ; trapclose [quit]"



   read spheres
   dim c(spheres,3),r(spheres),q(spheres),cl(4)
   scrw=WindowWidth
   scrh=WindowHeight
   w=scrw/2
   h=scrh/2
   s=0
   cl$(1)="brown"
   cl$(2)="darkblue"
   cl$(3)="yellow"
   cl$(4)="blue"
   for k=1 to spheres
       read a,b,c,d
       c(k,1)=a
       c(k,2)=b
       c(k,3)=c
       r=d
       r(k)=r
       q(k)=r*r
   next k

for y = 0 to scrh
#g "color ";255*( y)/scrh;" ";255*( y)/scrh;" ";255
#g "line ";0;" ";y;" ";scrw;" ";y
next

   for i=1 to scrh
       for j=0 to scrw-1
           x=0.3:y=-0.5:z=0:ba=3
           dx=j-w:dy=h-i:dz=(scrh/480)*600
           dd=dx*dx+dy*dy+dz*dz
           [recursion]
           scan
           n=(y>=0 or dy<=0)*-1
           if n=0 then s=(y/dy)*-1
           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 then goto [donek]
               bb=sc*sc/dd
               aa=q(k)-pp+bb
               if aa<=0 then goto [donek]
               sc=(sqr(bb)-sqr(aa))/sqr(dd)
               if sc<s or n<0 then n=k:s=sc
               [donek]
           next k
           if n<0 then
               #g "color ";128*(scrh -i)/scrh+ 128*(dy*dy/dd);" ";128*(scrh-i)/scrh+ 128*(dy*dy/dd);" ";200 + 55*(dy*dy/dd)
               #g "set ";j;" ";scrh-i
               goto [donej]
           end if
           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 then
               nx=x-c(n,1):ny=y-c(n,2):nz=z-c(n,3)
               nn=nx*nx+ny*ny+nz*nz
               l=2*(dx*nx+dy*ny+dz*nz)/nn
               dx=dx-nx*l:dy=dy-ny*l:dz=dz-nz*l
               goto [recursion]
           end if
           for k=1 to spheres
               u=c(k,1)-x
               v=c(k,3)-z
               if u*u+v*v<=q(k) then ba=1 : exit for
           next k
           if (x-int(x)>.5)=(z-int(z)>.5) then
               #g "color ";cl$(ba)
           else
               #g "color ";cl$(ba+1)
           end if
           #g "set ";j;" ";scrh-i
       [donej]
       next j
   next i
   wait

   [quit]
   close #g
   end

   data 6
   data -0.3,-0.8,3,0.6
   data 0.9,-1.4,3.5,0.35
   data 0.7,-0.45,2.5,0.4
   data -0.5,-0.3,1.5,0.15
   data 1.0,-0.2,1.5,0.1
   data -0.1,-0.2,1.25,0.2


[plus]

Is this any better? Just different...

[tsh73]

I like first version better
In second upper parts looks much less contrasted vs. lower ones.

[tsh73]

Wait, you still did not fixed that INT thing? Then I am not that late ;)

'https://retrobasic.allbasic.info/index.php?topic=721.0
'converting to JB

   desiredWidth = 320
   desiredHeight = 200
   gosub [ajustWindow]
   UpperLeftX = 1
   UpperLeftY = 1

   open "rayTrace" for graphics_nsb as #gr
   #gr, "trapclose [quit]"
   #gr, "home ; down ; posxy x y"
   #gr, "fill white"
   'x, y give us width, height
   scrw = 2*x : scrh = 2*y

' 10 PAPER 0: INK 15: CLS:
' palette 16,255,255,255:
' palette 32,0,192,255:
' palette 255,0,0,192:
' rainbow 16 to 32:
' rainbow 32 to 255
20 read spheres:t=msecs
DIM c(spheres,3),r(spheres),q(spheres),cl(4)
w=scrw/2:h=scrh/2:s=0
cl(1)=6:cl(2)=1
cl(3)=cl(1)+8:cl(4)=cl(2)+8
30 FOR k=1 TO spheres
   READ c1,c2,c3,r
c(k,1)=c1:c(k,2)=c2:c(k,3)=c3
   r(k)=r:q(k)=r*r
NEXT k

40 data 6
DATA -0.3,-0.8,3,0.6

50 DATA 0.9,-1.4,3.5,0.35
data 0.7,-0.45,2.5,0.4
data -0.5,-0.3,1.5,0.15
DATA 1.0,-0.2,1.5,0.1
DATA -0.1,-0.2,1.25,0.2

t0=time$("ms")
60 FOR i=1 TO scrh
print , i
   FOR j=0 TO scrw-1
70       x=0.3:y=-0.5:z=0:ba=3
      dx=j-w:dy=h-i:dz=(scrh/480)*600
      dd=dx*dx+dy*dy+dz*dz
80       n=0-(y>=0 OR dy<=0)
      IF n=0 THEN s=0-y/dy
90       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 THEN GOTO 120 'continue k
100          bb=sc*sc/dd
         aa=q(k)-pp+bb
         IF aa<=0 THEN GOTO 120 'continue k
110          sc=(SQR (bb)-SQR (aa))/SQR (dd)
         IF sc<s OR n<0 THEN n=k:s=sc
120       NEXT k

130       IF n<0 THEN
'plot ink 16+(dy*dy/dd)*240;j,scrh-i
c = int(16+(dy*dy/dd)*240)
'print c
#gr "color ";c;" ";c;" ";c
#gr "set ";j;" ";scrh-i
goto 200 'continue j
 end if
140       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 THEN
          nx=x-c(n,1):ny=y-c(n,2):nz=z-c(n,3)
         nn=nx*nx+ny*ny+nz*nz
         l=2*(dx*nx+dy*ny+dz*nz)/nn
         dx=dx-nx*l:dy=dy-ny*l:dz=dz-nz*l
         GOTO 80
 end if
160       FOR k=1 TO spheres
         u=c(k,1)-x
         v=c(k,3)-z
         IF u*u+v*v<=q(k) THEN
            ba=1
            'goto 180
exit for
 end if
170       NEXT k
180       'IF (x-INT (x)>.5)=(z-INT (z)>.5) THEN
'needs "int to lower" vs "int to 0"
'IF (x-(int(x)-(x<>int(x))*(x<0))>.5)=(z-(int(z)-(z<>int(z))*(z<0))>.5) THEN
               IF (x mod 1 +(x<0)>.5)=(z mod 1 +(z<0)>.5) THEN
         ik=cl(ba)
      else
         ik=cl(ba+1)
190       'plot ink ik;j,scrh-i
#gr "color ";ik;" ";ik;" ";ik
#gr "set ";j;" ";scrh-i
end if
200    NEXT j
NEXT i
' 210 print at 0,0;transparent 1;ink 0;"Time: ";(msecs-t)/1000;" secs":
' pause 0:

#gr, "flush"
print "Time: ";(time$("ms")-t0)/1000;" secs"
wait

'====================
[quit]
   close #gr
   end

[ajustWindow]
' this code demonstrates ajusting window height, width to get desired drawing space (like, 400x300)
   WindowWidth = 200   '100 seems to be too much - works different
   WindowHeight = 100
   open "Ajusting..." for graphics_nsb as #gr
'   graphics
'   graphics_nsb
'   graphics_nsb_nf
   #gr, "home ; down ; posxy x y"
   'x, y give us width, height
   width = 2*x : height = 2*y
   close #gr

   slackX = 200-width
   slackY = 100-height
   WindowWidth = desiredWidth + slackX
   WindowHeight = desiredHeight + slackY
return



[plus]

Well that's faster and full checkerboard, nice tsh73.

[tsh73]

In the process of translating it to C++ BGIm I realized that array c1() is actually number of some of 16 QBColors
(well, exactly these blue and yellow, light and dark, as your color versions use)
And "rainbow" stuff likely to be linear color change in 256-color palette between given color points.
Will see tomorrow.

[cundo]

Beautiful!

[Rod]

Couple of things I want to work on. The background, but perhaps that’s just my code. The original has a nice light blue sky. My globe tops are too dark they are supposed to be light silver fading to white at the top not black to white. I want to antialias if possible but that may be a step too far.

I want to add a tinge of color to differentiate between globes.

Tsh73 has fixed the int() bug, need to understand that a bit better.

And another thing, there isn’t an atan2() in sight!