Version 4 of Simple raytracing

Updated 2005-05-21 01:05:26

GS - Raytracing is one of the most popular method for rendering 3D images. It was invented by Thomas Whitted in 1979 on the basis of the early work of Appel (1968) on raycasting.

The key idea is to project a ray of light through a scene for every pixel on screen. The pixel through which the ray passes is set to the color of the intersected object defined mathematically (quadrics, planes, bezier patches, ....). For the theoritical part see [L1 ] and for the mathematical details see [L2 ].

http://gersoo.free.fr/wiki/w10857/ray.jpg

 # ray.tcl 
 # Author:      Gerard Sookahet
 # Date:        06 Feb 2004 
 # Description: Simple raytracer with sphere object

 proc Main {wd ht} {

  set w .ray
  catch {destroy $w}
  toplevel $w
  wm withdraw .
  wm title $w "Raytracing"

  pack [canvas $w.c -width $wd -height $ht -bg white]
  $w.c delete all
  set pix [image create photo]
  $w.c create image 0 0 -anchor nw -image $pix

  set f1 [frame $w.f1 -relief sunken -borderwidth 2]
  pack $f1 -fill x
  button $f1.bcreate -text Render -command "Raytrace $wd $ht $pix"
  button $f1.bq -text Quit -command exit 
  eval pack [winfo children $f1] -side left
 }

 proc Raytrace {wd ht pix} {
  for {set y 0} {$y <= $ht} {incr y} {
     set line {}
     for {set x 0} {$x <= $wd} {incr x} {
        set color [IntersectSphere $x $y $wd $ht]
        set R [expr {round([lindex $color 0])}]
        set V [expr {round([lindex $color 1])}]
        set B [expr {round([lindex $color 2])}]
        lappend line [format "#%02X%02X%02X" $R $V $B]
     }
     # 'put' and update once per line for best speed / visual response
     $pix put [list $line] -to 0 $y
     update idletasks
  }
 }

 proc IntersectSphere {x y wd ht} {
 # Center of the sphere
  set cx 0.0
  set cy 0.0
  set cz 0.0
  set radius 1.2
 # Point of view
  set from_x 0.0
  set from_y 0.0
  set from_z 6.0
  set tmin 1000000.0; # Closest intersection distance arbitrarly large

  set to_x [expr {double($x)/double($wd) - $from_x/$wd - 0.5}]
  set to_y [expr {double($y)/double($ht) - $from_y/$ht - 0.5}]
  set to_z [expr {4.0 - $from_z}]

  foreach {to_x to_y to_z} [VectNormalize $to_x $to_y $to_z] {}

  set vect_x [expr {$cx - $from_x}]
  set vect_y [expr {$cy - $from_y}]
  set vect_z [expr {$cz - $from_z}]
 # Solve the ray and sphere intersection equation
  set b [DotProduct $to_x $to_y $to_z $vect_x $vect_y $vect_z]
  set c [DotProduct $vect_x $vect_y $vect_z $vect_x $vect_y $vect_z]
  set c [expr {$c - $radius*$radius}]
  set d [expr {$b*$b - $c}]
  if {$d < 0} then {return [list 0 0 0]}; # No ray intersection
  set dsqrt [expr {sqrt($d)}]   
  set t1 [expr {$b + $dsqrt}]
  set t2 [expr {$b - $dsqrt}]
  if {$t1 < 0} then {return [list 0 0 0]}; # Object is behind the point of view
  if {$t2 > 0.0} then {set t $t2} else {set t $t1}
  if {$tmin > $t} then {set tmin $t}
  if {$tmin >= 1000000.0} then {return [list 0 0 0]}
 # Return a color since the ray intersect the sphere
  return [Shading $tmin $from_x $from_y $from_z $to_x $to_y $to_z $cx $cy $cz]
 }

 proc Shading {t from_x from_y from_z to_x to_y to_z cx cy cz} {
 # Normalized light vector <-1,-1,1>
  set l_x -0.577
  set l_y -0.577
  set l_z  0.577
 # Color of the object
  set color_x 0
  set color_y 0
  set color_z 255
 # Ambient light color 
  set amb_x 20
  set amb_y 20
  set amb_z 20

  set t_x [expr {$to_x*$t}]
  set t_y [expr {$to_y*$t}]
  set t_z [expr {$to_z*$t}]

  set c_x [expr {$from_x + $t_x - $cx}]
  set c_y [expr {$from_y + $t_y - $cy}]
  set c_z [expr {$from_z + $t_z - $cz}]

  foreach {c_x c_y c_z} [VectNormalize $c_x $c_y $c_z] {}

  set angle [DotProduct $c_x $c_y $c_z $l_x $l_x $l_z]
  if {$angle < 0.0} then {set angle 0.0}
 # Lambert's law light intensity plus an attenuation factor
  set c_x [expr {$color_x*$angle + $amb_x}]
  set c_y [expr {$color_y*$angle + $amb_y}]
  set c_z [expr {$color_z*$angle + $amb_z}]

  set c_x [expr {$c_x > 255 ? 255 : $c_x}]
  set c_y [expr {$c_y > 255 ? 255 : $c_y}]
  set c_z [expr {$c_z > 255 ? 255 : $c_z}]

  return [list $c_x $c_y $c_z]
 }

 proc DotProduct {ax ay az bx by bz} {
  return [expr {$ax*$bx + $ay*$by + $az*$bz}]
 }

 proc VectNormalize {vx vy vz} {
  set d [expr {sqrt($vx*$vx + $vy*$vy + $vz*$vz)}]
  return [list [expr {$vx/$d}] [expr {$vy/$d}] [expr {$vz/$d}]]
 }
 # Size of the screen
 Main 200 200

tclguy changed the original "draw and update for every pixel" to "collect pixels of a line into a list, draw and update once per line" which brought quite a speed increase:

         Raytrace0: 26511967 microseconds per iteration - original
        Raytrace1: 10648166 microseconds per iteration - [update] only once per line
        Raytrace2:  4359732 microseconds per iteration - pixels collected in list, put once per line

[ Category Graphics | Category Mathematics ]