#!/usr/local/bin/wish8.4 -f
#  'CBB' -- Check Book Balancer
#
#   balloon.tcl -- Routines for handling balloon help.
#
#  Written by Stewart Allen <stewart@neuron.com> as part of the
#    Visual Tcl application.
#
#  Modified by Curtis L. Olson to work with in the framework of CBB.
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
# $Id: balloon.tcl,v 1.2 1996/12/11 04:17:38 curt Exp $
# (Log is kept at end of this file)


bind cbb(balloon) <Enter> {
    set cbb(balloon,set) 0
    set cbb(balloon,first) 1
    set cbb(balloon,id) [after 500 {cbb_balloon %W $cbb(balloon,%W)}]
}

bind cbb(balloon) <Leave> {
    set cbb(balloon,first) 0
    cbb_kill_balloon
}

bind cbb(balloon) <Motion> {
    if {$cbb(balloon,set) == 0} {
	after cancel $cbb(balloon,id)
	set cbb(balloon,id) [after 500 {cbb_balloon %W $cbb(balloon,%W)}]
    }
}

proc cbb_set_balloon {target message} {
    global cbb
    set cbb(balloon,$target) $message
    bindtags $target "[bindtags $target] cbb(balloon)"
}

proc cbb_kill_balloon {} {
    global cbb
    after cancel $cbb(balloon,id)
    if {[winfo exists .balloon] == 1} {
        destroy .balloon
    }
    set cbb(balloon,set) 0
}

proc cbb_balloon {target message} {
    global cbb
    if {$cbb(balloon,first) == 1 && $cbb(balloon,on) == 1} {
        set cbb(balloon,first) 2
        set x [expr [winfo rootx $target] + ([winfo width $target]/2)]
        set y [expr [winfo rooty $target] + [winfo height $target] + 4]
        toplevel .balloon -bg black
        wm overrideredirect .balloon 1
        label .balloon.l \
		-text $message -relief flat -font $cbb(default_font) \
			-bg #ffffaa -fg black -padx 2 -pady 0 -anchor w
        pack .balloon.l -side left -padx 1 -pady 1
        wm geometry .balloon +${x}+${y}
        set cbb(balloon,set) 1
    }
}


# ----------------------------------------------------------------------------
# $Log: balloon.tcl,v $
# Revision 1.2  1996/12/11 04:17:38  curt
# Added cvs headers/log.
#
