' QB64 program by b+
' Ported to BASIC Anywhere Machine by Charlie Veniot
' This program exported from BASIC Anywhere Machine (Version [5.2.3].[2023.08.08.01.01]) on 2023.08.17 at 19:59 (Coordinated Universal Time)

' The QB64 program is based on a SpecBAS ray tracing program by Paul Dunn
' Paul Dunn's running version: https://youtu.be/_IhpguW18Uk?t=169

Const scrw = 1280, scrh = 780
screen _newimage(scrw,scrh,27)
Read spheres
dim i as integer : dim j as integer : dim k as integer
dim a as double : dim b as double : dim c2 as double : dim d as double
Dim c(6, 3) As double : Dim r(6) As double : Dim q(6) As double : Dim cl(4) As double
dim x as double : dim y as double : dim z as double
dim dx as double : dim dy as double : dim dz as double
dim px as double : dim py as double : dim pz as double
dim sc as double : dim ba as double : dim bb as double : dim aa as double : dim dd as double
dim s as double : dim w as double : dim h as double
' NX and NY are reserved variables in wwwBASIC
dim nx2 as double : dim ny2 as double : dim nz as double : dim nn as double : dim l as double
dim u as double : dim v as double
dim rval as double : dim bval as double : dim gval as double
w = scrw / 2
h = scrh / 2
s = 0
cl(1) = &ha0a0a0 ' shadow
cl(2) = &h0f0f0f
cl(3) = &hffffff
cl(4) = &h999999
For k = 1 To spheres
    Read a, b, c2, d
    c(k, 1) = a
    c(k, 2) = b
    c(k, 3) = c2
' r is a reserved variable in wwwBASIC
    r(k) = d
    q(k) = d * d
'	 r(k) = d
'    q(k) = (d * 100) * (d * 100 ) / 100
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:
        n = (y >= 0 Or dy <= 0) ' * -1   <<< Makes $1000 for knowing where to tap the hammer
        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
		      rval = int(178 * (scrh - i) / scrh + 128 * (dy * dy / dd)) * 256^2
				gval = int(178 * (scrh - i) / scrh + 128 * (dy * dy / dd)) * 256
				bval = int(178 + 55 * (dy * dy / dd))
            PSet (j, scrh - i), ( rval + gval + bval )
            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
            nx2 = x - c(n, 1): ny2 = y - c(n, 2): nz = z - c(n, 3)
            nn = nx2 * nx2 + ny2 * ny2 + nz * nz
            l = 2 * (dx * nx2 + dy * ny2 + dz * nz) / nn
            dx = dx - nx2 * l: dy = dy - ny2 * 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: k = spheres + 1
				End If
        Next k
If (x - Int(x) > .5) = (z - Int(z) > .5) Then
            PSet (j, scrh - i), cl(ba)
        Else
            PSet (j, scrh - i), cl(ba + 1)
        End If
        donej:
    Next j
Next i
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