Context Navigation

source: trunk/gui/scripts/sidebarframe.tcl @ 3394

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

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

Download in other formats: