====== # needlemeter.tcl # # Part of: The TCL'ers Wiki # Contents: a needlemeter 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: 9177,v 1.2 2005-07-01 06:00:18 jcw Exp $ # package require Tcl 8 package require Tk 8 option add *borderWidth 1 option add *Scale.from 0.0 option add *Scale.to 10.0 option add *Scale.resolution 0.1 option add *Scale.orient vertical option add *Scale.label value option add *Scale.showValue 1 proc main { argc argv } { global forever wm withdraw . wm title . "A needlemeter widget" wm geometry . +10+10 needlemeter::constructor .t1 ::value1 scale .s1 -command "set ::value1" needlemeter::constructor .t2 ::value2 after 100 "periodic ::value2 0.0" needlemeter::constructor .t3 ::value3 after 100 "sinusoid ::value3 0.0 0.45 0.05" needlemeter::constructor .t4 ::value4 after 100 "sinusoid ::value4 0.0 0.2 0.05" button .b -text Quit -command "set ::forever 1" grid .t1 .s1 .t2 .t3 .t4 .b -padx 2 -pady 2 wm deiconify . vwait forever needlemeter::destructor .t1 needlemeter::destructor .t2 needlemeter::destructor .t3 needlemeter::destructor .t4 exit 0 } proc periodic { varname value } { upvar $varname name set name $value after 50 "periodic $varname [expr {$value+0.01}]" } proc sinusoid { varname value ampli delta } { upvar $varname name set name [expr {$ampli*sin($value)}] after 50 "sinusoid $varname [expr {$value+$delta}] $ampli $delta" } namespace eval needlemeter { option add *Needlemeter.indexid {} option add *Needlemeter.relief flat option add *Needlemeter.borderWidth 0 option add *Needlemeter.Canvas.background gray option add *Needlemeter.Canvas.width 15m option add *Needlemeter.Canvas.height 15m option add *Needlemeter.Canvas.foreground black option add *Needlemeter.Canvas.highlightThickness 0 option add *Needlemeter.Canvas.borderWidth 1 option add *Needlemeter.Canvas.relief raised variable pi 3.14159265359 } proc needlemeter::constructor { widget varname } { variable pi upvar $varname value frame $widget -class Needlemeter canvas [set c $widget.canvas] grid $c -sticky news option add ${widget}.varname $varname set width [$c cget -width] # display set x1 [expr {$width/50.0*4.0}] set y1 [expr {$width/50.0*4.0}] set x2 [expr {$width/50.0*46.0}] set y2 [expr {$width/50.0*46.0}] $c create oval $x1 $y1 $x2 $y2 -fill white -width 1 -outline lightgray set xc [expr {($x2-$x1)/2.0}] shadowcircle $c $x1 $y1 $x2 $y2 40 0.7m 135.0 set value 0 drawline $widget $value trace add variable $varname write \ [namespace code "tracer $widget $varname"] return $widget } proc needlemeter::destructor { widget } { set varname [option get $widget varname {}] trace remove variable $varname write \ [namespace code "tracer $widget $varname"] return } proc needlemeter::tracer { widget varname args } { upvar $varname value drawline $widget $value return } proc needlemeter::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 angle [expr {($value+0.5)*2*$pi}] set width [$c cget -width] set half [expr {$width/2.0}] set length [expr {$half*0.6}] set xl [expr {$half-$length*sin($angle)}] set yl [expr {$half+$length*cos($angle)}] set xs [expr {$half+0.3*$length*sin($angle)}] set ys [expr {$half-0.3*$length*cos($angle)}] catch {$c delete $id} set id [$c create line $xs $ys $xl $yl -fill red -width 1m] option add *[string trimleft $widget .].indexid $id return } 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: ====== [uniquename] 2013jul28 This code has been here 10 years without a screenshot that shows what this 'needlemeter' looks like. Here is an image. [meterTclTk_needleMeters_MarcoMaggi_screenshot_468x129.jpg] <> GUI | Widget