Activity test

class Balloonwidget {
    inherit itk::Widget

    itk_option define -balloonhelp balloonHelp BalloonHelp ""

    private variable balloon_queue ""
    private variable destroy_queue ""

    public method enter
    public method leave
    public method balloon

    constructor { args } {
 bind $itk_component(hull) <Enter> [code $this enter]
 bind $itk_component(hull) <Leave> [code $this leave]
 eval itk_initialize $args }
}

body Balloonwidget::enter { } {
    if {$balloon_queue != ""} {
 after cancel $balloon_queue
    }
    if {$itk_option(-balloonhelp) != ""} {
 set balloon_queue [after 750 [code $this balloon]]
    }
}

body Balloonwidget::leave { } {
    if {$balloon_queue != ""} {
 after cancel $balloon_queue
    }
    set destroy_queue [after 100 {catch {destroy .balloon_help}}]
}

body Balloonwidget::balloon { } {
    set t .balloon_help
    catch {destroy $t}
    toplevel $t
    wm overrideredirect $t 1

    if {[tk windowingsystem] == "aqua"} {
 #unsupported1 style $itk_component(hull) floating sideTitlebar
 ::tk::unsupported::MacWindowStyle style $t help none
    }

    label $t.l \
    -text " $itk_option(-balloonhelp) " \
 -relief solid \
 -bd 2 \
 -bg gold \
 -fg #000000 \
 -font font_b
    pack $t.l -fill both
    set x [expr [winfo pointerx $itk_component(hull)] + 8]
    set y [expr [winfo pointery $itk_component(hull)] + 20]
    if {[expr $x + [winfo reqwidth $t.l]] > [winfo screenwidth $t.l]} {
    set x [expr [winfo screenwidth $t.l] - [winfo reqwidth $t.l] - 2]
    }
    if {[expr $y + [winfo reqheight $t.l]] > [winfo screenheight $t.l]} {
    set y [expr $y - 20 - [winfo reqheight $t.l] - 2]
    }
    wm geometry $t +$x\+$y
    #bind $t <Enter> [list [after cancel $destroy_queue]]
    #bind $t <Leave> "catch {destroy .balloon_help}"
}

class Activity {
    inherit Balloonwidget
#inherit itk::Widget
    private variable current_image_list {}
    private variable busy_list {::img::activity_blue_N16x16 ::img::activity_blue_NE16x16 ::img::activity_blue_E16x16 ::img::activity_blue_SE16x16 ::img::activity_blue_S16x16 ::img::activity_blue_SW16x16 ::img::activity_blue_W16x16 ::img::activity_blue_NW16x16}
    private variable warn_list {::img::activity_error_N16x16 ::img::activity_error_N16x16 ::img::activity_error_blank16x16}
    private variable pause_list {::img::activity_blue_N16x16 ::img::activity_blue_N16x16 ::img::activity_blue_blank16x16 }
    private variable idle_list {::img::activity_idle16x16 }

    private variable queue ""

    public method busy
    public method idle
    public method pause
    public method warn

    private method animate
    private method stop

    private method loopImages

    constructor { args } { }
}

body Activity::constructor { args } {

    itk_component add label {
 label $itk_interior.l
    }
    pack $itk_component(label)
  
    eval itk_initialize $args
}

body Activity::busy { {a_message ""} } {
    configure -balloonhelp $a_message
    animate $busy_list
}

body Activity::idle { } {
    configure -balloonhelp "Idle"
    animate $idle_list
}

body Activity::pause { } {
    configure -balloonhelp "Paused"
    animate $pause_list 200
}

body Activity::warn { {a_message "Error"} } {
    configure -balloonhelp $a_message
    animate $warn_list 200
}

body Activity::animate { a_list { a_interval "125" } } {
    stop
    set current_image_list $a_list
    if {[llength $current_image_list] <= 1} {
 $itk_component(label) configure \
     -image [lindex $current_image_list 0]
    } else {
 loopImages 0 $a_interval
    }
}

body Activity::stop { } {
    if {$queue != ""} {
 after cancel $queue
    }
}   

body Activity::loopImages { a_index a_interval } {
    if {$a_index >= [llength $current_image_list]} {
 set a_index 0
    }
    $itk_component(label) configure \
 -image [lindex $current_image_list $a_index]
    incr a_index
    set queue [after $a_interval [code $this loopImages $a_index $a_interval]]
}

usual Activity { }

class test  {
# inherit itk::Widget
 public method mes
 public method queryte
 constructor { args } { }
}
body test::constructor { args } {
 
        Activity .al 
 .al busy
        pack .al
}
body test::queryte { } {
}

body test::mes { } {
}

test .ck
#pack .ck