Posted to tcl by nscerqueira at Thu Mar 14 01:59:43 GMT 2013view raw

  1. proc dial {w x0 y0 x1 y1 args} {
  2. array set "" {-from 0 -to 100 -needle red
  3. -bg white -fg black}
  4. array set "" $args
  5. $w create oval $x0 $y0 $x1 $y1 -fill $(-bg)
  6. set xm [expr {($x0+$x1)/2.}]
  7. set ym [expr {($y0+$y1)/2.}]
  8. set id [$w create line $xm $ym $xm [+ $y0 10] -fill $(-needle) -width 3]
  9. $w create oval [- $xm 3] [- $ym 3] [+ $xm 3] [+ $ym 3] -fill $(-fg)
  10. set r [expr {$ym-$y0-15}]
  11. foreach i [dial'steps $(-from) $(-to)] {
  12. set a [dial'angle $(-from) $i $(-to)]
  13. set x [expr {$xm+$r*cos($a)}]
  14. set y [expr {$ym+$r*sin($a)}]
  15. $w create text $x $y -text $i -fill $(-fg)
  16. }
  17. trace var ::$(-variable) w [list dial'set $w $id $(-from) $(-to)]
  18.  
  19.  
  20.  
  21. }
  22. foreach op {+ -} {
  23. proc $op {a b} "expr {\$a $op \$b}"
  24. }
  25. proc dial'steps {min max} {
  26. set step [expr {($max-$min)/50*10}]
  27. set res {}
  28. for {set i $min} {$i<=$max} {incr i $step} {
  29. lappend res $i
  30. }
  31. set res
  32. }
  33. proc dial'angle {min v max} {
  34. expr {(0.5 + double($v-$min)/($max-$min))*acos(-1)*1.5}
  35. }
  36. proc dial'set {w id min max var el op} {
  37. set v [uplevel 1 set $var]
  38. set v [expr {$v<$min? $min: $v>$max? $max: $v}]
  39. foreach {xm ym x1 y1} [$w coords $id] break
  40. set r [expr {hypot($y1-$ym,$x1-$xm)}]
  41. set a [dial'angle $min $v $max]
  42. set x1 [expr {$xm+$r*cos($a)}]
  43. set y1 [expr {$ym+$r*sin($a)}]
  44. $w coords $id $xm $ym $x1 $y1
  45. }
  46.  
  47.  
  48. proc Go {} {
  49. set msg "\"CPU usage\""
  50. set fin [open "|top -l 1 | grep $msg " r]
  51. set cpu [string trim [read $fin]]
  52. set cpuUser [string range [lindex $cpu 2] 0 [expr [string length [lindex $cpu 2]] -2]]
  53. set cpuSys [string range [lindex $cpu 4] 0 [expr [string length [lindex $cpu 4]] -2]]
  54. set cpuTotal [expr $cpuUser + $cpuSys]
  55. close $fin
  56. return $cpuTotal
  57. }
  58.  
  59.  
  60. #-------- test & demo - modify the value of two variables with <Up>/<Down> keys
  61. # catch {eval destroy [winfo children .]}
  62. # catch {unset V R}
  63.  
  64. grid [ttk::button .b -text "Quit" -command {set cycle 1}] -row 2 -column 0 -sticky news
  65. grid [canvas .c -width 120 -height 120 ] -row 1 -column 0 -sticky news
  66. grid [ttk::label .t -text "Total CPU Usage"] -row 0 -column 0 -sticky news
  67.  
  68. dial .c 10 10 110 110 -variable V -to 100 -bg yellow
  69. set V 0
  70. raise .
  71. update
  72.  
  73. set cycle 0
  74. while {$cycle==0} {
  75. set V [Go]
  76. set color green
  77. if {$V>=50 } { set color yellow}
  78. if {$V>=80 } { set color red}
  79.  
  80. .c configure -background $color
  81. update
  82. }
  83. exit
  84.