ray casting

Algemene discussies en vragen omtrent Liberty BASIC programma's. Stuur zoveel mogelijk delen van listings (snippets) in als je hulp wilt.

Moderators: anthonio, Abcott

ray casting

Berichtdoor bluatigro » wo jul 02, 2014 12:35 pm

ik ben hier al n tijdje me bezig
bollen werken : maar niet goed
driehoeken werken helemaal niet
Code: Selecteer alles
''bluatigro 10-may-2014
''raytracer 3.0

WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , pi , cube
winx = WindowWidth
winy = WindowHeight
pi = atn( 1 ) * 4
cube = 100
global gray , red , green , yellow , dgray
global blue , magenta , cyan , white , black
gray = rgb( 127 , 127 , 127 )
dgray = rgb( 63 , 63 , 63  )
red = rgb( 255 , 0 , 0 )
green = rgb( 0 , 255 , 0 )
yellow = rgb( 255 , 255 , 0 )
blue = rgb( 0 , 0 , 255 )
magenta = rgb( 255 , 0 , 255 )
cyan = rgb( 0 , 255 , 255 )
white = rgb( 255 , 255 , 255 )
global spheremax , spheretel
spheremax = 200
dim sp( spheremax , 5 ) , l(2,2)
global  tx,ty,tz  , td , tkl , tr
ty = 1
tz = 2
td = 3
tkl = 4
tr = 5
global tx1,ty1,tz1,tx2,ty2,tz2,tx3,ty3,tz3,tritel,trimax
trimax = 200
ty1 = 1
tz1 = 2
tx2 = 3
ty2 = 6
tz2 = 7
tx3 = 8
ty3 = 9
tz3 = 10
dim tri( trimax , 10 )
''       sphere   x     y    z    d reflect kl
test = 4
testlight = 0
select case test
  case 1
    call sphere -50 , 0 , 55 , 50 , .5 , cyan
    call sphere  50 , 0 , 55 , 50 , .5 , yellow
  case 2
    call sphere  60 , -40 , 25 , 20 , 0 , red or dgray
    call sphere   0 ,  60 , 25 , 20 , 0 , green or dgray
    call sphere -60 , -40 , 25 , 20 , 0 , blue or dgray
    call sphere  60 ,  40 , 25 , 20 , 0 , yellow or dgray
    call sphere   0 , -60 , 25 , 20 , 0 , magenta or dgray
    call sphere -60 ,  40 , 25 , 20 , 0 , cyan or dgray
    call sphere   0 ,   0 , 23 , 20 , .5 , gray
  case 3
    call sphere 0 , 0 , 150 , 100 , 0 , white
  case 4
    call tri -100,0,0 , 86,50,0 , -86,50,0 , 0 , red
  case else
    for i = 0 to 10
      x = range( -100 , 100 )
      y = range( -100 , 100 )
      z = range( 50 , 150 )
      d = range( 10 , 50 )
      r = rnd(0)
      call sphere x , y , z , d , r , klrnd()
    next i
end select
''     light no    x     y    z
if testlight then
  call light 0 ,   0 , 1000 , 0  ''redlight
  call light 1 ,   0 , 1000 , 0  ''greenlight
  call light 2 ,   0 , 1000 , 0  ''bluelight
else
  call light 0 , -500 , -866 , 1000  ''redlight
  call light 1 ,    0 , 1000 , 1000  ''greenlight
  call light 2 ,  500 , -866 , 1000  ''bluelight
end if


nomainwin
open "Ray Trace 3.0.2" for graphics as #m
  #m "trapclose [quit]"
  #m "down"
  z = 1
  for x = -100 to 100
    for y = -100 to 100
      dx = x/200
      dy = y/200
      dz = 1
      kl = ray(  x,y,z  ,  dx,dy,dz  , 2 )
      call point  x+winx/2,winy/2-y  , kl
    next y
  next x
  notice "ready ."
wait
[quit]
  close #m
end
function range( l , h )
  range = rnd(0) * ( h - l ) + l
end function
''ray trace & help functions
sub point  x,y  , kl
  r = klred( kl )
  g = klgreen( kl )
  b = klblue( kl )
  #m "color ";r;" ";g;" ";b
  #m "set ";x;" ";y
end sub
function ray(  x,y,z  ,  dx,dy,dz  , diep )
  scan
  done = 0
  tel = 0
  colortri = black
  colorsphere = black
  distsphere = 1e13
  disttri = 1e13
  if diep > 0 then
    for i = 0 to spheretel
      if spherehit( i ,  x,y,z  ,  dx,dy,dz ) then
        dist = spheredist( i , x,y,z , dx,dy,dz )
        done = 1
        if dist < distsphere then
          distsphere = dist
          colorsphere = sp(i,tkl)
        end if
      end if
    next i
    for i = 0 to tritel
      if trihit( i , x,y,z , dx,dy,dz , dist ) then
        done = 1
        if dist < disttri then
          disttri = dist
          colortri = tri(i,tkl)
          trino = i
        end if
      end if
    next i
    if done then
      if distsphere < disttri then
      l = lenght(  dx,dy,dz  )
      x = ( dx - x ) / l * distsphere
      y = ( dy - y ) / l * distsphere
      z = ( dz - z ) / l * distsphere
      nx = sp(no,tx) - x
      ny = sp(no,ty) - y
      nz = sp(no,tz) - z
      ra = angle(  nx,ny,nz  ,  l(0,tx),l(0,ty),l(0,tz)  )
      ga = angle(  nx,ny,nz  ,  l(1,tx),l(1,ty),l(1,tz)  )
      ba = angle(  nx,ny,nz  ,  l(2,tx),l(2,ty),l(2,tz)  )
      r = cos( ra ) / 2 + .5
      g = cos( ga ) / 2 + .5
      b = cos( ba ) / 2 + .5
      color = klshade( colorsphere ,  r,g,b  )
      if sp(no,tr) > 0  then
        call mirror  dx,dy,dz  ,  nx,ny,nz
        color2 = ray(  x,y,z  ,  dx,dy,dz  , diep - 1 )
        color = klmix(color,sp(no,tr),color2)
      end if
      else
        e1x = tri( trino , tx2 ) - tri( trino , tx1 )
        e1y = tri( trino , ty2 ) - tri( trino , ty1 )
        e1z = tri( trino , tz2 ) - tri( trino , tz1 )
        e2x = tri( trino , tx3 ) - tri( trino , tx1 )
        e2y = tri( trino , ty3 ) - tri( trino , ty1 )
        e2z = tri( trino , tz3 ) - tri( trino , tz1 )
        call cros e1x,e1y,e1z , e2x,e2y,e2z , nx,ny,nz
        ra = angle(  nx,ny,nz  ,  l(0,tx),l(0,ty),l(0,tz)  )
        ga = angle(  nx,ny,nz  ,  l(1,tx),l(1,ty),l(1,tz)  )
        ba = angle(  nx,ny,nz  ,  l(2,tx),l(2,ty),l(2,tz)  )
        r = cos( ra ) / 2 + .5
        g = cos( ga ) / 2 + .5
        b = cos( ba ) / 2 + .5
        color = klshade( colortri ,  r,g,b  )
        if sp(no,tr) > 0  then
          call mirror  dx,dy,dz  ,  nx,ny,nz
          color2 = ray(  x,y,z  ,  dx,dy,dz  , diep - 1 )
          color = klmix(color,sp(no,tr),color2)
        end if
      end if
    end if
  end if
  ray = color
end function
function angle(  x,y,z  ,  lx,ly,lz  )
  l = lenght(  x,y,z  )
  ll = lenght(  lx,ly,lz  )
  dt = dot(  x,y,z  ,  lx,ly,lz  )
  angle = acs( dt / ( l * ll ) )
end function
function lenght(  x,y,z  )
  lenght = sqr( x ^ 2 + y ^ 2 + z ^ 2 )
end function
function dot(  x1,y1,z1  ,   x2,y2,z2  )
  dot = x1*x2 + y1*y2 + z1*z2
end function
sub cros x1,y1,z1  ,  x2,y2,z2 , byref nx , byref ny , byref nz
  nx = y1*z2 - z1*y2
  ny = z1*x2 - x1*z2
  nz = x1*y2 - y1*x2
end sub
sub mirror  byref ax,byref ay,byref az  ,  nx,ny,nz
  h1 = atan2( nx , ny )
  call rotate nx , ny , 0-h1
  call rotate ax , ay , 0-h1
  h2 = atan2( nz , ny )
  call rotate nz , ny , 0-h2
  call rotate az , ay , 0-h2
  ay = 0-ay
  call rotate az , ay , h2
  call rotate ax , ay , h1
end sub
function atan2( x , y )
  if x = 0 then
    if y < 0 then
      uit = 0 - pi / 2
    else
      uit = pi / 2
    end if
  else
    if x > 0 then
      uit = atn( y / x )
    else
      uit = pi + atn( y / x )
    end if
  end if
  atan2 = uit
end function
sub rotate byref k , byref l , r
  s = sin( r )
  c = cos( r )
  hk = k * c - l * s
  hl = k * s + l * c
  k = hk
  l = hl
end sub
''sphere & light & triangle object functions
sub light no ,  x,y,z
  if no < 0 or no >2 then exit sub
  l(no,tx) = x
  l(no,ty) = y
  l(no,tz) = z
end sub
function trihit( i ,  ox,oy,oz  , dx,dy,dz  , byref out )
  x1=tri(i,tx1)
  y1=tri(i,ty1)
  z1=tri(i,tz1)
  x2=tri(i,tx2)
  y2=tri(i,ty2)
  z2=tri(i,tz2)
  x3=tri(i,tx3)
  y3=tri(i,ty3)
  z3=tri(i,tz3)
