## Spheres

ulis, 2003-09-10

Inspired from Marco Maggi's page: Experimenting with graphics algorithms.

The proc

```proc gradient {image relief light source} {
set sunken [string match sun* \$relief]
set light [expr {\$light * 96 + 32}]
set source [expr {0.5 + \$source / 2.0}]
set D [image width \$image]
set R [expr {\$D / 2}]
set R2 [expr {\$R * \$R}]
for {set y 0} {\$y < \$D} {incr y} {
set Dy2 [expr {(\$y - \$R) * (\$y - \$R)}]
set dy [expr {(\$y * \$source - \$R)}]
set dy2 [expr {\$dy * \$dy}]
for {set x 0} {\$x < \$D} {incr x} {
set Dx2 [expr {(\$x - \$R) * (\$x - \$R)}]
set Dxy [expr {\$Dx2 + \$Dy2}]
if {\$Dxy <= \$R2} {
set dx [expr {(\$x * \$source - \$R)}]
set dx2 [expr {\$dx * \$dx}]
set dxy [expr {\$dx2 + \$dy2}]
set color [expr {int(127 + \$light * (1.0 - (\$dxy / \$R2 / 1.5)))}]
if {\$sunken} { set color [expr {int(127 + \$light * 2 - \$color)}] }
set color [format "#%02x%02x%02x" \$color \$color \$color]
\$image put \$color -to [expr {\$D - \$x}]  [expr {\$D - \$y}]
}
}
}
}```

The demo

```proc demo {args} {
# args
set size 128
set light 1.0
set source 0.0
foreach {key value} \$args {
switch -glob -- \$key {
-li* {
if {\$value < 0.0 ||\$value > 1.0} {
error "light should be between 0.0 and 1.0"
}
set light \$value
}
-si* { set size \$value }
-so* {
if {\$value < 0.0 ||\$value > 1.0} {
error "source should be between 0.0 and 1.0"
}
set source \$value
}
default { error "unknown option \"\$key\"" }
}
}
# title
wm title . "spheres"
# canvas
set ww \$size; incr ww \$size; incr ww
set hh \$size; incr hh
canvas .c -width \$ww -height \$hh -relief groove -bd 1
# raised image
image create photo raised -width \$size -height \$size
set x 3; set y 3
.c create image \$x \$y -image raised -anchor nw
# sunken image
incr x \$size
image create photo sunken -width \$size -height \$size
.c create image \$x \$y -image sunken -anchor nw
# button
button .b -text Quit -width 6 -command exit -bd 1
bind .b <Return> { %W invoke }
bind . <Escape> { exit }
}

package require Tk 8.4
demo -size 96 -light 0.9 -source 0.1```

___

uniquename 2014jan27

For those who do not have the facilities or time to implement the code above, here is an image of the window that is produced by the 'spheres' Tk script of 'ulis'.

Modified to use a dot-product for a simple (but accurate) lighting model

```package require Tk

proc draw_sphere {image } {
set D [image width \$image]
set R [expr {\$D / 2}]
set invR [expr {1.0/\$R}]
set R2 [expr {\$R * \$R}]

# direction to light source (normal vector)
set lightX 0.4472
set lightY 0.5366
set lightZ 0.7155

# iterate top to bottom
for {set sy 0} {\$sy < \$D} {incr sy} {
set y [expr {(\$sy - \$R)}]
set xmax [expr {\$R2-\$y*\$y}]
if { \$xmax < 0 } {continue}
set xmax [expr {int(sqrt(\$xmax))}]
set xmin [expr {\$R-\$xmax}]
set xmax [expr {\$R+\$xmax}]

set vY [expr {\$y * \$invR}]

# iterate left to right, but only within the circle
for {set sx \$xmin} {\$sx <= \$xmax} {incr sx} {
set vX [expr {(\$sx-\$R) * \$invR}]
set vZ [expr {1.0 - \$vY*\$vY - \$vX*\$vX}]
if { \$vZ < 0 }  { set vZ 0 }
set vZ [expr {sqrt(\$vZ)}]

# dot product of light vector with surface normal vector
set color [expr {\$lightX*\$vX+\$lightY*\$vY+\$lightZ*\$vZ}]
if { \$color < 0.0 } { set color 0.0 }
if { \$color > 1 } { set color 1 }
set red [expr {int(255 * \$color)}]
set color [format "#%02x%02x%02x" \$red \$red \$red ]
\$image put \$color -to [expr {\$D - \$sx}]  [expr {\$D - \$sy}]

}
}

}

proc demo2 {} {

wm title . "sphere"

set size 97
set ww [expr 2*\$size]
set hh [expr 2*\$size]
canvas .c -width \$ww -height \$hh  -bg #6060ff
.c create rectangle 0 [expr \$hh/3] \$ww \$hh -fill #00aa00 -outline {}
# raised image
image create photo sphere_img -width \$size -height \$size
set x [expr \$ww/2]
set y [expr \$hh*2.0/3]
.c create image \$x \$y -image sphere_img -anchor c
draw_sphere sphere_img

}

demo2```

___

uniquename 2014jan27

For those who do not have the facilities or time to implement the code above, here is an image of the window produced by the 'sphere' Tk script of 'ulis'.

 Category Example Category Graphics Category Image Processing