Simple raytracing

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

ABU 7-aug-2007

Based on Gerard's work, I've built a little GUI Ray Lab .


DKF: Here's another raytracer (written for Rosetta Code . The intersection algorithm could do with more work, but it does specular as well as diffuse lighting. It produces this output:

http://rosettacode.org/mw/images/f/fc/Deathstar-tcl.gif

package require Tcl 8.5
package require Tk

proc normalize vec {
    upvar 1 $vec v
    lassign $v x y z
    set len [expr {sqrt($x**2 + $y**2 + $z**2)}]
    set v [list [expr {$x/$len}] [expr {$y/$len}] [expr {$z/$len}]]
    return
}
 
proc dot {a b} {
    lassign $a ax ay az
    lassign $b bx by bz
    return [expr {-($ax*$bx + $ay*$by + $az*$bz)}]
}
 
# Intersection code; assumes that the vector is parallel to the Z-axis
proc hitSphere {sphere x y z1 z2} {
    dict with sphere {
        set x [expr {$x - $cx}]
        set y [expr {$y - $cy}]
        set zsq [expr {$r**2 - $x**2 - $y**2}]
        if {$zsq < 0} {return 0}
        upvar 1 $z1 _1 $z2 _2
        set zsq [expr {sqrt($zsq)}]
        set _1 [expr {$cz - $zsq}]
        set _2 [expr {$cz + $zsq}]
        return 1
    }
}
 
# How to do the intersection with our scene
proc intersectDeathStar {x y vecName} {
    global big small
    if {![hitSphere $big $x $y zb1 zb2]} {
        # ray lands in blank space
        return 0
    }
    upvar 1 $vecName vec
    # ray hits big sphere; check if it hit the small one first
    set vec [if {
        ![hitSphere $small $x $y zs1 zs2] || $zs1 > $zb1 || $zs2 <= $zb1
    } then {
        dict with big {
            list [expr {$x - $cx}] [expr {$y - $cy}] [expr {$zb1 - $cz}]
        }
    } else {
        dict with small {
            list [expr {$cx - $x}] [expr {$cy - $y}] [expr {$cz - $zs2}]
        }
    }]
    normalize vec
    return 1
}
 
# Intensity calculators for different lighting components
proc diffuse {k intensity L N} {
    expr {[dot $L $N] ** $k * $intensity}
}
proc specular {k intensity L N S} {
    # Calculate reflection vector
    set r [expr {2 * [dot $L $N]}]
    foreach l $L n $N {lappend R [expr {$l-$r*$n}]}
    normalize R
    # Calculate the specular reflection term
    return [expr {[dot $R $S] ** $k * $intensity}]
}
 
# Simple raytracing engine that uses parallel rays
proc raytraceEngine {diffparms specparms ambient intersector shades renderer fx tx sx fy ty sy} {
    global light
    for {set y $fy} {$y <= $ty} {set y [expr {$y + $sy}]} {
        set line {}
        for {set x $fx} {$x <= $tx} {set x [expr {$x + $sx}]} {
            if {![$intersector $x $y vec]} {
                # ray lands in blank space
                set intensity end
            } else {
                # ray hits something; we've got the normalized vector
                set b [expr {
                    [diffuse {*}$diffparms $light $vec]
                    + [specular {*}$specparms $light $vec {0 0 -1}]
                    + $ambient
                }]
                set intensity [expr {int((1-$b) * ([llength $shades]-1))}]
                if {$intensity < 0} {
                    set intensity 0
                } elseif {$intensity >= [llength $shades]-1} {
                    set intensity end-1
                }
            }
            lappend line [lindex $shades $intensity]
        }
        {*}$renderer $line
    }
}
 
# The general scene settings
set light {-50 30 50}
set big   {cx 20 cy 20 cz 0   r 20}
set small {cx 7  cy 7  cz -10 r 15}
normalize light

# Render as a picture (with many hard-coded settings)
proc guiDeathStar {photo diff spec lightBrightness ambient} {
    set row 0
    for {set i 255} {$i>=0} {incr i -1} {
        lappend shades [format "#%02x%02x%02x" $i $i $i]
    }
    raytraceEngine [list $diff $lightBrightness] \
        [list $spec $lightBrightness] $ambient intersectDeathStar \
        $shades {apply {l {
            upvar 2 photo photo row row
            $photo put [list $l] -to 0 $row
            incr row
            update
        }}} 0 40 0.0625 0 40 0.0625
}
pack [label .l -image [image create photo ds]]
guiDeathStar ds 3 10 0.7 0.3