''Find vectors for two edges sharing V1
  e1x=x2-x1
  e1y=y2-y1
  e1z=y2-y1
  e2x=x3-x1
  e2y=y3-y1
  e2z=z3-z1
''Begin calculating determinant
''- also used to calculate u parameter
  call cros dx,dy,dz , e1x,e1y,e1z , px,py,pz
''if determinant is near zero
'', ray lies in plane of triangle
  det = dot(  e1x,e1y,e1z  ,  px,py,pz  )
''not culling
  if abs( det ) < 1e-10 then trihit = 0 : exit function
  invdet = 1 / det
''calculate distance from V1 to ray origin
  ttx=ox-x1
  tty=oy-y1
  ttz=oz-z1
''Calculate u parameter and test bound
  u = dot( ttx,tty,ttz , px,py,pz ) * invdet
''The intersection lies outside of the triangle
  if ( u < 0 or u > 1 ) then trihit = 0 : exit function
''Prepare to test v parameter
  call cros Tx,Ty,Tz , e1x,e1y,e1z , qx,qy,qz
''Calculate V parameter and test bound
  v = dot( Dx,Dy,Dz , qx,qy,qz ) * invdet
''The intersection lies outside of the triangle
  if (v < 0 or u + v  > 1 ) then trihit = 0 : exit function
  t = dot( e2x,e2y,e2z, qx,qy,qz ) * invdet
  if ( t > 1e-10 ) then trihit = 1 : out = t : exit function
''No hit, no win
  trihit = 0
end function
function spherehit( o ,  x,y,z  ,  dx,dy,dz  )
  b = 2 * dx * ( x - sp( o , tx ) ) _
    + 2 * dy * ( y - sp( o , ty ) ) _
    + 2 * dz * ( z - sp( o , tz ) )
  c = ( x - sp( o , tx ) ) ^ 2 _
    + ( y - sp( o , ty ) ) ^ 2 _
    + ( z - sp( o , tz ) ) ^ 2 _
    - sp( o , td ) ^ 2
  d = b * b - 4 * c
  spherehit = d > 0
end function
function spheredist( o ,  x,y,z  ,  dx,dy,dz  )
  b = 2 * dx * ( x - sp( o , tx ) ) _
    + 2 * dy * ( y - sp( o , ty ) ) _
    + 2 * dz * ( z - sp( o , tz ) )
  c = ( x - sp( o , tx ) ) ^ 2 _
    + ( y - sp( o , ty ) ) ^ 2 _
    + ( z - sp( o , tz ) ) ^ 2 _
    - sp( o , td ) ^ 2
  d = b * b - 4 * c
  spheredist = ( b * -1 - sqr( b * b - 4 * c ) ) / 2
end function
sub sphere  x,y,z  , d , r , kl
  no = spheretel
  if no > spheremax then exit sub
  sp(no,tx) = x
  sp(no,ty) = y
  sp(no,tz) = z
  sp(no,td) = d
  sp(no,tkl) = kl
  sp(no,tr) = r
  spheretel = spheretel + 1
end sub
sub tri x1,y1,z1 , x2,y2,z2 , x3,y3,z3 , r , kl
  if tritel > trimax then exit sub
  tri( tritel , tx1 ) = x1
  tri( tritel , ty1 ) = y1
  tri( tritel , tz1 ) = z1
  tri( tritel , tx2 ) = x2
  tri( tritel , ty2 ) = y2
  tri( tritel , tz2 ) = z2
  tri( tritel , tx3 ) = x3
  tri( tritel , ty3 ) = y3
  tri( tritel , tz3 ) = z3
  tri( tritel , tr ) = r
  tri( tritel , tkl ) = kl
  tritel = tritel + 1
end sub
''color object functions
function rgb(  r,g,b  )
  r = r and 255
  g = g and 255
  b = b and 255
  rgb = r + g * 256 + b * 256 ^ 2
end function
function klred( kl )
  klred = kl and 255
end function
function klgreen( kl )
  klgreen = int( kl / 256 ) and 255
end function
function klblue( kl )
  klblue = int( kl / 256 ^ 2 ) and 255
end function
function klmix( kl1 , f , kl2 )
  r1 = klred( kl1 )
  g1 = klgreen( kl1 )
  b1 = klblue( kl1 )
  r2 = klred( kl2 )
  g2 = klgreen( kl2 )
  b2 = klblue( kl2 )
  r = r1 + ( r2 - r1 ) * f
  g = g1 + ( g2 - g1 ) * f
  b = b1 + ( b2 - b1 ) * f
  klmix = rgb(  r,g,b  )
end function
function klshade( kl ,  r,g,b )
  r = klred( kl ) * r
  g = klgreen( kl ) * g
  b = klblue( kl ) * b
  klshade = rgb(  r,g,b  )
end function
function klrnd()
  klrnd=rgb(rnd(0)*255,rnd(0)*255,rnd(0)*255)
end function
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Re: ray casting

Berichtdoor bluatigro » vr jul 18, 2014 12:29 pm

update :
- n paar errors verwijderd
Code: Selecteer alles
''bluatigro 15-jul-2014
''raytracer 3.0

WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , pi , cube
winx = WindowWidth
winy = WindowHeight
pi = atn( 1 ) * 4
cube = 100
global gray , red , green , yellow , dgray
global blue , magenta , cyan , white , black
gray = rgb( 127 , 127 , 127 )
dgray = rgb( 63 , 63 , 63  )
red = rgb( 255 , 0 , 0 )
green = rgb( 0 , 255 , 0 )
yellow = rgb( 255 , 255 , 0 )
blue = rgb( 0 , 0 , 255 )
magenta = rgb( 255 , 0 , 255 )
cyan = rgb( 0 , 255 , 255 )
white = rgb( 255 , 255 , 255 )
global spheremax , spheretel
spheremax = 200
dim sp( spheremax , 5 ) , l(2,2)
global  tx,ty,tz  , td , tkl , tr
tx = 0
ty = 1
tz = 2
td = 3
tkl = 4
tr = 5
global tx1,ty1,tz1,tx2,ty2,tz2,tx3,ty3,tz3,tritel,trimax
trimax = 200
tx1 = 0
ty1 = 1
tz1 = 2
tx2 = 3
ty2 = 6
tz2 = 7
tx3 = 8
ty3 = 9
tz3 = 10
dim tri( trimax , 10 )
''       sphere   x     y    z    d reflect kl
test = 4
testlight = 0
select case test
  case 1
    call sphere -50 , 0 , 55 , 50 , .5 , cyan
    call sphere  50 , 0 , 55 , 50 , .5 , yellow
  case 2
    call sphere  60 , -40 , 25 , 20 , 0 , red or dgray
    call sphere   0 ,  60 , 25 , 20 , 0 , green or dgray
    call sphere -60 , -40 , 25 , 20 , 0 , blue or dgray
    call sphere  60 ,  40 , 25 , 20 , 0 , yellow or dgray
    call sphere   0 , -60 , 25 , 20 , 0 , magenta or dgray
    call sphere -60 ,  40 , 25 , 20 , 0 , cyan or dgray
    call sphere   0 ,   0 , 23 , 20 , .5 , gray
  case 3
    call sphere 0 , 0 , 150 , 100 , 0 , white
  case 4
    call tri -100,0,0 , 86,50,0 , -86,50,0 , 0 , red
  case else
    for i = 0 to 10
      x = range( -100 , 100 )
      y = range( -100 , 100 )
      z = range( 50 , 150 )
      d = range( 10 , 50 )
      r = rnd(0)
      call sphere x , y , z , d , r , klrnd()
    next i
end select
''     light no    x     y    z
if testlight then
  call light 0 ,   0 , 1000 , 0  ''redlight
  call light 1 ,   0 , 1000 , 0  ''greenlight
  call light 2 ,   0 , 1000 , 0  ''bluelight
else
  call light 0 , -500 , -866 , 1000  ''redlight
  call light 1 ,    0 , 1000 , 1000  ''greenlight
  call light 2 ,  500 , -866 , 1000  ''bluelight
end if


nomainwin
open "Ray Trace 3.0.2" for graphics as #m
  #m "trapclose [quit]"
  #m "down"
  z = 1
  for x = -100 to 100
    for y = -100 to 100
      dx = x/200
      dy = y/200
      dz = 1
      kl = ray(  x,y,z  ,  dx,dy,dz  , 2 )
      call point  x+winx/2,winy/2-y  , kl
    next y
  next x
  notice "ready ."
wait
[quit]
  close #m
end
function range( l , h )
  range = rnd(0) * ( h - l ) + l
end function
''ray trace & help functions
sub point  x,y  , kl
  r = klred( kl )
  g = klgreen( kl )
  b = klblue( kl )
  #m "color ";r;" ";g;" ";b
  #m "set ";x;" ";y
