# tix3.6a/library/Balloon.tcl

set balloon_help 0
set tixBal(popped) 0
set tixBal(count) -1

proc tixEnableBalloon {} {
    global balloon_help
    set balloon_help 1
}

proc tixDisableBalloon {} {
    global balloon_help
    set balloon_help 0
}

proc tixAddBalloon {w class msg {initWait 200}} { 
    global tixBal

    bind $w <Any-Enter>  +[bind $class <Any-Enter>]
    bind $w <Any-Enter>  "+tixBalStart $w $initWait"
    bind $w <Any-Leave>  +[bind $class <Any-Leave>]
    bind $w <Any-Leave>  "+tixBalEnd $w $initWait"
    bind $w <Motion> +[bind $class <Motion>]
    bind $w <Motion> "+tixBalMotion $w $initWait"
    bind $w <Destroy>  +[bind $class <Destroy>]
    bind $w <Destroy> "+unset tixBal($w); tixBalPopdown"

    set tixBal($w) $msg
}

proc tixBalStart {w initWait} {
    global tixBal balloon_help

    if {$balloon_help == "1"} {
        set tixBal(count)  0
        set tixBal(popped) 0
        after $initWait tixBalActivate $w
    }
}

proc tixBalEnd {w initWait} {
    global tixBal

    set tixBal(count)  -1
    if {$tixBal(popped) == "1"} {
        tixBalPopdown
    } 
}

proc tixBalMotion {w initWait} {
    global tixBal balloon_help

    if {$balloon_help == "1" && $tixBal(popped) == 0} {
        incr tixBal(count)
        after $initWait tixBalActivate $w
    }
}

proc tixBalActivate {w} {
    global tixBal

    if {$tixBal(count) == "-1"} {
        return
    } elseif {$tixBal(count) == 0} {
        tixBalPopup $w
    } else {
        incr tixBal(count) -1
    }
}

proc tixBalPopup {widget} {
    global tixBal

    set w .tix_balloon

    catch {
        toplevel $w
        set bg    [tixQueryAppResource tixBalloonBg TixBalloonBg #ffff60]
        set fg    [tixQueryAppResource tixBalloonFg TixBalloonFg black]
        set width [tixQueryAppResource tixBalloonWidth TixBalloonWidth 180]
        wm overrideredirect $w 1
        message $w.msg -bg $bg -fg $fg -width $width
        pack $w.msg -expand yes -fill both
    }

    set x [expr [winfo rootx $widget]+[winfo width  $widget]-8]
    set y [expr [winfo rooty $widget]+[winfo height $widget]-8]
    $w.msg config -text $tixBal($widget)
    wm geometry $w +$x+$y
    wm deiconify $w
    raise $w
    set tixBal(popped) 1
}
    
proc tixBalPopdown {} {
    global tixBal
    set w .tix_balloon

    if {$tixBal(popped) != 0} {
        wm withdraw $w
        set tixBal(popped) 0
    }
}

proc tixQueryAppResource {name class default} {

    set value [option get . $name $class]
    if {$value == ""} {
        return $default
    } else {
        return $value
    }    
}
