' 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