1# ------------------------------------------------------------------------------
2#  pagesmgr.tcl
3#  This file is part of Unifix BWidget Toolkit
4#  $Id: pagesmgr.tcl 606 2004-04-05 07:06:06Z mcourtoi $
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    frame $path.f$page -relief flat \
114	    -background [Widget::cget $path -background] -borderwidth 0
115
116    return $path.f$page
117}
118
119
120# ------------------------------------------------------------------------------
121#  Command PagesManager::delete
122# ------------------------------------------------------------------------------
123proc PagesManager::delete { path page } {
124    variable $path
125    upvar 0  $path data
126
127    set pos [_test_page $path $page]
128    set data(pages) [lreplace $data(pages) $pos $pos]
129    if { $data(select) == $page } {
130        set data(select) ""
131    }
132    destroy $path.f$page
133    _redraw $path
134}
135
136
137# ------------------------------------------------------------------------------
138#  Command PagesManager::raise
139# ------------------------------------------------------------------------------
140proc PagesManager::raise { path {page ""} } {
141    variable $path
142    upvar 0  $path data
143
144    if { $page != "" } {
145        _test_page $path $page
146        _select $path $page
147    }
148    return $data(select)
149}
150
151
152# ------------------------------------------------------------------------------
153#  Command PagesManager::page - deprecated, use pages
154# ------------------------------------------------------------------------------
155proc PagesManager::page { path first {last ""} } {
156    variable $path
157    upvar 0  $path data
158
159    if { $last == "" } {
160        return [lindex $data(pages) $first]
161    } else {
162        return [lrange $data(pages) $first $last]
163    }
164}
165
166
167# ------------------------------------------------------------------------------
168#  Command PagesManager::pages
169# ------------------------------------------------------------------------------
170proc PagesManager::pages { path {first ""} {last ""} } {
171    variable $path
172    upvar 0  $path data
173
174    if { ![string length $first] } {
175	return $data(pages)
176    }
177
178    if { ![string length $last] } {
179        return [lindex $data(pages) $first]
180    } else {
181        return [lrange $data(pages) $first $last]
182    }
183}
184
185
186# ------------------------------------------------------------------------------
187#  Command PagesManager::getframe
188# ------------------------------------------------------------------------------
189proc PagesManager::getframe { path page } {
190    return $path.f$page
191}
192
193
194# ------------------------------------------------------------------------------
195#  Command PagesManager::_test_page
196# ------------------------------------------------------------------------------
197proc PagesManager::_test_page { path page } {
198    variable $path
199    upvar 0  $path data
200
201    if { [set pos [lsearch $data(pages) $page]] == -1 } {
202        return -code error "page \"$page\" does not exists"
203    }
204    return $pos
205}
206
207
208# ------------------------------------------------------------------------------
209#  Command PagesManager::_select
210# ------------------------------------------------------------------------------
211proc PagesManager::_select { path page } {
212    variable $path
213    upvar 0  $path data
214
215    set oldsel $data(select)
216    if { $page != $oldsel } {
217        set data(select) $page
218        _draw_area $path
219    }
220}
221
222
223# ------------------------------------------------------------------------------
224#  Command PagesManager::_redraw
225# ------------------------------------------------------------------------------
226proc PagesManager::_redraw { path } {
227    variable $path
228    upvar 0  $path data
229
230    if { !$data(realized) } {
231        return
232    }
233    _draw_area $path
234}
235
236
237# ------------------------------------------------------------------------------
238#  Command PagesManager::_draw_area
239# ------------------------------------------------------------------------------
240proc PagesManager::_draw_area { path } {
241    variable $path
242    upvar 0  $path data
243
244    set w   [winfo width  $path]
245    set h   [winfo height $path]
246    set sel $data(select)
247    if { $sel != "" } {
248        if { [llength [$path:cmd find withtag "window"]] } {
249            $path:cmd coords "window" 0 0
250            $path:cmd itemconfigure "window"    \
251                -width  $w        \
252                -height $h    \
253                -window $path.f$sel
254        } else {
255            $path:cmd create window 0 0 \
256                -width  $w          \
257                -height $h       \
258                -anchor nw                      \
259                -tags   "window"                \
260                -window $path.f$sel
261        }
262    } else {
263        $path:cmd delete "window"
264    }
265}
266
267
268# ------------------------------------------------------------------------------
269#  Command PagesManager::_realize
270# ------------------------------------------------------------------------------
271proc PagesManager::_realize { path } {
272    variable $path
273    upvar 0  $path data
274
275    if { [set width  [Widget::cget $path -width]]  == 0 ||
276         [set height [Widget::cget $path -height]] == 0 } {
277        compute_size $path
278    }
279
280    set data(realized) 1
281    _draw_area $path
282    bind $path <Configure> [list PagesManager::_draw_area $path]
283}
284
285
286# ------------------------------------------------------------------------------
287#  Command PagesManager::_destroy
288# ------------------------------------------------------------------------------
289proc PagesManager::_destroy { path } {
290    variable $path
291    upvar 0  $path data
292    Widget::destroy $path
293    unset data
294}
295