Context Navigation

source: branches/blt4/gui/scripts/sidebarframe.tcl @ 2316

Last change on this file since 2316 was 2316, checked in by gah, 13 years ago

File size: 17.7 KB

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

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

Download in other formats: