Graphics Fun

[tsh73]

Here is is, with all rainbow and stuff
JB is left, BGIm is right.
It looks like 16 BGI colors differ from 16 QB colors!
(of cource it looks better in bigger size, uncomment '640x480' at the top and see)

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

desiredWidth = 320
desiredHeight = 200
'desiredWidth = 640
'desiredHeight = 480
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:
dim palette$(255)
gosub [initQBcolors]
for i = 0 to 15: palette$(i)=qb$(i):next
' palette 16,255,255,255:
palette$(16)="255 255 255"
' palette 32,0,192,255:
palette$(32)="0 192 255"
' palette 255,0,0,192:
palette$(255)="0 0 192"
' rainbow 16 to 32:
call rainbow 16, 32
' rainbow 32 to 255
call rainbow 32, 255

read spheres
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
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

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

t0=time$("ms") 'main loop start
FOR i=1 TO scrh
print , i
FOR j=0 TO scrw-1
SCAN 'so we could break it
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
[recurs]  n=0-(y>=0 OR dy<=0)
IF n=0 THEN s=0-y/dy
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 [continueK]
bb=sc*sc/dd
aa=q(k)-pp+bb
IF aa<=0 THEN GOTO [continueK]
sc=(SQR (bb)-SQR (aa))/SQR (dd)
IF sc<s OR n<0 THEN n=k:s=sc
[continueK]
NEXT k

IF n<0 THEN
'plot ink 16+(dy*dy/dd)*240;j,scrh-i
c = int(16+(dy*dy/dd)*240)
'#gr "color ";c;" ";c;" ";c
if lastCol<>c then 'prevent extra color switching - JB speed-up
#gr "color ";palette$(c)
lastCol=c
end if
#gr "set ";j;" ";scrh-i
goto [continueJ]
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 [recurs] 'really only GOTO
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
end if
NEXT k
      '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)
end if
'plot ink ik;j,scrh-i
'#gr "color ";ik;" ";ik;" ";ik
if lastCol<>ik then 'prevent extra color switching
#gr "color ";palette$(ik)
lastCol=ik
end if
#gr "set ";j;" ";scrh-i
[continueJ]
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

[initQBcolors]
dim qb$(15) 'thanks Andy Amaya
qb$( 0) = "  0   0   0" 'black
qb$( 1) = "  0   0 128" 'blue
qb$( 2) = "  8 128   8" 'green
qb$( 3) = "  0 128 128" 'cyan
qb$( 4) = "128   0   0" 'red
qb$( 5) = "128   0 128" 'magenta
qb$( 6) = "128  64  32" 'brown
qb$( 7) = "168 168 168" 'white
qb$( 8) = "128 128 128" 'grey
qb$( 9) = " 84  84 252" 'light blue
qb$(10) = " 42 252  42" 'light green
qb$(11) = "  0 220 220" 'light cyan
qb$(12) = "255   0   0" 'light red
qb$(13) = "255  84 255" 'light magenta
qb$(14) = "255 255   0" 'yellow
qb$(15) = "255 255 255" 'bright white
return

sub rainbow startIdx, stopIdx
r0=val(word$(palette$(startIdx),1))
r1=val(word$(palette$(stopIdx),1))
g0=val(word$(palette$(startIdx),2))
g1=val(word$(palette$(stopIdx),2))
b0=val(word$(palette$(startIdx),3))
b1=val(word$(palette$(stopIdx),3))
for i = startIdx+1 to stopIdx-1
a=1-(stopIdx-i)/(stopIdx-startIdx)   'startIdx..stopIdx -> 0..1
R=int(r0*(1-a) + r1*a)
G=int(g0*(1-a) + g1*a)
B=int(b0*(1-a) + b1*a)
palette$(i)=R;" ";G;" ";B
next
end sub

[Rod]

Very nice, that’s perfect. I am still struggling to see how the background actually gets drawn!

[plus]

+1 another fine mess you've made tsh73

Dang I tried a good long time yesterday trying to get the coloring like that. I first thought if I got the sky background correct the balls would reflect that, no such hack!

