Tk Library Source Code

Artifact 63521b25c0f53dbb762c94ddfab36e19137588c3:

Attachment "rs_dials.tcl" to ticket [1580085fff] added by andreas_kupries 2006-10-19 05:51:18.

---

#####
#
# "Canvas dials"
# http://wiki.tcl.tk/17065
#
# Tcl code harvested on:  18 Oct 2006, 22:48 GMT
# Wiki page last updated: ???
#
#####


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 var ::$(-variable) w [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
}
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}


# EOF