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.
##+##########################################################################
#
# Gradient Spheres
# 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)}]
set gradient {}
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]
}
return $gradient
}
proc GradientSphere {c Ox Oy radius Lx Ly color1 color2 {csteps {}}} {
# c: canvas to use
# Ox,Oy, radius: center and radius of sphere
# 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 radius 100
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)}]]
}
GradientSphere .c $x0 $y0 $radius -.4 -.4 $clr white
}
}
Demo
return