RAY CASTING
Re: RAY CASTING
??? :
kleur = type<tcolor>( rnd , rnd , rnd , 0.0 )
kleur = type<tcolor>( rnd , rnd , rnd , 0.0 )
Re: RAY CASTING
Shading from a point source, the source being the largest sphere.
Also tried some sphere on sphere shading, but nothing too complicated.
Also tried some sphere on sphere shading, but nothing too complicated.
Code: Select all
Dim As Integer xres,yres,pitch
Screeninfo xres,yres
Screenres xres,yres,32,,1
Dim As Any Ptr row=Screenptr
Dim As Uinteger Ptr pixel
Screeninfo xres,yres,,,pitch
Dim As Any Ptr im=Imagecreate(2*xres,2*yres,Rgb(0,0,0))
Type V3
As Single x,y,z
Declare Function length As Single
Declare Function unit As V3
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))\((b)-(a))+(c)
End Type
Type sphere
As Single x,y,z
As Single dx,dy,dz
As Integer r
As Any Ptr image
End Type
Operator -(Byref v1 As v3,Byref v2 As v3) As v3
Return Type<V3>(v1.x-v2.x,v1.y-v2.y,v1.z-v2.z)
End Operator
Operator * (Byref v1 As v3,Byref v2 As v3) As Single 'dot
Return v1.x*v2.x+v1.y*v2.y+v1.z*v2.z
End Operator
Function v3.length As Single
Return Sqr(x*x+y*y+z*z)
End Function
Function v3.unit As v3 'normalize
Dim n As Single=Sqr(x*x+y*y+z*z)
Return Type<V3>(x/n,y/n,z/n)
End Function
#macro insphere(S,P)
(S.x-P.x)*(S.x-P.x)+(S.y-P.y)*(S.y-P.y)+(S.z-P.z)*(S.z-P.z) < S.R*S.R
#endmacro
#macro onsphere(S,P)
(S.x-P.x)*(S.x-P.x)+(S.y-P.y)*(S.y-P.y)+(S.z-P.z)*(S.z-P.z) <= S.R*S.R Andalso _
(S.x-P.x)*(S.x-P.x)+(S.y-P.y)*(S.y-P.y)+(S.z-P.z)*(S.z-P.z) > (S.R-1)*(S.R-1)
#endmacro
#macro ppset(_x,_y,colour)
pixel=row+pitch*(_y)+(_x)*4
*pixel=(colour)
#endmacro
#define onscreen(_x,_y) _x>0 and _x<xres-1 and _y>0 and _y<yres-1
Function Regulate(Byval MyFps As Integer,Byref fps As Integer) As Integer
Static As Double timervalue,lastsleeptime,t3,frames
Dim As Double t=Timer
frames+=1
If (t-t3)>=1 Then t3=t:fps=frames:frames=0
Dim As Integer sleeptime=lastsleeptime+((1/myfps)-T+timervalue)*1000
If sleeptime<1 Then sleeptime=1
lastsleeptime=sleeptime
timervalue=T
Return sleeptime
End Function
Dim As V3 p
Dim As sphere s=Type<sphere>(xres/6,xres/6,0,(2+Rnd*3),(2+Rnd*3),0,xres/6), _ 'large
s2=Type<sphere>(xres/5,yres/3,90,(3+Rnd*2),(3+Rnd*2),0,yres/9), _ 'middle
s3=Type<sphere>(xres/2,yres/2,100,(4+Rnd*5),(4+Rnd*5),0,yres/12) 'small
s.image=Imagecreate(2*s.r,2*s.r)
'some local variables
Dim As Integer x,y,z,n,rd,gr,bl,max=Sqr(xres^2+yres^2),cc,dist
Dim As V3 sctr=Type<V3>(xres,yres,0)
'background
For x=0 To 2*xres
For y=0 To 2*yres
p=Type<V3>(x,y)
dist=(sctr-p).length
cc=map(0,max,dist,(255*(.05*yres)/dist),0)
Pset im,(x,y),Rgb(cc,cc,cc)
Next y
Next x
'to image red sphere
For x =s.x-s.r To s.x+s.r
For y =s.y-s.r To s.y+s.r
For z =s.z To s.z+s.r
p=Type<V3>(x,y,z)
If onsphere(s,p) Then
Dim As v3 ctr=Type<V3>(s.x,s.y,s.r)
Var dist=(p-ctr).length
rd=map(0,2*s.r,dist,255,150)
gr=map(0,2*s.r,dist,255,0)
bl=map(0,2*s.r,dist,255,0)
Pset s.image,(p.x,p.y),Rgb(rd,gr,bl)
End If
Next z
Next y
Next x
'mobile spheres, set into arrays
Redim Shared As V3 a(0),a1(0)
'green
For x =s2.x-s2.r To s2.x+s2.r
For y =s2.y-s2.r To s2.y+s2.r
For z =s2.z To s2.z+s2.r
p=Type<V3>(x,y,z)
If onsphere(s2,p) Then
Redim Preserve a(1 To Ubound(a)+1)
a(Ubound(a))=Type<V3>(x,y,z)
End If
Next z
Next y
Next x
'blue
For x =s3.x-s3.r To s3.x+s3.r
For y =s3.y-s3.r To s3.y+s3.r
For z =s3.z To s3.z+s3.r
p=Type<V3>(x,y,z)
If onsphere(s3,p) Then
Redim Preserve a1(1 To Ubound(a1)+1)
a1(Ubound(a1))=Type<V3>(x,y,z)
End If
Next z
Next y
Next x
'=========================================================
Dim As Integer fps
Dim As Single dot,dt,f1=1,f2=1,dist1,dist2
Dim As V3 diff,c
dim as V3 d1,d2
Do
Screenlock
Cls
'move the reddish sphere image
S.x+=S.dx
S.y+=S.dy
If s.x>xres-s.r Or s.x<s.r Then S.dx=-S.dx
If s.y>yres-s.r Or s.y<s.r Then S.dy=-S.dy
Put(s.x-xres,s.y-yres),im,Pset 'the background
Put(s.x-s.r,s.y-s.r),s.image,trans'the redish sphere
Draw String (20,20),"Framerate " & fps
'move the other sphere centres and check edge boundaries
S2.x+=S2.dx
S2.y+=S2.dy
If s2.x>xres-s2.r-1 Or s2.x<s2.r Then S2.dx=-S2.dx
If s2.y>yres-s2.r-1 Or s2.y<s2.r Then S2.dy=-S2.dy
S3.x+=S3.dx
S3.y+=S3.dy
If s3.x>xres-s3.r-1 Or s3.x<s3.r Then S3.dx=-S3.dx
If s3.y>yres-s3.r-1 Or s3.y<s3.r Then S3.dy=-S3.dy
diff=(Type<V3>(s.x,s.y,s.z)-Type<V3>(s2.x,s2.y,s2.z)).unit
For n =1 To Ubound(a)'green one
'move all the sphere points
a(n).x+=S2.dx
a(n).y+=S2.dy
If onscreen(a(n).x,a(n).y) Then
If insphere(s,a(n))=0 Then
c=(Type<V3>(s2.x,s2.y,s2.z)-a(n)).unit
dot=c*diff
cc=map(1,-1,dot,0,250)
ppset(Cint(a(n).x),Cint(a(n).y),Rgb(0,cc*f1,0))
End If
End If
Next n
diff=(Type<V3>(s.x,s.y,s.z)-Type<V3>(s3.x,s3.y,s3.z)).unit
For n =1 To Ubound(a1)'blue one
'move all the sphere points
a1(n).x+=S3.dx
a1(n).y+=S3.dy
If onscreen(a1(n).x,a1(n).y) Then
If insphere(s,a1(n))=0 And insphere(s2,a1(n))=0 Then
c=(Type<V3>(s3.x,s3.y,s3.z)-a1(n)).unit
dot=c*diff
cc=map(1,-1,dot,00,255)
ppset(Cint(a1(n).x),Cint(a1(n).y),Rgb(0,0,cc*f2))
End If
End If
Next n
'aspect shade kinda
d1=(type<V3>(s2.x,s2.y,s2.z)-type<V3>(s.x,s.y,s.z)).unit
d2=(type<V3>(s3.x,s3.y,s3.z)-type<V3>(s.x,s.y,s.z)).unit
dt=d1*d2 'dot product
if dt>.975 then'nearly in line
dist1=(type<V3>(s2.x,s2.y,s2.z)-type<V3>(s.x,s.y,s.z)).length
dist2=(type<V3>(s3.x,s3.y,s3.z)-type<V3>(s.x,s.y,s.z)).length
if dist1>dist2 then f1=.75:f2=1
if dist1<dist2 then f1=1:f2=.75
else
f1=1:f2=1
end if
Screenunlock
Sleep regulate(25,fps),1
Loop Until Len(Inkey)
Imagedestroy s.image
Imagedestroy im
Sleep
Re: RAY CASTING
To make the spheres visible replace Function tsphere.hit and Function winner_index with these two new routines.bluatigro wrote:update :
- try at shading
error :
- i get only 1 sphere whit a color background
- i dont get shading
Code: Select all
Function tsphere.hit( ray As tray ) As Double
Dim As t3d o , d , s
o = ray.origin
d = ray.direction
s = position
/'
dim as double a = 1.0 , b , c
b = ( 2 * ( o.x - s.x ) * d.x ) _
+ ( 2 * ( o.y - s.y ) * d.y ) _
+ ( 2 * ( o.z - s.z ) * d.z )
c = ( o.x - s.x ) ^ 2.0 _
+ ( o.y - s.y ) ^ 2.0 _
+ ( o.z - s.z ) ^ 2.0 _
- ( r2 )
'/
Dim As t3d d1
' create a endpoint beyond the scene by multiplying the direction
d1.x = o.x - 2000 * d.x
d1.y = o.y - 2000 * d.y
d1.z = o.z - 2000 * d.z
Dim As Double a = d1.x*d1.x + d1.y*d1.y + d1.z*d1.z
Dim As Double b, c
' b = ( 2 * ( o.x - s.x ) * d1.x ) + ( 2 * ( o.y - s.y ) * d1.y ) + ( 2 * ( o.z - s.z ) * d1.z )
b = 2 * (( o.x - s.x ) * d1.x + ( o.y - s.y ) * d1.y + ( o.z - s.z ) * d1.z )
c = ( s.x ) ^ 2 + ( s.y ) ^ 2 + ( s.z ) ^ 2 _
+ ( o.x*o.x + o.y*o.y + o.z*o.z ) _
- 2 * (s.x*o.x + s.y*o.y + s.z*o.z) - (r2)
Dim As Double dis = b * b - 4 * a * c
If ( dis > 0.0 ) Then
'dim as double root1 = ( -b - sqr( dis ) ) / 2 - 1e-10
Dim As Double root1 = ( -b - Sqr( dis ) ) / (2 * a)
If ( root1 > 0.0 ) Then
Return root1
Else
'Return ( -b + sqr( dis ) ) / 2 + 1e-10
Return ( -b + Sqr( dis ) ) / (2*a) ' + 1e-10
End If
Else
Return -1
End If
End Function
Function winner_index( a() As Double , tel As Integer ) As Integer
Dim As Integer i , f = -1
Dim As Double Min = -1
For i = 0 To tel
If min < a(i) Then
min = a(i)
f = i
End If
Next
Return f
End Function
Re: RAY CASTING
If you multiply ang by say 2*pi (line ~ 220) -- kleur = kleur * ( cos( angl*(2*pi)) ) / 2 + .5 )
then you get a shading of sorts.
If you multiply by more than 2*pi the shading becomes banded, but the effect is OK.
then you get a shading of sorts.
If you multiply by more than 2*pi the shading becomes banded, but the effect is OK.
Re: RAY CASTING
update :
- added 2*pi
- added some OOP
error :
- now i get a black screen
- added 2*pi
- added some OOP
error :
- now i get a black screen
Code: Select all
''bluatigro
''raycater : start : 3 aug 2014
''update : shadow : 6 aug 2014
type t3d
public :
dim as double x , y , z
declare constructor (x as double = 0, y as double = 0, z as double = 0)
declare sub fill( x as double , y as double , z as double )
declare function dot( r as t3d ) as double
declare function ad( r as t3d ) as t3d
declare function cross( r as t3d ) as t3d
declare function angle( r as t3d ) as double
declare function length() as double
end type
constructor t3d( a as double , b as double , c as double )
x = a
y = b
z = c
end constructor
sub t3d.fill( a as double , b as double , c as double )
x = a
y = b
z = c
end sub
function t3d.dot( r as t3d ) as double
return x * r.x + y * r.y + z * r.z
end function
function t3d.ad( r as t3d ) as t3d
return type( x + r.x , y + r.y , z + r.z )
end function
function t3d.cross( r as t3d ) as t3d
return type( y * r.z - z * r.y _
, z * r.x - x * r.z _
, x * r.y - y * r.x )
end function
function t3d.angle( r as t3d ) as double
return acos( dot( r ) / ( length() * r.length() ) )
end function
function t3d.length() as double
return sqr( x ^ 2 + y ^ 2 + z ^ 2 )
end function
operator * ( l as t3d , f as double ) as t3d
return type( l.x * f , l.y * f , l.z * f )
end operator
operator -( r as t3d ) as t3d
return type( -r.x , -r.y , -r.z )
end operator
const as double pi = atn( 1 ) * 4
type tray
as t3d origin
as t3d direction
as double ODot
as double DDot
declare constructor(o as t3d, d as t3d)
end type
constructor tray(o as t3d, d as t3d)
origin = o
direction = d
ODot = origin.dot( origin )
DDot = direction.dot( direction )
end constructor
type tcolor
as double red , green , blue , special
declare constructor (r as double = 0.0, g as double = 0.0 , b as double = 0.0, s as double = 0.0)
declare function toInt() as integer
end type
constructor tcolor( r as double , g as double, b as double, s as double)
red = r : green = g : blue = b : special = s
end constructor
function tcolor.toInt() as integer
return rgb( red * 255 , green * 255 , blue * 255 )
end function
operator * ( kl as tColor , f as double ) as tColor
return type( kl.red * f , kl.green * f , kl.blue * f )
end operator
type tlight
as t3d position
as tcolor kleur
end type
''type tshape
''public :
'' dim kleur as tcolor
'' declare function getNormal( p as t3d ) as t3d
'' declare function hit( ray as tray ) as double
''end type
type tsphere ''( tshape )
as t3d position
as double PDot
as double radius,r2
as tcolor kleur
declare constructor ()
declare constructor ( p as t3d , r as double , kl as tcolor )
declare function getNormal( p as t3d ) as t3d
declare function hit( ray as tray ) as double
end type
constructor tsphere()
position = type<t3d>( 0.0 , 0.0 , 0.0 )
PDot = 0
radius = 100.0
r2 = radius * radius
kleur = type<tcolor>( 1.0 , 1.0 , 1.0 , 0.0 )
end constructor
constructor tsphere( p as t3d , r as double , kl as tcolor )
position = p
' pre caluculate position dot product
PDot = position.dot( position )
radius = r
' pre calculate radius squared
r2 = r * r
kleur = kl
end constructor
function tsphere.getNormal( p as t3d ) as t3d
return position.ad( -p )
end function
function tsphere.hit( ray as tray ) as double
dim as double L=Ray.DDot
If L = 0 Then return -1
dim as double M = 2 * Ray.Direction.X * (Ray.Origin.X-Position.X) _
+ 2 * Ray.Direction.Y * (Ray.Origin.Y-Position.Y) _
+ 2 * Ray.Direction.Z * (Ray.Origin.Z-Position.Z)
dim as double N = PDot + Ray.ODot
N = N - 2 * (Position.x*Ray.Origin.x + _
Position.y*Ray.Origin.y + _
Position.z*Ray.Origin.z) - R2
dim as double T = M * M - 4 * L * N
if (T<0) then return -1
L*=2
if (T=0) then
T = -M / L
if (T<=0) then
return -1
else
return T
end if
else ' two hit points
T=sqr(T)
dim as double T1 = (-M - t)/L
dim as double T2 = (-M + t)/L
If (T1 < 0.001) Then T1 = 0
If (T2 < 0.001) Then T2 = 0
' no hits
If (T1 = 0) And (T2 = 0) Then return -1
' both are ok
If (T1 > 0) And (T2 > 0) Then
If T1 < T2 Then
return T1
else
return T2
end if
Else ' one are ok
If (T1 > 0) Then
return T1
Else
return T2
end if
End If
End If
end function
type tcamera
public :
dim as t3d position , direction , rechts , down
declare constructor( p as t3d , d as t3d , r as t3d , u as t3d )
end type
function range( low as double , high as double ) as double
return rnd * ( high - low ) + low
end function
function winner_index( a() as double , tel as integer ) as integer
dim as integer found = -1 ,i
dim as double min = 1e13
for i = 0 to tel
if a( i ) > 0 then
if a( i ) < min then
min = a( i )
found = i
end if
end if
next
return found
end function
sub test
dim as integer winx , winy , wind
screeninfo winx , winy , wind
dim as tlight light
dim as tsphere spheres( 10 )
dim as integer i , spheremax = 0
dim p as t3d , r as double , kl as tcolor
for i = 0 to 10
p = type<t3d>( range( -500.0 , 500.0 ) _
, range( -300.0 , 300.0 ) _
, range( 200.0 , 1000.0 ) )
r = range( 10 , 50 )
kl = type<tcolor>( rnd , rnd , rnd , 0.0 )
spheres(i)=type<tsphere>(p,r,kl)
next i
dim as double x , y , a( 10 ) , angle
for x = -winx/2 to winx/2
for y = -winy/2 to winy/2
dim as t3d o , d
o.fill x , y , 0.0
d.fill x / winx , y / winx , 1.0
dim as TRAY ray = TRAY( o , d )
for i = 0 to 10
a(i) = spheres(i).hit(ray)
next i
i = winner_index( a() , 10 )
if (i<0) then
pset( winx/2 + x , winy/2 - y ) ,0
else
dim as t3d p = ray.direction * ( 1 / ray.direction.length() ) * a( i )
angle = spheres(i).getNormal( p ).angle( light.position )
kl = spheres( i ).kleur
kl = kl * ( cos( angle * pi * 2 ) / 2 + 0.5 )
pset( winx/2 + x , winy/2 - y ) , kl.toInt()
end if
next
next
end sub
'
' main
'
screen 20 , 32
randomize timer
''while inkey()=""
test
''wend
print "ready"
sleep
Re: RAY CASTING
bluatigro
A little lesson in finding a errors.
The error is one which I have seen is one you made before.
But let me try to help you how to find errors in your program.
If you change the black background color into white what will happen.
Thus pset( winx/2 + x , winy/2 - y ) ,0
into pset( winx/2 + x , winy/2 - y ) ,2^24-1 or ( ,RGB(255, 255, 255) )
You get a all white screen or a white screen with black filled circles.
White screen means no spheres are found/hit, the other means spheres are hit but there color is somehow changed in black.
The screen is white with back circles.
See what happens if you comment out some lines so that you get
kl = spheres( i ).kleur
pset( winx/2 + x , winy/2 - y ) , kl.toInt()
Ok you get colored circles on a white back ground meaning the error is in these 3 lines.
dim as t3d p = ray.direction * ( 1 / ray.direction.length() ) * a( i )
angle = spheres(i).getNormal( p ).angle( light.position )
kl = kl * ( cos( angle * pi * 2 ) / 2 + 0.5 )
adding a line with print angle reveals that angle is -1.#IND meaning that in somewhere in the first two lines you have most likely a division by 0 ("zero").
Now you know to look for the error, it is in these two lines.
dim as t3d p = ray.direction * ( 1 / ray.direction.length() ) * a( i )
angle = spheres(i).getNormal( p ).angle( light.position )
The code in this line is wrong if you trying to apply Lambert's cosine law,
kl = kl * ( cos( angle * pi * 2 ) / 2 + 0.5 ) the value of angle is already the cosine of the angle.
If have been trying for the last few weeks to add shadow and lambert cosine law in a earlier program of yours,
the shadow is not always correct haven't located the error yet.
Maybe the code gives you a clue where yours goes wrong.
Regards
A little lesson in finding a errors.
The error is one which I have seen is one you made before.
But let me try to help you how to find errors in your program.
If you change the black background color into white what will happen.
Thus pset( winx/2 + x , winy/2 - y ) ,0
into pset( winx/2 + x , winy/2 - y ) ,2^24-1 or ( ,RGB(255, 255, 255) )
You get a all white screen or a white screen with black filled circles.
White screen means no spheres are found/hit, the other means spheres are hit but there color is somehow changed in black.
The screen is white with back circles.
See what happens if you comment out some lines so that you get
kl = spheres( i ).kleur
pset( winx/2 + x , winy/2 - y ) , kl.toInt()
Ok you get colored circles on a white back ground meaning the error is in these 3 lines.
dim as t3d p = ray.direction * ( 1 / ray.direction.length() ) * a( i )
angle = spheres(i).getNormal( p ).angle( light.position )
kl = kl * ( cos( angle * pi * 2 ) / 2 + 0.5 )
adding a line with print angle reveals that angle is -1.#IND meaning that in somewhere in the first two lines you have most likely a division by 0 ("zero").
Now you know to look for the error, it is in these two lines.
dim as t3d p = ray.direction * ( 1 / ray.direction.length() ) * a( i )
angle = spheres(i).getNormal( p ).angle( light.position )
The code in this line is wrong if you trying to apply Lambert's cosine law,
kl = kl * ( cos( angle * pi * 2 ) / 2 + 0.5 ) the value of angle is already the cosine of the angle.
If have been trying for the last few weeks to add shadow and lambert cosine law in a earlier program of yours,
the shadow is not always correct haven't located the error yet.
Code: Select all
''bluatigro
''raycater strart : 3 aug 2014
' frisian 23-9-2014
' added shadows and Lambert cosine's law
' shadows are not always correct and the cosine value needs
' to inverted. somewhere the line I must have made some mistakes
' in constructor tcolor and the function tcolor.toInt() is code
' added to get value's that are in range (0 - 1)
' used the variable r2 in constructor tsphere to hold the result
' of a calculation
' added function hit_or_mis to do all the work
Type t3d
Public :
Dim As Double x , y , z
Declare Constructor ( x As Double = 0 _
, y As Double = 0 , z As Double = 0 )
Declare Sub fill( x As Double , y As Double , z As Double )
Declare Function length() As Double
End Type
Constructor t3d( a As Double , b As Double , c As Double )
x = a
y = b
z = c
End Constructor
Sub t3d.fill( a As Double , b As Double , c As Double )
x = a
y = b
z = c
End Sub
Function dot( l As t3d , r As t3d ) As Double
Return l.x * r.x + l.y * r.y + l.z * r.z
End Function
Function cross( l As t3d , r As t3d ) As t3d
Return Type( l.y * r.z - l.z * r.y _
, l.z * r.x - l.x * r.z _
, l.x * r.y - l.y * r.x )
End Function
Function t3d.length() As Double
Return Sqr( x ^ 2 + y ^ 2 + z ^ 2 )
End Function
Function angle( l As t3d , r As t3d ) As Double
Return dot( l , r ) / ( l.length() * r.length() )
End Function
Operator + ( l As t3d , r As t3d ) As t3d
Return Type( l.x + r.x , l.y + r.y , l.z + r.z )
End Operator
Operator * ( q As t3d , d As Double ) As t3d
Return Type( q.x * d , q.y * d , q.z * d )
End Operator
Operator - ( r As t3d ) As t3d
Return Type( -r.x , -r.y , -r.z )
End Operator
Type tray
Public :
Dim As t3d origin , direction
Declare Constructor( o As t3d , d As t3d )
End Type
Constructor tray( o As t3d , d As t3d )
origin = o
direction = d
End Constructor
Type tcolor
Public :
Dim As Double red , green , blue , special
Declare Constructor ( r As Double = 0.0 _
, g As Double = 0.0 , b As Double = 0.0 _
, s As Double = 0.0 )
Declare Function toInt() As Integer
End Type
Constructor tcolor( r As Double , g As Double _
, b As Double , s As Double )
red = IIf(r < 0, 0, IIf(r > 1, 1, r)) ' ###
green = IIf(g < 0, 0, IIf(g > 1, 1, g)) ' ###
blue = IIf(b < 0, 0, IIf(b > 1, 1, b)) ' ###
special = s
End Constructor
Function tcolor.toInt() As Integer
red = IIf(red < 0, 0, IIf(red > 1, 1 ,red)) ' ###
green = IIf(green < 0, 0, IIf(green > 1, 1 ,green)) ' ###
blue = IIf(blue < 0, 0, IIf(blue > 1, 1 ,blue)) ' ###
Return RGB( red * 255 , green * 255 , blue * 255 )
End Function
Operator * ( kl As tcolor , d As Double ) As tcolor
Return Type( kl.red * d , kl.green * d , kl.blue * d )
End Operator
Type tlight
Public :
Dim position As t3d
Dim kleur As tcolor
Declare Constructor()
End Type
Constructor tLight()
position.fill 0 , 100 , 0
kleur = Type<tcolor>( 1.0 , 1.0 , 1.0 , 0.0 )
End Constructor
''type tshape
''public :
'' dim kleur as tcolor
'' declare function getNormal( p as t3d ) as t3d
'' declare function hit( ray as tray ) as double
''end type
Type tsphere ''( tshape )
Dim position As t3d
Dim As Double radius , r2
Dim kleur As tcolor
Declare Constructor ()
Declare Constructor ( p As t3d , r As Double , kl As tcolor )
Declare Function getNormal( p As t3d ) As t3d
Declare Function hit( ray As tray ) As Double
End Type
Constructor tsphere()
position = Type<t3d>( 0.0 , 0.0 , 0.0 )
' radius = 0.0
r2 = 0 ' (radius ^ 2)
kleur = Type<tcolor>( 1.0 , 1.0 , 1.0 , 0.0 )
End Constructor
Constructor tsphere( p As t3d , r As Double , kl As tcolor )
position = p
radius = r
r2 = p.x^2 + p.y^2 + p.z^2 -(radius ^ 2) ' ###
kleur = kl
End Constructor
Function tsphere.getNormal( p As t3d ) As t3d
Return position + ( -p )
End Function
Dim Shared As tsphere spheres( 10 ) ' ###
Function tsphere.hit( ray As tray ) As Double
Dim As t3d o , d , s
o = ray.origin
d = ray.direction
s = position
/'
dim as double a = 1.0 , b , c
b = ( 2 * ( o.x - s.x ) * d.x ) _
+ ( 2 * ( o.y - s.y ) * d.y ) _
+ ( 2 * ( o.z - s.z ) * d.z )
c = ( o.x - s.x ) ^ 2.0 _
+ ( o.y - s.y ) ^ 2.0 _
+ ( o.z - s.z ) ^ 2.0 _
- ( r2 )
'/
Dim As t3d d1
' create a endpoint beyond the scene by multiplying the direction
d1.x = 2000 * d.x - o.x
d1.y = 2000 * d.y - o.y
d1.z = 2000 * d.z - o.z
Dim As Double a = d1.x*d1.x + d1.y*d1.y + d1.z*d1.z
Dim As Double b, c
' b = ( 2 * ( o.x - s.x ) * d1.x ) + ( 2 * ( o.y - s.y ) * d1.y ) + ( 2 * ( o.z - s.z ) * d1.z )
b = 2 * (( o.x - s.x ) * d1.x + ( o.y - s.y ) * d1.y + ( o.z - s.z ) * d1.z )
c = ( s.x ) ^ 2 + ( s.y ) ^ 2 + ( s.z ) ^ 2 _
+ ( o.x*o.x + o.y*o.y + o.z*o.z ) _
- 2 * (s.x*o.x + s.y*o.y + s.z*o.z) - (r2)
Dim As Double dis = b * b - 4 * a * c
If ( dis > 0.0 ) Then
Dim As Double root1 = ( -b - Sqr( dis ) ) / (2 * a)
Dim As Double root2 = ( -b + Sqr( dis ) ) / (2 * a)
If root1 > 0 Or root2 > 0 Then
If root1 > root2 Then Return root1 Else Return root2
End If
End If
Return -1
End Function
Function hit_or_mis( o As t3d, d As t3d) As tcolor
Dim As Integer i, index = -1
Dim As t3d d1, h_p
Dim As Double b, c, shadow = 1
Dim As Double dis, root1, root2, t = 1e10, dist
d1.x = 2000 * d.x - o.x
d1.y = 2000 * d.y - o.y
d1.z = 2000 * d.z - o.z
Dim As Double a = d1.x*d1.x + d1.y*d1.y + d1.z*d1.z
Dim As Double line_start = o.x*o.x + o.y*o.y + o.z*o.z
For i = 0 To 10
b = 2 * (( o.x - spheres(i).position.x ) * d1.x _
+ ( o.y - spheres(i).position.y ) * d1.y _
+ ( o.z - spheres(i).position.z ) * d1.z )
c = spheres(i).r2 + line_start _
- 2 * (spheres(i).position.x * o.x _
+ spheres(i).position.y * o.y _
+ spheres(i).position.z * o.z)
dis = b * b - 4 * a * c
If dis > 0 Then
root1 = ( -b - Sqr( dis ) ) / (2 * a)
root2 = ( -b + Sqr( dis ) ) / (2 * a)
If root1 > 0 Or root2 > 0 Then
If root1 < root2 Then dist = root1 Else dist = root2
If t > dist Then
t = dist
index = i
End If
End If
End If
Next
If index = -1 Then Return Type<tcolor>(0.2,0.2,0.2)
h_p.x = o.x + 2000*t * d.x
h_p.y = o.y + 2000*t * d.y
h_p.z = o.z + 2000*t * d.z
' only one light on (100,100,0)
d1.x = h_p.x - 100
d1.y = h_p.y - 100
d1.z = h_p.z
a = d1.x*d1.x + d1.y*d1.y + d1.z*d1.z
For i = 0 To 10
b = 2 * (( 100 - spheres(i).position.x ) * d1.x _
+ ( 100 - spheres(i).position.y ) * d1.y _
+ ( 0 - spheres(i).position.z ) * d1.z )
c = spheres(i).r2 + 100^2+100^2+0^2 _
- 2 * (spheres(i).position.x * 100 _
+ spheres(i).position.y * 100 _
+ spheres(i).position.z * 0)
dis = b * b - 4 * a * c
If dis > 0 Then
root1 = ( -b - Sqr( dis ) ) / (2 * a)
root2 = ( -b + Sqr( dis ) ) / (2 * a)
If root1 > 0 And root2 < 1 Then
shadow = .05
Exit For
End If
End If
Next
Dim As Double ang
If shadow = 1 Then
Dim As t3d p
p.x = h_p.x - spheres(index).position.x
p.y = h_p.y - spheres(index).position.y
p.z = h_p.z - spheres(index).position.z
Dim As Double dot_prod = (p.x * d1.x + p.y * d1.y + p.z * d1.z)
If dot_prod < 0 Then
ang = -dot_prod _
/ Sqr((p.x ^ 2 + p.y ^ 2 + p.z ^ 2) * (d1.x ^ 2 + d1.y ^ 2 + d1.z ^ 2))
End If
End If
ang = ang * shadow
Return Type<tcolor> (spheres(index).kleur.red * ang , _
spheres(index).kleur.green * ang , _
spheres(index).kleur.blue * ang )
End Function
Function winner_index( a() As Double , tel As Integer ) As Integer
Dim As Integer i , f = -1
Dim As Double Min = -1
For i = 0 To tel
If min < a(i) Then
min = a(i)
f = i
End If
Next
Return f
End Function
Type tcamera
Public :
Dim As t3d position , direction , rechts , down
Declare Constructor( p As t3d , d As t3d , r As t3d , u As t3d )
End Type
Function range( low As Double , high As Double ) As Double
Return Rnd * ( high - low ) + low
End Function
'=======================================================
' change the 0 into a number <> 0 to see a litte test
' i made up to see if spheres would produce a shadow
#Define other 0
'=======================================================
Sub test
Dim As Integer winx , winy , wind
Screen 20 , 32
ScreenInfo winx , winy , wind
' Dim As tlight light
' light.position.x = 100
' light.position.y = 100
' light.position.z = 0
Dim As Integer i
Dim As t3d p , n
Dim As tcolor kleur
Dim As Double r ', angl
#If other = 0
For i = 0 To 10
p.fill range( -500.0 , 500.0 ) _
, range( -300.0 , 300.0 ) _
, range( 200.0 ,1000.0 )
r = range( 100.0 , 100.0 )
kleur = Type<tcolor>(Rnd +.3, Rnd+.3, Rnd+.3, 0.0 )
spheres( i ) = tsphere( p , r , kleur )
Next i
#Else
'=======================================================
' test to see if spheres cast a shadow
p.fill -100, 100, 100
r = 40
kleur = Type<tcolor>(1, 0, 0, 0)
spheres(0) = tsphere(p, r, kleur)
p.fill -100, -100, 200
r = 50
kleur = Type<tcolor>(0, 1, 0, 0)
spheres(1) = tsphere(p, r, kleur)
p.fill 100, 100, 300
r = 60
kleur = Type<tcolor>(0, 0, 1, 0)
spheres(2) = tsphere(p, r, kleur)
p.fill 100, -100, 400
r = 70
kleur = Type<tcolor>(1, 1, 1, 0)
spheres(3) = tsphere(p, r, kleur)
p.fill 0, 0, 10000
r = 9000
kleur = Type<tcolor>(.8, .8, .8, 0)
spheres(10) = tsphere(p, r, kleur)
'=======================================================
#EndIf
Dim As Double x, y
For x = -winx/2 To winx/2
For y = -winy/2 To winy/2
Dim As t3d o , d
o.fill x , y , 0
d.fill x / winx , y / winx , 1
kleur = hit_or_mis(o, d)
PSet( winx / 2 + x , winy / 2 - y ), kleur.toInt()
Next y
Next x
End Sub
Randomize timer
While Inkey() = ""
test
#If other = 0
Sleep 4000
#Else
Sleep
#EndIf
Wend
End
Regards
Re: RAY CASTING
@ frisian :
- your remark that angle was a error got me thinking
- my error was that i forgot to set the light.position
- i fixed that now
update :
- shadowing [ soort of ] added
error :
- the shadows lokk a litle strange
first i want to have shadowing right
then i going to think about reflection
i have some idea how to do that
adding planes and triangles is on my todo list
refraction is another problem
- your remark that angle was a error got me thinking
- my error was that i forgot to set the light.position
- i fixed that now
update :
- shadowing [ soort of ] added
error :
- the shadows lokk a litle strange
Code: Select all
''bluatigro
''raycater : start : 3 aug 2014
''update : shadow : 25 sept 2014
type t3d
public :
dim as double x , y , z
declare constructor (x as double = 0, y as double = 0, z as double = 0)
declare sub fill( x as double , y as double , z as double )
declare function dot( r as t3d ) as double
declare function ad( r as t3d ) as t3d
declare function cross( r as t3d ) as t3d
declare function angle( r as t3d ) as double
declare function length() as double
end type
constructor t3d( a as double , b as double , c as double )
x = a
y = b
z = c
end constructor
sub t3d.fill( a as double , b as double , c as double )
x = a
y = b
z = c
end sub
function t3d.dot( r as t3d ) as double
return x * r.x + y * r.y + z * r.z
end function
function t3d.ad( r as t3d ) as t3d
return type( x + r.x , y + r.y , z + r.z )
end function
function t3d.cross( r as t3d ) as t3d
return type( y * r.z - z * r.y _
, z * r.x - x * r.z _
, x * r.y - y * r.x )
end function
function t3d.angle( r as t3d ) as double
return acos( dot( r ) / ( length() * r.length() ) )
end function
function t3d.length() as double
return sqr( x ^ 2 + y ^ 2 + z ^ 2 )
end function
operator * ( l as t3d , f as double ) as t3d
return type( l.x * f , l.y * f , l.z * f )
end operator
operator -( r as t3d ) as t3d
return type( -r.x , -r.y , -r.z )
end operator
const as double pi = atn( 1 ) * 4
type tray
as t3d origin
as t3d direction
as double ODot
as double DDot
declare constructor(o as t3d, d as t3d)
end type
constructor tray(o as t3d, d as t3d)
origin = o
direction = d
ODot = origin.dot( origin )
DDot = direction.dot( direction )
end constructor
type tcolor
as double red , green , blue , special
declare constructor (r as double = 0.0, g as double = 0.0 , b as double = 0.0, s as double = 0.0)
declare function toInt() as integer
end type
constructor tcolor( r as double , g as double, b as double, s as double)
red = r : green = g : blue = b : special = s
end constructor
function tcolor.toInt() as integer
return rgb( red * 255 , green * 255 , blue * 255 )
end function
operator * ( kl as tColor , f as double ) as tColor
return type( kl.red * f , kl.green * f , kl.blue * f )
end operator
type tlight
as t3d position
as tcolor kleur
end type
''type tshape
''public :
'' dim kleur as tcolor
'' declare function getNormal( p as t3d ) as t3d
'' declare function hit( ray as tray ) as double
''end type
type tsphere ''( tshape )
as t3d position
as double PDot
as double radius,r2
as tcolor kleur
declare constructor ()
declare constructor ( p as t3d , r as double , kl as tcolor )
declare function getNormal( p as t3d ) as t3d
declare function hit( ray as tray ) as double
end type
constructor tsphere()
position = type<t3d>( 0.0 , 0.0 , 0.0 )
PDot = 0
radius = 100.0
r2 = radius * radius
kleur = type<tcolor>( 1.0 , 1.0 , 1.0 , 0.0 )
end constructor
constructor tsphere( p as t3d , r as double , kl as tcolor )
position = p
' pre caluculate position dot product
PDot = position.dot( position )
radius = r
' pre calculate radius squared
r2 = r * r
kleur = kl
end constructor
function tsphere.getNormal( p as t3d ) as t3d
return position.ad( -p )
end function
function tsphere.hit( ray as tray ) as double
dim as double L=Ray.DDot
If L = 0 Then return -1
dim as double M = 2 * Ray.Direction.X * (Ray.Origin.X-Position.X) _
+ 2 * Ray.Direction.Y * (Ray.Origin.Y-Position.Y) _
+ 2 * Ray.Direction.Z * (Ray.Origin.Z-Position.Z)
dim as double N = PDot + Ray.ODot
N = N - 2 * (Position.x*Ray.Origin.x + _
Position.y*Ray.Origin.y + _
Position.z*Ray.Origin.z) - R2
dim as double T = M * M - 4 * L * N
if (T<0) then return -1
L*=2
if (T=0) then
T = -M / L
if (T<=0) then
return -1
else
return T
end if
else ' two hit points
T=sqr(T)
dim as double T1 = (-M - t)/L
dim as double T2 = (-M + t)/L
If (T1 < 0.001) Then T1 = 0
If (T2 < 0.001) Then T2 = 0
' no hits
If (T1 = 0) And (T2 = 0) Then return -1
' both are ok
If (T1 > 0) And (T2 > 0) Then
If T1 < T2 Then
return T1
else
return T2
end if
Else ' one are ok
If (T1 > 0) Then
return T1
Else
return T2
end if
End If
End If
end function
type tcamera
public :
dim as t3d position , direction , rechts , down
declare constructor( p as t3d , d as t3d , r as t3d , u as t3d )
end type
function range( low as double , high as double ) as double
return rnd * ( high - low ) + low
end function
function winner_index( a() as double , tel as integer ) as integer
dim as integer found = -1 ,i
dim as double min = 1e13
for i = 0 to tel
if a( i ) > 0 then
if a( i ) < min then
min = a( i )
found = i
end if
end if
next
return found
end function
sub test
dim as integer winx , winy , wind
screeninfo winx , winy , wind
dim as tlight light
light.position.fill 0 , 100 , 0
dim as tsphere spheres( 10 )
dim as integer i , spheremax = 0
dim p as t3d , r as double , kl as tcolor
for i = 0 to 10
p = type<t3d>( range( -500.0 , 500.0 ) _
, range( -300.0 , 300.0 ) _
, range( 200.0 , 1000.0 ) )
r = range( 10 , 100 )
kl = type<tcolor>( rnd , rnd , rnd , 0.0 )
spheres(i)=type<tsphere>(p,r,kl)
next i
dim as double x , y , a( 10 ) , angle
for x = -winx/2 to winx/2
for y = -winy/2 to winy/2
dim as t3d o , d
o.fill x , y , 0.0
d.fill x / winx , y / winx , 1.0
dim as TRAY ray = TRAY( o , d )
for i = 0 to 10
a(i) = spheres(i).hit(ray)
next i
i = winner_index( a() , 10 )
if (i<0) then
pset( winx/2 + x , winy/2 - y ) , 0
else
dim as t3d p = ray.direction * ( 1 / ray.direction.length() ) * a( i )
angle = spheres(i).getNormal( p ).angle( light.position )
kl = spheres( i ).kleur
kl = kl * ( cos( angle * pi * 2 ) / 2 + 0.5 )
pset( winx/2 + x , winy/2 - y ) , kl.toInt()
end if
next
next
end sub
'
' main
'
screen 20 , 32
''randomize timer
''while inkey()=""
test
''wend
print "ready"
sleep
then i going to think about reflection
i have some idea how to do that
adding planes and triangles is on my todo list
refraction is another problem
Re: RAY CASTING
The light source isn't consistent.
Some spheres are lit from above, some from other directions??
Some spheres are lit from above, some from other directions??
Re: RAY CASTING
bluatigro
For shadow you need to check for objects that are between the point that is hit by the view ray and the light source. The code is similar to the code for checking if a sphere is hit by a view ray. If there's a object between that point and the light source the color of the sphere need to be made darker.
If a point is not in the shadow of a object then you need to calculate the angle between the line from the center of the sphere to the point that is hit and the line from that point to the light source. The formula for this returns the cosine of the angle. I needs to have a value of 1 if the angle is 0 deg. meaning that the light shines directly on that point. And it needs to near 0 if the angle is nears 90 deg. this means the light beam just hits the sphere. The formula you use for this is not correct.
if you drop acos in the formula
function t3d.angle( r as t3d ) as double
return acos( dot( r ) / ( length() * r.length() ) )
end function
Then you can simply alter this line kl = kl * ( cos( angle * pi * 2 ) / 2 + 0.5 ) to read kl = kl * angle .
Perhaps you need to change the sign of the angle.
Have a look at the last program I posted to get a idea how it done.
For shadow you need to check for objects that are between the point that is hit by the view ray and the light source. The code is similar to the code for checking if a sphere is hit by a view ray. If there's a object between that point and the light source the color of the sphere need to be made darker.
If a point is not in the shadow of a object then you need to calculate the angle between the line from the center of the sphere to the point that is hit and the line from that point to the light source. The formula for this returns the cosine of the angle. I needs to have a value of 1 if the angle is 0 deg. meaning that the light shines directly on that point. And it needs to near 0 if the angle is nears 90 deg. this means the light beam just hits the sphere. The formula you use for this is not correct.
if you drop acos in the formula
function t3d.angle( r as t3d ) as double
return acos( dot( r ) / ( length() * r.length() ) )
end function
Then you can simply alter this line kl = kl * ( cos( angle * pi * 2 ) / 2 + 0.5 ) to read kl = kl * angle .
Perhaps you need to change the sign of the angle.
Have a look at the last program I posted to get a idea how it done.
Re: RAY CASTING
@ frisian :
- i added your stuf
update :
- try at shading
- try at shadows
the result is not [ jet ] wat i want
todo [ furure ] :
- planes
- triangles
- reflection
- i added your stuf
update :
- try at shading
- try at shadows
the result is not [ jet ] wat i want
todo [ furure ] :
- planes
- triangles
- reflection
Code: Select all
''bluatigro
''raycaster : start : 3 aug 2014
''update : shading : 25 aug 2014
''update : shadow : 29 sept 2014
''future : planes and triangles
type t3d
public :
dim as double x , y , z
declare constructor (x as double = 0, y as double = 0, z as double = 0)
declare sub fill( x as double , y as double , z as double )
declare function dot( r as t3d ) as double
declare function ad( r as t3d ) as t3d
declare function cross( r as t3d ) as t3d
declare function angle( r as t3d ) as double
declare function length() as double
end type
constructor t3d( a as double , b as double , c as double )
x = a
y = b
z = c
end constructor
sub t3d.fill( a as double , b as double , c as double )
x = a
y = b
z = c
end sub
function t3d.dot( r as t3d ) as double
return x * r.x + y * r.y + z * r.z
end function
function t3d.ad( r as t3d ) as t3d
return type( x + r.x , y + r.y , z + r.z )
end function
function t3d.cross( r as t3d ) as t3d
return type( y * r.z - z * r.y _
, z * r.x - x * r.z _
, x * r.y - y * r.x )
end function
function t3d.angle( r as t3d ) as double
return ( dot( r ) / ( length() * r.length() ) )
end function
function t3d.length() as double
return sqr( x ^ 2 + y ^ 2 + z ^ 2 )
end function
operator * ( l as t3d , f as double ) as t3d
return type( l.x * f , l.y * f , l.z * f )
end operator
operator -( r as t3d ) as t3d
return type( -r.x , -r.y , -r.z )
end operator
const as double pi = atn( 1 ) * 4
type tray
as t3d origin
as t3d direction
as double ODot
as double DDot
declare constructor(o as t3d, d as t3d)
end type
constructor tray(o as t3d, d as t3d)
origin = o
direction = d
ODot = origin.dot( origin )
DDot = direction.dot( direction )
end constructor
type tcolor
as double red , green , blue , special
declare constructor (r as double = 0.0, g as double = 0.0 , b as double = 0.0, s as double = 0.0)
declare function toInt() as integer
end type
constructor tcolor( r as double , g as double, b as double, s as double)
red = r : green = g : blue = b : special = s
end constructor
function tcolor.toInt() as integer
return rgb( red * 255 , green * 255 , blue * 255 )
end function
operator * ( kl as tColor , f as double ) as tColor
return type( kl.red * f , kl.green * f , kl.blue * f )
end operator
type tlight
as t3d position
as tcolor kleur
end type
''type tshape
''public :
'' dim kleur as tcolor
'' declare function getNormal( p as t3d ) as t3d
'' declare function hit( ray as tray ) as double
''end type
type tsphere ''( tshape )
as t3d position
as double PDot
as double radius,r2
as tcolor kleur
declare constructor ()
declare constructor ( p as t3d , r as double , kl as tcolor )
declare function getNormal( p as t3d ) as t3d
declare function hit( ray as tray ) as double
end type
constructor tsphere()
position = type<t3d>( 0.0 , 0.0 , 0.0 )
PDot = 0
radius = 100.0
r2 = radius * radius
kleur = type<tcolor>( 1.0 , 1.0 , 1.0 , 0.0 )
end constructor
constructor tsphere( p as t3d , r as double , kl as tcolor )
position = p
' pre caluculate position dot product
PDot = position.dot( position )
radius = r
' pre calculate radius squared
r2 = r * r
kleur = kl
end constructor
function tsphere.getNormal( p as t3d ) as t3d
return position.ad( -p )
end function
function tsphere.hit( ray as tray ) as double
dim as double L=Ray.DDot
If L = 0 Then return -1
dim as double M = 2 * Ray.Direction.X * (Ray.Origin.X-Position.X) _
+ 2 * Ray.Direction.Y * (Ray.Origin.Y-Position.Y) _
+ 2 * Ray.Direction.Z * (Ray.Origin.Z-Position.Z)
dim as double N = PDot + Ray.ODot
N = N - 2 * (Position.x*Ray.Origin.x + _
Position.y*Ray.Origin.y + _
Position.z*Ray.Origin.z) - R2
dim as double T = M * M - 4 * L * N
if (T<0) then return -1
L*=2
if (T=0) then
T = -M / L
if (T<=0) then
return -1
else
return T
end if
else ' two hit points
T=sqr(T)
dim as double T1 = (-M - t)/L
dim as double T2 = (-M + t)/L
If (T1 < 0.001) Then T1 = 0
If (T2 < 0.001) Then T2 = 0
' no hits
If (T1 = 0) And (T2 = 0) Then return -1
' both are ok
If (T1 > 0) And (T2 > 0) Then
If T1 < T2 Then
return T1
else
return T2
end if
Else ' one are ok
If (T1 > 0) Then
return T1
Else
return T2
end if
End If
End If
end function
type tcamera
public :
dim as t3d position , direction , rechts , down
declare constructor( p as t3d , d as t3d , r as t3d , u as t3d )
end type
function range( low as double , high as double ) as double
return rnd * ( high - low ) + low
end function
function winner_index( a() as double , tel as integer ) as integer
dim as integer found = -1 ,i
dim as double min = 1e13
for i = 0 to tel
if a( i ) > 0 then
if a( i ) < min then
min = a( i )
found = i
end if
end if
next
return found
end function
sub test
dim as integer winx , winy , wind , spheremax
screeninfo winx , winy , wind
spheremax = 20
dim as tlight light
light.position.fill 0 , 100 , 0
dim as tsphere spheres( spheremax )
dim as integer i , j
dim p as t3d , r as double , kl as tcolor
for i = 0 to spheremax
p = type<t3d>( range( -500.0 , 500.0 ) _
, range( -300.0 , 300.0 ) _
, range( 200.0 , 1000.0 ) )
r = range( 10 , 100 )
kl = type<tcolor>( rnd , rnd , rnd , 0.0 )
spheres(i)=type<tsphere>(p,r,kl)
next i
dim as double x , y , a( spheremax ) , angle
for x = -winx/2 to winx/2
for y = -winy/2 to winy/2
dim as t3d o , d
o.fill x , y , 0.0
d.fill x / winx , y / winx , 1.0
dim as TRAY ray = TRAY( o , d )
for i = 0 to spheremax
a(i) = spheres(i).hit(ray)
next i
i = winner_index( a() , spheremax )
if (i<0) then
pset( winx/2 + x , winy/2 - y ) , 0
else
dim as t3d p = ray.direction * ( 1 / ray.direction.length() ) * a( i )
angle = spheres(i).getNormal( p ).angle( light.position )
kl = spheres( i ).kleur
kl = kl * angle * pi
ray = tray( p , light.position.ad( -p ) )
j = 0
for i = 0 to spheremax
if spheres(i).hit(ray) > 0 then j = 1
next i
if j then kl = kl * 0
pset( winx/2 + x , winy/2 - y ) , kl.toInt()
end if
next
next
end sub
'
' main
'
screen 20 , 32
randomize timer
while inkey()=""
test
wend
''print "ready"
''sleep