# 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: