pack [canvas .c -width 250 -height 250] .c create oval 25 25 225 225 -fill yellow -outline black -tag face#-- Mouth
.c create line 65 150 125 150 185 150 -width 5 -smooth 1 \
-fill red -tag mouth
scale .c.1 -ori vert -length 200 -from -50 -to 100 \
-command {updateMouth .c} -showvalue 0
proc updateMouth {w val} {
$w coords mouth [lreplace [$w coords mouth] 3 3 [expr {150+$val}]]
}
.c create window 240 125 -window .c.1#-- Eyebrows .c create line 60 75 85 75 110 75 -tag brow -smooth 1 -width 3
.c create line 140 75 165 75 190 75 -tag brow -smooth 1 -width 3
scale .c.2 -ori vert -length 200 -from -25 -to 25 -showvalue 0 \
-command {updateBrows .c}
proc updateBrows {w val} {
foreach id [$w find withtag brow] {
$w coords $id [lreplace [$w coords $id] 3 3 [expr {75+$val}]]
}
}
.c create window 10 125 -window .c.2#-- Eyes .c create oval 60 90 110 110 -fill white -outline white
.c create oval 140 90 190 110 -fill white -outline white
.c create oval 75 90 95 110 -fill black -tag iris
.c create oval 155 90 175 110 -fill black -tag iris
scale .c.3 -ori hori -length 200 -from -13 -to 13 -showvalue 0\
-command {updateIris .c}
proc updateIris {w val} {
set x 85
foreach id [$w find withtag iris] {
foreach {x0 y0 x1 y1} [$w coords $id] break
$w coords $id [list [expr {$x+$val-10}] $y0\
[expr {$x+$val+10}] $y1]
incr x 80
}
}
.c create window 125 245 -window .c.3#-- Face color .c bind face <1> {
set color [tk_chooseColor]
if {$color ne ""} {%W itemconfig face -fill $color}
}TV Great. I'm sure missed some hidden variables/sliders...
