Shading a Plane With Light

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

gold testing inhouse pix

 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]

  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