Since the discussion in blitz about raytracing i've given it a little go. It's not got shadows yet and still needs some work on shading.
option explicit
const magic=6755399441055744.0
union float_to_int_conversion
_in as double
_out as integer
end union
union recip_sqr_conversion
_float as single
_int as integer
end union
type sphere_struct
x as single
y as single
z as single
rad as single
rad_recip as single
rad_recip2 as single
red as single
gre as single
blu as single
reflective as single
end type
type light_struct
x as single
y as single
z as single
red as single
gre as single
blu as single
end type
type vector_struct
x as single
y as single
z as single
end type
type raytrace_struct
x as single
y as single
z as single
vx as single
vy as single
vz as single
affect as single
red as single
gre as single
blu as single
sphere_list as sphere_struct pointer
sphere_count as integer
current_sphere as sphere_struct pointer
light_list as light_struct pointer
light_count as integer
display as integer pointer
vectors as vector_struct pointer
end type
sub raytrace (ray as raytrace_struct pointer)
dim as sphere_struct pointer sphere,this_sphere
dim as light_struct pointer light
dim as single current_distance=1000000.0,vx,vy,vz,d,d2,nx,ny,nz
dim as integer i,j
dim as recip_sqr_conversion dd
for i=0 to ray->sphere_count-1
sphere=@ray->sphere_list[i]
if ray->current_sphere<>sphere then
vx=sphere->x-ray->x
vy=sphere->y-ray->y
vz=sphere->z-ray->z
d=vx*ray->vx+vy*ray->vy+vz*ray->vz
If (d>0.0)and((d-sphere->rad)<current_distance) Then
vx-=ray->vx*d
vy-=ray->vy*d
vz-=ray->vz*d
d2=vx*vx+vy*vy+vz*vz
If d2<=sphere->rad*sphere->rad Then
d-=Sqr(sphere->rad*sphere->rad-d2)
if d<current_distance then
this_sphere=sphere
current_distance=d
end if
end if
end if
end if
next
if this_sphere then
ray->x+=ray->vx*current_distance
ray->y+=ray->vy*current_distance
ray->z+=ray->vz*current_distance
vx=ray->x-this_sphere->x
vy=ray->y-this_sphere->y
vz=ray->z-this_sphere->z
d=(ray->vx*vx+ray->vy*vy+ray->vz*vz)*this_sphere->rad_recip2
ray->vx-=vx*d
ray->vy-=vy*d
ray->vz-=vz*d
nx=-(this_sphere->x-ray->x)*this_sphere->rad_recip
ny=-(this_sphere->y-ray->y)*this_sphere->rad_recip
nz=-(this_sphere->z-ray->z)*this_sphere->rad_recip
for j=0 to ray->light_count-1
light=@ray->light_list[j]
vx=light->x-ray->x
vy=light->y-ray->y
vz=light->z-ray->z
dd._float=vx*vx+vy*vy+vz*vz
d2=0.5*dd._float
dd._int=&h5f3759df-(dd._int shr 1)
dd._float=dd._float*(1.5-d2*dd._float*dd._float)
vx*=dd._float
vy*=dd._float
vz*=dd._float
'test if point facing away from light
i=0
while(i<ray->sphere_count-1)
'test for shadow, if in shadow then i=ray->sphere_count
i+=1
wend
if i=ray->sphere_count then
'do lighting(no shadow)
end if
d=vx*ray->vx+vy*ray->vy+vz*ray->vz
if d>0.0 then
d=d*d*d*ray->affect
ray->red+=light->red*d
ray->gre+=light->gre*d
ray->blu+=light->blu*d
end if
next
d=vx*nx+vy*ny+vz*nz
if d>0.0 then
ray->red+=this_sphere->red*ray->affect*light->red*d
ray->gre+=this_sphere->gre*ray->affect*light->gre*d
ray->blu+=this_sphere->blu*ray->affect*light->blu*d
end if
ray->affect*=this_sphere->reflective
ray->current_sphere=this_sphere
if ray->affect>0.01 then raytrace(ray)
end if
End sub
sub render_world(ray as raytrace_struct pointer)
dim as integer w,h,x,y
dim as float_to_int_conversion red,gre,blu
dim as single d
screeninfo(w,h)
dim as integer pointer display=ray->display
dim as vector_struct pointer vector=ray->vectors
for y=0 to h-1
for x=0 to w-1
ray->x=0.0
ray->y=0.0
ray->z=0.0
ray->red=0.0
ray->gre=0.0
ray->blu=0.0
ray->vx=vector->x
ray->vy=vector->y
ray->vz=vector->z
ray->current_sphere=0
ray->affect=1.0
raytrace(ray)
if ray->red>1.0 then ray->red=1.0
if ray->gre>1.0 then ray->gre=1.0
if ray->blu>1.0 then ray->blu=1.0
red._in=ray->red*255.0+magic
gre._in=ray->gre*255.0+magic
blu._in=ray->blu*255.0+magic
*display=(red._out shl 16)or(gre._out shl 8)or blu._out
display+=1
vector+=1
next
next
end sub
sub set_screen_vectors(ray as raytrace_struct pointer,z as single=200.0)
dim as integer w,h,x,y
dim as single d
screeninfo(w,h)
ray->vectors=callocate(len(vector_struct)*w*h)
dim as vector_struct pointer vector=ray->vectors
for y=0 to h-1
for x=0 to w-1
vector->x=x-(w shr 1)
vector->y=(h shr 1)-y
vector->z=z
d=1.0/sqr(vector->x^2+vector->y^2+vector->z^2)
vector->x*=d
vector->y*=d
vector->z*=d
vector+=1
next
next
end sub
sub set_sphere(ray as raytrace_struct pointer,index as integer,_
x as single,y as single,z as single,radius as single,_
red as single,green as single,blue as single,reflective as single)
dim as sphere_struct pointer sphere=@ray->sphere_list[index]
sphere->x=x
sphere->y=y
sphere->z=z
sphere->rad=radius
sphere->rad_recip=1.0/radius
sphere->rad_recip2=sphere->rad_recip*sphere->rad_recip*2.0
sphere->red=red
sphere->gre=green
sphere->blu=blue
sphere->reflective=reflective
end sub
sub set_light(ray as raytrace_struct pointer,index as integer,_
x as single,y as single,z as single,_
red as single,green as single,blue as single)
dim as light_struct pointer light=@ray->light_list[index]
light->x=x
light->y=y
light->z=z
light->red=red
light->gre=green
light->blu=blue
end sub
sub main()
screenres 320,240,32,2
screenset 1,0
dim as raytrace_struct pointer ray=callocate(len(raytrace_struct))
ray->display=screenptr()
set_screen_vectors(ray)
ray->sphere_count=4
ray->light_count=1
ray->sphere_list=callocate(len(sphere_struct)*ray->sphere_count)
ray->light_list=callocate(len(light_struct)*ray->light_count)
set_sphere(ray,0,50.0,20.0,300.0,50.0,.9,.0,.0,.5)
set_sphere(ray,1,0.0,20.0,200.0,50.0,.0,.0,.2,.5)
set_sphere(ray,2,.0,-5040.0,.0,5000.0,.2,.2,.2,.24)
set_sphere(ray,3,.0,5080,.0,5000.0,.2,.2,.2,.1)
set_light(ray,0,100.0,20.0,.0,1.0,1.0,0.5)
dim as single angle=0
do
ray->sphere_list[0]->z=200.0+100*sin(angle)
ray->sphere_list[0]->x=0.0+100*cos(angle)
ray->sphere_list[1]->z=200.0-30*sin(angle)
ray->sphere_list[1]->x=0.0-30*cos(angle)
angle+=0.1
render_world(ray)
flip
cls
loop while inkey$=""
end sub
main()