# 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: progbar.tcl,v 1.3 2006/01/28 19:16:59 jfontain Exp $


class progressBar {

    proc progressBar {this parentPath args} composite {[new frame $parentPath] $args} {
        composite::manage $this [new frame $widget::($this,path) -relief sunken -borderwidth 1] bar\
            [new label $widget::($this,path)] label
        place $composite::($this,bar,path) -x 2 -rely 0.5 -anchor w
        place $composite::($this,label,path) -relx 1 -x -2 -rely 0.5 -anchor e
        set ($this,blocks) 0                                                                 ;# number of blocks currently displayed
        set ($this,initialized) 0
        composite::complete $this
        bind $widget::($this,path) <Configure> "progressBar::refresh $this"
    }

    proc ~progressBar {this} {}

    proc options {this} {
        return [list\
            [list -background $widget::option(label,background)]\
            [list -blockwidth 5 5]\
            [list -font $widget::option(button,font) $widget::option(button,font)]\
            [list -foreground $widget::option(listbox,selectbackground) $widget::option(listbox,selectbackground)]\
            [list -percent 0]\
        ]
    }

    proc set-background {this value} {
        $composite::($this,bar,path) configure -background $value
    }

    proc set-blockwidth {this value} {
        refresh $this 1
    }

    proc set-font {this value} {
        $composite::($this,label,path) configure -font $value
    }

    proc set-foreground {this value} {
        foreach frame [winfo children $composite::($this,bar,path)] {
            $frame configure -background $value
        }
    }

    proc set-percent {this value} {
        if {($value < 0) || ($value > 100)} {error "invalid value: $value"}
        $composite::($this,label,path) configure -text ${value}%
        refresh $this 1
    }

    proc refresh {this {force 0}} {
        set bar $composite::($this,bar,path)
        set height [winfo reqheight $composite::($this,label,path)]                              ;# use label height as total height
        $widget::($this,path) configure -height $height
        $bar configure -height [incr height -2]                                                    ;# use 1 pixel padding vertically
        set available [expr {[winfo width $widget::($this,path)] - [winfo reqwidth $composite::($this,label,path)] - 6}]  ;# padding
        if {$available < 0} return
        set block $composite::($this,-blockwidth)
        set blocks [expr {($available - 1) / ($block + 1)}]                                        ;# block are separated by 1 pixel
        if {!$force && ($blocks == $($this,blocks)) && $($this,initialized)} return                            ;# nothing else to do
        $bar configure -width [expr {($blocks * ($block + 1)) + 3}]         ;# 1 pixel to the left of first block plus border widths
        set number [expr {round(($composite::($this,-percent) / 100.0) * $blocks)}]  
        incr height -4                                                  ;# 1 pixel padding with frame border width of 1 on each side
        set color $composite::($this,-foreground)
        set x 0
        for {set index 0} {$index < $number} {incr index} {
            incr x                                                                                 ;# 1 pixel spacing between blocks
            if {![winfo exists $bar.$index]} {                                   ;# avoid flashing by not recreating existing blocks
                place [frame $bar.$index -background $color -width $block -height $height] -x $x -rely 0.5 -anchor w
            }
            incr x $block
        }
        for {} {$index < $blocks} {incr index} {destroy $bar.$index}                                ;# clear remaining blocks if any
        set ($this,blocks) $blocks
        set ($this,initialized) 1
    }

}
