## RAY CASTING

General FreeBASIC programming questions.
bluatigro
Posts: 652
Joined: Apr 25, 2012 10:35
Location: netherlands

### RAY CASTING

this is a try at a ray-caster

i got a set of errors

i dont know what is the right way whit the errors

Code: Select all

`''bluatigro ''raycater strart : 3 aug 2014type t3dpublic :  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 t3dend type constructor t3d( a as double , b as double , c as double )  x = a  y = b  z = cend constructor sub t3d.fill( a as double , b as double , c as double )  x = a  y = b  z = cend sub function t3d.dot( r as t3d ) as double   return x * r.x + y * r.y + z * r.zend function function t3d.ad( r as t3d ) as t3d  return type( x + r.x , y + r.y , z + r.z )end functionfunction 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 operator -( r as t3d ) as t3d  return type( -r.x , -r.y , -r.z )end operator type traypublic :  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 = dend constructortype tcolorpublic :  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 integerend typeconstructor tcolor( r as double , g as double _, b as double , s as double )  red = r  green = g  blue = b  special = send constructorfunction tcolor.toInt() as integer  return rgb( red * 255 , green * 255 , blue * 255 )end functiontype tlightpublic :  dim position as t3d  dim kleur as tcolorend 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 typetype tsphere ''( tshape )  dim position as t3d  dim radius as double  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 doubleend typeconstructor tsphere()  position = type<t3d>( 0.0 , 0.0 , 0.0 )  radius = 100.0  kleur = type<tcolor>( 1.0 , 1.0 , 1.0 , 0.0 )end constructorconstructor tsphere( p as t3d , r as double , kl as tcolor )  position = p  radius = r  kleur = klend constructorfunction tsphere.getNormal( p as t3d ) as t3d  return position.ad( -p )end functionfunction 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  _    - ( radius * radius )    dim as double dis = b * b - 4 * a * c   if ( dis > 0.0 ) then    dim as double root1 = ( -b - sqr( dis ) ) / 2 - 1e-10    if ( root1 > 0.0 ) then      return root1     else       return ( -b + sqr( dis ) ) / 2 + 1e-10    end if  else     return -1   end ifend functiontype tcamerapublic :  dim as t3d position , direction , rechts , down  declare constructor( p as t3d , d as t3d , r as t3d , u as t3d )end typefunction range( low as double , high as double ) as double  return rnd * ( high - low ) + lowend functionfunction winner_index( a() as double , tel as integer ) as integer  if tel = 0 then return -1  if tel = 1 then     if a( 0 ) < 0 then      return -1    else      return 0    end if  else    dim as integer i , t , f    dim as double min = 1e13    t = 0    for i = 0 to tel      if min > a( i ) then        min = a( i )        t = t + 1        f = i      end if    next i    if t = 0 then      return -1    else      return f    end if  end ifend function      declare sub testtestsleependsub testdim as integer winx , winy , windscreen 20 , 32screeninfo winx , winy , winddim as tsphere spheres( 10 )dim as integer i , spheremax = 0for i = 0 to 10  spheres(i).position.x = range( -500.0 , 500.0 )  spheres(i).position.y = range( -300.0 , 300.0 )  spheres(i).position.z = range( 200.0 , 1000.0 )  spheres(i).radius = range( 10.0 , 200.0 )  spheres(i).kleur = type<tcolor>( rnd , rnd , rnd , 0.0 )next idim as double x , y , a( 10 ) 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( 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      pset( winx / 2 + x , winy / 2 - y ) _      , spheres( i ).kleur.toInt()    end if  next ynext xend sub `
fxm
Posts: 9994
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

### Re: RAY CASTING

 dim as tray ray = tray( o , d )
 i = winner_index( a() , 10 )
D.J.Peters
Posts: 8189
Joined: May 28, 2005 3:28
Contact:

### Re: RAY CASTING

To get it working I changed winner_index() and for speed tsphere.hit()
you can pre calculated for all spheres the position dot product (PDot) and Radius squared (R2)
and of course Ray.Origin dot product (ray.ODot) also.

Happy ray tracing :-)

Joshy

Code: Select all

