Context Navigation

source: branches/uiuc_vtk_viewers/gui/scripts/sidebarframe.tcl @ 5033

Last change on this file since 5033 was 3782, checked in by gah, 11 years ago
fix multiple barchart results, fix PDB reader, dynamically create tabs for vtkviewer
File size: 20.6 KB

Line
1	# -- mode: tcl; indent-tabs-mode: nil --
2	# ----------------------------------------------------------------------
3	# COMPONENT: SidebarFrame - pop-out controls for visualization widgets
4	#
5	# The sidebar provides a way to put a thin strip of controls along the
6	# side of a visualization widget, with tabs that cause control panels
7	# to pop out. The SidebarFrame has an empty frame (component "frame")
8	# on the left and a sidebar that pops out on the right.
9	# ======================================================================
10	# AUTHOR: George Howlett, Michael McLennan, Purdue University
11	# Copyright (c) 2004-2012 HUBzero Foundation, LLC
12	#
13	# See the file "license.terms" for information on usage and
14	# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15	# ======================================================================
16	package require Itk
17
18	option add *SidebarFrame.width 3i widgetDefault
19	option add *SidebarFrame.height 3i widgetDefault
20	option add *SidebarFrame.titlebarBackground #6666cc widgetDefault
21	option add *SidebarFrame.titlebarForeground white widgetDefault
22	option add *SidebarFrame.controlBackground gray widgetDefault
23	option add SidebarFramecntls*highlightBackground gray widgetDefault
24	option add *SidebarFrame.sashRelief flat widgetDefault
25	option add *SidebarFrame.sashActiveRelief solid widgetDefault
26	option add *SidebarFrame.sashColor gray widgetDefault
27	option add *SidebarFrame.sashWidth 2 widgetDefault
28	option add *SidebarFrame.sashPadding 2 widgetDefault
29	option add *SidebarFrame.sashCursor sb_h_double_arrow
30
31	itcl::class Rappture::SidebarFrame {
32	inherit itk::Widget
33
34	itk_option define -sashrelief sashRelief Relief ""
35	itk_option define -sashactiverelief sashActiveRelief SashActiveRelief ""
36	itk_option define -sashcolor sashColor SashColor ""
37	itk_option define -sashwidth sashWidth SashWidth 0
38	itk_option define -sashpadding sashPadding SashPadding 0
39	itk_option define -sashcursor sashCursor Cursor ""
40
41	public variable resizeframe 1
42	constructor {args} { # defined below }
43
44	public method insert {pos args}
45	public method exists {which}
46	public method panel {which}
47	public method select {which}
48	public method pop {what}
49	public method width { size } {
50	set _width $size
51	}
52	public method enable { which }
53	public method disable { which }
54
55	protected method _toggleTab {which}
56	protected method _sash {op x}
57	protected method _fixLayout {args}
58	protected method TabIndex { which }
59
60	private variable _dispatcher "" ;# dispatcher for !events
61	private variable _state "closed" ;# sidebar open/closed
62	private variable _panels ;# maps panel => title, etc.
63	private variable _selected "" ;# selected panel
64	private variable _width "auto" ;# width adjusted by sash or "auto"
65	private variable _counter 0 ;# counter for auto-generated names
66	private variable _title2panel
67	}
68
69	itk::usual SidebarFrame {
70	keep -background -cursor
71	keep -titlebarbackground -titlebarforeground
72	}
73
74	# ----------------------------------------------------------------------
75	# CONSTRUCTOR
76	# ----------------------------------------------------------------------
77	itcl::body Rappture::SidebarFrame::constructor {args} {
78	itk_option add hull.width hull.height
79
80	# create a dispatcher for events
81	Rappture::dispatcher _dispatcher
82	$_dispatcher register !layout
83	$_dispatcher dispatch $this !layout [itcl::code $this _fixLayout]
84
85	# fix the layout whenever the window size changes
86	bind SidebarFrame <Configure> [itcl::code %W _fixLayout]
87
88	#
89	# Empty frame for main widget
90	#
91	itk_component add frame {
92	frame $itk_interior.f
93	}
94
95	#
96	# Sash along the left side of sidebar
97	#
98	itk_component add sashbg {
99	frame $itk_interior.sashbg
100	} {
101	usual
102	rename -cursor -sashcursor sashCursor Cursor
103	}
104
105	itk_component add sash {
106	frame $itk_component(sashbg).sash -borderwidth 1
107	} {
108	usual
109	ignore -background -borderwidth
110	rename -relief -sashrelief sashRelief Relief
111	rename -width -sashwidth sashWidth SashWidth
112	rename -cursor -sashcursor sashCursor Cursor
113	}
114	pack $itk_component(sash) -side left -fill y
115
116	foreach c {sash sashbg} {
117	bind $itk_component($c) <Enter> \
118	[itcl::code $this _sash enter %X]
119	bind $itk_component($c) <Leave> \
120	[itcl::code $this _sash leave %X]
121	bind $itk_component($c) <ButtonPress-1> \
122	[itcl::code $this _sash grab %X]
123	bind $itk_component($c) <B1-Motion> \
124	[itcl::code $this _sash drag %X]
125	bind $itk_component($c) <ButtonRelease-1> \
126	[itcl::code $this _sash release %X]
127	}
128
129	itk_component add sidebar {
130	frame $itk_interior.sbar
131	}
132
133	#
134	# Title bar along top of sidebar
135	#
136	itk_component add titlebar {
137	frame $itk_component(sidebar).tbar -highlightthickness 0
138	} {
139	usual
140	ignore -highlightthickness
141	rename -background -titlebarbackground titlebarBackground Background
142	}
143	pack $itk_component(titlebar) -side top -fill x
144
145	itk_component add popbutton {
146	button $itk_component(titlebar).popb \
147	-borderwidth 1 -relief flat -overrelief raised \
148	-highlightthickness 0 \
149	-image [Rappture::icon sbar-open] \
150	-command [itcl::code $this pop toggle]
151	} {
152	usual
153	ignore -borderwidth -relief -overrelief -highlightthickness
154	rename -background -titlebarbackground titlebarBackground Background
155	rename -activebackground -titlebarbackground titlebarBackground Background
156	}
157	pack $itk_component(popbutton) -side left -padx 6 -pady 2
158	Rappture::Tooltip::for $itk_component(popbutton) \
159	"Open/close the sidebar"
160
161	itk_component add title {
162	label $itk_component(titlebar).title -anchor w -font "Arial 10"
163	} {
164	usual
165	ignore -font
166	rename -foreground -titlebarforeground titlebarForeground Foreground
167	rename -background -titlebarbackground titlebarBackground Background
168	}
169	pack $itk_component(title) -side left -expand yes -fill both -padx 1 -pady 1
170
171	#
172	# Area for active panel
173	#
174	itk_component add area {
175	Rappture::Scroller $itk_component(sidebar).area \
176	-xscrollmode auto -yscrollmode auto \
177	-highlightthickness 0
178	}
179	$itk_component(area) contents frame
180
181	itk_component add controlbar {
182	frame $itk_component(sidebar).cbar
183	} {
184	usual
185	rename -background -controlbackground controlBackground Background
186	}
187	pack $itk_component(controlbar) -side left -fill y
188
189	#
190	# Control area above the tabs
191	#
192	itk_component add controls {
193	frame $itk_component(controlbar).cntls -height 20
194	} {
195	usual
196	rename -background -controlbackground controlBackground Background
197	}
198	pack $itk_component(controls) -side top -pady {8 20}
199
200	#
201	# Tabs used to select sidebar panels.
202	#
203	# Note: Bugs in BLT 2.4 tabset/VNC server crashes the server
204	# when -outerpad is set to 0.
205	#
206	itk_component add tabs {
207	blt::tabset $itk_component(controlbar).tabs \
208	-highlightthickness 0 -tearoff 0 -side left \
209	-bd 0 -gap 0 -tabborderwidth 1 \
210	-outerpad 1
211	} {
212	keep -background -cursor
213	ignore -highlightthickness -borderwidth
214	rename -highlightbackground -controlbackground controlBackground \
215	Background
216	rename -background -controlbackground controlBackground \
217	Background
218	}
219	pack $itk_component(tabs) -side top -expand yes -anchor e -padx {4 0} -fill y
220
221	eval itk_initialize $args
222
223	# make sure we fix up the layout at some point
224	$_dispatcher event -idle !layout
225	}
226
227	# ----------------------------------------------------------------------
228	# USAGE: insert <pos> ?-title t? ?-icon i?
229	#
230	# Adds a new panel into this widget at the given position <pos>. The
231	# panel has a tab with the specified -icon, and is labeled by the
232	# -title string in the titlebar area when it is selected.
233	# ----------------------------------------------------------------------
234	itcl::body Rappture::SidebarFrame::insert {pos args} {
235	Rappture::getopts args panel "
236	value -title Options
237	value -icon [Rappture::icon cboff]
238	"
239	if {[llength $args] > 0} {
240	error "wrong # args: should be \"insert pos ?-title t? ?-icon i?\""
241	}
242
243	set f [$itk_component(area) contents]
244	set pname "panel[incr _counter]"
245	itk_component add $pname {
246	frame $f.$pname
247	}
248
249	$itk_component(tabs) insert end $pname \
250	-image $panel(-icon) -text "" -padx 0 -pady 0 \
251	-command [itcl::code $this _toggleTab $pname]
252
253	set _title2panel($panel(-title)) $pname
254	Rappture::Tooltip::text $itk_component(tabs)-$pname \
255	"Open/close sidebar for $panel(-title)"
256	$itk_component(tabs) bind $pname <Enter> \
257	[list ::Rappture::Tooltip::tooltip pending %W-$pname @%X,%Y]
258	$itk_component(tabs) bind $pname <Leave> \
259	[list ::Rappture::Tooltip::tooltip cancel]
260	$itk_component(tabs) bind $pname <ButtonPress> \
261	[list ::Rappture::Tooltip::tooltip cancel]
262	$itk_component(tabs) bind $pname <KeyPress> \
263	[list ::Rappture::Tooltip::tooltip cancel]
264
265	set _panels($pname-title) $panel(-title)
266	lappend _panels(all) $pname
267	if {$_selected == ""} {
268	set _selected $pname
269	if {$_state == "open"} {
270	$itk_component(title) configure -text $panel(-title)
271	}
272	}
273
274	return $itk_component($pname)
275	}
276
277	# ----------------------------------------------------------------------
278	# USAGE: panel <which>
279	#
280	# Returns the frame representing the requested panel. The <which>
281	# argument can be a panel index, name, or title, or the keyword
282	# "current" for the selected panel.
283	# ----------------------------------------------------------------------
284	itcl::body Rappture::SidebarFrame::panel {which} {
285	switch -glob -- $which {
286	current {
287	return $itk_component($_selected)
288	}
289	[0-9]* {
290	set pname [lindex $_panels(all) $which]
291	return $itk_component($pname)
292	}
293	panel[0-9]* {
294	if {[info exists itk_component($which)]} {
295	return $itk_component($which)
296	}
297	error "bad panel name \"$which\""
298	}
299	default {
300	foreach pname $_panels(all) {
301	if {[string equal $_panels($pname-title) $which]} {
302	return $itk_component($pname)
303	}
304	}
305	error "bad panel title \"$which\""
306	}
307	}
308	}
309
310	# ----------------------------------------------------------------------
311	# USAGE: exists <which>
312	#
313	# Returns the frame representing the requested panel. The <which>
314	# argument can be a panel index, name, or title, or the keyword
315	# "current" for the selected panel.
316	# ----------------------------------------------------------------------
317	itcl::body Rappture::SidebarFrame::exists { title } {
318	if { [info exists _title2panel($title)] } {
319	return 1
320	}
321	return 0
322	}
323
324	# ----------------------------------------------------------------------
325	# USAGE: select <which>
326	#
327	# Pops open the sidebar and selects the specified panel. The <which>
328	# argument can be a panel index, name, or title.
329	# ----------------------------------------------------------------------
330	itcl::body Rappture::SidebarFrame::select {which} {
331	set pname ""
332	switch -glob -- $which {
333	[0-9]* {
334	set pname [lindex $_panels(all) $which]
335	}
336	panel[0-9]* {
337	if {[info exists itk_component($which)]} {
338	set pname $which
339	}
340	}
341	default {
342	foreach p $_panels(all) {
343	if {[string equal $_panels($p-title) $which]} {
344	set pname $p
345	break
346	}
347	}
348	}
349	}
350	if {$pname == ""} {
351	error "bad panel name \"$which\": should be panel id, title, or index"
352	}
353
354	if {$_state == "closed"} {
355	pop open
356	}
357
358	set minw [winfo reqwidth $itk_component(controlbar)]
359	if {$_width != "auto" && $_width < $minw+50} {
360	set _width [expr {$minw+50}]
361	$_dispatcher event -idle !layout
362	}
363	set n [$itk_component(tabs) index -name $pname]
364	$itk_component(tabs) select $n
365
366	$itk_component(title) configure -text $_panels($pname-title)
367
368	set f [$itk_component(area) contents]
369	foreach w [pack slaves $f] {
370	pack forget $w
371	}
372	pack $itk_component($pname) -expand yes -fill both
373
374	#
375	# HACK ALERT! Force the scroller to check the size of the
376	# panel that we just slid in under the covers. Make it
377	# think the panel and the scroller itself have changed size.
378	#
379	event generate [winfo parent $f] <Configure>
380	event generate $f <Configure>
381
382	set _selected $pname
383	return $pname
384	}
385
386	# ----------------------------------------------------------------------
387	# USAGE: pop open\|close\|toggle
388	#
389	# Used to open/close the sidebar area. When open, the selected panel
390	# appears and the titlebar shows its name.
391	# ----------------------------------------------------------------------
392	itcl::body Rappture::SidebarFrame::pop {how} {
393	if {$how == "toggle"} {
394	if {$_state == "closed"} {
395	set how "open"
396	} else {
397	set how "close"
398	}
399	}
400
401	switch -- $how {
402	open {
403	$itk_component(popbutton) configure \
404	-image [Rappture::icon sbar-closed]
405	pack $itk_component(area) -side right -expand yes -fill both
406
407	set _state "open"
408	select $_selected
409	$_dispatcher event -idle !layout
410	}
411	close {
412	$itk_component(popbutton) configure \
413	-image [Rappture::icon sbar-open]
414	$itk_component(title) configure -text ""
415	pack forget $itk_component(area)
416
417	set _state "closed"
418	$_dispatcher event -idle !layout
419	}
420	default {
421	error "bad option \"$how\": should be open, close, toggle"
422	}
423	}
424	}
425
426	# ----------------------------------------------------------------------
427	# USAGE: disable <which>
428	#
429	# Pops open the sidebar and selects the specified panel. The <which>
430	# argument can be a panel index, name, or title.
431	# ----------------------------------------------------------------------
432	itcl::body Rappture::SidebarFrame::disable {which} {
433	set index [TabIndex $which]
434	set tab [$itk_component(tabs) get $index]
435	$itk_component(tabs) tab configure $tab -state disabled
436	}
437
438
439	# ----------------------------------------------------------------------
440	# USAGE: enable <which>
441	#
442	# Pops open the sidebar and selects the specified panel. The <which>
443	# argument can be a panel index, name, or title.
444	# ----------------------------------------------------------------------
445	itcl::body Rappture::SidebarFrame::enable {which} {
446	set index [TabIndex $which]
447	set tab [$itk_component(tabs) get $index]
448	$itk_component(tabs) tab configure $tab -state normal
449	}
450
451	# ----------------------------------------------------------------------
452	# USAGE: TabIndex <which>
453	#
454	# Pops open the sidebar and selects the specified panel. The <which>
455	# argument can be a panel index, name, or title.
456	# ----------------------------------------------------------------------
457	itcl::body Rappture::SidebarFrame::TabIndex {which} {
458	set pname ""
459	switch -glob -- $which {
460	[0-9]* {
461	set pname [lindex $_panels(all) $which]
462	}
463	panel[0-9]* {
464	if {[info exists itk_component($which)]} {
465	set pname $which
466	}
467	}
468	default {
469	foreach p $_panels(all) {
470	if {[string equal $_panels($p-title) $which]} {
471	set pname $p
472	break
473	}
474	}
475	}
476	}
477	if {$pname == ""} {
478	error "bad panel name \"$which\": should be panel id, title, or index"
479	}
480	set n [$itk_component(tabs) index -name $pname]
481	return $n
482	}
483
484	# ----------------------------------------------------------------------
485	# USAGE: _toggleTab <which>
486	#
487	# Invoked automatically when the user clicks on a tab for the sidebar.
488	# If the sidebar is closed, it is automatically opened and the tab is
489	# selected. If the sidebar is opened, then it's closed.
490	# ----------------------------------------------------------------------
491	itcl::body Rappture::SidebarFrame::_toggleTab {which} {
492	if {$_state == "closed"} {
493	pop open
494	select $which
495	} elseif {[$itk_component(tabs) index -name $_selected]
496	== [$itk_component(tabs) index -name $which]} {
497	pop close
498	} else {
499	select $which
500	}
501	}
502
503	# ----------------------------------------------------------------------
504	# USAGE: _sash <op> <X>
505	#
506	# Invoked automatically when the user clicks/drags on a sash, to resize
507	# the sidebar.
508	# ----------------------------------------------------------------------
509	itcl::body Rappture::SidebarFrame::_sash {op X} {
510	switch -- $op {
511	enter {
512	# mouse over sash -- make it active
513	if {$itk_option(-sashactiverelief) != ""} {
514	$itk_component(sash) configure -relief $itk_option(-sashactiverelief)
515	}
516	}
517	leave {
518	# mouse left sash -- back to normal
519	$itk_component(sash) configure -relief $itk_option(-sashrelief)
520	}
521	grab {
522	if {$_state == "closed"} { pop open }
523	_sash drag $X
524	}
525	drag {
526	set w [winfo width $itk_component(hull)]
527	set minw [winfo reqwidth $itk_component(controlbar)]
528	set dx [expr {$X - [winfo rootx $itk_component(hull)]}]
529	set sashw [winfo reqwidth $itk_component(sashbg)]
530	set _width [expr {$w - $dx - $sashw/2}]
531
532	if {$_width < $minw} { set _width $minw }
533	if {$_width > $w-50} { set _width [expr {$w-50}] }
534	_fixLayout
535	}
536	release {
537	set minw [winfo reqwidth $itk_component(controlbar)]
538	if {$_width-$minw < 40} {
539	set _width "auto"
540	pop close
541	}
542	}
543	default {
544	error "bad option \"$op\": should be enter, leave, grab, drag, release"
545	}
546	}
547	}
548
549	# ----------------------------------------------------------------------
550	# USAGE: _fixLayout ?<eventArgs>...?
551	#
552	# Used internally to update the layout of panes whenever a new pane
553	# is added or a sash is moved.
554	# ----------------------------------------------------------------------
555	itcl::body Rappture::SidebarFrame::_fixLayout {args} {
556	set w [winfo width $itk_component(hull)]
557	set h [winfo height $itk_component(hull)]
558
559	set sashw [winfo reqwidth $itk_component(sashbg)]
560
561	set tabw [winfo reqwidth $itk_component(tabs)]
562	set btnw [winfo reqwidth $itk_component(controls)]
563	set ctrlw [expr {($tabw > $btnw) ? $tabw : $btnw}]
564
565	if {$_state == "closed"} {
566	set sbarw $ctrlw
567	} else {
568	if {$_width == "auto"} {
569	# pop open to the size of the widest pane
570	set sbarw 0
571	foreach pname $_panels(all) {
572	set pw [winfo reqwidth $itk_component($pname)]
573	if {$pw > $sbarw} {
574	set sbarw $pw
575	}
576	}
577	set sbarw [expr {$sbarw + $ctrlw + $sashw}]
578	} else {
579	set sbarw $_width
580	}
581	}
582
583	# don't let the sidebar take up too much of the window area
584	if {$sbarw > 0.75*$w} {
585	set sbarw [expr {int(0.75*$w)}]
586	}
587
588	set x1 [expr {$w - $sbarw - $sashw}]
589	set x2 [expr {$w - $sbarw}]
590	if { $resizeframe } {
591	set framew $x1
592	} else {
593	set framew [expr $w - $ctrlw - $sashw]
594	}
595	place $itk_component(frame) -x 0 -y 0 -anchor nw -width $framew -height $h
596	place $itk_component(sashbg) -x $x1 -y 0 -anchor nw -width $sashw -height $h
597	place $itk_component(sidebar) -x $x2 -y 0 -anchor nw \
598	-width $sbarw -height $h
599	}
600
601	# ----------------------------------------------------------------------
602	# CONFIGURATION OPTION: -sashpadding
603	# ----------------------------------------------------------------------
604	itcl::configbody Rappture::SidebarFrame::sashpadding {
605	pack $itk_component(sash) -padx $itk_option(-sashpadding)
606	}
607
608	# ----------------------------------------------------------------------
609	# CONFIGURATION OPTION: -sashcolor
610	# ----------------------------------------------------------------------
611	itcl::configbody Rappture::SidebarFrame::sashcolor {
612	if {$itk_option(-sashcolor) != ""} {
613	$itk_component(sash) configure -background $itk_option(-sashcolor)
614	} else {
615	$itk_component(sash) configure -background $itk_option(-background)
616	}
617	}
618

Note: See TracBrowser for help on using the repository browser.

Download in other formats: