# voltmeter.tcl --
#
# Part of: The TCL'ers Wiki
# Contents: a voltmeter-like widget
# Date: Fri Jun 13, 2003
#
# Abstract
#
#
#
# Copyright (c) 2003 Marco Maggi
#
# The author hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose,
# provided that existing copyright notices are retained in all copies
# and that this notice is included verbatim in any distributions. No
# written agreement, license, or royalty fee is required for any of the
# authorized uses. Modifications to this software may be copyrighted by
# their authors and need not follow the licensing terms described here,
# provided that the new terms are clearly indicated on the first page of
# each file where they apply.
#
# IN NO EVENT SHALL THE AUTHOR OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHOR HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHOR AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND
# NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS,
# AND THE AUTHOR AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE
# MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#
# $Id: 9109,v 1.6 2005-06-11 06:00:47 jcw Exp $
#
package require Tcl 8
package require Tk 8
option add *borderWidth 1
option add *Scale.from 0
option add *Scale.to 110
option add *Scale.orient vertical
option add *Scale.label voltage
option add *Scale.resolution 1
option add *Scale.showValue 1
proc main { argc argv } {
global forever
wm withdraw .
wm title . "A voltmeter-like widget"
wm geometry . +10+10
voltmeter::constructor .t1 ::value1 { 0 50 100 }
scale .s1 -command "set ::value1"
option add *t2.label "Ampermeter (mA)"
option add *t2.Canvas.width 80m
option add *t2.Canvas.height 40m
voltmeter::constructor .t2 ::value2 { 0 {} 2.5 {} 5 }
scale .s2 -command "set ::value2"
button .b -text Quit -command "set ::forever 1"
grid .t1 .s1 .t2 .s2 .b
wm deiconify .
vwait forever
voltmeter::destructor .t1
voltmeter::destructor .t2
exit 0
}
namespace eval voltmeter {
option add *Voltmeter.min 0.0
option add *Voltmeter.max 100.0
option add *Voltmeter.indexid {}
option add *Voltmeter.ticksfont { Helvetica 8 }
option add *Voltmeter.labelfont { Helvetica 9 }
option add *Voltmeter.label "Voltmeter (V)"
option add *Voltmeter.relief flat
option add *Voltmeter.borderWidth 0
option add *Voltmeter.Canvas.background gray
option add *Voltmeter.Canvas.width 50m
option add *Voltmeter.Canvas.height 25m
option add *Voltmeter.Canvas.foreground black
option add *Voltmeter.Canvas.highlightThickness 0
option add *Voltmeter.Canvas.borderWidth 1
option add *Voltmeter.Canvas.relief raised
variable pi [expr {3.14159265359/180.0}]
}
proc voltmeter::constructor { widget varname labels } {
variable pi
upvar $varname value
frame $widget -class Voltmeter
canvas [set c $widget.canvas]
grid $c -sticky news -padx 2m -pady 2m
option add ${widget}.varname $varname
set font [option get $widget ticksfont {}]
set width [$c cget -width]
set height [$c cget -height]
set xcentre [expr {$width*0.5}]
set ycentre [expr {$width*1.4}]
set t 1.15
set t1 1.25
$c create arc \
[expr {$xcentre-$width*$t}] [expr {$ycentre-$width*$t}] \
[expr {$xcentre+$width*$t}] [expr {$ycentre+$width*$t}] \
-start 70.5 -extent 37 -style arc -outline lightgray \
-width [expr {$ycentre*0.245}]
$c create arc \
[expr {$xcentre-$width*$t}] [expr {$ycentre-$width*$t}] \
[expr {$xcentre+$width*$t}] [expr {$ycentre+$width*$t}] \
-start 71 -extent 36 -style arc -outline white \
-width [expr {$ycentre*0.23}]
$c create arc \
[expr {$xcentre-$width*$t1}] [expr {$ycentre-$width*$t1}] \
[expr {$xcentre+$width*$t1}] [expr {$ycentre+$width*$t1}] \
-start 75 -extent 30 \
-fill black -style arc -width 0.5m
set num [llength $labels]
set angle 255.0
set delta [expr {30.0/($num-1)}]
set l1 [expr {$width*$t1}]
set l2 [expr {$width*$t1*0.95}]
set l3 [expr {$width*$t1*0.92}]
for {set i 0} {$i < $num} {incr i} {
set a [expr {($angle+$delta*$i)*$pi}]
set x1 [expr {$xcentre+$l1*cos($a)}]
set y1 [expr {$ycentre+$l1*sin($a)}]
set x2 [expr {$xcentre+$l2*cos($a)}]
set y2 [expr {$ycentre+$l2*sin($a)}]
$c create line $x1 $y1 $x2 $y2 -fill black -width 0.5m
set x1 [expr {$xcentre+$l3*cos($a)}]
set y1 [expr {$ycentre+$l3*sin($a)}]
set label [lindex $labels $i]
if { [string length $label] } {
$c create text $x1 $y1 \
-anchor center -justify center -fill black \
-text $label -font $font
}
}
set label [option get $widget label {}]
if { [string length $label] } {
set font [option get $widget labelfont {}]
$c create text $xcentre [expr {$ycentre-$width*1.05}] \
-anchor center -justify center -fill black \
-text $label -font $font
}
rivet $c 10 10
rivet $c [expr {$width-10}] 10
rivet $c 10 [expr {$height-10}]
rivet $c [expr {$width-10}] [expr {$height-10}]
set value 0
drawline $widget $value
trace add variable $varname write \
[namespace code "tracer $widget $varname"]
return $widget
}
proc voltmeter::destructor { widget } {
set varname [option get $widget varname {}]
trace remove variable $varname write \
[namespace code "tracer $widget $varname"]
return
}
proc voltmeter::tracer { widget varname args } {
upvar $varname value
drawline $widget $value
return
}
proc voltmeter::drawline { widget value } {
variable pi
set id [option get $widget indexid {}]
set min [option get $widget min {}]
set max [option get $widget max {}]
set c $widget.canvas
set v [expr { ($value <= ($max*1.05))? $value : ($max*1.05) }]
set angle [expr {((($v-$min)/($max-$min))*30.0+165.0)*$pi}]
set width [$c cget -width]
set xcentre [expr {$width/2.0}]
set ycentre [expr {$width*1.4}]
set l1 [expr {$ycentre*0.85}]
set l2 [expr {$ycentre*0.7}]
set xl [expr {$xcentre-$l1*sin($angle)}]
set yl [expr {$ycentre+$l1*cos($angle)}]
set xs [expr {$xcentre-$l2*sin($angle)}]
set ys [expr {$ycentre+$l2*cos($angle)}]
catch {$c delete $id}
set id [$c create line $xs $ys $xl $yl -fill black -width 0.6m]
option add *[string trimleft $widget .].indexid $id
return
}
proc voltmeter::rivet { c xc yc } {
shadowcircle $c \
[expr {$xc-4}] [expr {$yc-4}] [expr {$xc+4}] [expr {$yc+4}] \
5 0.5m -45.0
}
proc shadowcircle { canvas x1 y1 x2 y2 ticks width orient } {
set radius [expr {($x2-$x1)/2.0}]
set angle $orient
set delta [expr {180.0/$ticks}]
for {set i 0} {$i <= $ticks} {incr i} {
set a [expr {($angle+$i*$delta)}]
set b [expr {($angle-$i*$delta)}]
set color [expr {40+$i*(200/$ticks)}]
set color [format "#%x%x%x" $color $color $color]
$canvas create arc $x1 $y1 $x2 $y2 -start $a -extent $delta \
-style arc -outline $color -width $width
$canvas create arc $x1 $y1 $x2 $y2 -start $b -extent $delta \
-style arc -outline $color -width $width
}
}
main $argc $argv
### end of file
# Local Variables:
# mode: tcl
# page-delimiter: "^#PAGE"
# End:MG Apr 2 2005 - Very nicely done!
arjen - 2010-08-12 05:18:08I have put this code and several other related packages into the "controlwidget" module in Tklib.
uniquename 2013jul28This code has been here 10 years without a screenshot that shows what this voltmeter looks like. So here is an image.