`''bluatigro''raycater strart : 3 aug 2014type t3dpublic :  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 t3dend typeconstructor t3d( a as double , b as double , c as double )  x = a  y = b  z = cend constructorsub t3d.fill( a as double , b as double , c as double )  x = a  y = b  z = cend subfunction t3d.dot( r as t3d ) as double  return x * r.x + y * r.y + z * r.zend functionfunction t3d.ad( r as t3d ) as t3d  return type( x + r.x , y + r.y , z + r.z )end functionfunction 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 functionoperator -( r as t3d ) as t3d  return type( -r.x , -r.y , -r.z )end operatortype tray  as t3d origin  as t3d direction  as double ODot  as double DDot  declare constructor(o as t3d, d as t3d)end typeconstructor tray(o as t3d, d as t3d)  origin    = o  direction = d  ODot=origin.x*origin.x+origin.y*origin.y+origin.z*origin.z  DDot=Direction.x*Direction.x+Direction.y*Direction.y+Direction.z*Direction.zend constructortype 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 integerend typeconstructor tcolor( r as double , g as double, b as double, s as double)  red = r : green = g : blue = b : special = send constructorfunction tcolor.toInt() as integer  return rgb( red * 255 , green * 255 , blue * 255 )end functiontype tlight  as t3d    position  as tcolor kleurend 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 typetype 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 doubleend typeconstructor 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 constructorconstructor tsphere( p as t3d , r as double , kl as tcolor )  position = p  ' pre caluculate position dot product  PDot=position.x*position.x+ _       position.y*position.y+ _       position.z*position.z  radius = r  ' pre calculate radius squared  r2=r*r  kleur = klend constructorfunction tsphere.getNormal( p as t3d ) as t3d  return position.ad( -p )end functionfunction 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 Ifend functiontype tcamerapublic :  dim as t3d position , direction , rechts , down  declare constructor( p as t3d , d as t3d , r as t3d , u as t3d )end typefunction range( low as double , high as double ) as double  return rnd * ( high - low ) + lowend functionfunction 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 foundend functionsub test  dim as integer winx , winy , wind  screeninfo winx , winy , wind  dim as tsphere spheres( 10 )  dim as integer i , spheremax = 0  for i = 0 to 10    spheres(i).position.x = range( -500.0 , 500.0 )    spheres(i).position.y = range( -300.0 , 300.0 )    spheres(i).position.z = range( 200.0 , 1000.0 )    ' pre calculate position dot product    spheres(i).PDot=spheres(i).position.x*spheres(i).position.x _                   +spheres(i).position.y*spheres(i).position.y _                   +spheres(i).position.z*spheres(i).position.z    spheres(i).radius = range( 10.0 , 200.0 )    ' pre calculate radius squared    spheres(i).r2=spheres(i).radius*spheres(i).radius    spheres(i).kleur = type<tcolor>( rnd , rnd , rnd , 0.0 )  next i  dim as double x , y , a( 10 )    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        pset( winx/2 + x , winy/2 - y ) , spheres(i).kleur.toInt()      end if    next  nextend sub '' main'screen 20 , 32randomize timerwhile inkey()=""  testwend`
bluatigro
Posts: 652
Joined: Apr 25, 2012 10:35
Location: netherlands

### Re: RAY CASTING

@ fxm , d.j.peters :
- tanks for help

update :

error :
- my screen stays black

Code: Select all