end sub
function ray(  x,y,z  ,  dx,dy,dz  , diep )
  scan
  done = 0
  tel = 0
  colortri = black
  colorsphere = black
  distsphere = 1e13
  disttri = 1e13
  if diep > 0 then
    for i = 0 to spheretel
      if spherehit( i ,  x,y,z  ,  dx,dy,dz ) then
        dist = spheredist( i , x,y,z , dx,dy,dz )
        done = 1
        if dist < distsphere then
          distsphere = dist
          colorsphere = sp(i,tkl)
        end if
      end if
    next i
    for i = 0 to tritel
      if trihit( i , x,y,z , dx,dy,dz , dist ) then
        done = 1
        if dist < disttri then
          disttri = dist
          colortri = tri(i,tkl)
          trino = i
        end if
      end if
    next i
    if done then
      if distsphere < disttri then
      l = lenght(  dx,dy,dz  )
      x = ( dx - x ) / l * distsphere
      y = ( dy - y ) / l * distsphere
      z = ( dz - z ) / l * distsphere
      nx = sp(no,tx) - x
      ny = sp(no,ty) - y
      nz = sp(no,tz) - z
      ra = angle(  nx,ny,nz  ,  l(0,tx),l(0,ty),l(0,tz)  )
      ga = angle(  nx,ny,nz  ,  l(1,tx),l(1,ty),l(1,tz)  )
      ba = angle(  nx,ny,nz  ,  l(2,tx),l(2,ty),l(2,tz)  )
      r = cos( ra ) / 2 + .5
      g = cos( ga ) / 2 + .5
      b = cos( ba ) / 2 + .5
      color = klshade( colorsphere ,  r,g,b  )
      if sp(no,tr) > 0  then
        call mirror  dx,dy,dz  ,  nx,ny,nz
        color2 = ray(  x,y,z  ,  dx,dy,dz  , diep - 1 )
        color = klmix(color,sp(no,tr),color2)
      end if
      else
        e1x = tri( trino , tx2 ) - tri( trino , tx1 )
        e1y = tri( trino , ty2 ) - tri( trino , ty1 )
        e1z = tri( trino , tz2 ) - tri( trino , tz1 )
        e2x = tri( trino , tx3 ) - tri( trino , tx1 )
        e2y = tri( trino , ty3 ) - tri( trino , ty1 )
        e2z = tri( trino , tz3 ) - tri( trino , tz1 )
        call cros e1x,e1y,e1z , e2x,e2y,e2z , nx,ny,nz
        ra = angle(  nx,ny,nz  ,  l(0,tx),l(0,ty),l(0,tz)  )
        ga = angle(  nx,ny,nz  ,  l(1,tx),l(1,ty),l(1,tz)  )
        ba = angle(  nx,ny,nz  ,  l(2,tx),l(2,ty),l(2,tz)  )
        r = cos( ra ) / 2 + .5
        g = cos( ga ) / 2 + .5
        b = cos( ba ) / 2 + .5
        color = klshade( colortri ,  r,g,b  )
        if sp(no,tr) > 0  then
          call mirror  dx,dy,dz  ,  nx,ny,nz
          color2 = ray(  x,y,z  ,  dx,dy,dz  , diep - 1 )
          color = klmix(color,sp(no,tr),color2)
        end if
      end if
    end if
  end if
  ray = color
end function
function angle(  x,y,z  ,  lx,ly,lz  )
  l = lenght(  x,y,z  )
  ll = lenght(  lx,ly,lz  )
  dt = dot(  x,y,z  ,  lx,ly,lz  )
  angle = acs( dt / ( l * ll ) )
end function
function lenght(  x,y,z  )
  lenght = sqr( x ^ 2 + y ^ 2 + z ^ 2 )
end function
function dot(  x1,y1,z1  ,   x2,y2,z2  )
  dot = x1*x2 + y1*y2 + z1*z2
end function
sub cros x1,y1,z1  ,  x2,y2,z2 , byref nx , byref ny , byref nz
  nx = y1*z2 - z1*y2
  ny = z1*x2 - x1*z2
  nz = x1*y2 - y1*x2
end sub
sub mirror  byref ax,byref ay,byref az  ,  nx,ny,nz
  h1 = atan2( nx , ny )
  call rotate nx , ny , 0-h1
  call rotate ax , ay , 0-h1
  h2 = atan2( nz , ny )
  call rotate nz , ny , 0-h2
  call rotate az , ay , 0-h2
  ay = 0-ay
  call rotate az , ay , h2
  call rotate ax , ay , h1
end sub
function atan2( x , y )
  if x = 0 then
    if y < 0 then
      uit = 0 - pi / 2
    else
      uit = pi / 2
    end if
  else
    if x > 0 then
      uit = atn( y / x )
    else
      uit = pi + atn( y / x )
    end if
  end if
  atan2 = uit
end function
sub rotate byref k , byref l , r
  s = sin( r )
  c = cos( r )
  hk = k * c - l * s
  hl = k * s + l * c
  k = hk
  l = hl
end sub
''sphere & light & triangle object functions
sub light no ,  x,y,z
  if no < 0 or no >2 then exit sub
  l(no,tx) = x
  l(no,ty) = y
  l(no,tz) = z
end sub
function trihit( i ,  ox,oy,oz  , dx,dy,dz  , byref dist )
  x1=tri(i,tx1)
  y1=tri(i,ty1)
  z1=tri(i,tz1)
  x2=tri(i,tx2)
  y2=tri(i,ty2)
  z2=tri(i,tz2)
  x3=tri(i,tx3)
  y3=tri(i,ty3)
  z3=tri(i,tz3)
''Find vectors for two edges sharing V1
  e1x=x2-x1
  e1y=y2-y1
  e1z=y2-y1
  e2x=x3-x1
  e2y=y3-y1
  e2z=z3-z1
''Begin calculating determinant
''- also used to calculate u parameter
  call cros dx,dy,dz , e1x,e1y,e1z , px,py,pz
''if determinant is near zero
'', ray lies in plane of triangle
  det = dot(  e1x,e1y,e1z  ,  px,py,pz  )
''not culling
  if abs( det ) < 1e-10 then trihit = 0 : exit function
  invdet = 1 / det
''calculate distance from V1 to ray origin
  ttx=ox-x1
  tty=oy-y1
  ttz=oz-z1
''Calculate u parameter and test bound
  u = dot( ttx,tty,ttz , px,py,pz ) * invdet
''The intersection lies outside of the triangle
  if ( u < 0 ) or ( u > 1 ) then trihit = 0 : exit function
''Prepare to test v parameter
  call cros ttx,tty,ttz , e1x,e1y,e1z , qx,qy,qz
''Calculate V parameter and test bound
  v = dot( dx,dy,dz , qx,qy,qz ) * invdet
''The intersection lies outside of the triangle
  if ( v < 0 ) or ( u + v  > 1 ) then trihit = 0 : exit function
  t = dot( e2x,e2y,e2z, qx,qy,qz ) * invdet
  if t > 1e-10 then trihit = 1 : dist = t : exit function
''No hit, no win
  trihit = 0
end function
function spherehit( o ,  x,y,z  ,  dx,dy,dz  )
  b = 2 * dx * ( x - sp( o , tx ) ) _
    + 2 * dy * ( y - sp( o , ty ) ) _
    + 2 * dz * ( z - sp( o , tz ) )
  c = ( x - sp( o , tx ) ) ^ 2 _
    + ( y - sp( o , ty ) ) ^ 2 _
    + ( z - sp( o , tz ) ) ^ 2 _
    - sp( o , td ) ^ 2
  d = b * b - 4 * c
  spherehit = d > 0
end function
function spheredist( o ,  x,y,z  ,  dx,dy,dz  )
  b = 2 * dx * ( x - sp( o , tx ) ) _
    + 2 * dy * ( y - sp( o , ty ) ) _
    + 2 * dz * ( z - sp( o , tz ) )
  c = ( x - sp( o , tx ) ) ^ 2 _
    + ( y - sp( o , ty ) ) ^ 2 _
    + ( z - sp( o , tz ) ) ^ 2 _
    - sp( o , td ) ^ 2
  d = b * b - 4 * c
  spheredist = ( b * -1 - sqr( b * b - 4 * c ) ) / 2
end function
sub sphere  x,y,z  , d , r , kl
  no = spheretel
  if no > spheremax then exit sub
  sp(no,tx) = x
  sp(no,ty) = y
  sp(no,tz) = z
  sp(no,td) = d
  sp(no,tkl) = kl
  sp(no,tr) = r
  spheretel = spheretel + 1
end sub
sub tri x1,y1,z1 , x2,y2,z2 , x3,y3,z3 , r , kl
  if tritel > trimax then exit sub
  tri( tritel , tx1 ) = x1
  tri( tritel , ty1 ) = y1
  tri( tritel , tz1 ) = z1
  tri( tritel , tx2 ) = x2
  tri( tritel , ty2 ) = y2
  tri( tritel , tz2 ) = z2
  tri( tritel , tx3 ) = x3
  tri( tritel , ty3 ) = y3
  tri( tritel , tz3 ) = z3
  tri( tritel , tr ) = r
  tri( tritel , tkl ) = kl
  tritel = tritel + 1
end sub
''color object functions
function rgb(  r,g,b  )
  r = r and 255
  g = g and 255
  b = b and 255
  rgb = r + g * 256 + b * 256 ^ 2
end function
function klred( kl )
  klred = kl and 255
end function
function klgreen( kl )
  klgreen = int( kl / 256 ) and 255
end function
function klblue( kl )
  klblue = int( kl / 256 ^ 2 ) and 255
end function
function klmix( kl1 , f , kl2 )
  r1 = klred( kl1 )
  g1 = klgreen( kl1 )
  b1 = klblue( kl1 )
  r2 = klred( kl2 )
  g2 = klgreen( kl2 )
  b2 = klblue( kl2 )
  r = r1 + ( r2 - r1 ) * f
  g = g1 + ( g2 - g1 ) * f
  b = b1 + ( b2 - b1 ) * f
  klmix = rgb(  r,g,b  )
end function
function klshade( kl ,  r,g,b )
  r = klred( kl ) * r
  g = klgreen( kl ) * g
  b = klblue( kl ) * b
  klshade = rgb(  r,g,b  )
