diff options
-rw-r--r-- | LICENSE.txt | 78 | ||||
-rw-r--r-- | README.txt | 7 | ||||
-rw-r--r-- | bng.gif | bin | 0 -> 3853 bytes | |||
-rw-r--r-- | buttonpopup-plugin.tcl | 97 | ||||
-rw-r--r-- | floatatom.gif | bin | 0 -> 4321 bytes | |||
-rw-r--r-- | hi-bit/old.bng.gif | bin | 0 -> 4182 bytes | |||
-rw-r--r-- | hi-bit/old.hradio.gif | bin | 0 -> 4082 bytes | |||
-rw-r--r-- | hi-bit/old.hslider.gif | bin | 0 -> 4100 bytes | |||
-rw-r--r-- | hi-bit/old.msg.gif | bin | 0 -> 4122 bytes | |||
-rw-r--r-- | hi-bit/old.obj.gif | bin | 0 -> 4094 bytes | |||
-rw-r--r-- | hi-bit/old.text.gif | bin | 0 -> 4093 bytes | |||
-rw-r--r-- | hi-bit/old.vradio.gif | bin | 0 -> 4087 bytes | |||
-rw-r--r-- | hi-bit/old.vslider.gif | bin | 0 -> 4102 bytes | |||
-rw-r--r-- | hradio.gif | bin | 0 -> 3841 bytes | |||
-rw-r--r-- | hslider.gif | bin | 0 -> 3853 bytes | |||
-rw-r--r-- | menuarray.gif | bin | 0 -> 4275 bytes | |||
-rw-r--r-- | msg.gif | bin | 0 -> 3850 bytes | |||
-rw-r--r-- | mycnv.gif | bin | 0 -> 4080 bytes | |||
-rw-r--r-- | numbox.gif | bin | 0 -> 4380 bytes | |||
-rw-r--r-- | obj.gif | bin | 0 -> 3839 bytes | |||
-rw-r--r-- | pkgIndex.tcl | 10 | ||||
-rw-r--r-- | symbolatom.gif | bin | 0 -> 4324 bytes | |||
-rw-r--r-- | text.gif | bin | 0 -> 4093 bytes | |||
-rw-r--r-- | toggle.gif | bin | 0 -> 4176 bytes | |||
-rw-r--r-- | tooltip-1.4.2.tcl | 447 | ||||
-rw-r--r-- | vradio.gif | bin | 0 -> 3846 bytes | |||
-rw-r--r-- | vslider.gif | bin | 0 -> 3853 bytes | |||
-rw-r--r-- | vumeter.gif | bin | 0 -> 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 Binary files differdiff --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 Binary files differnew file mode 100644 index 0000000..d52d608 --- /dev/null +++ b/floatatom.gif diff --git a/hi-bit/old.bng.gif b/hi-bit/old.bng.gif Binary files differnew file mode 100644 index 0000000..9670581 --- /dev/null +++ b/hi-bit/old.bng.gif diff --git a/hi-bit/old.hradio.gif b/hi-bit/old.hradio.gif Binary files differnew file mode 100644 index 0000000..4654ba9 --- /dev/null +++ b/hi-bit/old.hradio.gif diff --git a/hi-bit/old.hslider.gif b/hi-bit/old.hslider.gif Binary files differnew file mode 100644 index 0000000..f8760fe --- /dev/null +++ b/hi-bit/old.hslider.gif diff --git a/hi-bit/old.msg.gif b/hi-bit/old.msg.gif Binary files differnew file mode 100644 index 0000000..a7e4fc3 --- /dev/null +++ b/hi-bit/old.msg.gif diff --git a/hi-bit/old.obj.gif b/hi-bit/old.obj.gif Binary files differnew file mode 100644 index 0000000..8be9048 --- /dev/null +++ b/hi-bit/old.obj.gif diff --git a/hi-bit/old.text.gif b/hi-bit/old.text.gif Binary files differnew file mode 100644 index 0000000..f5eb519 --- /dev/null +++ b/hi-bit/old.text.gif diff --git a/hi-bit/old.vradio.gif b/hi-bit/old.vradio.gif Binary files differnew file mode 100644 index 0000000..17f4347 --- /dev/null +++ b/hi-bit/old.vradio.gif diff --git a/hi-bit/old.vslider.gif b/hi-bit/old.vslider.gif Binary files differnew file mode 100644 index 0000000..a194f87 --- /dev/null +++ b/hi-bit/old.vslider.gif diff --git a/hradio.gif b/hradio.gif Binary files differnew file mode 100644 index 0000000..c0d8aa8 --- /dev/null +++ b/hradio.gif diff --git a/hslider.gif b/hslider.gif Binary files differnew file mode 100644 index 0000000..9fd9a81 --- /dev/null +++ b/hslider.gif diff --git a/menuarray.gif b/menuarray.gif Binary files differBinary files differnew file mode 100644 index 0000000..c446718 --- /dev/null +++ b/menuarray.gif diff --git a/mycnv.gif b/mycnv.gif Binary files differnew file mode 100644 index 0000000..61c55ae --- /dev/null +++ b/mycnv.gif diff --git a/numbox.gif b/numbox.gif Binary files differBinary files differnew file mode 100644 index 0000000..415fb06 --- /dev/null +++ b/numbox.gif 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 Binary files differnew file mode 100644 index 0000000..4cf64bd --- /dev/null +++ b/symbolatom.gif diff --git a/text.gif b/text.gif Binary files differnew file mode 100644 index 0000000..f5eb519 --- /dev/null +++ b/text.gif diff --git a/toggle.gif b/toggle.gif Binary files differnew file mode 100644 index 0000000..a5471bf --- /dev/null +++ b/toggle.gif 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 Binary files differnew file mode 100644 index 0000000..afcb929 --- /dev/null +++ b/vradio.gif diff --git a/vslider.gif b/vslider.gif Binary files differnew file mode 100644 index 0000000..f088b8d --- /dev/null +++ b/vslider.gif diff --git a/vumeter.gif b/vumeter.gif Binary files differnew file mode 100644 index 0000000..bc16a52 --- /dev/null +++ b/vumeter.gif |