Context Navigation

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

Last change on this file since 5053 was 5053, checked in by dkearney, 10 years ago
Merge sync from trunk to uvv branch
File size: 20.7 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 $pos $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	if { ![info exists _panels(all)] \|\| $pos == "end" } {
267	lappend _panels(all) $pname
268	} else {
269	set _panels(all) [linsert $_panels(all) $pos $pname]
270	}
271	if {$_selected == ""} {
272	set _selected $pname
273	if {$_state == "open"} {
274	$itk_component(title) configure -text $panel(-title)
275	}
276	}
277
278	return $itk_component($pname)
279	}
280
281	# ----------------------------------------------------------------------
282	# USAGE: panel <which>
283	#
284	# Returns the frame representing the requested panel. The <which>
285	# argument can be a panel index, name, or title, or the keyword
286	# "current" for the selected panel.
287	# ----------------------------------------------------------------------
288	itcl::body Rappture::SidebarFrame::panel {which} {
289	switch -glob -- $which {
290	current {
291	return $itk_component($_selected)
292	}
293	[0-9]* {
294	set pname [lindex $_panels(all) $which]
295	return $itk_component($pname)
296	}
297	panel[0-9]* {
298	if {[info exists itk_component($which)]} {
299	return $itk_component($which)
300	}
301	error "bad panel name \"$which\""
302	}
303	default {
304	foreach pname $_panels(all) {
305	if {[string equal $_panels($pname-title) $which]} {
306	return $itk_component($pname)
307	}
308	}
309	error "bad panel title \"$which\""
310	}
311	}
312	}
313
314	# ----------------------------------------------------------------------
315	# USAGE: exists <which>
316	#
317	# Returns the frame representing the requested panel. The <which>
318	# argument can be a panel index, name, or title, or the keyword
319	# "current" for the selected panel.
320	# ----------------------------------------------------------------------
321	itcl::body Rappture::SidebarFrame::exists { title } {
322	if { [info exists _title2panel($title)] } {
323	return 1
324	}
325	return 0
326	}
327
328	# ----------------------------------------------------------------------
329	# USAGE: select <which>
330	#
331	# Pops open the sidebar and selects the specified panel. The <which>
332	# argument can be a panel index, name, or title.
333	# ----------------------------------------------------------------------
334	itcl::body Rappture::SidebarFrame::select {which} {
335	set pname ""
336	switch -glob -- $which {
337	[0-9]* {
338	set pname [lindex $_panels(all) $which]
339	}
340	panel[0-9]* {
341	if {[info exists itk_component($which)]} {
342	set pname $which
343	}
344	}
345	default {
346	foreach p $_panels(all) {
347	if {[string equal $_panels($p-title) $which]} {
348	set pname $p
349	break
350	}
351	}
352	}
353	}
354	if {$pname == ""} {
355	error "bad panel name \"$which\": should be panel id, title, or index"
356	}
357
358	if {$_state == "closed"} {
359	pop open
360	}
361
362	set minw [winfo reqwidth $itk_component(controlbar)]
363	if {$_width != "auto" && $_width < $minw+50} {
364	set _width [expr {$minw+50}]
365	$_dispatcher event -idle !layout
366	}
367	set n [$itk_component(tabs) index -name $pname]
368	$itk_component(tabs) select $n
369
370	$itk_component(title) configure -text $_panels($pname-title)
371
372	set f [$itk_component(area) contents]
373	foreach w [pack slaves $f] {
374	pack forget $w
375	}
376	pack $itk_component($pname) -expand yes -fill both
377
378	#
379	# HACK ALERT! Force the scroller to check the size of the
380	# panel that we just slid in under the covers. Make it
381	# think the panel and the scroller itself have changed size.
382	#
383	event generate [winfo parent $f] <Configure>
384	event generate $f <Configure>
385
386	set _selected $pname
387	return $pname
388	}
389
390	# ----------------------------------------------------------------------
391	# USAGE: pop open\|close\|toggle
392	#
393	# Used to open/close the sidebar area. When open, the selected panel
394	# appears and the titlebar shows its name.
395	# ----------------------------------------------------------------------
396	itcl::body Rappture::SidebarFrame::pop {how} {
397	if {$how == "toggle"} {
398	if {$_state == "closed"} {
399	set how "open"
400	} else {
401	set how "close"
402	}
403	}
404
405	switch -- $how {
406	open {
407	$itk_component(popbutton) configure \
408	-image [Rappture::icon sbar-closed]
409	pack $itk_component(area) -side right -expand yes -fill both
410
411	set _state "open"
412	select $_selected
413	$_dispatcher event -idle !layout
414	}
415	close {
416	$itk_component(popbutton) configure \
417	-image [Rappture::icon sbar-open]
418	$itk_component(title) configure -text ""
419	pack forget $itk_component(area)
420
421	set _state "closed"
422	$_dispatcher event -idle !layout
423	}
424	default {
425	error "bad option \"$how\": should be open, close, toggle"
426	}
427	}
428	}
429
430	# ----------------------------------------------------------------------
431	# USAGE: disable <which>
432	#
433	# Pops open the sidebar and selects the specified panel. The <which>
434	# argument can be a panel index, name, or title.
435	# ----------------------------------------------------------------------
436	itcl::body Rappture::SidebarFrame::disable {which} {
437	set index [TabIndex $which]
438	set tab [$itk_component(tabs) get $index]
439	$itk_component(tabs) tab configure $tab -state disabled
440	}
441
442
443	# ----------------------------------------------------------------------
444	# USAGE: enable <which>
445	#
446	# Pops open the sidebar and selects the specified panel. The <which>
447	# argument can be a panel index, name, or title.
448	# ----------------------------------------------------------------------
449	itcl::body Rappture::SidebarFrame::enable {which} {
450	set index [TabIndex $which]
451	set tab [$itk_component(tabs) get $index]
452	$itk_component(tabs) tab configure $tab -state normal
453	}
454
455	# ----------------------------------------------------------------------
456	# USAGE: TabIndex <which>
457	#
458	# Pops open the sidebar and selects the specified panel. The <which>
459	# argument can be a panel index, name, or title.
460	# ----------------------------------------------------------------------
461	itcl::body Rappture::SidebarFrame::TabIndex {which} {
462	set pname ""
463	switch -glob -- $which {
464	[0-9]* {
465	set pname [lindex $_panels(all) $which]
466	}
467	panel[0-9]* {
468	if {[info exists itk_component($which)]} {
469	set pname $which
470	}
471	}
472	default {
473	foreach p $_panels(all) {
474	if {[string equal $_panels($p-title) $which]} {
475	set pname $p
476	break
477	}
478	}
479	}
480	}
481	if {$pname == ""} {
482	error "bad panel name \"$which\": should be panel id, title, or index"
483	}
484	set n [$itk_component(tabs) index -name $pname]
485	return $n
486	}
487
488	# ----------------------------------------------------------------------
489	# USAGE: _toggleTab <which>
490	#
491	# Invoked automatically when the user clicks on a tab for the sidebar.
492	# If the sidebar is closed, it is automatically opened and the tab is
493	# selected. If the sidebar is opened, then it's closed.
494	# ----------------------------------------------------------------------
495	itcl::body Rappture::SidebarFrame::_toggleTab {which} {
496	if {$_state == "closed"} {
497	pop open
498	select $which
499	} elseif {[$itk_component(tabs) index -name $_selected]
500	== [$itk_component(tabs) index -name $which]} {
501	pop close
502	} else {
503	select $which
504	}
505	}
506
507	# ----------------------------------------------------------------------
508	# USAGE: _sash <op> <X>
509	#
510	# Invoked automatically when the user clicks/drags on a sash, to resize
511	# the sidebar.
512	# ----------------------------------------------------------------------
513	itcl::body Rappture::SidebarFrame::_sash {op X} {
514	switch -- $op {
515	enter {
516	# mouse over sash -- make it active
517	if {$itk_option(-sashactiverelief) != ""} {
518	$itk_component(sash) configure -relief $itk_option(-sashactiverelief)
519	}
520	}
521	leave {
522	# mouse left sash -- back to normal
523	$itk_component(sash) configure -relief $itk_option(-sashrelief)
524	}
525	grab {
526	if {$_state == "closed"} { pop open }
527	_sash drag $X
528	}
529	drag {
530	set w [winfo width $itk_component(hull)]
531	set minw [winfo reqwidth $itk_component(controlbar)]
532	set dx [expr {$X - [winfo rootx $itk_component(hull)]}]
533	set sashw [winfo reqwidth $itk_component(sashbg)]
534	set _width [expr {$w - $dx - $sashw/2}]
535
536	if {$_width < $minw} { set _width $minw }
537	if {$_width > $w-50} { set _width [expr {$w-50}] }
538	_fixLayout
539	}
540	release {
541	set minw [winfo reqwidth $itk_component(controlbar)]
542	if {$_width-$minw < 40} {
543	set _width "auto"
544	pop close
545	}
546	}
547	default {
548	error "bad option \"$op\": should be enter, leave, grab, drag, release"
549	}
550	}
551	}
552
553	# ----------------------------------------------------------------------
554	# USAGE: _fixLayout ?<eventArgs>...?
555	#
556	# Used internally to update the layout of panes whenever a new pane
557	# is added or a sash is moved.
558	# ----------------------------------------------------------------------
559	itcl::body Rappture::SidebarFrame::_fixLayout {args} {
560	set w [winfo width $itk_component(hull)]
561	set h [winfo height $itk_component(hull)]
562
563	set sashw [winfo reqwidth $itk_component(sashbg)]
564
565	set tabw [winfo reqwidth $itk_component(tabs)]
566	set btnw [winfo reqwidth $itk_component(controls)]
567	set ctrlw [expr {($tabw > $btnw) ? $tabw : $btnw}]
568
569	if {$_state == "closed"} {
570	set sbarw $ctrlw
571	} else {
572	if {$_width == "auto"} {
573	# pop open to the size of the widest pane
574	set sbarw 0
575	foreach pname $_panels(all) {
576	set pw [winfo reqwidth $itk_component($pname)]
577	if {$pw > $sbarw} {
578	set sbarw $pw
579	}
580	}
581	set sbarw [expr {$sbarw + $ctrlw + $sashw}]
582	} else {
583	set sbarw $_width
584	}
585	}
586
587	# don't let the sidebar take up too much of the window area
588	if {$sbarw > 0.75*$w} {
589	set sbarw [expr {int(0.75*$w)}]
590	}
591
592	set x1 [expr {$w - $sbarw - $sashw}]
593	set x2 [expr {$w - $sbarw}]
594	if { $resizeframe } {
595	set framew $x1
596	} else {
597	set framew [expr $w - $ctrlw - $sashw]
598	}
599	place $itk_component(frame) -x 0 -y 0 -anchor nw -width $framew -height $h
600	place $itk_component(sashbg) -x $x1 -y 0 -anchor nw -width $sashw -height $h
601	place $itk_component(sidebar) -x $x2 -y 0 -anchor nw \
602	-width $sbarw -height $h
603	}
604
605	# ----------------------------------------------------------------------
606	# CONFIGURATION OPTION: -sashpadding
607	# ----------------------------------------------------------------------
608	itcl::configbody Rappture::SidebarFrame::sashpadding {
609	pack $itk_component(sash) -padx $itk_option(-sashpadding)
610	}
611
612	# ----------------------------------------------------------------------
613	# CONFIGURATION OPTION: -sashcolor
614	# ----------------------------------------------------------------------
615	itcl::configbody Rappture::SidebarFrame::sashcolor {
616	if {$itk_option(-sashcolor) != ""} {
617	$itk_component(sash) configure -background $itk_option(-sashcolor)
618	} else {
619	$itk_component(sash) configure -background $itk_option(-background)
620	}
621	}
622

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

Download in other formats: