aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--LICENSE.txt78
-rw-r--r--README.txt7
-rw-r--r--bng.gifbin0 -> 3853 bytes
-rw-r--r--buttonpopup-plugin.tcl97
-rw-r--r--floatatom.gifbin0 -> 4321 bytes
-rw-r--r--hi-bit/old.bng.gifbin0 -> 4182 bytes
-rw-r--r--hi-bit/old.hradio.gifbin0 -> 4082 bytes
-rw-r--r--hi-bit/old.hslider.gifbin0 -> 4100 bytes
-rw-r--r--hi-bit/old.msg.gifbin0 -> 4122 bytes
-rw-r--r--hi-bit/old.obj.gifbin0 -> 4094 bytes
-rw-r--r--hi-bit/old.text.gifbin0 -> 4093 bytes
-rw-r--r--hi-bit/old.vradio.gifbin0 -> 4087 bytes
-rw-r--r--hi-bit/old.vslider.gifbin0 -> 4102 bytes
-rw-r--r--hradio.gifbin0 -> 3841 bytes
-rw-r--r--hslider.gifbin0 -> 3853 bytes
-rw-r--r--menuarray.gifbin0 -> 4275 bytes
-rw-r--r--msg.gifbin0 -> 3850 bytes
-rw-r--r--mycnv.gifbin0 -> 4080 bytes
-rw-r--r--numbox.gifbin0 -> 4380 bytes
-rw-r--r--obj.gifbin0 -> 3839 bytes
-rw-r--r--pkgIndex.tcl10
-rw-r--r--symbolatom.gifbin0 -> 4324 bytes
-rw-r--r--text.gifbin0 -> 4093 bytes
-rw-r--r--toggle.gifbin0 -> 4176 bytes
-rw-r--r--tooltip-1.4.2.tcl447
-rw-r--r--vradio.gifbin0 -> 3846 bytes
-rw-r--r--vslider.gifbin0 -> 3853 bytes
-rw-r--r--vumeter.gifbin0 -> 4155 bytes
28 files changed, 639 insertions, 0 deletions
diff --git a/LICENSE.txt b/LICENSE.txt
new file mode 100644
index 0000000..075f39a
--- /dev/null
+++ b/LICENSE.txt
@@ -0,0 +1,78 @@
+This software is copyrighted by Miller Puckette and others. The following
+terms (the "Standard Improved BSD License") apply to all files associated with
+the software unless explicitly disclaimed in individual files:
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+3. The name of the author may not be used to endorse or promote
+ products derived from this software without specific prior
+ written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY
+EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR
+BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
+TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
+IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+THE POSSIBILITY OF SUCH DAMAGE.
+
+------------------------------------------------------------------------------
+tooltip-1.4.2.tcl
+
+
+Copyright (c) 1996-2007 Jeffrey Hobbs
+Tcl/Tk License
+
+This software is copyrighted by Ajuba Solutions and other parties.
+The following terms apply to all files associated with the software unless
+explicitly disclaimed in individual files.
+
+The authors 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 AUTHORS 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 AUTHORS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+THE AUTHORS 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 AUTHORS AND DISTRIBUTORS HAVE
+NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+
+GOVERNMENT USE: If you are acquiring this software on behalf of the
+U.S. government, the Government shall have only "Restricted Rights"
+in the software and related documentation as defined in the Federal
+Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
+are acquiring the software on behalf of the Department of Defense, the
+software shall be classified as "Commercial Computer Software" and the
+Government shall have only "Restricted Rights" as defined in Clause
+252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the
+authors grant the U.S. Government and others acting in its behalf
+permission to use and distribute the software in accordance with the
+terms specified in this license.
+
+
diff --git a/README.txt b/README.txt
new file mode 100644
index 0000000..753d83b
--- /dev/null
+++ b/README.txt
@@ -0,0 +1,7 @@
+This plugin creates a "button bar" of all the commonly used objects and puts it at the top of all patches in Edit Mode.
+
+This project was started at Eyebeam as part of an X-lab Residency and grew out of the NYC Patching Circle with the support of New Blankets.
+
+Hans-Christoph Steiner
+Joshua Clayton
+Sofy Yuditskaya
diff --git a/bng.gif b/bng.gif
new file mode 100644
index 0000000..c1d880c
--- /dev/null
+++ b/bng.gif
Binary files differ
diff --git a/buttonpopup-plugin.tcl b/buttonpopup-plugin.tcl
new file mode 100644
index 0000000..8a45176
--- /dev/null
+++ b/buttonpopup-plugin.tcl
@@ -0,0 +1,97 @@
+# this plugin creates a buttonpopup on a patch window when that patch
+# window is in Edit Mode
+
+# this GUI plugin removes the menubars from any patch window that is
+# not in Edit Mode. Also, if a patch is switched to Run Mode, the
+# menubar will be removed.
+
+# TODO make it scroll the patch so it acts as an overlay
+
+lappend ::auto_path $::current_plugin_loadpath
+
+package require base64
+package require tooltip 1.4.2
+
+namespace eval buttonpopup {
+ namespace export show_buttonpopup
+ namespace export hide_buttonpopup
+}
+
+proc ::buttonpopup::make_pd_button {tkpathname name description} {
+ button $tkpathname.$name -image buttonpopup::$name \
+ -relief flat -borderwidth 0 -highlightthickness 0 \
+ -highlightcolor grey -highlightbackground grey -padx 0 -pady 0 \
+ -command "menu_send_float \$::focused_window $name 0"
+ pack $tkpathname.$name -side left -padx 0 -pady 0
+ ::tooltip::tooltip $tkpathname.$name $description
+}
+
+proc ::buttonpopup::make_iemgui_button {tkpathname name description} {
+ button $tkpathname.$name -image buttonpopup::$name \
+ -relief sunken -borderwidth 0 -highlightthickness 0 \
+ -highlightcolor grey -highlightbackground grey -padx 0 -pady 0 \
+ -command "menu_send \$::focused_window $name"
+ pack $tkpathname.$name -side left -padx 0 -pady 0
+ ::tooltip::tooltip $tkpathname.$name $description
+}
+
+proc ::buttonpopup::hide {w} {
+ set mytoplevel [winfo toplevel $w]
+ set tkcanvas [tkcanvas_name $mytoplevel]
+ $tkcanvas delete buttonpopup_window
+}
+
+proc ::buttonpopup::show {w x y} {
+ set mytoplevel [winfo toplevel $w]
+ set tkcanvas [tkcanvas_name $mytoplevel]
+ set buttonpopup_pathname $tkcanvas.buttonpopup
+ if { ! [winfo exists $buttonpopup_pathname]} {
+ frame $buttonpopup_pathname -cursor arrow -background grey \
+ -pady 0
+ make_pd_button $buttonpopup_pathname obj {Object (obj)}
+ make_pd_button $buttonpopup_pathname msg {Message (msg)}
+ make_pd_button $buttonpopup_pathname floatatom {Number (floatatom)}
+ make_pd_button $buttonpopup_pathname symbolatom {Symbol (symbolatom)}
+ make_pd_button $buttonpopup_pathname text {Comment}
+ make_iemgui_button $buttonpopup_pathname bng {Bang Button [bng]}
+ make_iemgui_button $buttonpopup_pathname toggle {Toggle [tgl]}
+ make_iemgui_button $buttonpopup_pathname numbox {Number2 [my_numbox]}
+ make_iemgui_button $buttonpopup_pathname hslider {Horizontal Slider [hslider]}
+ make_iemgui_button $buttonpopup_pathname vslider {Verical Slider [vslider]}
+ make_iemgui_button $buttonpopup_pathname hradio {Horizontal Radio Button [hradio]}
+ make_iemgui_button $buttonpopup_pathname vradio {Vertical Radio Button [vradio]}
+ make_iemgui_button $buttonpopup_pathname vumeter {VU Meter [vumeter]}
+ make_iemgui_button $buttonpopup_pathname mycnv {Canvas [mycnv]}
+ make_iemgui_button $buttonpopup_pathname menuarray {Array (menuarray)}
+ bind $buttonpopup_pathname <KeyPress-Escape> {::buttonpopup::hide %W}
+ }
+ if {$::editmode($mytoplevel)} {
+ $tkcanvas create window $x $y -anchor nw -window $buttonpopup_pathname \
+ -tags buttonpopup_window
+ }
+}
+
+proc ::buttonpopup::load_button_images {loadpath} {
+ image create photo buttonpopup::obj -file $loadpath/obj.gif
+ image create photo buttonpopup::msg -file $loadpath/msg.gif
+ image create photo buttonpopup::floatatom -file $loadpath/floatatom.gif
+ image create photo buttonpopup::symbolatom -file $loadpath/symbolatom.gif
+ image create photo buttonpopup::text -file $loadpath/text.gif
+
+ image create photo buttonpopup::bng -file $loadpath/bng.gif
+ image create photo buttonpopup::toggle -file $loadpath/toggle.gif
+ image create photo buttonpopup::numbox -file $loadpath/numbox.gif
+ image create photo buttonpopup::hslider -file $loadpath/hslider.gif
+ image create photo buttonpopup::vslider -file $loadpath/vslider.gif
+ image create photo buttonpopup::hradio -file $loadpath/hradio.gif
+ image create photo buttonpopup::vradio -file $loadpath/vradio.gif
+ image create photo buttonpopup::vumeter -file $loadpath/vumeter.gif
+ image create photo buttonpopup::mycnv -file $loadpath/mycnv.gif
+
+ image create photo buttonpopup::menuarray -file $loadpath/menuarray.gif
+}
+
+::buttonpopup::load_button_images $::current_plugin_loadpath
+
+bind all <Double-ButtonRelease-1> {+::buttonpopup::show %W %x %y}
+bind all <ButtonRelease> {+after 100 ::buttonpopup::hide %W}
diff --git a/floatatom.gif b/floatatom.gif
new file mode 100644
index 0000000..d52d608
--- /dev/null
+++ b/floatatom.gif
Binary files differ
diff --git a/hi-bit/old.bng.gif b/hi-bit/old.bng.gif
new file mode 100644
index 0000000..9670581
--- /dev/null
+++ b/hi-bit/old.bng.gif
Binary files differ
diff --git a/hi-bit/old.hradio.gif b/hi-bit/old.hradio.gif
new file mode 100644
index 0000000..4654ba9
--- /dev/null
+++ b/hi-bit/old.hradio.gif
Binary files differ
diff --git a/hi-bit/old.hslider.gif b/hi-bit/old.hslider.gif
new file mode 100644
index 0000000..f8760fe
--- /dev/null
+++ b/hi-bit/old.hslider.gif
Binary files differ
diff --git a/hi-bit/old.msg.gif b/hi-bit/old.msg.gif
new file mode 100644
index 0000000..a7e4fc3
--- /dev/null
+++ b/hi-bit/old.msg.gif
Binary files differ
diff --git a/hi-bit/old.obj.gif b/hi-bit/old.obj.gif
new file mode 100644
index 0000000..8be9048
--- /dev/null
+++ b/hi-bit/old.obj.gif
Binary files differ
diff --git a/hi-bit/old.text.gif b/hi-bit/old.text.gif
new file mode 100644
index 0000000..f5eb519
--- /dev/null
+++ b/hi-bit/old.text.gif
Binary files differ
diff --git a/hi-bit/old.vradio.gif b/hi-bit/old.vradio.gif
new file mode 100644
index 0000000..17f4347
--- /dev/null
+++ b/hi-bit/old.vradio.gif
Binary files differ
diff --git a/hi-bit/old.vslider.gif b/hi-bit/old.vslider.gif
new file mode 100644
index 0000000..a194f87
--- /dev/null
+++ b/hi-bit/old.vslider.gif
Binary files differ
diff --git a/hradio.gif b/hradio.gif
new file mode 100644
index 0000000..c0d8aa8
--- /dev/null
+++ b/hradio.gif
Binary files differ
diff --git a/hslider.gif b/hslider.gif
new file mode 100644
index 0000000..9fd9a81
--- /dev/null
+++ b/hslider.gif
Binary files differ
diff --git a/menuarray.gif b/menuarray.gif
new file mode 100644
index 0000000..c446718
--- /dev/null
+++ b/menuarray.gif
Binary files differ
diff --git a/msg.gif b/msg.gif
new file mode 100644
index 0000000..a337f30
--- /dev/null
+++ b/msg.gif
Binary files differ
diff --git a/mycnv.gif b/mycnv.gif
new file mode 100644
index 0000000..61c55ae
--- /dev/null
+++ b/mycnv.gif
Binary files differ
diff --git a/numbox.gif b/numbox.gif
new file mode 100644
index 0000000..415fb06
--- /dev/null
+++ b/numbox.gif
Binary files differ
diff --git a/obj.gif b/obj.gif
new file mode 100644
index 0000000..c5be735
--- /dev/null
+++ b/obj.gif
Binary files differ
diff --git a/pkgIndex.tcl b/pkgIndex.tcl
new file mode 100644
index 0000000..ff70e2d
--- /dev/null
+++ b/pkgIndex.tcl
@@ -0,0 +1,10 @@
+# Tcl package index file, version 1.1
+# This file is generated by the "pkg_mkIndex" command
+# and sourced either when an application starts up or
+# by a "package unknown" script. It invokes the
+# "package ifneeded" command to set up package-related
+# information so that packages will be loaded automatically
+# in response to "package require" commands. When this
+# script is sourced, the variable $dir must contain the
+# full path name of this file's directory.
+package ifneeded tooltip 1.4.2 [list source [file join $dir tooltip-1.4.2.tcl]]
diff --git a/symbolatom.gif b/symbolatom.gif
new file mode 100644
index 0000000..4cf64bd
--- /dev/null
+++ b/symbolatom.gif
Binary files differ
diff --git a/text.gif b/text.gif
new file mode 100644
index 0000000..f5eb519
--- /dev/null
+++ b/text.gif
Binary files differ
diff --git a/toggle.gif b/toggle.gif
new file mode 100644
index 0000000..a5471bf
--- /dev/null
+++ b/toggle.gif
Binary files differ
diff --git a/tooltip-1.4.2.tcl b/tooltip-1.4.2.tcl
new file mode 100644
index 0000000..151583a
--- /dev/null
+++ b/tooltip-1.4.2.tcl
@@ -0,0 +1,447 @@
+# ACTIVESTATE TEAPOT-PKG BEGIN TM -*- tcl -*-
+# -- Tcl Module
+
+# @@ Meta Begin
+# Package tooltip 1.4.2
+# Meta as::origin http://sourceforge.net/projects/tcllib
+# Meta category Tooltip management
+# Meta description Tooltip management
+# Meta platform tcl
+# Meta require {Tk 8.4}
+# Meta require msgcat
+# Meta subject hover help balloon tooltip
+# Meta summary tooltip
+# @@ Meta End
+
+
+
+# ACTIVESTATE TEAPOT-PKG BEGIN REQUIREMENTS
+
+package require Tk 8.4
+package require msgcat
+
+# ACTIVESTATE TEAPOT-PKG END REQUIREMENTS
+
+# ACTIVESTATE TEAPOT-PKG BEGIN DECLARE
+
+package provide tooltip 1.4.2
+
+# ACTIVESTATE TEAPOT-PKG END DECLARE
+# ACTIVESTATE TEAPOT-PKG END TM
+# tooltip.tcl --
+#
+# Balloon help
+#
+# Copyright (c) 1996-2007 Jeffrey Hobbs
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: tooltip.tcl,v 1.14 2008/08/08 22:50:13 patthoyts Exp $
+#
+# Initiated: 28 October 1996
+
+
+package require Tk 8.4
+package provide tooltip 1.4.2
+package require msgcat
+
+#------------------------------------------------------------------------
+# PROCEDURE
+# tooltip::tooltip
+#
+# DESCRIPTION
+# Implements a tooltip (balloon help) system
+#
+# ARGUMENTS
+# tooltip <option> ?arg?
+#
+# clear ?pattern?
+# Stops the specified widgets (defaults to all) from showing tooltips
+#
+# delay ?millisecs?
+# Query or set the delay. The delay is in milliseconds and must
+# be at least 50. Returns the delay.
+#
+# disable OR off
+# Disables all tooltips.
+#
+# enable OR on
+# Enables tooltips for defined widgets.
+#
+# <widget> ?-index index? ?-item id? ?message?
+# If -index is specified, then <widget> is assumed to be a menu
+# and the index represents what index into the menu (either the
+# numerical index or the label) to associate the tooltip message with.
+# Tooltips do not appear for disabled menu items.
+# If message is {}, then the tooltip for that widget is removed.
+# The widget must exist prior to calling tooltip. The current
+# tooltip message for <widget> is returned, if any.
+#
+# RETURNS: varies (see methods above)
+#
+# NAMESPACE & STATE
+# The namespace tooltip is used.
+# Control toplevel name via ::tooltip::wname.
+#
+# EXAMPLE USAGE:
+# tooltip .button "A Button"
+# tooltip .menu -index "Load" "Loads a file"
+#
+#------------------------------------------------------------------------
+
+namespace eval ::tooltip {
+ namespace export -clear tooltip
+ variable tooltip
+ variable G
+
+ array set G {
+ enabled 1
+ fade 1
+ FADESTEP 0.2
+ FADEID {}
+ DELAY 500
+ AFTERID {}
+ LAST -1
+ TOPLEVEL .__tooltip__
+ }
+ if {[tk windowingsystem] eq "x11"} {
+ set G(fade) 0 ; # don't fade by default on X11
+ }
+ # The extra ::hide call in <Enter> is necessary to catch moving to
+ # child widgets where the <Leave> event won't be generated
+ bind Tooltip <Enter> [namespace code {
+ #tooltip::hide
+ variable tooltip
+ variable G
+ set G(LAST) -1
+ if {$G(enabled) && [info exists tooltip(%W)]} {
+ set G(AFTERID) \
+ [after $G(DELAY) [namespace code [list show %W $tooltip(%W) cursor]]]
+ }
+ }]
+
+ bind Menu <<MenuSelect>> [namespace code { menuMotion %W }]
+ bind Tooltip <Leave> [namespace code [list hide 1]] ; # fade ok
+ bind Tooltip <Any-KeyPress> [namespace code hide]
+ bind Tooltip <Any-Button> [namespace code hide]
+}
+
+proc ::tooltip::tooltip {w args} {
+ variable tooltip
+ variable G
+ switch -- $w {
+ clear {
+ if {[llength $args]==0} { set args .* }
+ clear $args
+ }
+ delay {
+ if {[llength $args]} {
+ if {![string is integer -strict $args] || $args<50} {
+ return -code error "tooltip delay must be an\
+ integer greater than 50 (delay is in millisecs)"
+ }
+ return [set G(DELAY) $args]
+ } else {
+ return $G(DELAY)
+ }
+ }
+ fade {
+ if {[llength $args]} {
+ set G(fade) [string is true -strict [lindex $args 0]]
+ }
+ return $G(fade)
+ }
+ off - disable {
+ set G(enabled) 0
+ hide
+ }
+ on - enable {
+ set G(enabled) 1
+ }
+ default {
+ set i $w
+ if {[llength $args]} {
+ set i [uplevel 1 [namespace code "register [list $w] $args"]]
+ }
+ set b $G(TOPLEVEL)
+ if {![winfo exists $b]} {
+ toplevel $b -class Tooltip
+ if {[tk windowingsystem] eq "aqua"} {
+ ::tk::unsupported::MacWindowStyle style $b help none
+ } else {
+ wm overrideredirect $b 1
+ }
+ catch {wm attributes $b -topmost 1}
+ # avoid the blink issue with 1 to <1 alpha on Windows
+ catch {wm attributes $b -alpha 0.99}
+ wm positionfrom $b program
+ wm withdraw $b
+ label $b.label -highlightthickness 0 -relief solid -bd 1 \
+ -background lightyellow -fg black
+ pack $b.label -ipadx 1
+ }
+ if {[info exists tooltip($i)]} { return $tooltip($i) }
+ }
+ }
+}
+
+proc ::tooltip::register {w args} {
+ variable tooltip
+ set key [lindex $args 0]
+ while {[string match -* $key]} {
+ switch -- $key {
+ -index {
+ if {[catch {$w entrycget 1 -label}]} {
+ return -code error "widget \"$w\" does not seem to be a\
+ menu, which is required for the -index switch"
+ }
+ set index [lindex $args 1]
+ set args [lreplace $args 0 1]
+ }
+ -item {
+ set namedItem [lindex $args 1]
+ if {[catch {$w find withtag $namedItem} item]} {
+ return -code error "widget \"$w\" is not a canvas, or item\
+ \"$namedItem\" does not exist in the canvas"
+ }
+ if {[llength $item] > 1} {
+ return -code error "item \"$namedItem\" specifies more\
+ than one item on the canvas"
+ }
+ set args [lreplace $args 0 1]
+ }
+ -tag {
+ set tag [lindex $args 1]
+ set r [catch {lsearch -exact [$w tag names] $tag} ndx]
+ if {$r || $ndx == -1} {
+ return -code error "widget \"$w\" is not a text widget or\
+ \"$tag\" is not a text tag"
+ }
+ set args [lreplace $args 0 1]
+ }
+ default {
+ return -code error "unknown option \"$key\":\
+ should be -index or -item"
+ }
+ }
+ set key [lindex $args 0]
+ }
+ if {[llength $args] != 1} {
+ return -code error "wrong # args: should be \"tooltip widget\
+ ?-index index? ?-item item? ?-tag tag? message\""
+ }
+ if {$key eq ""} {
+ clear $w
+ } else {
+ if {![winfo exists $w]} {
+ return -code error "bad window path name \"$w\""
+ }
+ if {[info exists index]} {
+ set tooltip($w,$index) $key
+ return $w,$index
+ } elseif {[info exists item]} {
+ set tooltip($w,$item) $key
+ enableCanvas $w $item
+ return $w,$item
+ } elseif {[info exists tag]} {
+ set tooltip($w,t_$tag) $key
+ enableTag $w $tag
+ return $w,$tag
+ } else {
+ set tooltip($w) $key
+ bindtags $w [linsert [bindtags $w] end "Tooltip"]
+ return $w
+ }
+ }
+}
+
+proc ::tooltip::clear {{pattern .*}} {
+ variable tooltip
+ # cache the current widget at pointer
+ set ptrw [winfo containing [winfo pointerx .] [winfo pointery .]]
+ foreach w [array names tooltip $pattern] {
+ unset tooltip($w)
+ if {[winfo exists $w]} {
+ set tags [bindtags $w]
+ if {[set i [lsearch -exact $tags "Tooltip"]] != -1} {
+ bindtags $w [lreplace $tags $i $i]
+ }
+ ## We don't remove TooltipMenu because there
+ ## might be other indices that use it
+
+ # Withdraw the tooltip if we clear the current contained item
+ if {$ptrw eq $w} { hide }
+ }
+ }
+}
+
+proc ::tooltip::show {w msg {i {}}} {
+ if {![winfo exists $w]} { return }
+
+ # Use string match to allow that the help will be shown when
+ # the pointer is in any child of the desired widget
+ if {([winfo class $w] ne "Menu")
+ && ![string match $w* [eval [list winfo containing] \
+ [winfo pointerxy $w]]]} {
+ return
+ }
+
+ variable G
+
+ after cancel $G(FADEID)
+ set b $G(TOPLEVEL)
+ # Use late-binding msgcat (lazy translation) to support programs
+ # that allow on-the-fly l10n changes
+ $b.label configure -text $msg -justify left
+ update idletasks
+ set screenw [winfo screenwidth $w]
+ set screenh [winfo screenheight $w]
+ set reqw [winfo reqwidth $b]
+ set reqh [winfo reqheight $b]
+ # When adjusting for being on the screen boundary, check that we are
+ # near the "edge" already, as Tk handles multiple monitors oddly
+ if {$i eq "cursor"} {
+ set y [expr {[winfo pointery $w]+20}]
+ if {($y < $screenh) && ($y+$reqh) > $screenh} {
+ set y [expr {[winfo pointery $w]-$reqh-5}]
+ }
+ } elseif {$i ne ""} {
+ set y [expr {[winfo rooty $w]+[winfo vrooty $w]+[$w yposition $i]+25}]
+ if {($y < $screenh) && ($y+$reqh) > $screenh} {
+ # show above if we would be offscreen
+ set y [expr {[winfo rooty $w]+[$w yposition $i]-$reqh-5}]
+ }
+ } else {
+ set y [expr {[winfo rooty $w]+[winfo vrooty $w]+[winfo height $w]+5}]
+ if {($y < $screenh) && ($y+$reqh) > $screenh} {
+ # show above if we would be offscreen
+ set y [expr {[winfo rooty $w]-$reqh-5}]
+ }
+ }
+ if {$i eq "cursor"} {
+ set x [winfo pointerx $w]
+ } else {
+ set x [expr {[winfo rootx $w]+[winfo vrootx $w]+
+ ([winfo width $w]-$reqw)/2}]
+ }
+ # only readjust when we would appear right on the screen edge
+ if {$x<0 && ($x+$reqw)>0} {
+ set x 0
+ } elseif {($x < $screenw) && ($x+$reqw) > $screenw} {
+ set x [expr {$screenw-$reqw}]
+ }
+ if {[tk windowingsystem] eq "aqua"} {
+ set focus [focus]
+ }
+ # avoid the blink issue with 1 to <1 alpha on Windows, watch half-fading
+ catch {wm attributes $b -alpha 0.99}
+ wm geometry $b +$x+$y
+ wm deiconify $b
+ raise $b
+ if {[tk windowingsystem] eq "aqua" && $focus ne ""} {
+ # Aqua's help window steals focus on display
+ after idle [list focus -force $focus]
+ }
+}
+
+proc ::tooltip::menuMotion {w} {
+ variable G
+
+ if {$G(enabled)} {
+ variable tooltip
+
+ # Menu events come from a funny path, map to the real path.
+ set m [string map {"#" "."} [winfo name $w]]
+ set cur [$w index active]
+
+ # The next two lines (all uses of LAST) are necessary until the
+ # <<MenuSelect>> event is properly coded for Unix/(Windows)?
+ if {$cur == $G(LAST)} return
+ set G(LAST) $cur
+ # a little inlining - this is :hide
+ after cancel $G(AFTERID)
+ catch {wm withdraw $G(TOPLEVEL)}
+ if {[info exists tooltip($m,$cur)] || \
+ (![catch {$w entrycget $cur -label} cur] && \
+ [info exists tooltip($m,$cur)])} {
+ set G(AFTERID) [after $G(DELAY) \
+ [namespace code [list show $w $tooltip($m,$cur) cursor]]]
+ }
+ }
+}
+
+proc ::tooltip::hide {{fadeOk 0}} {
+ variable G
+
+ after cancel $G(AFTERID)
+ after cancel $G(FADEID)
+ if {$fadeOk && $G(fade)} {
+ fade $G(TOPLEVEL) $G(FADESTEP)
+ } else {
+ catch {wm withdraw $G(TOPLEVEL)}
+ }
+}
+
+proc ::tooltip::fade {w step} {
+ if {[catch {wm attributes $w -alpha} alpha] || $alpha <= 0.0} {
+ catch { wm withdraw $w }
+ catch { wm attributes $w -alpha 0.99 }
+ } else {
+ variable G
+ wm attributes $w -alpha [expr {$alpha-$step}]
+ set G(FADEID) [after 50 [namespace code [list fade $w $step]]]
+ }
+}
+
+proc ::tooltip::wname {{w {}}} {
+ variable G
+ if {[llength [info level 0]] > 1} {
+ # $w specified
+ if {$w ne $G(TOPLEVEL)} {
+ hide
+ destroy $G(TOPLEVEL)
+ set G(TOPLEVEL) $w
+ }
+ }
+ return $G(TOPLEVEL)
+}
+
+proc ::tooltip::itemTip {w args} {
+ variable tooltip
+ variable G
+
+ set G(LAST) -1
+ set item [$w find withtag current]
+ if {$G(enabled) && [info exists tooltip($w,$item)]} {
+ set G(AFTERID) [after $G(DELAY) \
+ [namespace code [list show $w $tooltip($w,$item) cursor]]]
+ }
+}
+
+proc ::tooltip::enableCanvas {w args} {
+ if {[string match *itemTip* [$w bind all <Enter>]]} { return }
+ $w bind all <Enter> +[namespace code [list itemTip $w]]
+ $w bind all <Leave> +[namespace code [list hide 1]] ; # fade ok
+ $w bind all <Any-KeyPress> +[namespace code hide]
+ $w bind all <Any-Button> +[namespace code hide]
+}
+
+proc ::tooltip::tagTip {w tag} {
+ variable tooltip
+ variable G
+ set G(LAST) -1
+ if {$G(enabled) && [info exists tooltip($w,t_$tag)]} {
+ if {[info exists G(AFTERID)]} { after cancel $G(AFTERID) }
+ set G(AFTERID) [after $G(DELAY) \
+ [namespace code [list show $w $tooltip($w,t_$tag) cursor]]]
+ }
+}
+
+proc ::tooltip::enableTag {w tag} {
+ if {[string match *tagTip* [$w tag bind $tag]]} { return }
+ $w tag bind $tag <Enter> +[namespace code [list tagTip $w $tag]]
+ $w tag bind $tag <Leave> +[namespace code [list hide 1]] ; # fade ok
+ $w tag bind $tag <Any-KeyPress> +[namespace code hide]
+ $w tag bind $tag <Any-Button> +[namespace code hide]
+}
diff --git a/vradio.gif b/vradio.gif
new file mode 100644
index 0000000..afcb929
--- /dev/null
+++ b/vradio.gif
Binary files differ
diff --git a/vslider.gif b/vslider.gif
new file mode 100644
index 0000000..f088b8d
--- /dev/null
+++ b/vslider.gif
Binary files differ
diff --git a/vumeter.gif b/vumeter.gif
new file mode 100644
index 0000000..bc16a52
--- /dev/null
+++ b/vumeter.gif
Binary files differ