1# ------------------------------------------------------------------------------
2#  pagesmgr.tcl
3#  This file is part of Unifix BWidget Toolkit
4#  $Id: pagesmgr.tcl,v 1.6.2.1 2011/02/14 16:56:09 oehhar Exp $
5# ------------------------------------------------------------------------------
6#  Index of commands:
7#     - PagesManager::create
8#     - PagesManager::configure
9#     - PagesManager::cget
10#     - PagesManager::compute_size
11#     - PagesManager::add
12#     - PagesManager::delete
13#     - PagesManager::raise
14#     - PagesManager::page
15#     - PagesManager::pages
16#     - PagesManager::getframe
17#     - PagesManager::_test_page
18#     - PagesManager::_select
19#     - PagesManager::_redraw
20#     - PagesManager::_draw_area
21#     - PagesManager::_realize
22# ------------------------------------------------------------------------------
23package require Tcl 8.1.1
24
25namespace eval PagesManager {
26    Widget::define PagesManager pagesmgr
27
28    Widget::declare PagesManager {
29        {-background TkResource "" 0 frame}
30        {-cursor     TkResource "" 0 frame}
31        {-width      Int        0  0 "%d >= 0"}
32        {-height     Int        0  0 "%d >= 0"}
33    }
34
35    Widget::addmap PagesManager "" :cmd { -width {} -height {} -cursor {} }
36}
37
38
39# ------------------------------------------------------------------------------
40#  Command PagesManager::create
41# ------------------------------------------------------------------------------
42proc PagesManager::create { path args } {
43    variable $path
44    upvar 0  $path data
45
46    Widget::init PagesManager $path $args
47
48    set data(select)   ""
49    set data(pages)    {}
50    set data(cpt)      0
51    set data(realized) 0
52
53    # --- creation du canvas -----------------------------------------------------------------
54    eval canvas $path -relief flat -bd 0 -highlightthickness 0 \
55	    [Widget::subcget $path :cmd]
56
57    bind $path <Configure> [list PagesManager::_realize $path]
58    bind $path <Destroy>   [list PagesManager::_destroy $path]
59
60    return [Widget::create PagesManager $path]
61}
62
63
64# ------------------------------------------------------------------------------
65#  Command PagesManager::configure
66# ------------------------------------------------------------------------------
67proc PagesManager::configure { path args } {
68    return [Widget::configure $path $args]
69}
70
71
72# ------------------------------------------------------------------------------
73#  Command PagesManager::cget
74# ------------------------------------------------------------------------------
75proc PagesManager::cget { path option } {
76    return [Widget::cget $path $option]
77}
78
79
80# ------------------------------------------------------------------------------
81#  Command PagesManager::compute_size
82# ------------------------------------------------------------------------------
83proc PagesManager::compute_size { path } {
84    variable $path
85    upvar 0  $path data
86
87    set wmax 0
88    set hmax 0
89    update idletasks
90    foreach page $data(pages) {
91        set w    [winfo reqwidth  $path.f$page]
92        set h    [winfo reqheight $path.f$page]
93        set wmax [expr {$w>$wmax ? $w : $wmax}]
94        set hmax [expr {$h>$hmax ? $h : $hmax}]
95    }
96    configure $path -width $wmax -height $hmax
97}
98
99
100# ------------------------------------------------------------------------------
101#  Command PagesManager::add
102# ------------------------------------------------------------------------------
103proc PagesManager::add { path page } {
104    variable $path
105    upvar 0  $path data
106
107    if { [lsearch -exact $data(pages) $page] != -1 } {
108        return -code error "page \"$page\" already exists"
109    }
110
111    lappend data(pages) $page
112
113    if {[Widget::theme]} {
114        ttk::frame $path.f$page
115    }  else  {
116        frame $path.f$page -relief flat \
117            -background [Widget::cget $path -background] -borderwidth 0
118    }
119
120    return $path.f$page
121}
122
123
124# ------------------------------------------------------------------------------
125#  Command PagesManager::delete
126# ------------------------------------------------------------------------------
127proc PagesManager::delete { path page } {
128    variable $path
129    upvar 0  $path data
130
131    set pos [_test_page $path $page]
132    set data(pages) [lreplace $data(pages) $pos $pos]
133    if { $data(select) == $page } {
134        set data(select) ""
135    }
136    destroy $path.f$page
137    _redraw $path
138}
139
140
141# ------------------------------------------------------------------------------
142#  Command PagesManager::raise
143# ------------------------------------------------------------------------------
144proc PagesManager::raise { path {page ""} } {
145    variable $path
146    upvar 0  $path data
147
148    if { $page != "" } {
149        _test_page $path $page
150        _select $path $page
151    }
152    return $data(select)
153}
154
155
156# ------------------------------------------------------------------------------
157#  Command PagesManager::page - deprecated, use pages
158# ------------------------------------------------------------------------------
159proc PagesManager::page { path first {last ""} } {
160    variable $path
161    upvar 0  $path data
162
163    if { $last == "" } {
164        return [lindex $data(pages) $first]
165    } else {
166        return [lrange $data(pages) $first $last]
167    }
168}
169
170
171# ------------------------------------------------------------------------------
172#  Command PagesManager::pages
173# ------------------------------------------------------------------------------
174proc PagesManager::pages { path {first ""} {last ""} } {
175    variable $path
176    upvar 0  $path data
177
178    if { ![string length $first] } {
179	return $data(pages)
180    }
181
182    if { ![string length $last] } {
183        return [lindex $data(pages) $first]
184    } else {
185        return [lrange $data(pages) $first $last]
186    }
187}
188
189
190# ------------------------------------------------------------------------------
191#  Command PagesManager::getframe
192# ------------------------------------------------------------------------------
193proc PagesManager::getframe { path page } {
194    return $path.f$page
195}
196
197
198# ------------------------------------------------------------------------------
199#  Command PagesManager::_test_page
200# ------------------------------------------------------------------------------
201proc PagesManager::_test_page { path page } {
202    variable $path
203    upvar 0  $path data
204
205    if { [set pos [lsearch $data(pages) $page]] == -1 } {
206        return -code error "page \"$page\" does not exists"
207    }
208    return $pos
209}
210
211
212# ------------------------------------------------------------------------------
213#  Command PagesManager::_select
214# ------------------------------------------------------------------------------
215proc PagesManager::_select { path page } {
216    variable $path
217    upvar 0  $path data
218
219    set oldsel $data(select)
220    if { $page != $oldsel } {
221        set data(select) $page
222        _draw_area $path
223    }
224}
225
226
227# ------------------------------------------------------------------------------
228#  Command PagesManager::_redraw
229# ------------------------------------------------------------------------------
230proc PagesManager::_redraw { path } {
231    variable $path
232    upvar 0  $path data
233
234    if { !$data(realized) } {
235        return
236    }
237    _draw_area $path
238}
239
240
241# ------------------------------------------------------------------------------
242#  Command PagesManager::_draw_area
243# ------------------------------------------------------------------------------
244proc PagesManager::_draw_area { path } {
245    variable $path
246    upvar 0  $path data
247
248    set w   [winfo width  $path]
249    set h   [winfo height $path]
250    set sel $data(select)
251    if { $sel != "" } {
252        if { [llength [$path:cmd find withtag "window"]] } {
253            $path:cmd coords "window" 0 0
254            $path:cmd itemconfigure "window"    \
255                -width  $w        \
256                -height $h    \
257                -window $path.f$sel
258        } else {
259            $path:cmd create window 0 0 \
260                -width  $w          \
261                -height $h       \
262                -anchor nw                      \
263                -tags   "window"                \
264                -window $path.f$sel
265        }
266    } else {
267        $path:cmd delete "window"
268    }
269}
270
271
272# ------------------------------------------------------------------------------
273#  Command PagesManager::_realize
274# ------------------------------------------------------------------------------
275proc PagesManager::_realize { path } {
276    variable $path
277    upvar 0  $path data
278
279    if { [set width  [Widget::cget $path -width]]  == 0 ||
280         [set height [Widget::cget $path -height]] == 0 } {
281        compute_size $path
282    }
283
284    set data(realized) 1
285    _draw_area $path
286    bind $path <Configure> [list PagesManager::_draw_area $path]
287}
288
289
290# ------------------------------------------------------------------------------
291#  Command PagesManager::_destroy
292# ------------------------------------------------------------------------------
293proc PagesManager::_destroy { path } {
294    variable $path
295    upvar 0  $path data
296    Widget::destroy $path
297    unset data
298}
299