end function
function klrnd()
  klrnd=rgb(rnd(0)*255,rnd(0)*255,rnd(0)*255)
end function
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Re: ray casting

Berichtdoor bluatigro » wo sep 10, 2014 2:15 pm

probeersel : alleen driehoeken

error :
- ik zie alleen n zwart vierkant

Code: Selecteer alles
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy
winx = WindowWidth
winy = WindowHeight
dim tri( 10 , 9 ) , dist( 10 )
global tx1 , ty1 , tz1 , tx2 , ty2 , tz2 , tx3 , ty3 , tz3 _
, tkl , tritel
tx1 = 0
ty1 = 1
tz1 = 2
tx1 = 3
ty1 = 4
tz1 = 5
tx1 = 6
ty1 = 7
tz1 = 8
tkl = 9
global red , green , yellow , blue
red = rgb( 255 , 0 , 0 )
green = rgb( 0 , 255 , 0 )
yellow = rgb( 255 , 255 , 0 )
blue = rgb( 0 , 0 , 255 )

call tri -86,50,0 , -86,50,0 , 100,0,0 , red

open "ray triangle 1.0" for graphics as #m
  for x = -100 to 100
    for y = -100 to 100
      scan
      ox = x
      oy = y
      oz = 0
      dx = x / 100
      dy = y / 100
      dz = 1
      for i = 0 to tritel
        dist( i ) = hit( i , ox,oy,oz , dx,dy,dz )
      next i
      min = 1e10
      t = -1
      for i = 0 to tritel
        if dist( i ) < min and dist( i ) > 0 then
          t = i
          min = dist( i )
        end if
      next i
      if t = -1 then
        #m "color black"
      else
        #m "color" ; color$( t )
      end if
      #m "goto " ; winx + x ; " " ; winy - y
      #m "down"
      #m "set " ; winx + x ; " " ; winy - y
      #m "up"
    next y
  next x
wait
[quit]
  close #m
end

function rgb( r , g , b )
  r = r and 255
  g = g and 255
  b = b and 255
  rgb = r + g * 256 + b * 256 ^ 2
end function

function hit( no , ox , oy , oz , dx , dy , dz )

  x1 = tri(no,tx1)
  y1 = tri(no,ty1)
  z1 = tri(no,tz1)
  x2 = tri(no,tx2)
  y2 = tri(no,ty2)
  z2 = tri(no,tz2)
  x3 = tri(no,tx3)
  y3 = tri(no,ty3)
  z3 = tri(no,tz3)

  call minus ex1,ey1,ez1 , x2,y2,z2 , x1,y1,z1
  call minus ex2,ey2,ez2 , x3,y3,z3 , x1,y1,z1

  call cross hx,hy,hz , dx,dy,dz , ex2,ey2,ez2
  a = dot( hx,hy,hz , ex1,ey1,ez1 )

  if a > -1e-5 and a < 1e-5 then
    hit = -1
    exit function
  end if

  f = 1 / a
  call minus sx,sy,sz , ox,oy,oz , x1,y1,z1
  u = f * dot( sx,sy,sz , hx,hy,hz )

  if u < 0 or u > 1 then
    hit = -1
    exit function
  end if

  call cross qx,qy,qz , sx,sy,sz , ex1,ey1,ez1
  v = f * dot( dx,dy,dz , qx,qy,qz )

  if v < 0 or v > 1 then
    hit = -1
    exit function
  end if

  t = f * dot( ex2,ey2,ez2 , qx,qy,qz )

  if t < 1e-5 then
    hit = -1
    exit function
  end if

  hit = t

end function

function dot( ax,ay,az , bx,by,bz )
  dot = ax * bx + ay * by + az * bz
end function

sub tri x1,y1,z1 , x2,y2,z2 , x3,y3,z3 , kl
  tri(tritel,tx1) = x1
  tri(tritel,ty1) = y1
  tri(tritel,tz1) = z1
  tri(tritel,tx2) = x2
  tri(tritel,ty2) = y2
  tri(tritel,tz2) = z2
  tri(tritel,tx3) = x3
  tri(tritel,ty3) = y3
  tri(tritel,tz3) = z3
  tri(tritel,tkl) = kl
  tritel = tritel + 1
end sub

function color$( no )
  kl = tri(no,tkl)
  r = kl and 255
  g = int( kl / 256 ) and 255
  b = int( kl / 256^2 ) and 255
  color$ = " " ; r ; " " ; g ; " " ; b
end function

sub minus byref x,byref y,byref z , bx,by,bz , cx,cy,cz
  x = bx - cx
  y = by - cy
  z = bz - cz
end sub

sub cross byref x,byref y,byref z , bx,by,bz , cx,cy,cz
  x = by * cz - bz * cy
  y = bz * cx - bx * cz
  z = bx * cy - by * cx
end sub

bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Re: ray casting

Berichtdoor bluatigro » wo sep 10, 2014 2:20 pm

probeersel : bollen en vlakken

error :
- isempty

Code: Selecteer alles
''ray caster : spheres and planes
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy
winx = WindowWidth
winy = WindowHeight
dim shape( 10 , 7 ) , dist( 10 )
global ttype , tx , ty , tz , td , tred , tgreen , tblue , ttel
global tshpere , tplane

ttype = 0
tx = 1
ty = 2
tz = 3
td = 4
tred = 5
tgreen = 6
tblue = 7

tsphere = 1
tplane = 2

red = rgb( 255 , 0 , 0 )
white = rgb( 255 , 255 , 255 )

call plane 0,1,0 , -100 , white
call sphere 0,0,50 , 50 , red

nomainwin
open "ray 1.0" for graphics as #m
  #m "trapclose [quit]"

  for x = -100 to 100
    for y = -100 to 100
      ox = x
      oy = y
      oz = 0
      dx = x / 100
      dy = y / 100
      dz = 1
      for i = 0 to ttel
        dist( i ) = hit( i , ox , oy , oz , dx , dy , dz )
      next i
      i = index()
      if i < 0 then
        #m "color black"
      else
        #m "color " ; color$( i )
      end if
      #m "goto " ; winx / 2 + x ; " " ; winy / 2 - y
      #m "down"
      #m "set " ; winx / 2 + x ; " " ; winy / 2 - y
      #m "up"
    next y
  next x

end

function index()
  min = 1e10
  for i = 0 to ttel
    if dist( i ) > 0 and dist( i ) < min then
      uit = i
      t = t + 1
      min = dist( i )
    end if
  next i
  if t = 0 then
    uit = -1
  end if
  index  = uit
end function

function color$( i )
  r = ( shape( i , tred ) * 255 ) and 255
  g = ( shape( i , tgreen ) * 255 ) and 255
  b = ( shape( i , tblue ) * 255 ) and 255
  color$ = str$( r ) ; " " ; g ; " "; b
end function

function rgb( r , g , b )
  r = r and 255
  g = g and 255
  b = b and 255
  rgb = r + g * 256 + b * 256 ^ 2
end function

function hit( no , ox , oy , oz , dx , dy , dz )

      sx = shape( no , tx )
      sy = shape( no , ty )
      sz = shape( no , tz )
      sr = shape( no , tr )

  select case shape( no , ttype )
    case tsphere
      a = 1
      b = ( 2 * ( ox - sx ) * dx ) _
        + ( 2 * ( oy - sy ) * dy ) _
        + ( 2 * ( oz - sz ) * dz )
      c = ( ox - sx ) ^ 2 _
        + ( oy - sy ) ^ 2 _
        + ( oz - sz ) ^ 2 _
        - ( sr * sr )
      dis = b * b - 4 * a * c
      if dis < 0 then
        uit = -1
      else
        root = ( ( 0 - sqr( dis ) ) * ( 0 - b ) ) / 2 - 1e-10
        if root > 0 then
          uit = root
        else
          uit = ( sqr( dis ) * ( 0 - b ) ) / 2 + 1e-10
        end if
      end if
    case tplane
      a = dot( sx , sy , sz , dx , dy , dz )
      if a = 0 then
        uit = -1
      else
        call multy sx , sy , sz , 0 - sr
        call add ox , oy , oz , sx , sy , sz
        b = dot( sx , sy , sz , ox , oy , oz )
        uit = 0 - ( b / a )
      end if
    case else
      uit = -1
  end select
  hit = uit
end function

sub multy byref x , byref y , byref x , f
  x = x * f
  y = y * f
  z = z * f
end sub

function lenght( x , y , z )
  lenght = sqr( x ^ 2 + y ^ 2 + z ^ 2 )
end function

function dot( x1 , y1 , z1 , x2 , y2 , z2 )
  dot = x1 * x2 + y1 * y2 + z1 * z2
end function

sub sphere x , y , z , d , kl
  shape( ttel , tx ) = x
  shape( ttel , ty ) = y
  shape( ttel , tz ) = z
  shape( ttel , td ) = d
  shape( ttel , tred ) = int( kl and 255 ) / 256
  shape( ttel , tgreen ) = int( ( kl / 256 ) and 255 ) / 256
  shape( ttel , tblue ) = int( ( kl / 256 ^ 2 ) and 255 ) / 256
  shape( ttel , ttype ) = tsphere
  ttel = ttel + 1
end sub

sub plane x , y , z , d , kl
  call multy x , y , z , 1 / lenght( x , y , z )
  shape( ttel , tx ) = x
  shape( ttel , ty ) = y
  shape( ttel , tz ) = z
  shape( ttel , td ) = d
  shape( ttel , tred ) = int( kl and 255 ) / 256
  shape( ttel , tgreen ) = int( ( kl / 256 ) and 255 ) / 256
  shape( ttel , tblue ) = int( ( kl / 256 ^ 2 ) and 255 ) / 256
  shape( ttel , ttype ) = tplane
  ttel = ttel + 1
