02-10-2026, 10:46 AM
I made comments to @Petr and felt i had to back it up. I'll use it to make my 3d text variant when i get it done.
Love me or hate me, but youll see this is something tasty!
John
Code: (Select All)
' Unseen Machine: World-Space 3-Light Raytracer
SCREEN _NEWIMAGE(800, 600, 32)
_DELAY 0.1
TYPE Vector
x AS SINGLE
y AS SINGLE
z AS SINGLE
END TYPE
TYPE LightSource
pos AS Vector
r AS SINGLE
g AS SINGLE
b AS SINGLE
power AS SINGLE
ambient AS SINGLE
END TYPE
TYPE Triangle
v1 AS Vector
v2 AS Vector
v3 AS Vector
r AS SINGLE
g AS SINGLE
b AS SINGLE
END TYPE
REDIM SHARED MyModel(1 TO 6) AS Triangle
REDIM SHARED SceneLights(1 TO 3) AS LightSource
' Global Pre-allocations for speed
DIM SHARED BakeImg AS LONG
DIM SHARED m AS _MEM
DIM SHARED step_w AS SINGLE
step_w = 1 / 63
DIM SHARED px AS INTEGER
DIM SHARED py AS INTEGER
DIM SHARED clr AS _UNSIGNED LONG
DIM SHARED w1 AS SINGLE
DIM SHARED w2 AS SINGLE
DIM SHARED w3 AS SINGLE
DIM SHARED p3x AS SINGLE
DIM SHARED p3y AS SINGLE
DIM SHARED p3z AS SINGLE
DIM SHARED lx AS SINGLE
DIM SHARED ly AS SINGLE
DIM SHARED lz AS SINGLE
DIM SHARED d2 AS SINGLE
DIM SHARED dist AS SINGLE
DIM SHARED dot AS SINGLE
DIM SHARED nx AS SINGLE
DIM SHARED ny AS SINGLE
DIM SHARED nz AS SINGLE
DIM SHARED mag AS SINGLE
DIM SHARED tr AS SINGLE
DIM SHARED tg AS SINGLE
DIM SHARED tb AS SINGLE
DIM SHARED shade AS SINGLE
DIM SHARED a AS SINGLE
DIM SHARED s AS SINGLE
DIM SHARED c AS SINGLE
DIM SHARED zOff AS SINGLE
' World-Space Vertices
DIM SHARED wx1 AS SINGLE
DIM SHARED wy1 AS SINGLE
DIM SHARED wz1 AS SINGLE
DIM SHARED wx2 AS SINGLE
DIM SHARED wy2 AS SINGLE
DIM SHARED wz2 AS SINGLE
DIM SHARED wx3 AS SINGLE
DIM SHARED wy3 AS SINGLE
DIM SHARED wz3 AS SINGLE
BakeImg = _NEWIMAGE(64, 64, 32)
m = _MEMIMAGE(BakeImg)
' --- SCENE SETUP ---
SetupLights
SetupPyramid
' --- RENDER LOOP ---
a = 0
zOff = -600
DO
_LIMIT 60
CLS
a = a + 0.03
s = SIN(a)
c = COS(a)
FOR i = 1 TO 6
' 1. WORLD SPACE TRANSFORM
wx1 = MyModel(i).v1.x * c - MyModel(i).v1.z * s
wy1 = MyModel(i).v1.y
wz1 = MyModel(i).v1.x * s + MyModel(i).v1.z * c
wx2 = MyModel(i).v2.x * c - MyModel(i).v2.z * s
wy2 = MyModel(i).v2.y
wz2 = MyModel(i).v2.x * s + MyModel(i).v2.z * c
wx3 = MyModel(i).v3.x * c - MyModel(i).v3.z * s
wy3 = MyModel(i).v3.y
wz3 = MyModel(i).v3.x * s + MyModel(i).v3.z * c
' 2. CALCULATE WORLD-SPACE NORMAL
ux! = wx2 - wx1
uy! = wy2 - wy1
uz! = wz2 - wz1
vx! = wx3 - wx1
vy! = wy3 - wy1
vz! = wz3 - wz1
nx = uy! * vz! - uz! * vy!
ny = uz! * vx! - ux! * vz!
nz = ux! * vy! - uy! * vx!
mag = SQR(nx * nx + ny * ny + nz * nz)
IF mag > 0 THEN
nx = nx / mag
ny = ny / mag
nz = nz / mag
END IF
' 3. SOFTWARE SHADER (RAYTRACE IN WORLD SPACE)
FOR py = 0 TO 63
w3 = py * step_w
FOR px = 0 TO 63
w2 = px * step_w
w1 = 1 - w2 - w3
IF w1 >= 0 AND w2 >= 0 AND w3 >= 0 THEN
p3x = (wx1 * w1) + (wx2 * w2) + (wx3 * w3)
p3y = (wy1 * w1) + (wy2 * w2) + (wy3 * w3)
p3z = (wz1 * w1) + (wz2 * w2) + (wz3 * w3)
tr = 0
tg = 0
tb = 0
FOR li = 1 TO 3
lx = SceneLights(li).pos.x - p3x
ly = SceneLights(li).pos.y - p3y
lz = SceneLights(li).pos.z - p3z
d2 = lx * lx + ly * ly + lz * lz
dist = SQR(d2)
dot = (nx * (lx / dist)) + (ny * (ly / dist)) + (nz * (lz / dist))
IF dot < 0 THEN
dot = 0
END IF
shade = (dot * SceneLights(li).power) / d2 + SceneLights(li).ambient
tr = tr + (MyModel(i).r * SceneLights(li).r * shade)
tg = tg + (MyModel(i).g * SceneLights(li).g * shade)
tb = tb + (MyModel(i).b * SceneLights(li).b * shade)
NEXT
IF tr > 255 THEN
tr = 255
END IF
IF tg > 255 THEN
tg = 255
END IF
IF tb > 255 THEN
tb = 255
END IF
clr = _RGB32(tr, tg, tb)
ELSE
clr = _RGBA32(0, 0, 0, 0)
END IF
_MEMPUT m, m.OFFSET + (py * 64 + px) * 4, clr
NEXT
NEXT
' 4. HARDWARE RENDER
HWBake& = _COPYIMAGE(BakeImg, 33)
_MAPTRIANGLE _CLOCKWISE _SEAMLESS(0, 0)-(63, 0)-(0, 63), HWBake& TO(wx1, wy1, wz1 + zOff)-(wx2, wy2, wz2 + zOff)-(wx3, wy3, wz3 + zOff)
_FREEIMAGE HWBake&
NEXT
_DISPLAY
LOOP UNTIL INKEY$ = CHR$(27)
SUB SetupLights
' WHITE
SceneLights(1).pos.x = 0
SceneLights(1).pos.y = 300
SceneLights(1).pos.z = 0
SceneLights(1).r = 1
SceneLights(1).g = 1
SceneLights(1).b = 1
SceneLights(1).power = 180000
SceneLights(1).ambient = 0.05
' RED
SceneLights(2).pos.x = -300
SceneLights(2).pos.y = 0
SceneLights(2).pos.z = -100
SceneLights(2).r = 1
SceneLights(2).g = 0
SceneLights(2).b = 0
SceneLights(2).power = 120000
SceneLights(2).ambient = 0.02
' BLUE
SceneLights(3).pos.x = 300
SceneLights(3).pos.y = 0
SceneLights(3).pos.z = -100
SceneLights(3).r = 0
SceneLights(3).g = 0
SceneLights(3).b = 1
SceneLights(3).power = 120000
SceneLights(3).ambient = 0.02
END SUB
SUB SetupPyramid
FOR i = 1 TO 6
MyModel(i).r = 255
MyModel(i).g = 255
MyModel(i).b = 255
NEXT
tx = 0
ty = 100
tz = 0
b1x = -100
b1y = -50
b1z = -100
b2x = 100
b2y = -50
b2z = -100
b3x = 100
b3y = -50
b3z = 100
b4x = -100
b4y = -50
b4z = 100
' Corrected Winding for all 4 sides + 2 base tris
SetV MyModel(1), tx, ty, tz, b1x, b1y, b1z, b2x, b2y, b2z
SetV MyModel(2), tx, ty, tz, b2x, b2y, b2z, b3x, b3y, b3z
SetV MyModel(3), tx, ty, tz, b3x, b3y, b3z, b4x, b4y, b4z
SetV MyModel(4), tx, ty, tz, b4x, b4y, b4z, b1x, b1y, b1z
SetV MyModel(5), b1x, b1y, b1z, b3x, b3y, b3z, b2x, b2y, b2z
SetV MyModel(6), b1x, b1y, b1z, b4x, b4y, b4z, b3x, b3y, b3z
END SUB
SUB SetV (t AS Triangle, x1, y1, z1, x2, y2, z2, x3, y3, z3)
t.v1.x = x1
t.v1.y = y1
t.v1.z = z1
t.v2.x = x2
t.v2.y = y2
t.v2.z = z2
t.v3.x = x3
t.v3.y = y3
t.v3.z = z3
END SUBLove me or hate me, but youll see this is something tasty!
John