# copyright (C) 1997-2001 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu

set rcsId {$Id: scrollbl.tcl,v 2.7 2000/12/31 23:14:19 jfontain Exp $}


class scrollingLabel {

    proc scrollingLabel {this parentPath args} composite {[new frame $parentPath] $args} {
        # anchor label for proper behavior with multi-line messages
        composite::manage $this [new label $widget::($this,path) -font $widget::option(button,font) -justify left] label
        composite::complete $this
        bind $widget::($this,path) <Configure> "scrollingLabel::refresh $this %w"     ;# now that everything is initialized properly
    }

    proc ~scrollingLabel {this} {}

    proc options {this} {                                                                      ;# force text and step initialization
        return [list\
            [list -font $widget::option(button,font) $widget::option(button,font)]\
            [list -interval 15 15]\
            [list -step 1]\
            [list -text {}]\
            [list -width 0 0]\
        ]
    }

    proc set-interval {this value} {}

    proc set-step {this value} {
        set ($this,step) -$value                                                                                ;# start moving left
    }

    proc set-font {this value} {
        $composite::($this,label,path) configure -font $value
        refresh $this [winfo width $widget::($this,path)]                                                           ;# force refresh
    }

    proc set-text {this value} {
        $composite::($this,label,path) configure -text $value
        refresh $this [winfo width $widget::($this,path)]                                                           ;# force refresh
    }

    proc set-width {this value} {
        $widget::($this,path) configure -width $value
    }

    proc refresh {this width} {
        if {![info exists ($this,step)]} return                                                               ;# not initialized yet
        set ($this,textWidth) [winfo reqwidth $composite::($this,label,path)]
        $widget::($this,path) configure -height [winfo reqheight $composite::($this,label,path)]
        place $composite::($this,label,path) -anchor nw -x [set ($this,x) 0] -y 0
        if {$width<$($this,textWidth)} {                                                                       ;# scrolling required
            scroll $this $width
        } else {
            catch {after cancel $($this,event)}
        }
    }

    proc scroll {this width} {
        set interval $composite::($this,-interval)
        if {(($($this,step)<0)&&($($this,x)<($width-$($this,textWidth))))||(($($this,step)>0)&&($($this,x)>0))} {
            set ($this,step) [expr {-$($this,step)}]                                                             ;# change direction
            set interval [expr {20*$interval}]                                                                      ;# pause a while
        }
        place $composite::($this,label,path) -x [incr ($this,x) $($this,step)]
        catch {after cancel $($this,event)}                                                                 ;# avoid race conditions
        set ($this,event) [after $interval "scrollingLabel::scroll $this $width"]
    }

}