end sub

sub add byref x , byref y , byref z , dx , dy , dz
  x = x + dx
  y = y + dy
  z = z + dz
end sub

bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Re: ray casting

Berichtdoor bluatigro » za sep 13, 2014 3:23 pm

update :
- bollen en vlakken zonder error melding

error :
- ik zie allen n lijn niet n vierkant

Code: Selecteer alles
''ray caster : spheres and planes
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy
winx = WindowWidth
winy = WindowHeight
dim shape( 10 , 7 ) , dist( 10 )
global ttype , tx , ty , tz , td , tred , tgreen , tblue , ttel
global tsphere , tplane

ttype = 0
tx = 1
ty = 2
tz = 3
td = 4
tred = 5
tgreen = 6
tblue = 7

tsphere = 1
tplane = 2

red = rgb( 255 , 0 , 0 )
white = rgb( 255 , 255 , 255 )

call plane 0,1,0 , -100 , white
call sphere 0,0,50 , 50 , red

nomainwin

open "ray 1.1" for graphics as #m
  #m "trapclose [quit]"

  for x = -100 to 100
    for y = -100 to 100
      ox = x
      oy = y
      oz = 0
      dx = x / 100
      dy = y / 100
      dz = 1
      for i = 0 to ttel
        dist( i ) = hit( i , ox , oy , oz , dx , dy , dz )
      next i
      i = index()
      if i < 0 then
        #m "color black"
      else
        #m "color" ; kleur$( i )
      end if
      #m "goto " ; winx / 2 + x ; " " ; winy / 2 - y
      #m "down"
      #m "set " ; winx / 2 + x ; " " ; winy / 2 - y
      #m "up"
    next y
  next x

  notice "ready !!"
wait
[quit]
  close #m
end

function index()
  low = 1e10
  uit = -1
  for i = 0 to ttel
    if dist( i ) > 0 and dist( i ) < low then
      uit = i
      low = dist( i )
    end if
  next i
  index  = uit
end function

function kleur$( i )
  r = shape(i,tred)
  g = shape(i,tgreen)
  b = shape(i,tblue)
  kleur$ = " " ; r ; " " ; g ; " "; b
end function

function color$( no )
  kl = shape(no,tred)
  r = int( kl ) and 255
  g = int( kl / 256 ) and 255
  b = int( kl / 256^2 ) and 255
  color$ = " " ; r ; " " ; g ; " " ; b
end function

function rgb( r , g , b )
  r = r and 255
  g = g and 255
  b = b and 255
  rgb = r + g * 256 + b * 256 ^ 2
end function

function hit( no , ox , oy , oz , dx , dy , dz )

      sx = shape( no , tx )
      sy = shape( no , ty )
      sz = shape( no , tz )
      sr = shape( no , tr )

  select case shape( no , ttype )
    case tsphere
      a = 1
      b = ( 2 * ( ox - sx ) * dx ) _
        + ( 2 * ( oy - sy ) * dy ) _
        + ( 2 * ( oz - sz ) * dz )
      c = ( ox - sx ) ^ 2 _
        + ( oy - sy ) ^ 2 _
        + ( oz - sz ) ^ 2 _
        - ( sr )
      dis = b * b - 4 * a * c
      if dis < 0 then
        uit = -1
      else
        root = ( 0 - sqr( dis ) - b ) / 2 - 1e-10
        if root > 0 then
          uit = root
        else
          uit = ( sqr( dis ) - b ) / 2 + 1e-10
        end if
      end if
    case tplane
      a = dot( sx , sy , sz , dx , dy , dz )
      if a = 0 then
        uit = -1
      else
        call multy sx , sy , sz , 0 - sr
        call add ox , oy , oz , sx , sy , sz
        b = dot( sx , sy , sz , ox , oy , oz )
        uit = 0 - ( b / a )
      end if
    case else
      uit = -1
  end select
  hit = uit
end function

sub multy byref x , byref y , byref z , f
  x = x * f
  y = y * f
  z = z * f
end sub

function lenght( x , y , z )
  lenght = sqr( x ^ 2 + y ^ 2 + z ^ 2 )
end function

function dot( x1 , y1 , z1 , x2 , y2 , z2 )
  dot = x1 * x2 + y1 * y2 + z1 * z2
end function

sub sphere x , y , z , d , kl
  shape( ttel , tx ) = x
  shape( ttel , ty ) = y
  shape( ttel , tz ) = z
  shape( ttel , td ) = d * d
  shape( ttel , tred ) = int( kl ) and 255
  shape( ttel , tgreen ) = int( kl / 256 ) and 255
  shape( ttel , tblue ) = int( kl / 256 ^ 2 ) and 255
  shape( ttel , ttype ) = tsphere
  ttel = ttel + 1
end sub

sub plane x , y , z , d , kl
  call multy x , y , z , 1 / lenght( x , y , z )
  shape( ttel , tx ) = x
  shape( ttel , ty ) = y
  shape( ttel , tz ) = z
  shape( ttel , td ) = d
  shape( ttel , tred ) = int( kl ) and 255
  shape( ttel , tgreen ) = int( kl / 256 ) and 255
  shape( ttel , tblue ) = int( kl / 256 ^ 2 ) and 255
  shape( ttel , ttype ) = tplane
  ttel = ttel + 1
end sub

bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Re: ray casting

Berichtdoor bluatigro » za sep 13, 2014 3:52 pm

update :
- white als plane kleur verandert

error :
- als ik de plane REM dan zie ik alleen n zwart vierkant

Code: Selecteer alles
''ray caster : spheres and planes
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy
winx = WindowWidth
winy = WindowHeight
dim shape( 10 , 7 ) , dist( 10 )
global ttype , tx , ty , tz , td , tred , tgreen , tblue , ttel
global tsphere , tplane

ttype = 0
tx = 1
ty = 2
tz = 3
td = 4
tred = 5
tgreen = 6
tblue = 7

tsphere = 1
tplane = 2

red = rgb( 255 , 0 , 0 )
green = rgb( 0 , 255 , 0 )
yellow = rgb( 255 , 255 , 0 )
blue = rgb( 0 , 0 , 255 )
white = rgb( 255 , 255 , 0 )

''call plane 0,1,0 , 100 , green
call sphere 0,0,100 , 50 , red

nomainwin

open "ray 1.1" for graphics as #m
  #m "trapclose [quit]"

  for x = -100 to 100
    for y = -100 to 100
      ox = x
      oy = y
      oz = 0
      dx = x / 100
      dy = y / 100
      dz = 1
      for i = 0 to ttel
        dist( i ) = hit( i , ox , oy , oz , dx , dy , dz )
      next i
      i = index()
      if i < 0 then
        #m "color black"
      else
        #m "color" ; kleur$( i )
      end if
      #m "goto " ; winx / 2 + x ; " " ; winy / 2 - y
      #m "down"
      #m "set " ; winx / 2 + x ; " " ; winy / 2 - y
      #m "up"
    next y
  next x

  notice "ready !!"
wait
[quit]
  close #m
end

function index()
  low = 1e10
  uit = -1
  for i = 0 to ttel
    if dist( i ) > 0 and dist( i ) < low then
      uit = i
      low = dist( i )
    end if
  next i
  index  = uit
end function

function kleur$( i )
  r = shape(i,tred)
  g = shape(i,tgreen)
  b = shape(i,tblue)
  kleur$ = " " ; r ; " " ; g ; " "; b
end function

function rgb( r , g , b )
  r = r and 255
  g = g and 255
  b = b and 255
  rgb = r + g * 256 + b * 256 ^ 2
end function

function hit( no , ox , oy , oz , dx , dy , dz )

      sx = shape( no , tx )
      sy = shape( no , ty )
      sz = shape( no , tz )
      sr = shape( no , tr )

  select case shape( no , ttype )
    case tsphere
      a = 1
      b = ( 2 * ( ox - sx ) * dx ) _
        + ( 2 * ( oy - sy ) * dy ) _
        + ( 2 * ( oz - sz ) * dz )
      c = ( ox - sx ) ^ 2 _
        + ( oy - sy ) ^ 2 _
        + ( oz - sz ) ^ 2 _
        - ( sr )
      dis = b * b - 4 * a * c
      if dis < 0 then
        uit = -1
      else
        root = ( 0 - sqr( dis ) - b ) / 2 - 1e-10
        if root > 0 then
          uit = root
        else
          uit = ( sqr( dis ) - b ) / 2 + 1e-10
        end if
      end if
    case tplane
      a = dot( sx , sy , sz , dx , dy , dz )
      if a = 0 then
        uit = -1
      else
        call multy sx , sy , sz , 0 - sr
        call add ox , oy , oz , sx , sy , sz
        b = dot( sx , sy , sz , ox , oy , oz )
        uit = 0 - ( b / a )
      end if
    case else
      uit = -1
  end select
  hit = uit
end function

sub multy byref x , byref y , byref z , f
  x = x * f
  y = y * f
  z = z * f
end sub

sub add byref x , byref y , byref z , dx,dy,dz
  x = x + dx
  y = y + dy
  z = z + dz
end sub

function lenght( x , y , z )
  lenght = sqr( x ^ 2 + y ^ 2 + z ^ 2 )
end function

function dot( x1 , y1 , z1 , x2 , y2 , z2 )
  dot = x1 * x2 + y1 * y2 + z1 * z2
end function

