Keith Vetter 2006-08-16 : For a game I'm writing, I needed sphere shaped playing pieces. I grabbed some images off the web but I had trouble when I made the background transparent--the edges just looked horrible.

So I decided to create my own. It draws a series of shrinking circles, each slightly offset from the previous and with colors from a gradient.

The result looks (sort of) like a sphere with an offset light source.

Stu 2008-11-11 Commented-out code that causes expected integer but got "bold" error on *nix systems.

uniquename 2013aug17

Here is an image to show what the following code creates. (This image was created on Linux --- Ubuntu 9.10 - the good old 2009 October version - 'Karmic Koala'. Those were the days. Ubuntu and Gnome have gone downhill since then ... IMHO.)

``` ##+##########################################################################
#
# by Keith Vetter, August 2006
#
package require Tk

proc Gradient {n clr1 clr2} {

foreach {r1 g1 b1} [winfo rgb . \$clr1] {r2 g2 b2} [winfo rgb . \$clr2] break

set n [expr {\$n <= 1 ? 1 : double(\$n - 1)}]
for {set i 0} {\$i <= \$n} {incr i} {
set r [expr {int((\$r2 - \$r1) * \$i / \$n + \$r1) * 255 / 65535}]
set g [expr {int((\$g2 - \$g1) * \$i / \$n + \$g1) * 255 / 65535}]
set b [expr {int((\$b2 - \$b1) * \$i / \$n + \$b1) * 255 / 65535}]
lappend gradient [format "#%.2x%.2x%.2x" \$r \$g \$b]
}

}

proc GradientSphere {c Ox Oy radius Lx Ly color1 color2 {csteps {}}} {
# c: canvas to use
# Lx,Ly: where light source hits and is a position in a -1,-1 to 1,1 box
#   which is mapped onto the bounding box of the sphere
# color1, color2: outer and inner colors for the gradient
# csteps: how many colors to use, defaults to radius

if {\$csteps eq {}} {set csteps \$radius}
set clrs [Gradient \$csteps \$color1 \$color2]

for {set i 0} {\$i < \$radius} {incr i} {
set x [expr {\$Ox + \$i * \$Lx}]           ;# Center of shrinking circle
set y [expr {\$Oy + \$i * \$Ly}]
set x0 [expr {\$x - (\$radius - \$i)}]     ;# BBox of shrinking circle
set y0 [expr {\$y - (\$radius - \$i)}]
set x1 [expr {\$x + (\$radius - \$i)}]
set y1 [expr {\$y + (\$radius - \$i)}]
set idx [expr {round(\$csteps * \$i / double(\$radius))}]
set clr [lindex \$clrs \$idx]

\$c create oval \$x0 \$y0 \$x1 \$y1 -tag gradient -fill \$clr -outline \$clr
}
}

# DEMO code
proc Demo {{random 0}} {
if {! [winfo exists .c]} {
canvas .c -width 750 -height 500 -bg yellow
button .go -text "Random Colors" -command {Demo 1}

#causes 'expected integer but got "bold"' error on *nix systems.
#.go config -font "[.go cget -font] bold"

pack .go -side bottom -pady 10
pack .c -fill both -side top
}

.c delete all
set row 0
set col -1
foreach clr {#000080 #008000 #800000 #808000 #800080 #008080} {
if {[incr col] >= 3} { set col 0; incr row }
set x0 [expr {(.5 + \$col) * (2*\$radius + 50)}]
set y0 [expr {(.5 + \$row) * (2*\$radius + 50)}]
if {\$random} {
set clr [format \#%06x [expr {int(rand() * 0xFFFFFF)}]]
}