Now more to study... sigh

[plus]

Update: MasterGy at QB64 has started moving a sphere around and offers zoom in and out, left / right, with WASD keypresses. The reflections are updated and seem accurate. (I shared our adventures here with that forum.)

[tsh73]

One line mod
'IF (x mod 1 +(x<0)>.5)=(z mod 1 +(z<0)>.5) THEN
IF ((x+z) mod 1 +((x+z)<0)>.5)=((x-z) mod 1 +((x-z)<0)>.5) THEN


[carlgundel]

Mar 2, 2022 20:01:49 GMT tsh73 said:

One line mod
'IF (x mod 1 +(x<0)>.5)=(z mod 1 +(z<0)>.5) THEN
IF ((x+z) mod 1 +((x+z)<0)>.5)=((x-z) mod 1 +((x-z)<0)>.5) THEN

What does that one change do?

[tsh73]

It changed pattern on the floor
from right-aligned to diagonal one.

[plus]

Oh ho! I hadn't noticed that wow.

It amazes me when I move balls around and even have one be my mouse (in another Basic), all the reflections keep up!

[tsh73]

How many frames per second they get?

On my slow machine 320x200 screen renders at about 40 seconds with 6 balls (fast machine 13 sec- 3x faster)
about 15 sec at 1 ball (fast machine 5.5 sec)
empty scene (no balls) 10 seconds (fast machine 4 sec)
So most of the time spends calculating, not drawing.

Writing to a file instead of plotting points about 6 seconds (I tried writing 256 color BMP)
Bigger screens, time goes up as size^2 (actually number of pixels - right thing to expect),
writing to file instead of plotting each pixel saves 25% of time.

And as I said I have it translated to C++ + Win BGIm graphic library.
It still takes several seconds per 320x200 frame.
(though that library is known to be old and slow).

