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