RayTracer

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

Moderators: anthonio, Abcott

RayTracer

Berichtdoor bluatigro » do mei 13, 2010 9:22 am

ik ben begonnen met n ray tracer
t zou n rode bol moeten tekenen
maat t tekend zelfs geen achtergrond

WAARSCHUWING : deze code kan aleen gestopt worden met crtl+alt+del

Code: Selecteer alles
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy
winx = WindowWidth
winy = WindowHeight
global pi , frame
global black , red , green , yellow
global blue , magenta , cyan , white
global pink , purple , gray , orange
black   = rgb(   0 ,   0 ,   0 )
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 )
pink    = rgb( 255 , 127 , 127 )
orange  = rgb( 255 , 127 ,   0 )
gray    = rgb( 127 , 127 , 127 )
purple  = rgb( 127 ,   0 , 127 )
pi = atn( 1 ) * 4
global sphtel , sphmax
sphmax = 200
dim sph( sphmax , 5 )
open "RAY" for graphics as #m
  #m "trapclose [quit]"
  sphtel = 0
  call sphere 0,0,100 , 50 , red , 0
  call draw
wait
end
sub draw
  for x = 0-winx/2 to winx/2
    for y = 0-winy/2 to winy/2
    ''for al pixels
      nux = x
      nuy = y
      nuz = 1000
      tel = 0
      adx = nux / length( nux , nuy , nuz )
      ady = nuy / length( nux , nuy , nuz )
      adz = nuz / length( nux , nuy , nuz )
      while tel < 1000 _
      and sphno( nux , nuy , nuz ) = 0-1
      ''while no sphere and no background
        q = length( adx , ady , adz )+1e-10
        call mul adx,ady,adz _
        ,( nuz + 1000 ) / 1000 / q
        call mul adx , ady , adz , adq
        call add nux,nuy,nuz,adx,ady,adz
        tel = tel + 1
      wend
      sph1 = sphno( nux , nuy , nuz )
      if sph1 = 0-1 then
      ''no sphere found
        kl = black
      else
      ''get color of sphere
        kl = sph( sph1 , 4 )
        call add nux , nuy , nuz _
        , 0-sph( sph1 , 0 ) _
        , 0-sph( sph1 , 1 ) _
        , 0-sph( sph1 , 2 )
        ''use angle normal - light for shading
        a = gamma(nux,nuy,nuz,0,1,0)
        kl = mix(kl,a/pi,black)
      end if
      r = kl and 255
      g = int( kl / 256 ) and 255
      b = int( kl / 256 ^ 2 ) and 255
      #m "color ";r;" ";g;" ";b
      #m "goto ";x+winx/2;" ";winy/2-y
      #m "down"
      #m "set ";x+winx/2;" ";winy/2-y
      #m "up"
    next y
  next x
end sub
[quit]
  close #m
end
function sphno( x , y , z )
''look if ray hit any sphere
  no = 0-1
  i = 0
  while i < sphtel _
  and no = 0-1
  ''for al spheres
    if sph( i , 3 ) _
    >length(sph(i,0)-x,sph(i,1)-y,sph(i,2)-z)then
    ''ray hit this sphere
      no = i
    end if
    i =  i + 1
  wend
  sphno = no
end function
sub sphere x , y , z , d , kl , flags
''create a sphere
  if sphtel >= sphmax then exit sub
  sph( sphtel , 0 ) = x
  sph( sphtel , 1 ) = y
  sph( sphtel , 2 ) = z
  sph( sphtel , 3 ) = d
  sph( sphtel , 4 ) = kl
  sph( sphtel , 5 ) = flags
  sphtel = sphtel + 1
end sub
sub add byref x , byref y , byref z , dx , dy , dz
''add 2 vectors
  x = x + dx
  y = y + dy
  z = z + dz
end sub
sub mul byref x , byref y , byref z , d
''multiply vector whit scalar
  x = x * d
  y = y * d
  z = z * d
end sub
function gamma(x,y,z,a,b,c)
''get angle between 2 vectors
  ao = length(x,y,z)
  bo = length(a,b,c)
  ab = length(x-a,y-b,z-c)
  gamma = acos((ab^2-ao^2-bo^2)/(0-2*ao*bo))
end function
function acos( x )
  acos = Atn(x / Sqr(x * 0-x + 1)) + Pi / 2
end function
function length( x , y , z )
''get length of vector
  length = sqr( x ^ 2 + y ^ 2 + z ^ 2 )
end function
function nr$( no , max )
''for animation storing
  nr$ = right$( "00000000" + str$( no ) , max )
end function
function rad( deg )
''get radians from degrees
  rad = deg * pi / 180
end function
function rainbow( deg )
''ful circle = rainbow efect
  rainbow = rgb( sin( rad( deg ) ) * 127 + 128 _
               , sin( rad( deg - 120 ) ) * 127 + 128 _
               , sin( rad( deg + 120 ) ) * 127 + 128 )
end function
function rgb( r , g , b )
''create a color
''r g b = 0...255
  rgb = ( r and 255 ) _
  + ( g and 255 ) * 256 _
  + ( b and 255 ) * 256 * 256
end function
function mix( kl1 , f , kl2 )
''get a color between 2 colors
''kl1 kl2 = colors
''f = 0...1
  r1 = int( kl1 and 255 )
  g1 = int( kl1 / 256 ) and 255
  b1 = int( kl1 / 256 / 256 ) and 255
  r2 = int( kl2 and 255 )
  g2 = int( kl2 / 256 ) and 255
  b2 = int( kl2 / 256 / 256 ) and 255
  dr = r2 - r1
  dg = g2 - g1
  db = b2 - b1
  dr = dr * f
  dg = dg * f
  db = db * f
  r = r1 + dr
  g = g1 + dg
  b = b1 + db
  mix = rgb( r and 255 , g and 255 , b and 255 )
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: Bing [Bot] en 1 gast

cron