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