source: trunk/BWidget-1.2.1/pagesmgr.tcl @ 984

Last change on this file since 984 was 931, checked in by toby, 11 years ago

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