# tachometer.tcl --
#
# Part of: The TCL'ers Wiki
# Contents: a tachometer-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: 9108,v 1.1 2003-06-14 08:01:19 jcw Exp $
#
package require Tcl 8
package require Tk 8
option add *borderWidth 1
option add *Scale.from 0
option add *Scale.to 105
option add *Scale.orient vertical
option add *Scale.label speed
option add *Scale.resolution 1
option add *Scale.showValue 1
proc main { argc argv } {
global forever
wm withdraw .
wm title . "A tachometer-like widget"
wm geometry . +10+10
tachometer::constructor .t1 ::value1 { 0 10 20 30 40 50 60 70 80 90 100 }
scale .s1 -command "set ::value1"
tachometer::constructor .t2 ::value2 { 0 {} {} 5 {} {} 10 }
scale .s2 -command "set ::value2"
button .b -text Quit -command "set ::forever 1"
grid .t1 .s1 .t2 .s2 .b -padx 2 -pady 2
wm deiconify .
vwait forever
tachometer::destructor .t1
tachometer::destructor .t2
exit 0
}
namespace eval tachometer {
option add *Tachometer.min 0.0
option add *Tachometer.max 100.0
option add *Tachometer.indexid {}
option add *Tachometer.relief flat
option add *Tachometer.borderWidth 0
option add *Tachometer.Canvas.background gray
option add *Tachometer.Canvas.width 50m
option add *Tachometer.Canvas.height 50m
option add *Tachometer.Canvas.foreground black
option add *Tachometer.Canvas.highlightThickness 0
option add *Tachometer.Canvas.borderWidth 1
option add *Tachometer.Canvas.relief raised
variable pi [expr {3.14159265359/180.0}]
}
proc tachometer::constructor { widget varname labels } {
variable pi
upvar $varname value
frame $widget -class Tachometer
canvas [set c $widget.canvas]
grid $c -sticky news
option add ${widget}.varname $varname
set width [$c cget -width]
set height [$c cget -height]
set num [llength $labels]
set delta [expr {(360.0-40.0)/($num-1)}]
$c create oval \
[expr {$width/50.0}] [expr {$width/50.0}] \
[expr {$width/50.0*49.0}] [expr {$width/50.0*49.0}] \
-fill white -width 0.7m -outline lightgray
$c create oval \
[expr {$width/50.0*23.0}] [expr {$width/50.0*23.0}] \
[expr {$width/50.0*27.0}] [expr {$width/50.0*27.0}] \
-width 0.7m -outline lightgray -fill red
$c create arc \
[expr {$width/50.0*5.0}] [expr {$width/50.0*5.0}] \
[expr {$width/50.0*45.5}] [expr {$width/50.0*45.5}] \
-start -70 -extent $delta -style arc \
-outline red -fill red -width 3m
$c create arc \
[expr {$width/50.0*3.0}] [expr {$width/50.0*3.0}] \
[expr {$width/50.0*47.0}] [expr {$width/50.0*47.0}] \
-start -70 -extent 320 -style arc \
-outline black -width 0.5m
set half [expr {$width/2.0}]
set l1 [expr {$half*0.88}]
set l2 [expr {$half*0.76}]
set l3 [expr {$half*0.64}]
set angle 110.0
for {set i 0} {$i < $num} {incr i} {
set a [expr {($angle+$delta*$i)*$pi}]
set x1 [expr {$half+$l1*cos($a)}]
set y1 [expr {$half+$l1*sin($a)}]
set x2 [expr {$half+$l2*cos($a)}]
set y2 [expr {$half+$l2*sin($a)}]
$c create line $x1 $y1 $x2 $y2 -fill black -width 0.5m
set x1 [expr {$half+$l3*cos($a)}]
set y1 [expr {$half+$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 { Helvetica 10 }
}
}
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 tachometer::destructor { widget } {
set varname [option get $widget varname {}]
trace remove variable $varname write \
[namespace code "tracer $widget $varname"]
return
}
proc tachometer::tracer { widget varname args } {
upvar $varname value
drawline $widget $value
return
}
proc tachometer::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.02))? $value : ($max*1.02) }]
set angle [expr {((($v-$min)/($max-$min))*320.0+20.0)*$pi}]
set width [$c cget -width]
set half [expr {$width/2.0}]
set length [expr {$half*0.8}]
set xl [expr {$half-$length*sin($angle)}]
set yl [expr {$half+$length*cos($angle)}]
set xs [expr {$half+0.2*$length*sin($angle)}]
set ys [expr {$half-0.2*$length*cos($angle)}]
catch {$c delete $id}
set id [$c create line $xs $ys $xl $yl -fill red -width 0.6m]
option add *[string trimleft $widget .].indexid $id
return
}
proc tachometer::rivet { c xc yc } {
$c create oval \
[expr {$xc-4}] [expr {$yc-4}] [expr {$xc+4}] [expr {$yc+4}] \
-fill lightgray -width 0.5m -outline black
}
main $argc $argv
### end of file
# Local Variables:
# mode: tcl
# page-delimiter: "^#PAGE"
# End: