1# ----------------------------------------------------------------------------
2#  progressbar.tcl
3#  This file is part of Unifix BWidget Toolkit
4#  $Id: progressbar.tcl,v 1.14 2009/09/06 21:37:18 oberdorfer Exp $
5# ----------------------------------------------------------------------------
6#  Index of commands:
7#     - ProgressBar::create
8#     - ProgressBar::configure
9#     - ProgressBar::cget
10#     - ProgressBar::_destroy
11#     - ProgressBar::_modify
12#     - ProgressBar::_themechanged
13# ----------------------------------------------------------------------------
14# to-do: johann: -troughcolor has no effect ?!
15
16namespace eval ProgressBar {
17    Widget::define ProgressBar progressbar
18
19    Widget::declare ProgressBar {
20        {-type        Enum       normal     0
21                      {normal incremental infinite nonincremental_infinite}}
22        {-maximum     Int        100        0 "%d > 0"}
23        {-background  Color      "SystemWindowFrame" 0}
24        {-foreground  Color      "SystemHighlight"   0}
25        {-troughcolor Color      "SystemScrollbar"  0}
26        {-borderwidth TkResource 2          0 frame}
27        {-relief      TkResource sunken     0 label}
28        {-orient      Enum       horizontal 1 {horizontal vertical}}
29        {-variable    String     ""         0}
30        {-idle        Boolean    0          0}
31        {-width       TkResource 100        0 frame}
32        {-height      TkResource 4m         0 frame}
33        {-bg          Synonym    -background}
34        {-fg          Synonym    -foreground}
35        {-bd          Synonym    -borderwidth}
36    }
37
38    Widget::addmap ProgressBar "" :cmd {-background {} -width {} -height {}}
39    Widget::addmap ProgressBar "" .bar {
40	-troughcolor -background -borderwidth {} -relief {}
41    }
42
43    if {[lsearch [bindtags .] ProgressBarThemeChanged] < 0} {
44        bindtags . [linsert [bindtags .] 1 ProgressBarThemeChanged]
45    }
46
47    variable _widget
48}
49
50
51# ----------------------------------------------------------------------------
52#  Command ProgressBar::create
53# ----------------------------------------------------------------------------
54proc ProgressBar::create { path args } {
55    variable _widget
56
57    array set maps [list ProgressBar {} :cmd {} .bar {}]
58    array set maps [Widget::parseArgs ProgressBar $args]
59
60    eval frame $path $maps(:cmd) -class ProgressBar -bd 0 \
61	    -highlightthickness 0 -relief flat
62    Widget::initFromODB ProgressBar $path $maps(ProgressBar)
63
64    set c  [eval [list canvas $path.bar] $maps(.bar) -highlightthickness 0]
65    set fg [Widget::cget $path -foreground]
66    if { [string equal [Widget::cget $path -orient] "horizontal"] } {
67        $path.bar create rectangle -1 0 0 0 -fill $fg -outline $fg -tags rect
68    } else {
69        $path.bar create rectangle 0 1 0 0 -fill $fg -outline $fg -tags rect
70    }
71
72    set _widget($path,val) 0
73    set _widget($path,dir) 1
74    set _widget($path,var) [Widget::cget $path -variable]
75    if {$_widget($path,var) != ""} {
76        GlobalVar::tracevar variable $_widget($path,var) w \
77		[list ProgressBar::_modify $path]
78        set _widget($path,afterid) \
79	    [after idle [list ProgressBar::_modify $path]]
80    }
81
82    bind $path.bar <Destroy>   [list ProgressBar::_destroy $path]
83    bind $path.bar <Configure> [list ProgressBar::_modify $path]
84
85    bind ProgressBarThemeChanged <<ThemeChanged>> \
86	     "+ [namespace current]::_themechanged $path"
87
88    return [Widget::create ProgressBar $path]
89}
90
91
92# ----------------------------------------------------------------------------
93#  Command ProgressBar::configure
94# ----------------------------------------------------------------------------
95proc ProgressBar::configure { path args } {
96    variable _widget
97
98    set res [Widget::configure $path $args]
99
100    if { [Widget::hasChangedX $path -variable] } {
101	set newv [Widget::cget $path -variable]
102        if { $_widget($path,var) != "" } {
103            GlobalVar::tracevar vdelete $_widget($path,var) w \
104		    [list ProgressBar::_modify $path]
105        }
106        if { $newv != "" } {
107            set _widget($path,var) $newv
108            GlobalVar::tracevar variable $newv w \
109		    [list ProgressBar::_modify $path]
110	    if {![info exists _widget($path,afterid)]} {
111		set _widget($path,afterid) \
112		    [after idle [list ProgressBar::_modify $path]]
113	    }
114        } else {
115            set _widget($path,var) ""
116        }
117    }
118
119    foreach {cbd cor cma} [Widget::hasChangedX $path -borderwidth \
120	    -orient -maximum] break
121
122    if { $cbd || $cor || $cma } {
123	if {![info exists _widget($path,afterid)]} {
124	    set _widget($path,afterid) \
125		[after idle [list ProgressBar::_modify $path]]
126	}
127    }
128    if { [Widget::hasChangedX $path -foreground] } {
129	set fg [Widget::cget $path -foreground]
130        $path.bar itemconfigure rect -fill $fg -outline $fg
131    }
132    if { [Widget::hasChangedX $path -background] } {
133	set bg [Widget::cget $path -background]
134        $path.bar configure -background $bg
135    }
136
137    return $res
138}
139
140
141# ----------------------------------------------------------------------------
142#  Command ProgressBar::cget
143# ----------------------------------------------------------------------------
144proc ProgressBar::cget { path option } {
145    return [Widget::cget $path $option]
146}
147
148
149# ----------------------------------------------------------------------------
150#  Command ProgressBar::_modify
151# ----------------------------------------------------------------------------
152proc ProgressBar::_modify { path args } {
153    variable _widget
154
155    catch {unset _widget($path,afterid)}
156    if { ![GlobalVar::exists $_widget($path,var)] ||
157	 [set val [GlobalVar::getvar $_widget($path,var)]] < 0 } {
158        catch {place forget $path.bar}
159    } else {
160	place $path.bar -relx 0 -rely 0 -relwidth 1 -relheight 1
161	set type [Widget::getoption $path -type]
162	if { $val != 0 && $type != "normal" && \
163		$type != "nonincremental_infinite"} {
164	    set val [expr {$val+$_widget($path,val)}]
165	}
166	set _widget($path,val) $val
167	set max [Widget::getoption $path -maximum]
168	set bd  [expr {2*[$path.bar cget -bd]}]
169	set w   [winfo width  $path.bar]
170	set h   [winfo height $path.bar]
171	if {$type == "infinite" || $type == "nonincremental_infinite"} {
172	    # JDC: New infinite behaviour
173	    set tval [expr {$val % $max}]
174	    if { $tval < ($max / 2.0) } {
175		set x0 [expr {double($tval) / double($max) * 1.5}]
176	    } else {
177		set x0 [expr {(1.0-(double($tval) / double($max))) * 1.5}]
178	    }
179	    set x1 [expr {$x0 + 0.25}]
180	    # convert coords to ints to prevent triggering canvas refresh
181	    # bug related to fractional coords
182	    if {[Widget::getoption $path -orient] == "horizontal"} {
183		$path.bar coords rect [expr {int($x0*$w)}] 0 \
184		    [expr {int($x1*$w)}] $h
185	    } else {
186		$path.bar coords rect 0 [expr {int($h-$x0*$h)}] $w \
187		    [expr {int($x1*$h)}]
188	    }
189	} else {
190	    if { $val > $max } {set val $max}
191	    if {[Widget::getoption $path -orient] == "horizontal"} {
192		$path.bar coords rect -1 0 [expr {int(double($val)*$w/$max)}] $h
193	    } else {
194		$path.bar coords rect 0 [expr {$h+1}] $w \
195		    [expr {int($h*(1.0 - double($val)/$max))}]
196	    }
197	}
198    }
199    if {![Widget::cget $path -idle]} {
200	update idletasks
201    }
202}
203
204
205# ----------------------------------------------------------------------------
206#  Command ProgressBar::_destroy
207# ----------------------------------------------------------------------------
208proc ProgressBar::_destroy { path } {
209    variable _widget
210
211    if {[info exists _widget($path,afterid)]} {
212	after cancel $_widget($path,afterid)
213	unset _widget($path,afterid)
214    }
215    if {[info exists _widget($path,var)]} {
216	if {$_widget($path,var) != ""} {
217	    GlobalVar::tracevar vdelete $_widget($path,var) w \
218		[list ProgressBar::_modify $path]
219	}
220	unset _widget($path,var)
221    }
222    unset _widget($path,dir)
223    Widget::destroy $path
224}
225
226
227# ----------------------------------------------------------------------------
228#  Command ProgressBar::_themechanged
229# ----------------------------------------------------------------------------
230proc ProgressBar::_themechanged { path } {
231
232    if { ![winfo exists $path] } { return }
233    BWidget::set_themedefaults
234
235    $path configure \
236           -background $BWidget::colors(SystemWindowFrame) \
237           -foreground $BWidget::colors(SystemHighlight)
238}
239
240