Anyway. Too slow.
So no way to move by mouse in JB/LB :((

Have an idea - to write something so balls would mirror it?

I hope reading this
gabrielgambetta.com/computer-graphics-from-scratch/
will make me a bit undestand how this thing work. (or let me recreate one myself, with blackjack and ballerinas)

I just looked through first chapter - Basic Raytracing - and it ends like this:

This is a good first step. The spheres look like circles, which is better than if they looked like cats

Really, encouraging.

(but it made me think *how* I could make this program show cats?)

[plus]

Doing 320 X 200 also, not blazing speed but fast enough to not be jerky and "natural", whatever natural is for abstract picture

LOL cats! have I pointed you guys to Homer Simpson by way of Epicycles?
www.youtube.com/watch?v=qS4H6PEcCCA

[tsh73]

If you fiddle with functions long enough you will get this

And if you make it print circle parameters...
and make it output DATA statements...
and put those DATA lines into program above...
and fiddle with it some more...
You'll get this:

'nomainwin
open "egg" for graphics_nsb_nf as #gr
#gr "trapclose [quit]"
#gr "down; home; posxy cx cy"

pi=acs(-1)
pi2=2*pi
x0=70:xk=cx*2-100
print "data 7"
for i = 0 to 6
   x=x0+i/6*(xk-x0)
   #gr "place ";x;" ";cy
   r = sin((i+2)/pi2*1.5)*80
   #gr "circle ";r
   print "data ";x/80*.4-.5;",";-0.6;",";1.5;",";r/80*.4
next

#gr "flush"
wait

[quit]
close #gr
end

[plus]

Egg mod:
'nomainwin
open "egg" for graphics_nsb_nf as #gr
#gr "trapclose [quit]"
#gr "down; home; posxy cx cy"

'#gr "size 2"
pi=acs(-1)
pi2=2*pi
x0=70:xk=cx*2-100
print "data 49"
#gr "color 255 160 200"
#gr "backcolor 255 160 200"
for i = 0 to 6 step .125
   x=x0+i/7*(xk-x0)
   #gr "place ";x;" ";cy
   r = sin((i+2)/pi2*1.5)*80
   #gr "circlefilled ";r
   print "data ";x/80*.4-.5;",";-0.6;",";1.5;",";r/80*.4
next
'#gr "color 0 0 200"
'#gr "backcolor 0 0 200"
'for i = 0 to 6
'    x=x0+i/6*(xk-x0)
'    #gr "place ";x;" ";cy
'    r = sin((i+2)/pi2*1.5)*80
'    #gr "circle ";r
'    print "data ";x/80*.4-.5;",";-0.6;",";1.5;",";r/80*.4
'next

#gr "flush"
wait

[quit]
close #gr
end


Attachments:

[plus]

So Ray Trace with new data lines from above

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

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

open "rayTrace b+ mod tsh73 egg and applied more brute force" 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:
dim palette$(255)
gosub [initQBcolors]
for i = 0 to 15: palette$(i)=qb$(i):next
' palette 16,255,255,255:
palette$(16)="255 255 255"
' palette 32,0,192,255:
palette$(32)="0 192 255"
' palette 255,0,0,192:
palette$(255)="0 0 192"
' rainbow 16 to 32:
call rainbow 16, 32
' rainbow 32 to 255
call rainbow 32, 255

read spheres
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
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
data 49
data -0.15,-0.6,1.5,0.1838116
data -0.13732143,-0.6,1.5,0.19432986
data -0.12464286,-0.6,1.5,0.20467506
data -0.11196429,-0.6,1.5,0.21483802
data -0.99285714e-1,-0.6,1.5,0.22480967
data -0.86607143e-1,-0.6,1.5,0.23458114
data -0.73928571e-1,-0.6,1.5,0.24414373
data -0.06125,-0.6,1.5,0.25348892
data -0.48571429e-1,-0.6,1.5,0.26260839
data -0.35892857e-1,-0.6,1.5,0.27149402
data -0.23214286e-1,-0.6,1.5,0.2801379
data -0.10535714e-1,-0.6,1.5,0.28853232
data 0.21428571e-2,-0.6,1.5,0.29666983
data 0.14821429e-1,-0.6,1.5,0.30454316
data 0.0275,-0.6,1.5,0.31214531
data 0.40178571e-1,-0.6,1.5,0.31946951
data 0.52857143e-1,-0.6,1.5,0.32650924
data 0.65535714e-1,-0.6,1.5,0.33325823
data 0.78214286e-1,-0.6,1.5,0.33971047
data 0.90892857e-1,-0.6,1.5,0.34586021
data 0.10357143,-0.6,1.5,0.35170198
data 0.11625,-0.6,1.5,0.35723058
data 0.12892857,-0.6,1.5,0.36244108
data 0.14160714,-0.6,1.5,0.36732884
data 0.15428571,-0.6,1.5,0.37188951
data 0.16696429,-0.6,1.5,0.37611904
data 0.17964286,-0.6,1.5,0.38001365
data 0.19232143,-0.6,1.5,0.38356987
data 0.205,-0.6,1.5,0.38678454
data 0.21767857,-0.6,1.5,0.38965481
data 0.23035714,-0.6,1.5,0.3921781
data 0.24303571,-0.6,1.5,0.39435217
data 0.25571429,-0.6,1.5,0.3961751
data 0.26839286,-0.6,1.5,0.39764525
data 0.28107143,-0.6,1.5,0.39876131
data 0.29375,-0.6,1.5,0.3995223
data 0.30642857,-0.6,1.5,0.39992753
data 0.31910714,-0.6,1.5,0.39997665
data 0.33178571,-0.6,1.5,0.3996696
data 0.34446429,-0.6,1.5,0.39900667
data 0.35714286,-0.6,1.5,0.39798844
data 0.36982143,-0.6,1.5,0.39661583
data 0.3825,-0.6,1.5,0.39489004
data 0.39517857,-0.6,1.5,0.39281263
data 0.40785714,-0.6,1.5,0.39038543
data 0.42053571,-0.6,1.5,0.38761061
data 0.43321429,-0.6,1.5,0.38449065
data 0.44589286,-0.6,1.5,0.38102832
data 0.45857143,-0.6,1.5,0.37722669


t0=time$("ms")    'main loop start
FOR i=1 TO scrh
   print , i
   FOR j=0 TO scrw-1
       SCAN    'so we could break it
       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
[recurs]  n=0-(y>=0 OR dy<=0)
       IF n=0 THEN s=0-y/dy
       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 [continueK]
           bb=sc*sc/dd
           aa=q(k)-pp+bb
           IF aa<=0 THEN GOTO [continueK]
           sc=(SQR (bb)-SQR (aa))/SQR (dd)
           IF sc<s OR n<0 THEN n=k:s=sc
[continueK]
       NEXT k

       IF n<0 THEN
           'plot ink 16+(dy*dy/dd)*240;j,scrh-i
           c = int(16+(dy*dy/dd)*240)
           '#gr "color ";c;" ";c;" ";c
           if lastCol<>c then 'prevent extra color switching - JB speed-up
               #gr "color ";palette$(c)
               lastCol=c
           end if
           #gr "set ";j;" ";scrh-i
           goto [continueJ]
       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 [recurs]    'really only GOTO
       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
           end if
       NEXT k
      '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
       IF ((x+z) mod 1 +((x+z)<0)>.5)=((x-z) mod 1 +((x-z)<0)>.5) THEN  ' tsh73 fix so diagonal checkers
           ik=cl(ba)
       else
           ik=cl(ba+1)
       end if
       'plot ink ik;j,scrh-i
       '#gr "color ";ik;" ";ik;" ";ik
           if lastCol<>ik then 'prevent extra color switching
               #gr "color ";palette$(ik)
               lastCol=ik
           end if
       #gr "set ";j;" ";scrh-i
[continueJ]
   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

[initQBcolors]
   dim qb$(15) 'thanks Andy Amaya
   qb$( 0) = "  0   0   0" 'black
   qb$( 1) = "  0   0 128" 'blue
   qb$( 2) = "  8 128   8" 'green
   qb$( 3) = "  0 128 128" 'cyan
   qb$( 4) = "128   0   0" 'red
   qb$( 5) = "128   0 128" 'magenta
   qb$( 6) = "128  64  32" 'brown
   qb$( 7) = "168 168 168" 'white
   qb$( 8) = "128 128 128" 'grey
   qb$( 9) = " 84  84 252" 'light blue
   qb$(10) = " 42 252  42" 'light green
   qb$(11) = "  0 220 220" 'light cyan
   qb$(12) = "255   0   0" 'light red
   qb$(13) = "255  84 255" 'light magenta
   qb$(14) = "255 255   0" 'yellow
   qb$(15) = "255 255 255" 'bright white
return

sub rainbow startIdx, stopIdx
   r0=val(word$(palette$(startIdx),1))
   r1=val(word$(palette$(stopIdx),1))
   g0=val(word$(palette$(startIdx),2))
   g1=val(word$(palette$(stopIdx),2))
   b0=val(word$(palette$(startIdx),3))
   b1=val(word$(palette$(stopIdx),3))
   for i = startIdx+1 to stopIdx-1
       a=1-(stopIdx-i)/(stopIdx-startIdx)   'startIdx..stopIdx -> 0..1
       R=int(r0*(1-a) + r1*a)
       G=int(g0*(1-a) + g1*a)
       B=int(b0*(1-a) + b1*a)
       palette$(i)=R;" ";G;" ";B
   next
end sub


[tsh73]

Keeping it in one place
current state is using any 100x100 bitmap as a floor tile
with this Sunflower tile - -
(I saved it via Paint to made it 24bpp, BGR bytes from position 54, program just reads it in)
I got this

code that makes almost it (there are DATA segments egg, 1 big sphere or 6 smaller ones. If you comment previous segment out next segment will work!)
'https://retrobasic.allbasic.info/index.php?topic=721.0
'converting to JB. Tsh73 Feb/Mar/Apr 2022

'full color bg (+ some shading)
'+egg shape by B+

desiredWidth = 320
desiredHeight = 200
'desiredWidth = 640
'desiredHeight = 480
' desiredWidth = 400
' desiredHeight = 300
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:
dim palette$(255)
gosub [initQBcolors]
for i = 0 to 15: palette$(i)=qb$(i):next
' palette 16,255,255,255:
palette$(16)="255 255 255"
' palette 32,0,192,255:
palette$(32)="0 192 255"
' palette 255,0,0,192:
palette$(255)="0 0 192"
' rainbow 16 to 32:
call rainbow 16, 32
' rainbow 32 to 255
call rainbow 32, 255

dim a$(1,1) 'to be redimmed
gosub [readTile]
'x0=-0.25:z0=1.6 'tile origin

read spheres
DIM c(spheres,3),r(spheres),q(spheres),cl(4)
w=scrw/2:h=scrh/2:s=0
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

'''49 spheres making a smooth egg shape
data 49
data -0.15,-0.6,1.5,0.1838116
data -0.13732143,-0.6,1.5,0.19432986
data -0.12464286,-0.6,1.5,0.20467506
data -0.11196429,-0.6,1.5,0.21483802
data -0.99285714e-1,-0.6,1.5,0.22480967
data -0.86607143e-1,-0.6,1.5,0.23458114
data -0.73928571e-1,-0.6,1.5,0.24414373
data -0.06125,-0.6,1.5,0.25348892
data -0.48571429e-1,-0.6,1.5,0.26260839
data -0.35892857e-1,-0.6,1.5,0.27149402
data -0.23214286e-1,-0.6,1.5,0.2801379
data -0.10535714e-1,-0.6,1.5,0.28853232
data 0.21428571e-2,-0.6,1.5,0.29666983
data 0.14821429e-1,-0.6,1.5,0.30454316
data 0.0275,-0.6,1.5,0.31214531
data 0.40178571e-1,-0.6,1.5,0.31946951
data 0.52857143e-1,-0.6,1.5,0.32650924
data 0.65535714e-1,-0.6,1.5,0.33325823
data 0.78214286e-1,-0.6,1.5,0.33971047
data 0.90892857e-1,-0.6,1.5,0.34586021
data 0.10357143,-0.6,1.5,0.35170198
data 0.11625,-0.6,1.5,0.35723058
data 0.12892857,-0.6,1.5,0.36244108
data 0.14160714,-0.6,1.5,0.36732884
data 0.15428571,-0.6,1.5,0.37188951
data 0.16696429,-0.6,1.5,0.37611904
data 0.17964286,-0.6,1.5,0.38001365
data 0.19232143,-0.6,1.5,0.38356987
data 0.205,-0.6,1.5,0.38678454
data 0.21767857,-0.6,1.5,0.38965481
data 0.23035714,-0.6,1.5,0.3921781
data 0.24303571,-0.6,1.5,0.39435217
data 0.25571429,-0.6,1.5,0.3961751
data 0.26839286,-0.6,1.5,0.39764525
data 0.28107143,-0.6,1.5,0.39876131
data 0.29375,-0.6,1.5,0.3995223
data 0.30642857,-0.6,1.5,0.39992753
data 0.31910714,-0.6,1.5,0.39997665
data 0.33178571,-0.6,1.5,0.3996696
data 0.34446429,-0.6,1.5,0.39900667
data 0.35714286,-0.6,1.5,0.39798844
data 0.36982143,-0.6,1.5,0.39661583
data 0.3825,-0.6,1.5,0.39489004
data 0.39517857,-0.6,1.5,0.39281263
data 0.40785714,-0.6,1.5,0.39038543
data 0.42053571,-0.6,1.5,0.38761061
data 0.43321429,-0.6,1.5,0.38449065
data 0.44589286,-0.6,1.5,0.38102832
data 0.45857143,-0.6,1.5,0.37722669

'''single big sphere
data 1
DATA 0.3,-0.8,3,0.7

'''src 6 spheres
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

shadeFactor = .5 'actually feels ok

t0=time$("ms") 'main loop start
FOR i=1 TO scrh
print , i
FOR j=0 TO scrw-1
SCAN 'so we could break it
x=0.3:y=-0.5:z=0:ba=1 'ba=1 is light, 0 is shadow
'- not used with fullColor BG (unless you write color darker procedure)
dx=j-w:dy=h-i:dz=(scrh/480)*600
dd=dx*dx+dy*dy+dz*dz
[recurs]  n=0-(y>=0 OR dy<=0)
IF n=0 THEN s=0-y/dy
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 [continueK]
bb=sc*sc/dd
aa=q(k)-pp+bb
IF aa<=0 THEN GOTO [continueK]
sc=(SQR (bb)-SQR (aa))/SQR (dd)
IF sc<s OR n<0 THEN n=k:s=sc
[continueK]
NEXT k

IF n<0 THEN
c = int(16+(dy*dy/dd)*240)
color$=palette$(c)
if lastCol$<>color$ then 'prevent extra color switching
#gr "color ";color$
lastCol$=color$
end if

#gr "set ";j;" ";scrh-i
goto [continueJ]
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 [recurs] 'really only GOTO
end if
''shading
FOR k=1 TO spheres
u=c(k,1)-x
v=c(k,3)-z
IF u*u+v*v<=q(k) THEN
ba=0 'shadow
exit for
end if
NEXT k

xt=(x mod 1 +(x<0))*99.99
yt=(z mod 1 +(z<0))*99.99 '100 out of tile pixels
color$=a$(xt, yt) '1x1
if ba=0 then
R=val(word$(color$,1))
G=val(word$(color$,2))
B=val(word$(color$,3))
color$ = int(R*shadeFactor);" ";int(G*shadeFactor);" ";int(B*shadeFactor)
end if
if lastCol$<>color$ then 'prevent extra color switching
#gr "color ";color$
lastCol$=color$
end if
#gr "set ";j;" ";scrh-i
[continueJ]
NEXT j
#gr,  "discard"
NEXT i

#gr, "getbmp  bmp 0 0 ";desiredWidth;" ";desiredHeight
#gr, "drawbmp bmp 0 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

[initQBcolors]
dim qb$(15) 'thanks Andy Amaya
qb$( 0) = "  0   0   0" 'black
qb$( 1) = "  0   0 128" 'blue
qb$( 2) = "  8 128   8" 'green
qb$( 3) = "  0 128 128" 'cyan
qb$( 4) = "128   0   0" 'red
qb$( 5) = "128   0 128" 'magenta
qb$( 6) = "128  64  32" 'brown
qb$( 7) = "168 168 168" 'white
qb$( 8) = "128 128 128" 'grey
qb$( 9) = " 84  84 252" 'light blue
qb$(10) = " 42 252  42" 'light green
qb$(11) = "  0 220 220" 'light cyan
qb$(12) = "255   0   0" 'light red
qb$(13) = "255  84 255" 'light magenta
qb$(14) = "255 255   0" 'yellow
qb$(15) = "255 255 255" 'bright white
return

sub rainbow startIdx, stopIdx
r0=val(word$(palette$(startIdx),1))
r1=val(word$(palette$(stopIdx),1))
g0=val(word$(palette$(startIdx),2))
g1=val(word$(palette$(stopIdx),2))
b0=val(word$(palette$(startIdx),3))
b1=val(word$(palette$(stopIdx),3))
for i = startIdx+1 to stopIdx-1
a=1-(stopIdx-i)/(stopIdx-startIdx)   'startIdx..stopIdx -> 0..1
R=int(r0*(1-a) + r1*a)
G=int(g0*(1-a) + g1*a)
B=int(b0*(1-a) + b1*a)
palette$(i)=R;" ";G;" ";B
next
end sub

[readTile]
' fname$="tile0.bmp"
' fname$="tile1.bmp"
fname$="tile2.bmp"

er$=ckhTile$(fname$)
   if er$<>"" then
print tab(3);er$
print
print "Program needs 100x100 BMP file 24 bit per pixel"
print "Open your picture in Paint and Save As 24 bit BMP file"
print
input "-=* press Enter to quit *=-"; dummy$
goto [quit]
else
call GetBmpDimensions fname$, width, height
if width<>100 or height<>100 then print "supposed to get 100x100, got ";width;"x";height;" instead"
end if

redim a$(width,  height)

print "reading tile..."
open fname$ for input as #1
ll=lof(#1)
seek #1, 54
'for j = height-1 to 0 step -1 'as bitmap stored
for j = 0 to height-1 'but I happen to need it upside down
for i = 0 to width-1
a$=input$(#1, 3)
R=asc(mid$(a$,3,1))
G=asc(mid$(a$,2,1))
B=asc(mid$(a$,1,1))
a$(i,j)=R;" ";G;" ";B
next
next
close #1

print " tile read!"

return

sub GetBmpDimensions fileName$, byref width, byref height
   open fileName$ for input as #gbd
   temp$ = input$(#gbd, 24)
   close #gbd
   width = asc(mid$(temp$, 19, 1))+asc(mid$(temp$, 20, 1))*256
   height = asc(mid$(temp$, 23, 1))+asc(mid$(temp$, 24, 1))*256
end sub

function toReadable$(a$)
   b$=""
   for i = 1 to len(a$)
       c=asc(mid$(a$,i,1))
       if c>32 and c <128 then b$=b$+mid$(a$,i,1) else b$=b$+"."
   next
   toReadable$=b$
end function

function ckhTile$(fileName$)
   'returns error message
   open fileName$ for input as #gbd
   temp$ = input$(#gbd, 54)
   close #gbd
   if left$(temp$,2)<>"BM" then
ckhTile$="Not a valid BMP file, check first 10 bytes: " _
+toReadable$(left$(temp$,10))
exit function
end if
   bpp = asc(mid$(temp$, 29, 1))+asc(mid$(temp$, 30, 1))*256
   if bpp<>24 then ckhTile$="Expected 24 bpp BMP, got ";bpp
end function


[plus]

I keep getting low on memory or out of memory errors and program dies

Even with 1 sphere!

I also tried the other BMP tile1 code and non-continuable... error Goodbye!

Error log timestamp 4/1/2022 19:14:28
Message 3001:
out of memory - unable to continue.


Error log timestamp 4/1/2022 19:14:52
Message 3001:
out of memory - unable to continue.


Error log timestamp 4/1/2022 19:17:56
Message 3001:
out of memory - unable to continue.


Error log timestamp 4/1/2022 19:19:04
Message 3001:
out of memory - unable to continue.


Error log timestamp 4/1/2022 19:20:49

The registers were:
EIP = 0x10019b0b
ESP = 0x0019fd1c
EBP = 0x0019fd30
EAX = 0x00000001
EBX = 0x00000400
ECX = 0x06f08850
EDX = 0x02687ef8
EDI = 0x02687f00
ESI = 0x0000c001
CS = 0x00000023
DS = 0x0000002b
ES = 0x0000002b
SS = 0x0000002b
End Registers



Error log timestamp 4/1/2022 19:20:49
Message 1001:
a non-continuable protection violation has occurred. Check ERROR.LOG file.


Error log timestamp 4/1/2022 19:40:31

The registers were:
EIP = 0x10019783
ESP = 0x0019fa94
EBP = 0x0019fab4
EAX = 0x00000010
EBX = 0x026a0010
ECX = 0x0000417b
EDX = 0x026d2148
EDI = 0x06f1d000
ESI = 0x026a8a28
CS = 0x00000023
DS = 0x0000002b
ES = 0x0000002b
SS = 0x0000002b
End Registers



Error log timestamp 4/1/2022 19:40:31
Message 1001:
a non-continuable protection violation has occurred. Check ERROR.LOG file.

Also odd, a new Error Log was started in the folder with these tiles and code, AFTER the first out of memory error attempt with tile2.bmp which was recorded in normal Error Log. The last message 20 minutes later was test with tile1.bmp and code from LB.

I also checked the code of 3/28 of post above and still works fine.

Yes, something is going wrong reading the bmp file. For tile2.bmp it should be 25600 x 25600?
And tile1.bmp should be 100 x 100? I had to change tile1.bmp to 16 bit in Paint and still wouldn't work.