1# voltmeter.tcl -- 2# 3# Adapted by Arjen Markus (snitified), july 2010 4# 5# 6# 7# 8# Part of: The TCL'ers Wiki 9# Contents: a voltmeter-like widget 10# Date: Fri Jun 13, 2003 11# 12# Abstract 13# 14# 15# 16# Copyright (c) 2003 Marco Maggi 17# 18# The author hereby grant permission to use, copy, modify, distribute, 19# and license this software and its documentation for any purpose, 20# provided that existing copyright notices are retained in all copies 21# and that this notice is included verbatim in any distributions. No 22# written agreement, license, or royalty fee is required for any of the 23# authorized uses. Modifications to this software may be copyrighted by 24# their authors and need not follow the licensing terms described here, 25# provided that the new terms are clearly indicated on the first page of 26# each file where they apply. 27# 28# IN NO EVENT SHALL THE AUTHOR OR DISTRIBUTORS BE LIABLE TO ANY PARTY 29# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES 30# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY 31# DERIVATIVES THEREOF, EVEN IF THE AUTHOR HAVE BEEN ADVISED OF THE 32# POSSIBILITY OF SUCH DAMAGE. 33# 34# THE AUTHOR AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, 35# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 36# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND 37# NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, 38# AND THE AUTHOR AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE 39# MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. 40# 41# $Id: voltmeter.tcl,v 1.2 2010/08/10 11:05:51 arjenmarkus Exp $ 42# 43 44package require Tk 8.5 45package require snit 46 47namespace eval controlwidget { 48 namespace export voltmeter 49} 50 51# voltmeter -- 52# Voltmeter-like widget 53# 54snit::widget controlwidget::voltmeter { 55 56 # 57 # widget default values 58 # 59 option -borderwidth -default 1 60 option -background -default gray 61 option -dialcolor -default white 62 option -needlecolor -default black 63 option -scalecolor -default black 64 option -indexid -default {} 65 66 option -variable -default {} -configuremethod VariableName 67 option -min -default 0.0 68 option -max -default 100.0 69 option -labelcolor -default black 70 option -titlecolor -default black 71 option -labelfont -default {Helvetica 8} 72 option -titlefont -default {Helvetica 9} 73 option -labels -default {} 74 option -title -default {} 75 option -width -default 50m 76 option -height -default 25m 77 option -highlightthickness -default 0 78 option -relief -default raised 79 80 variable pi [expr {3.14159265359/180.0}] 81 variable motion 82 variable xc 83 variable yc 84 85 constructor args { 86 87 # 88 # Configure the widget 89 # 90 $self configurelist $args 91 92 canvas $win.c -background $options(-background) -width $options(-width) -height $options(-height) \ 93 -relief $options(-relief) -borderwidth $options(-borderwidth) 94 grid $win.c -sticky news -padx 2m -pady 2m 95 96 if {$options(-variable) ne ""} { 97 trace add variable ::$options(-variable) write [mymethod tracer $options(-variable)] 98 } 99 100 set width [$win.c cget -width] 101 set height [$win.c cget -height] 102 set xcentre [expr {$width*0.5}] 103 set ycentre [expr {$width*1.4}] 104 set t 1.15 105 set t1 1.25 106 107 $win.c create arc \ 108 [expr {$xcentre-$width*$t}] [expr {$ycentre-$width*$t}] \ 109 [expr {$xcentre+$width*$t}] [expr {$ycentre+$width*$t}] \ 110 -start 70.5 -extent 37 -style arc -outline lightgray \ 111 -width [expr {$ycentre*0.245}] 112 $win.c create arc \ 113 [expr {$xcentre-$width*$t}] [expr {$ycentre-$width*$t}] \ 114 [expr {$xcentre+$width*$t}] [expr {$ycentre+$width*$t}] \ 115 -start 71 -extent 36 -style arc -outline $options(-dialcolor) \ 116 -width [expr {$ycentre*0.23}] 117 $win.c create arc \ 118 [expr {$xcentre-$width*$t1}] [expr {$ycentre-$width*$t1}] \ 119 [expr {$xcentre+$width*$t1}] [expr {$ycentre+$width*$t1}] \ 120 -start 75 -extent 30 \ 121 -fill black -outline $options(-scalecolor) -style arc -width 0.5m 122 123 set num [llength $options(-labels)] 124 set angle 255.0 125 set delta [expr {30.0/($num-1)}] 126 set l1 [expr {$width*$t1}] 127 set l2 [expr {$width*$t1*0.95}] 128 set l3 [expr {$width*$t1*0.92}] 129 for {set i 0} {$i < $num} {incr i} { 130 set a [expr {($angle+$delta*$i)*$pi}] 131 132 set x1 [expr {$xcentre+$l1*cos($a)}] 133 set y1 [expr {$ycentre+$l1*sin($a)}] 134 set x2 [expr {$xcentre+$l2*cos($a)}] 135 set y2 [expr {$ycentre+$l2*sin($a)}] 136 $win.c create line $x1 $y1 $x2 $y2 -fill $options(-scalecolor) -width 0.5m 137 138 set x1 [expr {$xcentre+$l3*cos($a)}] 139 set y1 [expr {$ycentre+$l3*sin($a)}] 140 141 set label [lindex $options(-labels) $i] 142 if { [string length $label] } { 143 $win.c create text $x1 $y1 \ 144 -anchor center -justify center -fill $options(-labelcolor) \ 145 -text $label -font $options(-labelfont) 146 } 147 } 148 149 set title $options(-title) 150 if { [string length $title] } { 151 $win.c create text $xcentre [expr {$ycentre-$width*1.05}] \ 152 -anchor center -justify center -fill $options(-titlecolor) \ 153 -text $title -font $options(-titlefont) 154 } 155 156 rivet $win.c 10 10 157 rivet $win.c [expr {$width-10}] 10 158 rivet $win.c 10 [expr {$height-10}] 159 rivet $win.c [expr {$width-10}] [expr {$height-10}] 160 161 set motion 0 162 set xc $xcentre 163 set yc $ycentre 164 bind $win.c <ButtonRelease> [list $self needleRelease %W] 165 bind $win.c <Motion> [list $self needleMotion %W %x %y] 166 167 set value 0 168 $self drawline $win $value 169 } 170 171 method destructor {} { 172 set varname ::$options(-variable)] 173 trace remove variable $varname write \ 174 [namespace code "mymethod tracer $win $varname"] 175 } 176 177 # 178 # public methods -- 179 # 180 method set {newValue} { 181 if { $options(-variable) != "" } { 182 set ::$options(-variable) $newValue ;#! This updates the dial too 183 } else { 184 set options(-value) $newValue 185 $self draw $win.c $options(-value) 186 } 187 } 188 method get {} { 189 return $options(-value) 190 } 191 192 # 193 # private methods -- 194 # 195 196 method VariableName {option name} { 197 198 # Could be still constructing in which case 199 # $win.c does not exist: 200 201 if {![winfo exists $win.c]} { 202 set options(-variable) $name 203 return; 204 } 205 206 # Remove any old traces 207 208 if {$options(-variable) ne ""} { 209 trace remove variable ::$options(-variable) write [mymethod tracer $options(-variable)] 210 } 211 212 # Set new trace if appropriate and update value. 213 214 set options(-variable) $name 215 if {$options(-variable) ne ""} { 216 trace add variable ::$options(-variable) write [mymethod tracer $options(-variable)] 217 $self drawline $win.c [set ::$options(-variable)] 218 } 219 } 220 221 method tracer { varname args } \ 222 { 223 set options(-value) [set ::$varname] 224 $self drawline $win [set ::$varname] 225 } 226 227 method drawline { widget value } { 228 set id $options(-indexid) 229 set min $options(-min) 230 set max $options(-max) 231 232 set c $widget.c 233 234 set v [expr { ($value <= ($max*1.05))? $value : ($max*1.05) }] 235 236 set angle [expr {((($v-$min)/(1.0*($max-$min)))*30.0+165.0)*$pi}] 237 238 set width [$c cget -width] 239 set xcentre [expr {$width/2.0}] 240 set ycentre [expr {$width*1.4}] 241 set l1 [expr {$ycentre*0.85}] 242 set l2 [expr {$ycentre*0.7}] 243 244 set xl [expr {$xcentre-$l1*sin($angle)}] 245 set yl [expr {$ycentre+$l1*cos($angle)}] 246 set xs [expr {$xcentre-$l2*sin($angle)}] 247 set ys [expr {$ycentre+$l2*cos($angle)}] 248 249 catch {$c delete $id} 250 set id [$c create line $xs $ys $xl $yl -fill $options(-needlecolor) -width 0.6m] 251 $c bind $id <ButtonPress> [list $self needlePress %W] 252 set options(-indexid) $id 253 } 254 255 method needlePress {w} \ 256 { 257 set motion 1 258 } 259 260 method needleRelease {w} \ 261 { 262 set motion 0 263 } 264 265 method needleMotion {w x y} \ 266 { 267 if {! $motion} { return } 268 if {$y == $yc && $x == $xc} { return } 269 270 # 271 # Compute the angle with the positive y-axis - easier to examine! 272 # 273 set angle [expr {atan2($xc - $x,$yc - $y) / $pi}] 274 if { $angle >= 15.0 } { 275 set angle 15.0 276 } 277 if { $angle < -15.0 } { 278 set angle -15.0 279 } 280 set ::$options(-variable) [expr {$options(-min) + ($options(-max)-$options(-min))*(15.0-$angle) / 30.0}] 281 } 282 283 284 proc rivet { c xc yc } { 285 shadowcircle $c \ 286 [expr {$xc-4}] [expr {$yc-4}] [expr {$xc+4}] [expr {$yc+4}] \ 287 5 0.5m -45.0 288 } 289 290 proc shadowcircle { canvas x1 y1 x2 y2 ticks width orient } { 291 set radius [expr {($x2-$x1)/2.0}] 292 293 set angle $orient 294 set delta [expr {180.0/$ticks}] 295 for {set i 0} {$i <= $ticks} {incr i} { 296 set a [expr {($angle+$i*$delta)}] 297 set b [expr {($angle-$i*$delta)}] 298 299 set color [expr {40+$i*(200/$ticks)}] 300 set color [format "#%x%x%x" $color $color $color] 301 302 $canvas create arc $x1 $y1 $x2 $y2 -start $a -extent $delta \ 303 -style arc -outline $color -width $width 304 $canvas create arc $x1 $y1 $x2 $y2 -start $b -extent $delta \ 305 -style arc -outline $color -width $width 306 } 307 } 308} 309 310if {0} { 311# main -- 312# Demonstration of the voltmeter object 313# 314proc main { argc argv } { 315 global forever 316 317 wm withdraw . 318 wm title . "A voltmeter-like widget" 319 wm geometry . +10+10 320 321 ::controlwidget::voltmeter .t1 -variable value1 -labels { 0 50 100 } -title "Voltmeter (V)" 322 scale .s1 -command "set ::value1" -variable value1 323 324 ::controlwidget::voltmeter .t2 -variable value2 -labels { 0 {} 2.5 {} 5 } \ 325 -width 80m -height 40m -title "Ampere (mA)" -dialcolor lightgreen -scalecolor white \ 326 -min 0 -max 5 327 scale .s2 -command "set ::value2" -variable value2 328 329 button .b -text Quit -command "set ::forever 1" 330 331 grid .t1 .s1 .t2 .s2 .b 332 wm deiconify . 333 vwait forever 334 .t1 destructor 335 .t2 destructor 336 exit 0 337} 338 339main $argc $argv 340} 341 342### end of file 343# Local Variables: 344# mode: tcl 345# page-delimiter: "^#PAGE" 346# End: 347