1 # fca-ui.tcl --
2 #
3 # FIXME: This file needs a description here.
4 #
5 # Copyright (c) 1997-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
32 set V(fonts) [new Fonts adobe]
33 option add *Font [$V(fonts) set helv10]
34
35
36 Class FCA_UI
37
38
39 FCA_UI instproc attach_uimgr { uiMgr } {
40 $self next
41 $self set uiMgr_ $uiMgr
42 }
43
44
45 FCA_UI instproc attach_appmgr { appMgr } {
46 $self set appMgr_ $appMgr
47 }
48
49
50
51 FCA_UI instproc build { path } {
52 $self instvar main_book_ page1_ page2_
53
54 frame $path
55 bind $path <Destroy> "+delete $self"
56
57 set main_book_ [new UIBook $path.main_book]
58 pack $path.main_book -padx 10 -pady 5 -fill both -expand true
59
60 set page1_ [$self build_floor_page $main_book_]
61 set page2_ [$self build_queue_page $main_book_]
62 set page3_ [$self build_srclist_page $main_book_]
63 $self build_buttons $path.buttons
64 $self build_request_menu
65 $self build_srclist_menu
66
67 $page1_ bring_to_top
68 }
69
70
71 FCA_UI instproc build_floor_page { book } {
72 global V
73 set page [new UIPage $book text "-text \"Floor\ncontrol\" \
74 -font [$V(fonts) set helv10b]"]
75 Within [$page frame] {
76 $self build_floorReq [WithinPath floorReq]
77 $self build_status [WithinPath status]
78 $self set statusFrame_ [WithinPath status]
79 }
80 return $page
81 }
82
83
84
85 FCA_UI instproc build_queue_page { book } {
86 global V
87 set page [new UIPage $book text "-text \"Queue\nstatus\" \
88 -font [$V(fonts) set helv10b]"]
89 Within [$page frame] {
90 $self build_admittedList [WithinPath admittedList]
91 $self build_pendingList [WithinPath pendingList]
92 }
93 return $page
94 }
95
96
97 FCA_UI instproc build_srclist_page { book } {
98 global V
99 $self instvar srcList_
100 set page [new UIPage $book text "-text \"Source\nlist \" \
101 -font [$V(fonts) set helv10b]"]
102 Within [$page frame] {
103 set srcList_ [new UIList [WithinPath srcList] \
104 {-width 225 -height 241 -bg white} 1 0]
105 Pack srcList -fill both -expand 1
106
107 $srcList_ proc on_ButtonPress_1 { id x y } \
108 "$self post_menu \[$self set srclist_menu_\] \
109 enable_srclist_menu \$id \$x \$y"
110 }
111
112 return $page
113 }
114
115
116 FCA_UI instproc build_buttons { path } {
117 global exit_icon exit_press_icon
118 imagebutton $path -image $exit_icon -pressimage $exit_press_icon \
119 -command "destroy ."
120 pack $path -anchor e -padx 10 -pady 3 -side bottom
121 }
122
123
124 FCA_UI instproc build_admittedList { path } {
125 $self instvar admittedList_
126 Frame $path
127 Pack $path -side top -fill x -expand 1
128 Within $path {
129 Label label -text "Admitted requests:" -anchor w
130 Pack label -anchor w
131
132 set admittedList_ [new UIList [WithinPath main] \
133 {-width 225 -height 110 -bg white} 1 1]
134 Pack main -fill x -expand 1
135 }
136
137
138 $admittedList_ proc build_item { path id info } \
139 "$self build_request_item \$path \$id"
140 $admittedList_ proc on_ButtonPress_1 { id x y } \
141 "$self post_menu \[$self set request_menu_\] \
142 enable_admitted_menu \$id \$x \$y"
143
144 }
145
146
147 FCA_UI instproc build_pendingList { path } {
148 $self instvar pendingList_
149 Frame $path
150 Pack $path -side top -fill x -expand 1
151 Within $path {
152 Label label -text "Pending requests:" -anchor w
153 Pack label -anchor w -side top
154
155 set pendingList_ [new UIList [WithinPath main] \
156 {-width 225 -height 65 -bg white} 1 1]
157 Pack main -fill x -expand 1
158 }
159
160 $pendingList_ proc build_item { path id info } \
161 "$self build_request_item \$path \$id"
162 $pendingList_ proc on_ButtonPress_1 { id x y } \
163 "$self post_menu \[$self set request_menu_\] \
164 enable_pending_menu \$id \$x \$y"
165 }
166
167
168
169 FCA_UI instproc build_floorReq { path } {
170 $self instvar commentPath_
171 Frame $path -bd 1 -relief raised
172 Pack $path -side top -fill x -expand 1 -padx 5 -pady 2
173 Within $path {
174 Label label -text "Comment:" -anchor w
175 Pack label -anchor w -side top
176
177 set commentPath_ [Text comment -bd 1 -relief sunken -bg white \
178 -fg black -width 30 -height 3 -highlightthickness 0]
179 Pack comment -anchor w -padx 5 -fill x -expand 1
180
181 Frame split
182 Pack split -expand 1 -fill x
183 Within split {
184 $self build_floorlist [WithinPath floorlist]
185
186 Frame buttons
187 Pack buttons -side right -padx 5 -pady 3
188 Within buttons {
189 Button request -text "Make request" -pady 0 -bd 1 \
190 -highlightthickness 1 \
191 -command "$self make_floor_request"
192 Button follow -text "Follow on" -pady 0 -bd 1 \
193 -highlightthickness 1 -state disabled
194 Pack request follow -padx 3 -pady 1 -side top -anchor w \
195 -fill x -expand 1
196 }
197 }
198 }
199 }
200
201
202
203 FCA_UI instproc build_floorlist { path } {
204 Frame $path
205 Pack $path -side left -padx 10 -pady 3
206 Within $path {
207 $self tkvar rbFloors_ # rb => radio-button
208 set rbFloors_ Text-only
209 trace variable rbFloors_ w "$self enable_selectfloors"
210 Frame helper -bd 0 -relief flat
211 RadioButton textonly -text "Text-only" -bd 1 -variable \
212 [$self tkvarname rbFloors_] -value Text-only -pady 0 -anchor w
213 RadioButton all -text "All" -variable [$self tkvarname rbFloors_]\
214 -value All -pady 0 -anchor w -bd 1
215 RadioButton select -text "Select floors" -bd 1 -variable \
216 [$self tkvarname rbFloors_] -value Select -pady 0 -anchor w
217
218 new UIMinimize [WithinPath min] [WithinPath selectFrame] 1 {} \
219 Down_arrow_Icon Down_arrow_Icon
220 Pack select min -in [WithinPath helper] -side left
221 Pack textonly all helper -side top -anchor w -pady 0 -fill x
222 $self build_selectfloors [WithinPath selectFrame]
223 }
224
225 $self instvar floors_
226 }
227
228
229 FCA_UI instproc build_selectfloors { path } {
230 $self instvar selectfloors_path_ floors_
231 Frame $path
232 set selectfloors_path_ $path
233 set floors_(all) {}
234 }
235
236
237 FCA_UI instproc enable_selectfloors { variable dummy op } {
238 $self instvar floors_
239 $self tkvar rbFloors_
240 if { $rbFloors_=="Select" } {
241 set state normal
242 } else {
243 set state disabled
244 }
245
246 foreach floortype $floors_(all) {
247 $floors_($floortype,button) configure -state $state
248 }
249 }
250
251
252
253
254 FCA_UI instproc build_status { path } {
255 Frame $path -bd 1 -relief raised
256 Pack $path -side top -fill x -expand 1 -padx 5 -pady 2
257 Within $path {
258 Label label -text "Floor status:" -anchor w
259 Pack label -anchor w -side top
260 }
261 }
262
263
264
265
266
267
268
269
270
271 FCA_UI instproc create_floorstatus_entry { floorType floorInstObj } {
272 set parentPath [$self statusFrame $floorType]
273 set path $parentPath.instance_$floorInstObj
274 label $path -bg [$parentPath cget -bg] -anchor w -text \
275 [[$self srcList] get_info [$floorInstObj srcId]]
276 pack $path -side top -fill x -expand 1
277 }
278
279
280 FCA_UI instproc destroy_floorstatus_entry { floorType floorInstObj } {
281 set parentPath [$self statusFrame $floorType]
282 set path $parentPath.instance_$floorInstObj
283 catch { destroy $path }
284 }
285
286
287
288
289
290 FCA_UI instproc build_request_item { path request } {
291 $self instvar uiMgr_
292 frame $path -bd 1
293 $path configure -bg [[winfo parent $path] cget -bg]
294
295 foreach floorType [$request floorTypes] {
296 $self build_floortype_label $path.floortype_$floorType $floorType
297 pack $path.floortype_$floorType -padx 0 -pady 0 -side left
298 }
299
300 label $path.cname -text [$uiMgr_ cname [$request srcId]] -anchor w
301 $path.cname configure -bg [[winfo parent $path.cname] cget -bg]
302 pack $path.cname -side left -anchor w -fill x -expand 1
303 #set comment [$request comment]
304 }
305
306
307 FCA_UI instproc build_floortype_label { path floorType } {
308 $self instvar floors_
309 label $path -image $floors_($floorType,icon) -padx 0 -pady 0 -bd 0 \
310 -highlightthickness 0 -relief flat
311 $path configure -bg [[winfo parent $path] cget -bg]
312 }
313
314
315 FCA_UI instproc build_request_menu { } {
316 $self instvar uiMgr_ listId_ request_menu_
317 set menu .request_menu_$self
318 menu $menu -tearoff 0
319 $menu add command -label "Grant floor" -command "$uiMgr_ grant_floor \
320 \[$self currentListElement\]"
321 $menu add command -label "Cancel request" -command "$uiMgr_ \
322 cancel_floor_request \[$self currentListElement\]"
323 set request_menu_ $menu
324 }
325
326
327 FCA_UI instproc build_srclist_menu { } {
328 $self instvar uiMgr_ listId_ srclist_menu_
329 set menu .srclist_menu_$self
330 menu $menu -tearoff 0
331 $menu add command -label "Grant floor" -command \
332 "$self grant_floor_to_participant \[$self currentListElement\]"
333 set srclist_menu_ $menu
334 }
335
336
337 FCA_UI instproc post_menu { menu enableMethod id x y } {
338 $self set currentListElement_ $id
339 $self $enableMethod $menu $id
340 tk_popup $menu $x $y
341 }
342
343
344 FCA_UI instproc currentListElement { } {
345 return [$self set currentListElement_]
346 }
347
348
349
350 FCA_UI instproc enable_admitted_menu { menu request } {
351 # 0 = grant floor
352 # 1 = cancel request
353 $self instvar appMgr_
354 $menu entryconfigure 0 -state disabled
355 if { [$request srcId]==[[$appMgr_ localRcvr] srcId] } {
356 $menu entryconfigure 1 -state normal
357 } else {
358 $menu entryconfigure 1 -state disabled
359 }
360 }
361
362
363 FCA_UI instproc enable_pending_menu { menu request } {
364 # 0 = grant floor
365 # 1 = cancel request
366 $menu entryconfigure 0 -state disabled
367 $menu entryconfigure 1 -state normal
368 # all pending requests are my own
369 }
370
371
372
373 FCA_UI instproc enable_srclist_menu { menu request } {
374 # 0 = grant floor
375 $menu entryconfigure 0 -state disabled
376 }
377
378
379
380 Class FCA_UI/Moderator -superclass FCA_UI
381
382
383 FCA_UI/Moderator instproc enable_admitted_menu { menu request } {
384 # 0 = grant floor
385 # 1 = cancel request
386
387 # moderator can do everything!
388 $menu entryconfigure 0 -state normal
389 $menu entryconfigure 1 -state normal
390 }
391
392
393 FCA_UI/Moderator instproc enable_pending_menu { menu request } {
394 # 0 = grant floor
395 # 1 = cancel request
396 $menu entryconfigure 0 -state disabled
397 $menu entryconfigure 1 -state normal
398 }
399
400
401 FCA_UI/Moderator instproc enable_srclist_menu { menu request } {
402 # 0 = grant floor
403 $menu entryconfigure 0 -state normal
404 }
405
406
407
408
409
410
411
412
413
414
415 FCA_UI instproc add_floor { floortype label icon } {
416 puts "adding floor for $floortype"
417 $self instvar selectfloors_path_ floors_
418 $self tkvar rbFloors_
419
420 # add this floor type to the selection panel
421 Within $selectfloors_path_ {
422 lappend floors_(all) $floortype
423 set floors_($floortype,label) $label
424 set floors_($floortype,icon) $icon
425 set floors_($floortype,var) floor_var_$floortype
426
427 $self tkvar $floors_($floortype,var)
428 set $floors_($floortype,var) 0
429 set floors_($floortype,button) [WithinPath floorbutton_$label]
430 CheckButton $floors_($floortype,button) -text $label -bd 1 -anchor w \
431 -highlightthickness 1 -variable [$self tkvarname \
432 $floors_($floortype,var)]
433 if { $rbFloors_!="Select" } {
434 $floors_($floortype,button) configure -state disabled
435 }
436
437 Pack $floors_($floortype,button) -pady 0 -fill x -anchor w
438 }
439
440 # add this floor type to the status panel
441 $self instvar statusFrame_
442 Within $statusFrame_ {
443 Frame floorstatus_$floortype -bd 0 -highlightthickness 0
444 Pack floorstatus_$floortype -padx 2 -pady 1 -fill x -expand 1
445 Within floorstatus_$floortype {
446 Label label -text $label -anchor w
447 set frame [Frame frame -bd 1 -relief sunken -bg White]
448 Pack label -side left
449 Pack frame -side left -expand 1 -fill x
450 Within frame {
451 if { $icon != {} } {
452 Label icon -image $icon -bg [$frame cget -bg]
453 set floors_($floortype,statusFrame) [Frame frame \
454 -bg [$frame cget -bg]]
455 Pack icon -side left
456 Pack frame -fill x -expand 1 -side left
457 }
458 }
459 }
460 }
461
462 }
463
464
465 FCA_UI instproc get_floor_label { floortype } {
466 $self instvar floors_
467 if { [info exists floors_($floortype,label)] } {
468 return $floors_($floortype,label)
469 }
470 return ""
471 }
472
473
474 FCA_UI instproc floortype_from_label { label } {
475 $self instvar floors_
476 foreach entry [array names floors_ "*,label"] {
477 if { $floors_($entry)==$label } {
478 set floorType ""
479 regexp "(.*),label" $entry dummy floorType
480 return $floorType
481 }
482 }
483 return ""
484 }
485
486
487 FCA_UI instproc admittedList { } {
488 return [$self set admittedList_]
489 }
490
491
492 FCA_UI instproc pendingList { } {
493 return [$self set pendingList_]
494 }
495
496
497 FCA_UI instproc srcList { } {
498 return [$self set srcList_]
499 }
500
501
502 FCA_UI instproc statusFrame { floorType } {
503 $self instvar floors_
504 return [$self set floors_($floorType,statusFrame)]
505 }
506
507
508
509 FCA_UI instproc make_floor_request { } {
510 $self tkvar rbFloors_
511 $self instvar floors_
512 switch $rbFloors_ {
513 Text-only {
514 set floorTypes {}
515 }
516 All {
517 set floorTypes $floors_(all)
518 }
519 Select {
520 set floorTypes {}
521 foreach type $floors_(all) {
522 $self tkvar $floors_($type,var)
523 if { [set $floors_($type,var)] } {
524 # this box has been checked
525 lappend floorTypes $type
526 }
527 }
528 }
529 }
530
531 $self instvar commentPath_ uiMgr_
532 $uiMgr_ make_floor_request $floorTypes [$commentPath_ get 1.0 end]
533 $commentPath_ delete 1.0 end
534 }
535
536
537 FCA_UI instproc grant_floor_to_participant { src } {
538 # src is the SRM_Source object!
539
540 $self instvar uiMgr_ floors_
541 $uiMgr_ grant_floor_to_participant $floors_(all) [$src srcid]
542 }
543
544
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.