1 # mb-pagemgr.tcl --
2 #
3 # FIXME: This file needs a description here.
4 #
5 # Copyright (c) 1998-2002 The Regents of the University of California.
6 # All rights reserved.
7 #
8 # Redistribution and use in source and binary forms, with or without
9 # modification, are permitted provided that the following conditions are met:
10 #
11 # A. Redistributions of source code must retain the above copyright notice,
12 # this list of conditions and the following disclaimer.
13 # B. Redistributions in binary form must reproduce the above copyright notice,
14 # this list of conditions and the following disclaimer in the documentation
15 # and/or other materials provided with the distribution.
16 # C. Neither the names of the copyright holders nor the names of its
17 # contributors may be used to endorse or promote products derived from this
18 # software without specific prior written permission.
19 #
20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
21 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
23 # ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
24 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
25 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
26 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
27 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
28 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
29 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
30 #
31 # @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/mb/mb-pagemgr.tcl,v 1.11 2002/02/03 04:27:17 lim Exp $
32
33 import Observable
34
35 # MediaBoard Page Manager <br>
36 # Manages mb pages, used to switch pages and manages canvas for each page
37 # <p>
38 # notifies the following events:
39 # <ul>
40 # <li> add_page $page_id: add a new page with id: $page_id
41 # <li> switch_page $page_id: switches to page with id: $page_id
42 # </ul>
43 Class MBPageMgr -superclass Observable
44
45 # $mbMgr is the mb manager object
46 #
47 MBPageMgr public init {mbMgr} {
48 # when new items were drawn onto a new page, we sched a event to
49 # happen when idle for switching to this page, $idleHandler_
50 # stores the scheduled event id, while $nextPage_ is the next page
51 # $idleHandler_ is scheduled to switch to.
52 $self set idleHandler_ {}
53 $self set nextPage_ {}
54
55 $self set currPage_ {}
56 $self set mgr_ $mbMgr
57 }
58
59 # $mbMgr is the mb manager object
60 #
61 MBPageMgr public destroy {} {
62 $self instvar arPage2Canv_
63 foreach page_id [array names arPage2Canv_] {
64 mtrace trcMB "deleting canvas for page: $page_id"
65 delete $arPage2Canv_($page_id)
66 }
67 }
68
69 # switches to the page corr. to <u>page_id</u> when idle <br>
70 # since this procedure might be called when mb
71 # is in a process of doing something (e.g. half way drawing a line),
72 # we arrange for switching to occur after all events have been handled.
73 #
74 MBPageMgr public switch_page_later {page_id} {
75 $self instvar idleHandler_ nextPage_
76
77 # Reschedule if a different page is to be switched.
78 # - note that nextPage_ is initialized to "" which guarantees
79 # execution on the 1st round
80 # - also, nextPage_ will be equal to the current page when no
81 # event is scheduled, so this proc does nothing unless
82 # a different page is to be switched.
83
84 # DbgOut "in: switch to $page_id $nextPage_ $idleHandler_"
85 if {[string compare $nextPage_ $page_id]} {
86 after cancel $idleHandler_
87 # DbgOut "switch to $page_id"
88 set idleHandler_ [after idle $self switch_page $page_id]
89 set nextPage_ $page_id
90 }
91 }
92
93 MBPageMgr public create_new_page {{page_name {}}} {
94 $self instvar mgr_
95
96 if {$page_name=={}} {
97 set page_name "Page "
98 append page_name [$self nextPageNumber]
99 } else {
100 set page_name [lindex $args 0]
101 }
102 set page_id [[$mgr_ sender] create_page $page_name]
103 return $page_id
104 }
105
106 # inform mgr of a new page and canvas pair <br>
107 # throws error if it is not a new page (for now) <br>
108 #
109 MBPageMgr public add_page {page_id canvas} {
110 $self instvar arCanv2Page_ arPage2Canv_
111 if [info exists arCanv2Page_($canvas)] {
112 error "MBPageMgr add_page called with already created page"
113 }
114 set arCanv2Page_($canvas) $page_id
115 set arPage2Canv_($page_id) $canvas
116 $self notify_observers add_page $page_id
117 }
118
119 # returns the current page
120 MBPageMgr public current_page {} {
121 return [$self set currPage_]
122 }
123
124 # returns the current page
125 MBPageMgr public current_canvas {} {
126 $self instvar currPage_
127 if {$currPage_!={}} {
128 return [$self page2canv $currPage_]
129 } else {
130 return {}
131 }
132 }
133
134 # returns a list of pages
135 # right now the order is quite random
136 # <! FIXME: should be sorted according to MBPageList>
137 MBPageMgr public pagelist {} {
138 $self instvar arPage2Canv_
139 return [array names arPage2Canv_]
140 return
141 }
142
143 # returns 0 if $page_id is not found, 1 otherwise
144 MBPageMgr public has_page {page_id} {
145 $self instvar arPage2Canv_
146 return [info exists arPage2Canv_($page_id)]
147 }
148
149 # returns the canvas associated with $page_id
150 MBPageMgr public page2canv {page_id} {
151 $self instvar arPage2Canv_
152 if ![info exists arPage2Canv_($page_id)] {
153 error "cannot find $page_id"
154 }
155 return $arPage2Canv_($page_id)
156 }
157
158 # returns the page associated with canvas
159 MBPageMgr public canv2page {canvas} {
160 $self instvar arCanv2Page_
161 if ![info exists arCanv2Page_($canvas)] {
162 error "cannot find $canvas"
163 }
164 return $arCanv2Page_($canvas)
165 }
166
167 # switches current page to $page_id
168 MBPageMgr private switch_page {page_id} {
169 $self instvar currPage_ nextPage_ sender_
170 $self instvar menubutton_ mgr_
171
172 if {$page_id==$currPage_} {
173 mtrace trcVerbose "same page, do nothing"
174 return
175 }
176 mtrace trcVerbose "switching to $page_id"
177 puts "before update idletasks 1"
178 update idletasks
179 puts "after update idletasks 1"
180 if {$currPage_ != {}} {
181 set old_canv [$self page2canv $currPage_]
182 $old_canv unpack
183 }
184
185 set new_canv [$self page2canv $page_id]
186 $new_canv pack -side left -fill both -expand true -anchor nw
187 if {$currPage_ != {}} {
188 $new_canv transfer_state_from $old_canv
189 }
190
191 set currPage_ $page_id
192 set nextPage_ $page_id
193
194 #FIXME: would be nice if the observer API works for this
195 [$mgr_ sender] switch_page $currPage_
196 $self notify_observers switch_page $currPage_
197 }
198
199 #
200 # searches thru all currently defined pages to get new number for
201 # the next page id
202 # the page formats are <addr>_<uid>:<number>, all in hex
203 #
204 MBPageMgr public nextPageNumber {} {
205 $self instvar arCanv2Page_ mgr_
206
207 set part [$mgr_ local_srcid]
208 set pages [array names arCanv2Page_]
209 mtrace trcVerbose "pages:$pages, part=$part"
210 set max 0
211 foreach id $pages {
212 if {[string first $part $id]>=0} {
213 mtrace trcExcessive \
214 [concat "match $id, split returns <" \
215 [split $id :] ">"]
216 set n "0x"
217 append n [lindex [split $id :] 1]
218 if {$n > $max} {
219 set max $n
220 }
221 }
222 }
223 return [expr $max + 1]
224 }
225
226 MBPageMgr public page_label {page_id} {
227 set wrk [split $page_id :]
228 set srcid [lindex $wrk 0]
229 # change to hex
230 set h "0x"
231 append h [lindex $wrk 1]
232 if {$h == "0x"} {
233 return "(null)"
234 }
235 set pagenum [format "%d" $h]
236 set wrk [split $srcid _]
237
238 set addr [lindex $wrk 0]
239 set uid [lindex $wrk 1]
240
241 set agent [[[$self set mgr_] session] get_agent]
242 set src [$agent get_source $addr $uid]
243 # use conventional userid@addr:page number
244 $self instvar mgr_
245 if {$src=={}} {
246 # these values are in hex, change them to base 10 first
247 set addr [format %u "0x$addr"]
248 set uid [format %u "0x$uid"]
249 set addr [$mgr_ intoa $addr]
250 return [append nothing $uid "@" $addr ":Page " $pagenum]
251 }
252 return [append nothing [$src cname] ": " $pagenum]
253 }
254
255 # sorts page ids by host first, then page number
256 MBPageMgr proc sort_pages {pagelist} {
257 # compares 2 mb page ids, src id first, then page number
258 # note that this procedure is not visible in global space
259 proc mbPageIdCompare {p1 p2} {
260 puts "compare $p1 $p2"
261 set t [split $p1 :]
262 set h1 [lindex $t 0]
263 set n1 [lindex $t 1]
264 set t [split $p2 :]
265 set h2 [lindex $t 0]
266 set n2 [lindex $t 1]
267 set r [string compare $h1 $h2]
268 if {$r == 0} {
269 return [expr {$n1 - $n2}]
270 }
271 puts "return $r"
272 return $r
273 }
274 return [lsort -command mbPageIdCompare $pagelist]
275 }
276
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.