% tclsh ray.tcl > ray.ppm
proc innerproduct {vx1 vy1 vz1 vx2 vy2 vz2} {
expr $vx1 * $vx2 + $vy1 * $vy2 + $vz1 * $vz2
}
proc sphere_color {pointx pointy pointz tox toy toz t} {
set lx 0.5773
set ly -0.5773
set lz 0.5773
set vx1 [expr $t * $tox]
set vy1 [expr $t * $toy]
set vz1 [expr $t * $toz]
set vx2 [expr $vx1 - $pointx]
set vy2 [expr $vy1 - $pointy]
set vz2 [expr $vz1 - $pointz]
set d [expr sqrt($vx2*$vx2 + $vy2*$vy2 + $vz2*$vz2)]
set vx2 [expr $vx2 / $d]
set vy2 [expr $vy2 / $d]
set vz2 [expr $vz2 / $d]
set d [innerproduct $lx $ly $lz $vx2 $vy2 $vz2]
set col [expr int(255 * $d + 50)]
if {$col > 255} {
set col 255
}
if {$col < 0} {
set col 0
}
puts "$col 0 0"
}
proc scan {} {
set pointx 0.0
set pointy 0.0
set pointz 0.0
set radius 0.5
set fromx -1.0
set fromy -1.0
set fromz 3.0
set tox 0.0
set toy 0.0
set toz -1.0
for {set y 1} {$y <= 200} {incr y} {
set fromy [expr $fromy + 2.0/200]
for {set x 1} {$x <= 200} {incr x} {
set fromx [expr $fromx + 2.0/200]
set vecx [expr $fromx - $pointx]
set vecy [expr $fromy - $pointy]
set vecz [expr $fromz - $pointz]
set b [innerproduct $tox $toy $toz $vecx $vecy $vecz]
set c [innerproduct $vecx $vecy $vecz $vecx $vecy $vecz]
set c [expr $c - $radius * $radius]
set d [expr $b * $b - $c]
if {$d < 0} {
puts "100 100 100"
continue
}
set det [expr sqrt($d)]
set t [expr -$b + $det]
if {$t < 0} {
puts "100 100 100"
continue
}
sphere_color $pointx $pointy $pointz $fromx $fromy $fromz $t
}
set fromx -1.0
}
}
proc head {} {
puts "P3\n200 200\n255"
}
head
scan