`''bluatigro''raycater : start :  3 aug 2014''update : shadow  :  6 aug 2014type t3dpublic :  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 doubleend typeconstructor t3d( a as double , b as double , c as double )  x = a  y = b  z = cend constructorsub t3d.fill( a as double , b as double , c as double )  x = a  y = b  z = cend subfunction t3d.dot( r as t3d ) as double  return x * r.x + y * r.y + z * r.zend functionfunction t3d.ad( r as t3d ) as t3d  return type( x + r.x , y + r.y , z + r.z )end functionfunction 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 functionfunction t3d.angle( r as t3d ) as double  return acos( dot( r ) / ( length() * r.length() ) )end functionfunction t3d.length() as double  return sqr( x ^ 2 + y ^ 2 + z ^ 2 )end functionoperator * ( l as t3d , f as double ) as t3d  return type( l.x * f , l.y * f , l.z * f )end operatoroperator -( r as t3d ) as t3d  return type( -r.x , -r.y , -r.z )end operatortype tray  as t3d origin  as t3d direction  as double ODot  as double DDot  declare constructor(o as t3d, d as t3d)end typeconstructor tray(o as t3d, d as t3d)  origin    = o  direction = d  ODot=origin.x*origin.x+origin.y*origin.y+origin.z*origin.z  DDot=Direction.x*Direction.x+Direction.y*Direction.y+Direction.z*Direction.zend constructortype 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 integerend typeconstructor tcolor( r as double , g as double, b as double, s as double)  red = r : green = g : blue = b : special = send constructorfunction tcolor.toInt() as integer  return rgb( red * 255 , green * 255 , blue * 255 )end functionoperator * ( kl as tColor , f as double ) as tColor  return type( kl.red * f , kl.green * f , kl.blue * f )end operatortype tlight  as t3d    position  as tcolor kleurend 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 typetype 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 doubleend typeconstructor 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 constructorconstructor tsphere( p as t3d , r as double , kl as tcolor )  position = p  ' pre caluculate position dot product  PDot=position.x*position.x+ _       position.y*position.y+ _       position.z*position.z  radius = r  ' pre calculate radius squared  r2=r*r  kleur = klend constructorfunction tsphere.getNormal( p as t3d ) as t3d  return position.ad( -p )end functionfunction 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 Ifend functiontype tcamerapublic :  dim as t3d position , direction , rechts , down  declare constructor( p as t3d , d as t3d , r as t3d , u as t3d )end typefunction range( low as double , high as double ) as double  return rnd * ( high - low ) + lowend functionfunction 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 foundend functionsub 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  for i = 0 to 10    spheres(i).position.x = range( -500.0 , 500.0 )    spheres(i).position.y = range( -300.0 , 300.0 )    spheres(i).position.z = range( 200.0 , 1000.0 )    ' pre calculate position dot product    spheres(i).PDot=spheres(i).position.x*spheres(i).position.x _                   +spheres(i).position.y*spheres(i).position.y _                   +spheres(i).position.z*spheres(i).position.z    spheres(i).radius = range( 10.0 , 200.0 )    ' pre calculate radius squared    spheres(i).r2=spheres(i).radius*spheres(i).radius    spheres(i).kleur = type<tcolor>( rnd , rnd , rnd , 0.0 )  next i  dim as double x , y , a( 10 ) , angle  dim as tColor kl    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 ) / 2 + 0.5 )        pset( winx/2 + x , winy/2 - y ) , kl.toInt()      end if    next  nextend sub '' main'screen 20 , 32randomize timerwhile inkey()=""  testwend`
fxm
Posts: 9994
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

### Re: RAY CASTING

- At line:
 angle = spheres(i).getNormal( p ).angle( light.position )
'light.position' is never initialized.

- That induces a division by '0':
r.length() = light.position.length() = 0
in the method 't3d.angle()'.
dodicat
Posts: 6727
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: RAY CASTING

Here's my puny effort at shading spheres:

Code: Select all

` dim as integer xres,yresScreen 19,32screeninfo xres,yresDim As Any Ptr im=Imagecreate(800,600,Rgb(0,0,200))Type V3    As Single x,y,z    Declare Property length As Single    Declare Property unit As V3    #define map(a,b,x,c,d) ((d)-(c))*((x)-(a))\((b)-(a))+(c)End TypeOperator -(Byref v1 As v3,Byref v2 As v3) As v3Return Type<V3>(v1.x-v2.x,v1.y-v2.y,v1.z-v2.z)End OperatorOperator * (Byref v1 As v3,Byref v2 As v3) As Single 'dotReturn v1.x*v2.x+v1.y*v2.y+v1.z*v2.zEnd OperatorProperty v3.length As SingleReturn Sqr(x*x+y*y+z*z)End PropertyProperty v3.unit As v3Dim n As Single=Sqr(x*x+y*y+z*z)Return Type<V3>(x/n,y/n,z/n)End PropertyType sphere Extends V3    As Integer rEnd Type#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)#endmacroDim As V3 pDim As sphere s=Type<sphere>(400,300,0,200),s2=Type<sphere>(250,400,90,100)'to image fixed sphereFor x As Integer=s.x-s.r To s.x+s.r    For y As Integer=s.y-s.r To s.y+s.r        For z As Integer=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\2)                Var dist=(p-ctr).length                Dim As Integer cc=map(0,s.r,dist,250,50)                Pset im,(p.x,p.y),Rgb(cc,0,0)            End If        Next z    Next yNext x'=========================================================Dim As Integer kx=1,ky=1Var dirnx=(2+Rnd*5),dirny=(2+Rnd*5)Do    Screenlock    Cls    Put(0,0),im,Pset    S2.x+=dirnx*kx    S2.y+=dirny*ky    If s2.x>xres-s2.r Or  s2.x<s2.r Then kx=-kx    If s2.y>yres-s2.r Or  s2.y<s2.r Then ky=-ky        For x As Integer=s2.x-s2.r To s2.x+s2.r        For y As Integer=s2.y-s2.r To s2.y+s2.r            For z As Integer=s2.z To s2.z+s2.r                p=Type<V3>(x,y,z)                If onsphere(s2,p) Then                    If insphere(s,p)=0 Then                        Var diff=(Type<V3>(s.x,s.y,s.z)-Type<V3>(s2.x,s2.y,s2.z)).unit                        Var c=Type<V3>((s2.x-p.x)/s2.r,(s2.y-p.y)/s2.r,(s2.z-p.z)/s2.r)                        Var dot=c*diff                        Dim As Integer cc=map(1,-1,dot,50,250)                        Pset(p.x,p.y),Rgb(0,cc,0)                    End If                End If            Next z        Next y    Next x        Screenunlock    Sleep 1,1Loop Until Len(Inkey)imagedestroy imSleep`
dodicat
Posts: 6727
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: RAY CASTING

A bit sharper:

Code: Select all

` dim as integer xres,yresScreen 20,32screeninfo xres,yresDim As Any Ptr im=Imagecreate(xres,yres,Rgb(0,0,200))Type V3    As Single x,y,z    #define map(a,b,x,c,d) ((d)-(c))*((x)-(a))\((b)-(a))+(c)End TypeType sphere Extends V3    As Integer rEnd Type#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)#endmacroFunction Regulate(Byval MyFps As Integer,Byref fps As Integer) As Integer    Static As Double timervalue,lastsleeptime,t3,frames    Var t=Timer    frames+=1    If (t-t3)>=1 Then t3=t:fps=frames:frames=0    Var sleeptime=lastsleeptime+((1/myfps)-T+timervalue)*1000    If sleeptime<1 Then sleeptime=1    lastsleeptime=sleeptime    timervalue=T    Return sleeptimeEnd FunctionDim As V3 pDim As sphere s=Type<sphere>(400,300,0,200),s2=Type<sphere>(250,400,90,100),s3=type<sphere>(500,500,100,60)'to image fixed sphereFor x As Integer=s.x-s.r To s.x+s.r    For y As Integer=s.y-s.r To s.y+s.r        For z As Integer=s.z To s.z+s.r            p=Type<V3>(x,y,z)            If onsphere(s,p) Then                 var xx=(s.x-p.x)/s.r                Dim As Integer cc=map(-1,1,xx,250,50)                Pset im,(p.x,p.y),Rgb(cc,0,0)            End If        Next z    Next yNext x'mobile onesredim shared as V3 a(0),a1(0)For x As Integer=s2.x-s2.r To s2.x+s2.r        For y As Integer=s2.y-s2.r To s2.y+s2.r            For z As Integer=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      For x As Integer=s3.x-s3.r To s3.x+s3.r        For y As Integer=s3.y-s3.r To s3.y+s3.r            For z As Integer=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 kx=1,ky=1,kx1=1,ky1=-1,fpsVar dirnx=(4+Rnd*5),dirny=(4+Rnd*5),dirnx1=(4+Rnd*5),dirny1=(4+Rnd*5)Do    Screenlock    Cls    Put(0,0),im,Pset   draw string (20,20),"Framerate " & fps   'move the sphere centres and check edge boundaries        S2.x+=dirnx*kx        S2.y+=dirny*ky        If s2.x>xres-s2.r Or  s2.x<s2.r Then kx=-kx        If s2.y>yres-s2.r Or  s2.y<s2.r Then ky=-ky                S3.x+=dirnx1*kx1        S3.y+=dirny1*ky1        If s3.x>xres-s3.r Or  s3.x<s3.r Then kx1=-kx1        If s3.y>yres-s3.r Or  s3.y<s3.r Then ky1=-ky1            for n as integer=1 to ubound(a)'green one        'move all the sphere points        a(n).x+=dirnx*kx        a(n).y+=dirny*ky        If insphere(s,a(n))=0 Then            Var c=(s2.x-a(n).x)/s2.r            Dim As Integer cc=map(1,-1,c,50,250)            Pset(a(n).x,a(n).y),Rgb(0,cc,0)            end if        next n              for n as integer=1 to ubound(a1)'blue one          'move all the sphere points        a1(n).x+=dirnx1*kx1        a1(n).y+=dirny1*ky1        If insphere(s,a1(n))=0 and insphere(s2,a1(n))=0 Then            Var c=(s3.x-a1(n).x)/s3.r            Dim As Integer cc=map(1,-1,c,50,250)            Pset(a1(n).x,a1(n).y),Rgb(50,0,cc)            end if        next n          Screenunlock    Sleep regulate(40,fps),1Loop Until Len(Inkey)imagedestroy imSleep  `
dodicat
Posts: 6727
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: RAY CASTING

And my final:

Code: Select all

`Dim As Integer xres,yres,pitchScreeninfo xres,yresScreenres xres,yres,32,,1Dim As Any Ptr row=ScreenptrDim As Uinteger Ptr pixelScreeninfo xres,yres,,,pitchDim As Any Ptr im=Imagecreate(xres,yres,Rgb(0,0,200))Type V3    As Integer x,y,z    As Uinteger col    #define map(a,b,x,c,d) ((d)-(c))*((x)-(a))\((b)-(a))+(c)End TypeType sphere Extends V3    As Single dx,dy,dz    As Integer r    As Any Ptr imageEnd Type#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#macro blue()#ifdef __FB_WIN32__Declare Function ScaleWindow Alias "MoveWindow"(As Any Ptr,As Integer=0,As Integer=0,As Integer,As Integer,As Integer=1) As Integerscope    dim as string s,t    #macro rd(a)    s=string(ubound(a)," ")    for n as integer=1 to ubound(a)        s[n-1]=a(n)    next n    t+=s    #endmacro    screen 0dim as integer desktopW,desktopH,xres,yresscreeninfo desktopW,desktopHscreenres DesktopW/1.8,DesktopH/1.8,32,,64 or 8color rgb(200,200,200),rgb(0,0,200)clsscreeninfo xres,yreswidth xres\8,yres\16Dim As Integer IScreencontrol(2,I)ScaleWindow(Cast(Any Ptr,I),0,0,desktopW,desktopH)dim as ubyte a1(1 to 68)={65,32,102,97,116,97,108,32,101,120,99,101,112,116,105,111,110,32,79,69,32,104,97,_115,32,111,99,99,117,114,114,101,100,32,97,116,32,48,48,50,56,58,67,48,48,49,49,_69,51,54,32,105,110,32,86,88,68,32,86,77,77,40,48,49,41,32,43,10}dim as ubyte a2(1 to 58) ={32,32,32,32,48,48,48,49,48,69,51,54,46,32,84,104,101,32,99,117,114,114,101,110,116,32,97,112,_112,108,105,99,97,116,105,111,110,32,119,105,108,108,32,98,101,32,116,101,114,109,_105,110,97,116,101,100,46,10}dim as ubyte a3(1 to 2)= {10,10}dim as ubyte a4(1 to 57)= {32,32,32,32,42,32,80,114,101,115,115,32,97,110,121,32,107,101,121,32,116,111,32,_116,101,114,109,105,110,97,116,101,32,116,104,101,32,99,117,114,114,101,110,116,_32,97,112,112,108,105,99,97,116,105,111,110,10}dim as ubyte a5(1 to 69)= {32,32,32,32,42,32,80,114,101,115,115,32,67,84,82,76,32,43,32,65,76,84,32,43,32,68,_69,76,32,97,103,97,105,110,32,116,111,32,114,101,115,116,97,114,116,32,121,111,_117,114,32,99,111,109,112,117,116,101,114,46,89,111,117,32,119,105,108,108,10}dim as ubyte a6(1 to 56)= { 32,32,32,32,32,32,108,111,111,115,101,32,97,110,121,32,117,110,115,97,118,101,100,_32,105,110,102,111,114,109,97,116,105,111,110,32,105,110,32,97,108,108,32,97,112,_112,108,105,99,97,116,105,111,110,115,46}dim as ubyte a7(1 to 2)= {10,10}dim as ubyte a8(1 to 56)= { 32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,_80,114,101,115,115,32,97,110,121,32,107,101,121,32,116,111,32,99,111,110,116,105,_110,117,101,32,95} rd(a1):rd(a2):rd(a3):rd(a4):rd(a5):rd(a6):rd(a7):rd(a8)locate 10,5print tsleepend scope#endif #endmacro   Function Regulate(Byval MyFps As Integer,Byref fps As Integer) As Integer    Static As Double timervalue,lastsleeptime,t3,frames    Var t=Timer    frames+=1    If (t-t3)>=1 Then t3=t:fps=frames:frames=0    Var sleeptime=lastsleeptime+((1/myfps)-T+timervalue)*1000    If sleeptime<1 Then sleeptime=1    lastsleeptime=sleeptime    timervalue=T    Return sleeptimeEnd FunctionDim As V3 pDim As sphere s=Type<sphere>(200,200,0,0,(2+Rnd*3),(2+Rnd*3),0,200), _s2=Type<sphere>(250,400,90,0,(3+Rnd*2),(3+Rnd*2),0,100), _s3=Type<sphere>(500,500,100,0,(4+Rnd*5),(4+Rnd*5),0,80)'60s.image=Imagecreate(2*s.r,2*s.r)'background         For n As Integer=0 To xres    Dim As Integer rr=map(0,xres,n,0,100)    Dim As Integer gg=map(0,xres,n,0,100)    Line im,(n,0)-(n,yres),Rgb(rr,gg,255)Next n'to image red sphereFor x As Integer=s.x-s.r To s.x+s.r    For y As Integer=s.y-s.r To s.y+s.r        For z As Integer=s.z To s.z+s.r            p=Type<V3>(x,y,z)            If onsphere(s,p) Then                 Var xx=(s.x-p.x)/s.r                Dim As Integer cc=map(-1,1,xx,250,50)                Pset s.image,(p.x,p.y),Rgb(cc,0,0)            End If        Next z    Next yNext x'mobile onesRedim Shared As V3 a(0),a1(0)For x As Integer=s2.x-s2.r To s2.x+s2.r    For y As Integer=s2.y-s2.r To s2.y+s2.r        For z As Integer=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)                Var c=(s2.x-a(Ubound(a)).x)/s2.r                Dim As Integer cc=map(1,-1,c,50,250)                a(Ubound(a)).col=Rgb(0,cc,0)            End If        Next z    Next yNext xFor x As Integer=s3.x-s3.r To s3.x+s3.r    For y As Integer=s3.y-s3.r To s3.y+s3.r        For z As Integer=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)                Var c=(s3.x-a1(Ubound(a1)).x)/s3.r                Dim As Integer cc=map(1,-1,c,50,250)                a1(Ubound(a1)).col=Rgb(50,0,cc)            End If        Next z    Next yNext x  '=========================================================Dim As Integer fpsDo    Screenlock    Cls    'move the red 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(0,0),im,Pset    Put(s.x-s.r,s.y-s.r),s.image,trans        Draw String (20,20),"Framerate " & fps    'move the 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        For n As Integer=1 To Ubound(a)'green one        'move all the sphere points        a(n).x+=S2.dx        a(n).y+=S2.dy        If insphere(s,a(n))=0 Then            If onscreen(a(n).x,a(n).y) Then                ppset(a(n).x,a(n).y,a(n).col)            End If        End If    Next n        For n As Integer=1 To Ubound(a1)'blue one        'move all the sphere points        a1(n).x+=S3.dx        a1(n).y+=S3.dy        If insphere(s,a1(n))=0 And insphere(s2,a1(n))=0 Then            If onscreen(a1(n).x,a1(n).y) Then                ppset(a1(n).x,a1(n).y,a1(n).col)            End If        End If            Next n          Screenunlock    Sleep regulate(40,fps),1Loop Until Len(Inkey)blue()Imagedestroy s.imageImagedestroy imSleep  `
BasicCoder2
Posts: 3598
Joined: Jan 01, 2009 7:03
Location: Australia

### Re: RAY CASTING

@dodicat
Will just have to wait until I update to the latest FreeBasic as all I get are compiler errors starting with,
Syntax error, found 'Extends' in 'Type sphere Extends V3'
dodicat
Posts: 6727
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: RAY CASTING

Hi BasicCoder2.

Extends is OK with version .90 or even version 0.24.0
BasicCoder2
Posts: 3598
Joined: Jan 01, 2009 7:03
Location: Australia

### Re: RAY CASTING

dodicat wrote:Hi BasicCoder2.

Extends is OK with version .90 or even version 0.24.0

@dodicat
As I haven't gotten around to learning to use the more advanced programming techniques I only need the later versions to run other people's code. I appear to have Version 0.23.0 at the moment.
dodicat
Posts: 6727
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: RAY CASTING

Thanks BasicCoder2.

Mind you, I think you should update.

You post quite a lot of code, and in your own words, you prefer to use basic methods, and they work well.
I have borrowed some of your techniques, for instance, moving a screen with the mouse, and some of your direct pixel routines.

Plus the fact that using version .91 you may come across some bugs.

Here is the previous code without extends and using lang fb or fblite.
I don't have version 23 any more, but fingers crossed.

By the way, the demo is absolutely stupid, just a joke really. bluatigro didn't fix his code, so I just made some stuff up.

Code: Select all

` '#lang "fblite"Dim As Integer xres,yres,pitchScreeninfo xres,yresScreenres xres,yres,32,,1Dim As Any Ptr row=ScreenptrDim As Uinteger Ptr pixelScreeninfo xres,yres,,,pitchDim As Any Ptr im=Imagecreate(xres,yres,Rgb(0,0,200))Type V3    As Integer x,y,z    As Uinteger col    #define map(a,b,x,c,d) ((d)-(c))*((x)-(a))\((b)-(a))+(c)End TypeType sphere     As Integer x,y,z    As Single dx,dy,dz    As Integer r    As Any Ptr imageEnd Type#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-1Function 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 sleeptimeEnd FunctionDim As V3 pDim As sphere s=Type<sphere>(200,200,0,(2+Rnd*3),(2+Rnd*3),0,200), _s2=Type<sphere>(250,400,90,(3+Rnd*2),(3+Rnd*2),0,100), _s3=Type<sphere>(500,500,100,(4+Rnd*5),(4+Rnd*5),0,80)'60s.image=Imagecreate(2*s.r,2*s.r)dim as integer x,y,z,ndim as single c,cc'background         For n =0 To xres    Dim As Integer rr=map(0,xres,n,0,100)    Dim As Integer gg=map(0,xres,n,0,100)    Line im,(n,0)-(n,yres),Rgb(rr,gg,255)Next n'to image red sphereFor 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 single xx=(s.x-p.x)/s.r                cc=map(-1,1,xx,250,50)                Pset s.image,(p.x,p.y),Rgb(cc,0,0)            End If        Next z    Next yNext x'mobile onesRedim Shared As V3 a(0),a1(0)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)                 c=(s2.x-a(Ubound(a)).x)/s2.r                cc=map(1,-1,c,50,250)                a(Ubound(a)).col=Rgb(0,cc,0)            End If        Next z    Next yNext xFor 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)                c=(s3.x-a1(Ubound(a1)).x)/s3.r                 cc=map(1,-1,c,50,250)                a1(Ubound(a1)).col=Rgb(50,0,cc)            End If        Next z    Next yNext x  '=========================================================Dim As Integer fpsDo    Screenlock    Cls    'move the red 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(0,0),im,Pset    Put(s.x-s.r,s.y-s.r),s.image,trans        Draw String (20,20),"Framerate " & fps    'move the 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        For n =1 To Ubound(a)'green one        'move all the sphere points        a(n).x+=S2.dx        a(n).y+=S2.dy        If insphere(s,a(n))=0 Then            If onscreen(a(n).x,a(n).y) Then                ppset(a(n).x,a(n).y,a(n).col)            End If        End If    Next n        For n =1 To Ubound(a1)'blue one        'move all the sphere points        a1(n).x+=S3.dx        a1(n).y+=S3.dy        If insphere(s,a1(n))=0 And insphere(s2,a1(n))=0 Then            If onscreen(a1(n).x,a1(n).y) Then                ppset(a1(n).x,a1(n).y,a1(n).col)            End If        End If            Next n          Screenunlock    Sleep regulate(40,fps),1Loop Until Len(Inkey)Imagedestroy s.imageImagedestroy imSleep  `
BasicCoder2
Posts: 3598
Joined: Jan 01, 2009 7:03
Location: Australia

### Re: RAY CASTING

dodicat wrote:You post quite a lot of code, and in your own words, you prefer to use basic methods, and they work well.
I have borrowed some of your techniques, for instance, moving a screen with the mouse, and some of your direct pixel routines.

Your code ran ok with the last version. Reminds me of those molecular models.
If I used a direct pixel routine it would have been written by someone else.
Last edited by BasicCoder2 on Sep 09, 2014 7:41, edited 1 time in total.
Roland Chastain
Posts: 948
Joined: Nov 24, 2011 19:49
Location: France
Contact:

### Re: RAY CASTING

Very nice effect, dodicat.
bluatigro
Posts: 652
Joined: Apr 25, 2012 10:35
Location: netherlands

### Re: RAY CASTING

update :

error :
- i get only 1 sphere whit a color background
`''bluatigro ''raycater strart : 3 aug 2014type t3dpublic :  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 doubleend type constructor t3d( a as double , b as double , c as double )  x = a  y = b  z = cend constructor sub t3d.fill( a as double , b as double , c as double )  x = a  y = b  z = cend sub function dot( l as t3d , r as t3d ) as double   return l.x * r.x + l.y * r.y + l.z * r.zend 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 functionfunction angle( l as t3d , r as t3d ) as double  return dot( l , r ) / ( l.length() * r.length() )end functionoperator + ( l as t3d , r as t3d ) as t3d  return type( l.x + r.x , l.y + r.y , l.z + r.z )end operatoroperator * ( q as t3d , d as double ) as t3d  return type( q.x * d , q.y * d , q.z * d )end operatoroperator - ( r as t3d ) as t3d  return type( -r.x , -r.y , -r.z )end operator type traypublic :  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 = dend constructortype tcolorpublic :  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 integerend typeconstructor tcolor( r as double , g as double _, b as double , s as double )  red = r  green = g  blue = b  special = send constructorfunction tcolor.toInt() as integer  return rgb( red * 255 , green * 255 , blue * 255 )end functionoperator * ( kl as tcolor , d as double ) as tcolor  return type( kl.red * d , kl.green * d , kl.blue * d )end operatortype tlightpublic :  dim position as t3d  dim kleur as tcolor  declare constructor()end typeconstructor 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 typetype 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 doubleend typeconstructor tsphere()  position = type<t3d>( 0.0 , 0.0 , 0.0 )  radius = 100.0  r2 = radius ^ 2  kleur = type<tcolor>( 1.0 , 1.0 , 1.0 , 0.0 )end constructorconstructor tsphere( p as t3d , r as double , kl as tcolor )  position = p  radius = r  r2 = radius ^ 2  kleur = klend constructorfunction tsphere.getNormal( p as t3d ) as t3d  return position + ( -p )end functionfunction 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 double dis = b * b - 4 * a * c   if ( dis > 0.0 ) then    dim as double root1 = ( -b - sqr( dis ) ) / 2 - 1e-10    if ( root1 > 0.0 ) then      return root1     else       return ( -b + sqr( dis ) ) / 2 + 1e-10    end if  else     return -1   end ifend functiontype tcamerapublic :  dim as t3d position , direction , rechts , down  declare constructor( p as t3d , d as t3d , r as t3d , u as t3d )end typefunction range( low as double , high as double ) as double  return rnd * ( high - low ) + lowend functionfunction winner_index( a() as double , tel as integer ) as integer  if tel = 0 then return -1  if tel = 1 then     if a( 0 ) < 0 then      return -1    else      return 0    end if  else    dim as integer i , t , f    dim as double min = 1e13    t = 0    for i = 0 to tel      if min > a( i ) then        min = a( i )        t = t + 1        f = i      end if    next i    if t = 0 then      return -1    else      return f    end if  end ifend function      sub test  dim as integer winx , winy , wind  screen 20 , 32  screeninfo winx , winy , wind  dim as tlight light  dim as tsphere spheres( 10 )  dim as integer i , spheremax = 0  dim as t3d p , n  dim as tcolor kleur   dim as double r , angl  for i = 0 to 10    p.fill range( -500.0 , 500.0 ) _         , range( -300.0 , 300.0 ) _         , range( 200.0 , 1000.0 )    r = range( 10.0 , 10.0 )    kleur = type<tcolor>( rnd , rnd , rnd , 0.0 )    spheres( i ) = tsphere( p , r , kleur )  next i  dim as double x , y , a( 10 )   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        kleur = spheres( i ).kleur        p = ray.origin + ray.direction _        * ( a(i) / ray.direction.length() )        angl = angle( spheres(i).getNormal( p ) , light.position )        kleur = kleur * ( cos( angl ) / 2 + .5 )         pset( winx / 2 + x , winy / 2 - y ) _        , kleur.toInt()      end if    next y  next xend sub while inkey() = ""  test  sleep 1000wendend `