Version 0 of Shading a Plane With Light

Updated 2005-09-08 07:32:32

George Peter Staplin Sep 8, 2005 - I'm learning about the color changes caused by light on objects. I wrote this little prototype after I discovered the ratios behind most shading. In the future I might try to use the physics of light to simulate the effect more realistically.

http://www.xmission.com/~georgeps/images/wiki/shading_a_plane.png

package require Tk

proc radiate {win px py width height} {

 # XXX be aware of this.
 $win delete all

 set ratio [expr {hypot($px,$py) / 255.0}]

 for {set y 0} {$y < $height} {incr y} {
  for {set x 0} {$x < $width} {incr x} {
   set gray [expr {int(hypot(($x - $px),($y - $py)) * $ratio)}]

   if {$gray > 255} {
    set gray 255
   }

   set value [expr {255 - $gray}]
   set color [format #%2.2x%2.2x%2.2x $value $value $value]
   #puts $color
   $win create line $x $y [expr {$x + 1}] [expr {$y + 1}] -fill $color -width 1
  }
 }

}

proc main {argc argv} {

 pack [canvas .c -width 400 -height 400 -bg black]

 update idletasks

 #radiate .c 200 200 400 400

 set ::px 200
 set ::py 200

 pack [frame .fpoint] -fill x
 label .fpoint.lx -text X:
 entry .fpoint.ex -textvariable ::px
 label .fpoint.ly -text Y:
 entry .fpoint.ey -textvariable ::py

 grid .fpoint.lx -row 0 -column 0
 grid .fpoint.ex -row 0 -column 1
 grid .fpoint.ly -row 0 -column 2
 grid .fpoint.ey -row 0 -column 3

 pack [button .b -text Radiate -command {radiate .c $::px $::py 400 400}]

} main $::argc $::argv

Category Graphics