RAY CASTING

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

Re: RAY CASTING

Postby fxm » Sep 13, 2014 16:47

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

Re: RAY CASTING

Postby dodicat » Sep 14, 2014 0:36

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,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



 
frisian
Posts: 249
Joined: Oct 08, 2009 17:25

Re: RAY CASTING

Postby frisian » Sep 14, 2014 15:25

bluatigro wrote:update :
- try at shading

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


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


Can't help you with the shading, have no clue how that's done.
dodicat
Posts: 6728
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: RAY CASTING

Postby dodicat » Sep 14, 2014 16:00

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

Postby bluatigro » Sep 23, 2014 13:03

update :
- 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
frisian
Posts: 249
Joined: Oct 08, 2009 17:25

Re: RAY CASTING

Postby frisian » Sep 23, 2014 18:46

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.

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


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

Postby bluatigro » Sep 24, 2014 12:03

@ 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

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

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

Postby dodicat » Sep 24, 2014 13:05

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

Postby frisian » Sep 24, 2014 19:08

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

Postby bluatigro » Sep 29, 2014 10:04

@ 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

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

Return to “General”

Who is online

Users browsing this forum: No registered users and 8 guests