# 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 2013jul28This code has been here 10 years without a screenshot that shows what this 'needlemeter' looks like. Here is an image.Getting started
Home • Recent changes • Help • Create new page • Search • Add comments
• Edit