sub sphere x , y , z , d , kl
  shape( ttel , tx ) = x
  shape( ttel , ty ) = y
  shape( ttel , tz ) = z
  shape( ttel , tr ) = d * d
  shape( ttel , tred ) = int( kl ) and 255
  shape( ttel , tgreen ) = int( kl / 256 ) and 255
  shape( ttel , tblue ) = int( kl / 256 ^ 2 ) and 255
  shape( ttel , ttype ) = tsphere
  ttel = ttel + 1
end sub

sub plane x , y , z , d , kl
  call multy x , y , z , 1 / lenght( x , y , z )
  shape( ttel , tx ) = x
  shape( ttel , ty ) = y
  shape( ttel , tz ) = z
  shape( ttel , tr ) = d
  shape( ttel , tred ) = int( kl ) and 255
  shape( ttel , tgreen ) = int( kl / 256 ) and 255
  shape( ttel , tblue ) = int( kl / 256 ^ 2 ) and 255
  shape( ttel , ttype ) = tplane
  ttel = ttel + 1
end sub


bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Re: ray casting

Berichtdoor bluatigro » do feb 26, 2015 1:24 pm

opnieuw begonen

error :
- ik kreeg allen n zwart vierkantje

Code: Selecteer alles
''bluatigro 26 feb 2015
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , spmax
winx = WindowWidth
winy = WindowHeight
spmax = 10
dim sp( spmax , 5 )
global spx , spy , spz , spr , spkl , spmat
spx = 0
spy = 1
spz = 2
spr = 3
spkl = 4
spmat = 5
nomainwin
for i = 0 to spmax
  call sphere  i , range( -100 , 100 ) _
                 , range( -100 , 100 ) _
                 , range( 50 , 200 ) _
                 , range( 10 , 50 ) _
                 , range( 0 , 2^24-1 ) , 0
next i

open "ray" for graphics as #m
  #m "trapclose [quit]"
  for x = -100 to 100
    for y = -100 to 100
      kl = pixel( x,y,0 , x,y,1e10 )
      r = kl and 255
      g = int( kl / 256 ) and 255
      b = int( kl / 256 ^ 2 ) and 255
      #m "color " ; rgb$( r , g , b )
      #m "goto " ; winx / 2 + x ; " " ; winy / 2 - y
      #m "down"
      #m "set " ; winy / 2 + x ; " " ; winy / 2 - y
      #m "up"
    next y
  next x
  notice "ready !!"
wait
function range( low , high )
  range = rnd(0) * ( high - low ) + low
end function
sub sphere no , x,y,z , r , kl , mat
  sp( no , spx ) = x
  sp( no , spy ) = y
  sp( no , spz ) = z
  sp( no , spr ) = r
  sp( no , spkl ) = kl
  sp( no , spmat ) = mat
end sub
function rgb$( r , g , b )
  rgb$ = str$( r and 255 ) ; " " ; g and 255 ; " " ; b and 255
end function
function pixel( ox,oy,oz , dx,dy,dz )
  minst = 1e10
  found = -1
  for i = 0 to spmax
    d = hit( i , ox,oy,oz , dx,dy,dz )
    if d > 0 and d < minst then
      minst = d
      found = i
    end if
  next i
  if found < 0 then pixel = 0 : exit function
  pixel = sp( found , spkl )
end function
function hit( no , ox,oy,oz , dx,dy,dz )
  opx = sp( no , spx ) - ox
  opy = sp( no , spy ) - oy
  opz = sp( no , spz ) - oz
  b = dot( opx,opy,opz , dx,dy,dz )
  disc = b ^ 2 * dot( opx,opy,opz , dx,dy,dz ) + sp( no , spr ) ^ 2
  if disc < 0 then hit = -1 : exit function
  disc = sqr( disc )
  t = b^2 - disc
  if t > 1e-10 then hit = t : exit function
  t = b^2 + disc
  if t > 1e-10 then hit = t : exit function
  hit = -1
end function
function dot( ax,ay,az , bx,by,bz )
  dot = ax * bx + ay * by + az * bz
end function
[quit]
  close #m
end
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Re: ray casting

Berichtdoor bluatigro » vr feb 27, 2015 12:04 pm

ik ben aan t vertalen van
http://www.freebasic.net/forum/viewtopi ... =7&t=23291
naar LB

alle help is welkom
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Re: ray casting

Berichtdoor bluatigro » zo maart 01, 2015 4:11 pm

ander voorbeeld gevonden
Code: Selecteer alles
nomainwin
'constants to access the point arrays
global X,Y,Z,R,Red,Green,Blue,Xp,Yp,DistToScreen,maxObjects
X=0
Y=1
Z=2
R=3
Red=4
Green=5
Blue=6

'the world is 24x24 units
'0,0 is centre of the world
'-12 far left 12 far right
'12 top -12 bottom
'objects are specified in world units
'rays are specified in world units
'pixel coordinates are converted by
'dividing the world width by the screen width
'and the world height by the screen height
'this gives a per pixel world increment value

ScrXLeft=-12
ScrXRight=12
ScrYTop=-12
ScrYBottom=12
ImgX=512 'pixel width of screen
ImgY=512 'pixel height of screen
ScrX=2*ScrXRight/ImgX 'per pixel world increment value
ScrY=2*ScrYBottom/ImgY

'Calculate how much space windows borders take
'Anatoly's tip
WindowWidth = 200
WindowHeight = 200
open "Ajusting..." for graphics_nsb as #1
#1, "home ; down ; posxy w h"
w=200-2*w : h = 200-2*h
'w and h now contain the number of pixels
'the Windows scheme/theme takes
close #1
WindowWidth  = ImgX+w
WindowHeight = ImgY+h
UpperLeftX = int((DisplayWidth-WindowWidth)/2)
UpperLeftY = int((DisplayHeight-WindowHeight)/2)
open "Raytrace" for graphics_nsb as #1
#1 "down ; fill 192 192 192 ; trapclose [quit]"



'sphere data x,y,z,radius,color
'three spheres ,red green and blue
'evenly spaced around centre of screen
'z order front to back blue, green, red

'there are five massive spheres positioned
'all round the edges and to the rear to create walls


maxObjects=7
dim sp(maxObjects,6)
sp(0,X)=0
sp(0,Y)=0
sp(0,Z)=5
sp(0,R)=4
sp(0,Red)=255
sp(0,Green)=0
sp(0,Blue)=0
sp(1,X)=-6
sp(1,Y)=0
sp(1,Z)=5
sp(1,R)=2
sp(1,Red)=0
sp(1,Green)=255
sp(1,Blue)=0
sp(2,X)=6
sp(2,Y)=0
sp(2,Z)=2
sp(2,R)=2
sp(2,Red)=0
sp(2,Green)=0
sp(2,Blue)=255
sp(3,X)=-36
sp(3,Y)=0
sp(3,Z)=20
sp(3,R)=26
sp(3,Red)=64
sp(3,Green)=128
sp(3,Blue)=255
sp(4,X)=36
sp(4,Y)=0
sp(4,Z)=20
sp(4,R)=26
sp(4,Red)=64
sp(4,Green)=128
sp(4,Blue)=255
sp(5,X)=0
sp(5,Y)=-36
sp(5,Z)=20
sp(5,R)=26
sp(5,Red)=64
sp(5,Green)=128
sp(5,Blue)=25
sp(6,X)=0
sp(6,Y)=36
sp(6,Z)=20
sp(6,R)=26
sp(6,Red)=64
sp(6,Green)=128
sp(6,Blue)=25
sp(7,X)=0
sp(7,Y)=0
sp(7,Z)=36
sp(7,R)=24
sp(7,Red)=128
sp(7,Green)=128
sp(7,Blue)=128

'point origin of camera
'centre screen, 24 world units back from the image plane
cam(X)=0
cam(Y)=0
cam(Z)=-24

'point origin of light source
'centre top, on the image plane
lit(X)=12
lit(Y)=5
lit(Z)=-10

'now cast a ray through every pixel on the screen
for Xp=0 to ImgX
    for Yp=0 to ImgY
    scan

        'point0, the camera x,y,z
        o(X)=cam(X)                     'world x camera 0
        o(Y)=cam(Y)                     'world y camera 0
        o(Z)=cam(Z)                     'world z camera -10


        'point1, the screen x,y,z
        'which is ScrXLeft (-12) + .5 * ScrX, the per pixel world increment value
        'to which we add xp * ScrX to give world x in world units
        r(X)=ScrXLeft+.5*ScrX+Xp*ScrX   'world x
        r(Y)=ScrYTop+.5*ScrY+Yp*ScrY    'world y
        r(Z)=0                          'world z image plane 0

        'flat parrallell ray no perspective
        'o(X)=r(X)
        'o(Y)=r(Y)
        'o(Z)=-10

        'subtract point0 from point1 to get vector direction d()
        d(X)=r(X)-o(X)
        d(Y)=r(Y)-o(Y)
        d(Z)=r(Z)-o(Z)

        'normalize it by dividing by its length to make a unit vector ie it sums to 1
        l=sqr(d(X)*d(X)+d(Y)*d(Y)+d(Z)*d(Z))
        d(X)=d(X)/l
        d(Y)=d(Y)/l
        d(Z)=d(Z)/l
        DistToScreen=l

        'go look for an intersect
        null=raySphereIntersect()
    next 'y
next 'x

wait

[quit]
close #1
end

