/usr/share/tcltk/tklib0.6/controlwidget/led.tcl is in tklib 0.6-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 | #
# This software is Copyright by the Board of Trustees of Michigan
# State University (c) Copyright 2005.
#
# You may use this software under the terms of the GNU public license
# (GPL) ir the Tcl BSD derived license The terms of these licenses
# are described at:
#
# GPL: http://www.gnu.org/licenses/gpl.txt
# Tcl: http://www.tcl.tk/softare/tcltk/license.html
# Start with the second paragraph under the Tcl/Tk License terms
# as ownership is solely by Board of Trustees at Michigan State University.
#
# Author:
# Ron Fox
# NSCL
# Michigan State University
# East Lansing, MI 48824-1321
#
# Adjusted by Arjen Markus
#
#
# This package provides an LED
# widget. LED widgets are one color when on
# and another when off.
# Implementation is just a filled circle on a
# canvas.
# Options recognized:
# (all standard options for a frame).
# -size - Radius of the led.
# -on - Color of on state.
# -off - Color of off state.
# -variable - on color when variable is nonzero else off.
# Methods
# on - Turn led on.
# off - Turn led off.
#
# TODO:
# Add a label
#
package provide led 1.0
package require Tk
package require snit
package require bindDown
namespace eval controlwidget {
namespace export led
}
snit::widget controlwidget::led {
delegate option * to hull
option -size {17}
option -on green
option -off black
option -variable {}
constructor args {
$self configurelist $args
canvas $win.led -width $options(-size) -height $options(-size)
set border [expr [$win cget -borderwidth] + 2]
set end [expr $options(-size) - $border]
$win.led create oval $border $border $end $end -fill $options(-off)
grid $win.led -sticky nsew
bindDown $win $win
}
# Process the -variable configuration by killing off prior traces
# and setting an new trace:
#
onconfigure -variable name {
if {$options(-variable) ne ""} {
trace remove variable ::$options(-variable) write [mymethod varTrace]
}
trace add variable ::$name write [mymethod varTrace]
set options(-variable) $name
# set our initial state to the current value of the var:
# the after is because we could be constructing an need to give
# the widgets a chance to get built:
after 10 [list $self varTrace $name "" write]
}
# Trace for the led variable..
#
method varTrace {name index op} {
set name ::$name
set value [set $name]
if {[string is boolean -strict $value]} {
$self setstate $value
}
}
#
# Set the led on.
#
method on {} {
if {$options(-variable) ne ""} {
set ::$options(-variable) 1
} else {
$self setstate 1
}
}
# set the led off
#
method off {} {
if {$options(-variable) ne ""} {
set ::$options(-variable) 0
} else {
$self setstate 0
}
}
#
# Set the led state
#
method setstate {value} {
if {$value} {
$win.led itemconfigure 1 -fill $options(-on)
} else {
$win.led itemconfigure 1 -fill $options(-off)
}
}
}
|