05-29-2005, 07:41 AM
Got a bit sidetracked and ended up writing this, it only does spheres and it's pretty slow.
Code:
option explicit
'$include: 'tinyptc.bi'
const SCR_WIDTH = 320
const SCR_HEIGHT = 240
const MULT=2.0
type sphere
x as single
y as single
z as single
argb as integer
radius as single
orbit_angle as single
orbit_radius as single
end type
declare sub render_world()
dim shared display(SCR_WIDTH*SCR_HEIGHT) as integer
dim shared sphere_array(1000) as sphere
dim shared spheres as integer
dim shared light_x as single
dim shared light_y as single
dim shared light_z as single
light_x=-500.0
light_y=1500.0
light_z=200.0
spheres=10
dim i as integer
for i=1 to spheres
sphere_array(i).y=rnd*800.0-400.0
sphere_array(i).radius=5.0+rnd*145.0
sphere_array(i).orbit_radius=100.0+rnd*400.0
sphere_array(i).argb=rnd*&hffffff
next
if( ptc_open( "test", SCR_WIDTH, SCR_HEIGHT ) = 0 ) then
end -1
end if
'main loop
do
for i=1 to spheres
sphere_array(i).x=sphere_array(i).orbit_radius*sin(sphere_array(i).orbit_angle)
sphere_array(i).z=400.0+sphere_array(i).orbit_radius*cos(sphere_array(i).orbit_angle)
sphere_array(i).orbit_angle=sphere_array(i).orbit_angle+i/60.0
next
render_world()
ptc_update @display(0)
loop until( inkey$ = chr$( 27 ) )
ptc_close
end
function check_shadow(byval px as single,byval py as single,byval pz as single)as integer
dim cvx as single,cvy as single,cvz as single
dim evx as single,evy as single,evz as single
dim d as single,ret as integer,i as integer
dim l as single,radius as single
evx=light_x-px
evy=light_y-py
evz=light_z-pz
d=1.0/sqr(evx*evx+evy*evy+evz*evz)
evx=evx*d
evy=evy*d
evz=evz*d
ret=0
i=0
while i<spheres
i=i+1
cvx=sphere_array(i).x-px
cvy=sphere_array(i).y-py
cvz=sphere_array(i).z-pz
l=evx*cvx+evy*cvy+evz*cvz
d=cvx*cvx+cvy*cvy+cvz*cvz-l*l
if (d<sphere_array(i).radius*sphere_array(i).radius)and(l>0.0) then
i=spheres
ret=1
end if
wend
check_shadow=ret
end function
function trace(byval ex as single,byval ey as single,byval ez as single,byval evx as single,byval evy as single,byval evz as single,byval va as integer) as integer
if va<=0 then trace=0
dim sphere_count as integer
dim current_sphere as sphere
dim rgb_out as integer,rgb_in as integer
dim px as single,py as single,pz as single
dim nx as single,ny as single,nz as single
dim rx as single,ry as single,rz as single
dim cvx as single,cvy as single,cvz as single
dim lvx as single,lvy as single,lvz as single
dim shade1 as integer,shade2 as integer,red as integer,gre as integer,blu as integer
dim l as single,d2 as single,z as single
rgb_out=0
rgb_in=0
sphere_count=0
z=1000000.0
while sphere_count<spheres
sphere_count=sphere_count+1
current_sphere=sphere_array(sphere_count)
cvx=current_sphere.x-ex
cvy=current_sphere.y-ey
cvz=current_sphere.z-ez
l=evx*cvx+evy*cvy+evz*cvz
d2=cvx*cvx+cvy*cvy+cvz*cvz-l*l
if (d2<sphere_array(sphere_count).radius*sphere_array(sphere_count).radius) then
l=l-sqr(sphere_array(sphere_count).radius*sphere_array(sphere_count).radius-d2)
if (l<z) and (l>0.0) then
rgb_out=current_sphere.argb
z=l
px=ex+evx*l
py=ey+evy*l
pz=ez+evz*l
nx=(px-current_sphere.x)/sphere_array(sphere_count).radius
ny=(py-current_sphere.y)/sphere_array(sphere_count).radius
nz=(pz-current_sphere.z)/sphere_array(sphere_count).radius
lvx=light_x-px
lvy=light_y-py
lvz=light_z-pz
l=1.0/sqr(lvx*lvx+lvy*lvy+lvz*lvz)
lvx=lvx*l
lvy=lvy*l
lvz=lvz*l
shade1=256.0*(nx*lvx+ny*lvy+nz*lvz)
l=2.0*(nx*evx+ny*evy+nz*evz)
rx=evx-nx*l
ry=evy-ny*l
rz=evz-nz*l
' shade2=(256.0*(rx*current_sphere.lvx+ry*current_sphere.lvy+rz*current_sphere.lvz)-240.0)*16.0
shade2=256.0*(rx*lvx+ry*lvy+rz*lvz)^8
end if
end if
wend
if shade1<40 then shade1=40
if check_shadow(px,py,pz) then
shade1=40
shade2=0
end if
red=((rgb_out and &hff0000)shr 8)*shade1
gre=((rgb_out and &h00ff00)*shade1)shr 8
blu=((rgb_out and &h0000ff)*shade1)shr 8
if shade2>0 then
red=red+(shade2 shl 16)
gre=gre+(shade2 shl 8)
blu=blu+shade2
end if
if rgb_out<>0 then rgb_in=trace(px,py,pz,rx,ry,rz,va shr 1)
red=red+(rgb_in and &hff0000)
gre=gre+(rgb_in and &h00ff00)
blu=blu+(rgb_in and &h0000ff)
red=(red shr 8)*va
gre=(gre*va)shr 8
blu=(blu*va)shr 8
if red>&hff0000 then
red=&hff0000
else
red=red and &hff0000
end if
if gre>&h00ff00 then
gre=&h00ff00
else
gre=gre and &h00ff00
end if
if blu>&h0000ff then
blu=&h0000ff
else
blu=blu and &h0000ff
end if
trace=red or gre or blu
end function
sub render_world()
dim x as integer,y as integer
dim vx as single,vy as single,vz as single
dim ex as single,ey as single,ez as single
dim evx as single,evy as single,evz as single
dim lx as single,ly as single,lz as single
dim d as single
dim i as integer
vz=400.0
ex=0.0
ey=0.0
ez=-400.0
i=0
for y=0 to SCR_HEIGHT-1
vy=((SCR_HEIGHT shr 1)-y)*MULT
for x=0 to SCR_WIDTH-1
vx=(x-(SCR_WIDTH shr 1))*MULT
d=1.0/sqr(vx*vx+vy*vy+vz*vz)
evx=vx*d
evy=vy*d
evz=vz*d
display(i)=trace(ex,ey,ez,evx,evy,evz,256)
i=i+1
next
next
end sub