function raySphereIntersect()
        maxdist=1000000
        for o=0 to maxObjects
            b=2*d(X)*(o(X)-sp(o,X))+2*d(Y)*(o(Y)-sp(o,Y))+2*d(Z)*(o(Z)-sp(o,Z))
            c=(o(X)-sp(o,X))^2+(o(Y)-sp(o,Y))^2+(o(Z)-sp(o,Z))^2-sp(o,R)^2
            d = b * b - 4 * c
            if d>0 then
                t=(b*-1 - sqr(b*b-4*c))/2
                if t>DistToScreen  then
                    'store the shortest intersect of all sphere intersects
                    if t<maxdist then maxdist=t : id=o
                end if
            end if
        next
        if maxdist<1000000 then

            'establish the sphere surface intersect point
            i(X)=o(X)+d(X)*maxdist
            i(Y)=o(Y)+d(Y)*maxdist
            i(Z)=o(Z)+d(Z)*maxdist

            'get unit normal vector from sphere centre to surface intersect
            n(X)=(i(X)-sp(id,X))/sp(id,R)
            n(Y)=(i(Y)-sp(id,Y))/sp(id,R)
            n(Z)=(i(Z)-sp(id,Z))/sp(id,R)


            'get the unit normal vector from sphere surface intersect to the light
            l(X)=lit(X)-i(X)
            l(Y)=lit(Y)-i(Y)
            l(Z)=lit(Z)-i(Z)
            l=sqr(l(X)*l(X)+l(Y)*l(Y)+l(Z)*l(Z))
            l(X)=l(X)/l
            l(Y)=l(Y)/l
            l(Z)=l(Z)/l
            'the dot product of these vectors gives an indication of the light
            color=n(X)*l(X)+n(Y)*l(Y)+n(Z)*l(Z)


            'cast a ray from intersect to the light to check for shadow
            'we have done most of the ray prep
            'point0 is the intersect point1 is the light
            'so l() is our ray direction, point1-point0, normalized
            shadow=1
            for o=0 to maxObjects
                if o<>id then  'check all other spheres not the one we are currently considering
                    b=2*l(X)*(i(X)-sp(o,X))+2*l(Y)*(i(Y)-sp(o,Y))+2*l(Z)*(i(Z)-sp(o,Z))
                    c=(i(X)-sp(o,X))^2+(i(Y)-sp(o,Y))^2+(i(Z)-sp(o,Z))^2-sp(o,R)^2
                    d = b * b - 4 * c
                    if d>0 then t=(b*-1 - sqr(b*b-4*c))/2
                    if d>0 and t>0 then shadow=.5 : exit for
                end if
            next

            'add some ambient light
            if color < .3 then color = .3

            'color the pixel
            #1 "color ";sp(id,Red)*color*shadow;" ";sp(id,Green)*color*shadow;" ";sp(id,Blue)*color*shadow;" ; set ";Xp;" ";Yp

        end if

end function

tot nu toe verbouwt tot
Code: Selecteer alles
''bluatigro 1 mrt 2015
''rebild of internet raytracer
nomainwin
'constants to access the point arrays
global X,Y,Z,R,clr,Xp,Yp,DistToScreen,maxObjects
X=0
Y=1
Z=2
R=3
clr=4

global sptel
'the world is 24x24 units
'0,0 is centre of the world
'-12 far left 12 far right
'12 top -12 bottom
'objects are specified in world units
'rays are specified in world units
'pixel coordinates are converted by
'dividing the world width by the screen width
'and the world height by the screen height
'this gives a per pixel world increment value

ScrXLeft=-12
ScrXRight=12
ScrYTop=-12
ScrYBottom=12
ImgX=512 'pixel width of screen
ImgY=512 'pixel height of screen
ScrX=2*ScrXRight/ImgX 'per pixel world increment value
ScrY=2*ScrYBottom/ImgY

'Calculate how much space windows borders take
'Anatoly's tip
WindowWidth = 200
WindowHeight = 200
open "Ajusting..." for graphics_nsb as #1
#1, "home ; down ; posxy w h"
w=200-2*w : h = 200-2*h
'w and h now contain the number of pixels
'the Windows scheme/theme takes
close #1
WindowWidth  = ImgX+w
WindowHeight = ImgY+h
UpperLeftX = int((DisplayWidth-WindowWidth)/2)
UpperLeftY = int((DisplayHeight-WindowHeight)/2)
open "Raytrace" for graphics_nsb as #1
#1 "down ; fill 192 192 192 ; trapclose [quit]"


global red , green , blue , gray

red = rgb( 255 , 0 , 0 )
green = rgb( 0 , 255 , 0 )
blue = rgb( 0 , 0 , 255 )
gray = rgb( 128 , 128 , 128 )


'sphere data x,y,z,radius,color
'three spheres ,red green and blue
'evenly spaced around centre of screen
'z order front to back blue, green, red

'there are five massive spheres positioned
'all round the edges and to the rear to create walls


maxObjects=10
dim sp(maxObjects,4)
call sphere 0,0,5 , 4 , red
call sphere 0,5,2 , 2 , green
call sphere 6,0,2 , 2 , blue
call sphere -1e5-12,20,26 , 1e5 , gray
call sphere 1e5+12,20,26 , 1e5 , gray
call sphere 0,-1e5-12,26 , 1e5 , gray
call sphere 0,1e5+12,26 , 1e5 , gray
call sphere 0,0,1e5+12 , 1e5 , gray

'point origin of camera
'centre screen, 24 world units back from the image plane
cam(X)=0
cam(Y)=0
cam(Z)=-24

'point origin of light source
'centre top, on the image plane
lit(X)=-11
lit(Y)=-11
lit(Z)=-11

'now cast a ray through every pixel on the screen
for Xp=0 to ImgX
    for Yp=0 to ImgY
    scan

        'point0, the camera x,y,z
        o(X)=cam(X)                     'world x camera 0
        o(Y)=cam(Y)                     'world y camera 0
        o(Z)=cam(Z)                     'world z camera -10


        'point1, the screen x,y,z
        'which is ScrXLeft (-12) + .5 * ScrX, the per pixel world increment value
        'to which we add xp * ScrX to give world x in world units
        r(X)=ScrXLeft+.5*ScrX+Xp*ScrX   'world x
        r(Y)=ScrYTop+.5*ScrY+Yp*ScrY    'world y
        r(Z)=0                          'world z image plane 0

        'flat parrallell ray no perspective
        'o(X)=r(X)
        'o(Y)=r(Y)
        'o(Z)=-10

        'subtract point0 from point1 to get vector direction d()
        d(X)=r(X)-o(X)
        d(Y)=r(Y)-o(Y)
        d(Z)=r(Z)-o(Z)

        'normalize it by dividing by its length to make a unit vector ie it sums to 1
        l=sqr(d(X)*d(X)+d(Y)*d(Y)+d(Z)*d(Z))
        d(X)=d(X)/l
        d(Y)=d(Y)/l
        d(Z)=d(Z)/l
        DistToScreen=l

        'go look for an intersect
        null=raySphereIntersect()
    next 'y
next 'x

wait

[quit]
close #1
end
function rgb( a , b , c )
  rgb = a + b * 256 + c * 256 ^ 2
end function
function clr.r( kl )
  clr.r = kl and 255
end function
function clr.g( kl )
  clr.g = int( kl / 256 ) and 255
end function
function clr.b( kl )
  clr.b = int( kl / 256 ^ 2 ) and 255
end function
sub sphere a , b , c , d , kl
  if sptel >= maxObjects then exit sub
  sp( sptel , X ) = a
  sp( sptel , Y ) = b
  sp( sptel , Z ) = c
  sp( sptel , R ) = d
  sp( sptel , clr ) = kl
  sptel = sptel + 1
end sub
function raySphereIntersect()
  maxdist=1e6
  for o=0 to sptel
    b=2*d(X)*(o(X)-sp(o,X))+2*d(Y)*(o(Y)-sp(o,Y))+2*d(Z)*(o(Z)-sp(o,Z))
    c=(o(X)-sp(o,X))^2+(o(Y)-sp(o,Y))^2+(o(Z)-sp(o,Z))^2-sp(o,R)^2
    d = b * b - 4 * c
    if d>0 then
      t=(b*-1 - sqr(b*b-4*c))/2
      if t>DistToScreen  then
      'store the shortest intersect of all sphere intersects
        if t<maxdist then maxdist=t : id=o
      end if
    end if
  next
  if maxdist < 1e7 then
  'establish the sphere surface intersect point
    i(X)=o(X)+d(X)*maxdist
    i(Y)=o(Y)+d(Y)*maxdist
    i(Z)=o(Z)+d(Z)*maxdist
  'get unit normal vector from sphere centre to surface intersect
    n(X)=(i(X)-sp(id,X))/sp(id,R)
    n(Y)=(i(Y)-sp(id,Y))/sp(id,R)
    n(Z)=(i(Z)-sp(id,Z))/sp(id,R)
  'get the unit normal vector from sphere surface intersect to the light
    l(X)=lit(X)-i(X)
    l(Y)=lit(Y)-i(Y)
    l(Z)=lit(Z)-i(Z)
    l=sqr(l(X)*l(X)+l(Y)*l(Y)+l(Z)*l(Z))
    l(X)=l(X)/l
    l(Y)=l(Y)/l
    l(Z)=l(Z)/l
  'the dot product of these vectors gives an indication of the light
    color=n(X)*l(X)+n(Y)*l(Y)+n(Z)*l(Z)


  'cast a ray from intersect to the light to check for shadow
  'we have done most of the ray prep
  'point0 is the intersect point1 is the light
  'so l() is our ray direction, point1-point0, normalized
    shadow=1
    for o=0 to maxObjects
      if o<>id then 
      'check all other spheres not the one we are currently considering
        b=2*l(X)*(i(X)-sp(o,X))+2*l(Y)*(i(Y)-sp(o,Y))+2*l(Z)*(i(Z)-sp(o,Z))
        c=(i(X)-sp(o,X))^2+(i(Y)-sp(o,Y))^2+(i(Z)-sp(o,Z))^2-sp(o,R)^2
        d = b * b - 4 * c
        if d>0 then t=(b*-1 - sqr(b*b-4*c))/2
        if d>0 and t>0 then shadow=.5 : exit for
      end if
    next

    'add some ambient light
    if color < .2 then color = .2

    kl = sp( id , clr )
    'color the pixel
    #1 "color " ; clr.r( kl ) * color * shadow _
          ; " " ; clr.g( kl ) * color * shadow _
          ; " " ; clr.b( kl ) * color * shadow
    #1 "set " ; Xp ; " " ; Yp

  end if
end function


WAARSCHUWING : tekenen duurt minuten
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Re: ray casting

Berichtdoor bluatigro » ma maart 02, 2015 1:38 pm

update :
- ik probberde meer functies

error :
- zwart schermpje

Code: Selecteer alles
''bluatigro 1 mrt 2015
''rebild of internet raytracer
nomainwin
'constants to access the point arrays
global X,Y,Z,R,clr,Xp,Yp,DistToScreen,maxObjects
X = 0
Y = 1
Z = 2
R = 3
clr = 4

global sptel
'the world is 24x24 units
'0,0 is centre of the world
'-12 far left 12 far right
'12 top -12 bottom
'objects are specified in world units
'rays are specified in world units
'pixel coordinates are converted by
'dividing the world width by the screen width
'and the world height by the screen height
'this gives a per pixel world increment value

global ScrXleft , ScrXRight , ScrYTop , ScrYBottom
ScrXLeft=-12
ScrXRight=12
ScrYTop=-12
ScrYBottom=12
global ImgX , ImgY , ScrX , Scry
ImgX=512 'pixel width of screen
ImgY=512 'pixel height of screen
ScrX=2*ScrXRight/ImgX 'per pixel world increment value
ScrY=2*ScrYBottom/ImgY

'Calculate how much space windows borders take
'Anatoly's tip
WindowWidth = 200
WindowHeight = 200
open "Ajusting..." for graphics_nsb as #1
  #1, "home ; down ; posxy w h"
  w=200-2*w : h = 200-2*h
  'w and h now contain the number of pixels
  'the Windows scheme/theme takes
close #1
WindowWidth  = ImgX+w
WindowHeight = ImgY+h
UpperLeftX = int((DisplayWidth-WindowWidth)/2)
UpperLeftY = int((DisplayHeight-WindowHeight)/2)
open "Raytrace" for graphics_nsb as #1
  #1  "down ; fill black ; trapclose [quit]"


  global red , green , blue , gray

  red = rgb( 255 , 0 , 0 )
  green = rgb( 0 , 255 , 0 )
  blue = rgb( 0 , 0 , 255 )
  gray = rgb( 200 , 200 , 200 )


  'sphere data x,y,z,radius,color
  'three spheres ,red green and blue
  'evenly spaced around centre of screen
  'z order front to back blue, green, red

  'there are five massive spheres positioned
  'all round the edges and to the rear to create walls


  maxObjects = 10
  dim sp( maxObjects , 4 )
  call sphere 0,0,5 , 4 , red
  call sphere 0,5,2 , 2 , green
  call sphere 6,0,2 , 2 , blue
  call sphere -1e5-12,20,26 , 1e5 , gray
  call sphere 1e5+12,20,26 , 1e5 , gray
  call sphere 0,-1e5-12,26 , 1e5 , gray
  call sphere 0,1e5+12,26 , 1e5 , gray
  call sphere 0,0,1e5+12 , 1e5 , gray

  'point origin of camera
  'centre screen, 24 world units back from the image plane
  cam(X) = 0
  cam(Y) = 0
  cam(Z) = -24

  'point origin of light source
  'centre top, on the image plane
  lit(X) = -11
  lit(Y) = -11
  lit(Z) = -11

  call render
  notice "ready !!"
wait

sub render
'now cast a ray through every pixel on the screen

  for Xp=0 to ImgX
    for Yp=0 to ImgY
      scan

      'point0, the camera x,y,z
      o(X) = cam(X)                     'world x camera 0
      o(Y) = cam(Y)                     'world y camera 0
      o(Z) = cam(Z)                     'world z camera -10


      'point1, the screen x,y,z 
      'which is ScrXLeft (-12) + .5 * ScrX, the per pixel world increment value
      'to which we add xp * ScrX to give world x in world units
      r(X) = ScrXLeft + 0.5 * ScrX + Xp * ScrX   'world x
      r(Y) = ScrYTop + 0.5 * ScrY + Yp * ScrY    'world y
      r(Z) = 0                          'world z image plane 0

      'flat parrallell ray no perspective 
      'o(X)=r(X)
      'o(Y)=r(Y)
      'o(Z)=-10

      'subtract point0 from point1 to get vector direction d()
      d(X) = r(X) - o(X)
      d(Y) = r(Y) - o(Y)
      d(Z) = r(Z) - o(Z)

      'normalize it by dividing by its length to make a unit vector ie it sums to 1
      l = sqr( d(X) * d(X) + d(Y) * d(Y) + d(Z) * d(Z) )
      d(X) = d(X) / l
      d(Y) = d(Y) / l
      d(Z) = d(Z) / l
      DistToScreen = l

      'go look for an intersect
      null = raySphereIntersect()
    next 'y
  next 'x
end sub
[quit]
  close #1
end
function nr$( no , digits )
  nr$ = right$( "0000000000" ; no , digits )
end function
sub savescreen a$
  #1  "getbmp screen 0 0 " ; ImgX ; " " ; ImgY
  bmpsave "screen" , a$ + ".bmp"
end sub
function rgb( a , b , c )
  rgb = a + b * 256 + c * 256 ^ 2
end function
function clr.r( kl )
  clr.r = kl and 255
end function
function clr.g( kl )
  clr.g = int( kl / 256 ) and 255
end function
function clr.b( kl )
  clr.b = int( kl / 256 ^ 2 ) and 255
end function
sub sphere a , b , c , d , kl
  if sptel >= maxObjects then exit sub
  sp( sptel , X ) = a
  sp( sptel , Y ) = b
  sp( sptel , Z ) = c
  sp( sptel , R ) = d
  sp( sptel , clr ) = kl
  sptel = sptel + 1
end sub
function Sphere.dist( o )
  uit = 1e7
  b = 2 * d(X) * ( o(X) - sp(o,X)) _
    + 2 * d(Y) * ( o(Y) - sp(o,Y)) _
    + 2 * d(Z) * ( o(Z) - sp(o,Z))
  c = ( o(X) - sp(o,X) ) ^ 2 _
    + ( o(Y) - sp(o,Y) ) ^ 2 _
    + ( o(Z) - sp(o,Z) ) ^ 2 - sp(o,R) ^ 2
  d = b * b - 4 * c
  if d > 0 then
    uit = ( b * -1 - sqr( b * b - 4 * c ) ) / 2
  end if
  Sphere.dist = uit
end function
function raySphereIntersect()
  maxdist = 1e7
  for o = 0 to sptel
    t = Sphere.dist( o )
    if t > DistToScreen  then
    'store the shortest intersect of all sphere intersects
      if t < maxdist then maxdist = t : id = o
    end if
  next
  if maxdist < 1e7 then
  'establish the sphere surface intersect point
    i(X) = o(X) + d(X) * maxdist
    i(Y) = o(Y) + d(Y) * maxdist
    i(Z) = o(Z) + d(Z) * maxdist
  'get unit normal vector from sphere centre to surface intersect
    n(X) = ( i(X) - sp(id,X) ) / sp(id,R)
    n(Y) = ( i(Y) - sp(id,Y) ) / sp(id,R)
    n(Z) = ( i(Z) - sp(id,Z) ) / sp(id,R)
  'get the unit normal vector from sphere surface intersect to the light
    l(X) = lit(X) - i(X)
    l(Y) = lit(Y) - i(Y)
    l(Z) = lit(Z) - i(Z)
    l = sqr( l(X) * l(X) + l(Y) * l(Y) + l(Z) * l(Z) )
    l(X) = l(X) / l
    l(Y) = l(Y) / l
    l(Z) = l(Z) / l
  'the dot product of these vectors gives an indication of the light
    color = n(X) * l(X) + n(Y) * l(Y) + n(Z) * l(Z)


  'cast a ray from intersect to the light to check for shadow
  'we have done most of the ray prep
  'point0 is the intersect point1 is the light
  'so l() is our ray direction, point1-point0, normalized
    shadow = 1
    o(X) = i(X)
    o(Y) = i(Y)
    o(Z) = i(Z)
    d(X) = l(X)
    d(Y) = l(Y)
    d(Z) = l(Z)
    for o = 0 to sptel
      if o <> id then 
      'check a ll other spheres not the one we are currently considering
        t = Sphere.dist( o )
        if t > 0 and t < 1e7 then shadow = 0.5 : exit function
      end if
    next

    'add some ambient light
    if color < .3 then color = .3

    kl = sp( id , clr )
    'color the pixel
    #1 "color " ; clr.r( kl ) * color * shadow _
          ; " " ; clr.g( kl ) * color * shadow _
          ; " " ; clr.b( kl ) * color * shadow
    #1 "set " ; Xp ; " " ; Yp
  else
    #1 "color black"
    #1 "set " ; Xp ; " " ; Yp
  end if
end function

bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm


Keer terug naar Liberty BASIC Code

Wie is er online

Gebruikers op dit forum: Geen geregistreerde gebruikers. en 1 gast

cron