Face control

if 0 {Richard Suchenwirth 2004-08-30 - Vacations is a time without real work. But before getting bored, one can always try an unreal fun project - so here's a little emotion visualisation tool. With scales you can control whether eye brows are lifted or lowered (at left), whether the mouth is sad or happy (at right), and where the eyes look (at bottom). Clicking on the face gives you a color selector to choose a suitable fill color.

}

 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...