# copyright (C) 1997-2006 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

# $Id: scrollbl.tcl,v 2.14 2006/01/28 19:16:59 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"]
    }

}
