## RAY CASTING

General FreeBASIC programming questions.
fxm
Posts: 9997
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

### Re: RAY CASTING

??? :
kleur = type<tcolor>( rnd , rnd , rnd , 0.0 )
dodicat
Posts: 6728
Joined: Jan 10, 2006 20:30
Location: Scotland

### 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.

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(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 TypeType sphere     As Single x,y,z    As Single dx,dy,dz    As Integer r    As Any Ptr imageEnd 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 OperatorFunction v3.length As Single    Return Sqr(x*x+y*y+z*z)End FunctionFunction 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-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>(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 variablesDim As Integer x,y,z,n,rd,gr,bl,max=Sqr(xres^2+yres^2),cc,distDim As V3 sctr=Type<V3>(xres,yres,0)'backgroundFor 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 yNext x'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 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 yNext x'mobile spheres, set into arraysRedim Shared As V3 a(0),a1(0)'greenFor 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 yNext x'blueFor 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 yNext x  '=========================================================Dim As Integer fpsDim As Single dot,dt,f1=1,f2=1,dist1,dist2Dim As V3 diff,cdim as V3 d1,d2Do    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),1Loop Until Len(Inkey)Imagedestroy s.imageImagedestroy imSleep `
frisian
Posts: 249
Joined: Oct 08, 2009 17:25

### Re: RAY CASTING

bluatigro wrote:update :

error :
- i get only 1 sphere whit a color background

To make the spheres visible replace Function tsphere.hit and Function winner_index with these two new routines.

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 IfEnd FunctionFunction 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 fEnd Function`

dodicat
Posts: 6728
Joined: Jan 10, 2006 20:30
Location: Scotland

### 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.
bluatigro
Posts: 652
Joined: Apr 25, 2012 10:35
Location: netherlands

### Re: RAY CASTING

update :

error :
- now i get a black screen

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 operatorconst as double pi = atn( 1 ) * 4type 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.dot( origin )  DDot = direction.dot( direction )end 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.dot( position )  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  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  nextend sub '' main'screen 20 , 32randomize timer''while inkey()=""  test''wendprint "ready"sleep `
frisian
Posts: 249
Joined: Oct 08, 2009 17:25

### Re: RAY CASTING

bluatigro

A little lesson in finding a errors.

The error is one which I have seen is one you made before.
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 workType 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 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 dot( l As t3d , r As t3d ) As Double  Return l.x * r.x + l.y * r.y + l.z * r.zEnd FunctionFunction 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 FunctionFunction 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 OperatorType tray  Public :  Dim As t3d origin , direction  Declare Constructor( o As t3d , d As t3d )End TypeConstructor tray( o As t3d , d As t3d )  origin = o  direction = dEnd ConstructorType 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 IntegerEnd TypeConstructor 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 = sEnd ConstructorFunction 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 FunctionOperator * ( kl As tcolor , d As Double ) As tcolor  Return Type( kl.red * d , kl.green * d , kl.blue * d )End OperatorType tlight  Public :  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 = 0.0  r2 = 0  ' (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 = p.x^2 + p.y^2 + p.z^2 -(radius ^ 2)   ' ###  kleur = klEnd ConstructorFunction tsphere.getNormal( p As t3d ) As t3d  Return position + ( -p )End FunctionDim 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 -1End FunctionFunction 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 FunctionFunction 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 fEnd FunctionType tcamera  Public :  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 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 xEnd SubRandomize timerWhile Inkey() = ""  test    #If other = 0    Sleep 4000  #Else    Sleep    #EndIfWendEnd`

Maybe the code gives you a clue where yours goes wrong.

Regards
bluatigro
Posts: 652
Joined: Apr 25, 2012 10:35
Location: netherlands

### 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 :

error :
- the shadows lokk a litle strange

Code: Select all

`''bluatigro''raycater : start :  3 aug 2014''update : shadow  :  25 sept 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 operatorconst as double pi = atn( 1 ) * 4type 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.dot( origin )  DDot = direction.dot( direction )end 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.dot( position )  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  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  nextend sub '' main'screen 20 , 32''randomize timer''while inkey()=""  test''wendprint "ready"sleep `

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
dodicat
Posts: 6728
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: RAY CASTING

The light source isn't consistent.
Some spheres are lit from above, some from other directions??
frisian
Posts: 249
Joined: Oct 08, 2009 17:25

### 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.
bluatigro
Posts: 652
Joined: Apr 25, 2012 10:35
Location: netherlands

### Re: RAY CASTING

@ frisian :

update :

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 trianglestype 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 ( 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 operatorconst as double pi = atn( 1 ) * 4type 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.dot( origin )  DDot = direction.dot( direction )end 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.dot( position )  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 , 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  nextend sub '' main'screen 20 , 32randomize timerwhile inkey()=""  testwend''print "ready"''sleep `