package require Tk
 proc dial {w x0 y0 x1 y1 args} {
    array set "" {-from 0 -to 100 -needle red
         -bg white -fg black}
     array set "" $args
     $w create oval $x0 $y0 $x1 $y1 -fill $(-bg)
     set xm [expr {($x0+$x1)/2.}]
     set ym [expr {($y0+$y1)/2.}]
     set id [$w create line $xm $ym $xm [+ $y0 10] -fill $(-needle) -width 3]
     $w create oval [- $xm 3] [- $ym 3] [+ $xm 3] [+ $ym 3] -fill $(-fg)
     set r [expr {$ym-$y0-15}]
    foreach i [dial'steps $(-from) $(-to)] {
        set a [dial'angle $(-from) $i $(-to)]
        set x [expr {$xm+$r*cos($a)}]
        set y [expr {$ym+$r*sin($a)}]
        $w create text $x $y -text $i -fill $(-fg)
    }
    trace add variable ::$(-variable) write [list dial'set $w $id $(-from) $(-to)]
 }
 foreach op {+ -} {
    proc $op {a b} "expr {\$a $op \$b}"
 }
 proc dial'steps {min max} {
    set step [expr {($max-$min)/50*10}]
    set res {}
    for {set i $min} {$i<=$max} {incr i $step} {
        lappend res $i
    }
    set res
 }
 proc dial'angle {min v max} {
    expr {(0.5 + double($v-$min)/($max-$min))*acos(-1)*1.5}
 }
 proc dial'set {w id min max var el op} {
    set v [uplevel 1 set $var]
    set v [expr {$v<$min? $min: $v>$max? $max: $v}]
    foreach {xm ym x1 y1} [$w coords $id] break
    set r [expr {hypot($y1-$ym,$x1-$xm)}]
    set a [dial'angle $min $v $max]
    set x1 [expr {$xm+$r*cos($a)}]
    set y1 [expr {$ym+$r*sin($a)}]
    $w coords $id $xm $ym $x1 $y1
 }
#-------- test & demo - modify the value of two variables with <Up>/<Down> keys
 catch {eval destroy [winfo children .]}
 catch {unset V R}
 pack [canvas .c -takefocus 1]
 dial .c 10 10 110 110 -variable V -to 180 -bg yellow
 set V 0
 dial .c 120 10 220 110 -variable R -to 5000 -fg blue
 set R 0
 raise .
 bind . <Up>   {incr V  5; incr R  120}
 bind . <Down> {incr V -5; incr R -120}