Context Navigation

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

Last change on this file since 1695 was 1661, checked in by gah, 15 years ago

File size: 17.8 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	itcl::class Rappture::SidebarFrame {
31	inherit itk::Widget
32
33	itk_option define -sashrelief sashRelief Relief ""
34	itk_option define -sashactiverelief sashActiveRelief SashActiveRelief ""
35	itk_option define -sashcolor sashColor SashColor ""
36	itk_option define -sashwidth sashWidth SashWidth 0
37	itk_option define -sashpadding sashPadding SashPadding 0
38	itk_option define -sashcursor sashCursor Cursor ""
39
40	constructor {args} { # defined below }
41
42	public method insert {pos args}
43	public method panel {which}
44	public method select {which}
45	public method pop {what}
46
47	protected method _toggleTab { which }
48	protected method _sash {op x}
49	protected method _fixLayout {args}
50
51	private variable _dispatcher "" ;# dispatcher for !events
52	private variable _state "closed" ;# sidebar open/closed
53	private variable _panels ;# maps panel => title, etc.
54	private variable _selected "" ;# selected panel
55	private variable _width "auto" ;# width adjusted by sash or "auto"
56	private variable _counter 0 ;# counter for auto-generated names
57	}
58
59	itk::usual SidebarFrame {
60	keep -background -cursor
61	keep -titlebarbackground -titlebarforeground
62	}
63
64	# ----------------------------------------------------------------------
65	# CONSTRUCTOR
66	# ----------------------------------------------------------------------
67	itcl::body Rappture::SidebarFrame::constructor {args} {
68	itk_option add hull.width hull.height
69
70	# create a dispatcher for events
71	Rappture::dispatcher _dispatcher
72	$_dispatcher register !layout
73	$_dispatcher dispatch $this !layout [itcl::code $this _fixLayout]
74
75	# fix the layout whenever the window size changes
76	bind SidebarFrame <Configure> [itcl::code %W _fixLayout]
77
78	#
79	# Empty frame for main widget
80	#
81	itk_component add frame {
82	frame $itk_interior.f
83	}
84
85	#
86	# Sash along the left side of sidebar
87	#
88	itk_component add sashbg {
89	frame $itk_interior.sashbg
90	} {
91	usual
92	rename -cursor -sashcursor sashCursor Cursor
93	}
94
95	itk_component add sash {
96	frame $itk_component(sashbg).sash -borderwidth 1
97	} {
98	usual
99	ignore -background -borderwidth
100	rename -relief -sashrelief sashRelief Relief
101	rename -width -sashwidth sashWidth SashWidth
102	rename -cursor -sashcursor sashCursor Cursor
103	}
104	pack $itk_component(sash) -side left -fill y
105
106	foreach c {sash sashbg} {
107	bind $itk_component($c) <Enter> \
108	[itcl::code $this _sash enter %X]
109	bind $itk_component($c) <Leave> \
110	[itcl::code $this _sash leave %X]
111	bind $itk_component($c) <ButtonPress-1> \
112	[itcl::code $this _sash grab %X]
113	bind $itk_component($c) <B1-Motion> \
114	[itcl::code $this _sash drag %X]
115	bind $itk_component($c) <ButtonRelease-1> \
116	[itcl::code $this _sash release %X]
117	}
118
119	itk_component add sidebar {
120	frame $itk_interior.sbar
121	}
122
123	#
124	# Title bar along top of sidebar
125	#
126	itk_component add titlebar {
127	frame $itk_component(sidebar).tbar -highlightthickness 0
128	} {
129	usual
130	ignore -highlightthickness
131	rename -background -titlebarbackground titlebarBackground Background
132	}
133	pack $itk_component(titlebar) -side top -fill x
134
135	itk_component add popbutton {
136	button $itk_component(titlebar).popb \
137	-borderwidth 1 -relief flat -overrelief raised \
138	-highlightthickness 0 \
139	-image [Rappture::icon sbar-open] \
140	-command [itcl::code $this pop toggle]
141	} {
142	usual
143	ignore -borderwidth -relief -overrelief -highlightthickness
144	rename -background -titlebarbackground titlebarBackground Background
145	rename -activebackground -titlebarbackground titlebarBackground Background
146	}
147	pack $itk_component(popbutton) -side left -padx 6 -pady 2
148	Rappture::Tooltip::for $itk_component(popbutton) \
149	"Open/close the sidebar"
150
151	itk_component add title {
152	label $itk_component(titlebar).title -anchor w -font "Arial 10"
153	} {
154	usual
155	ignore -font
156	rename -foreground -titlebarforeground titlebarForeground Foreground
157	rename -background -titlebarbackground titlebarBackground Background
158	}
159	pack $itk_component(title) -side left -expand yes -fill both -padx 1 -pady 1
160
161	#
162	# Area for active panel
163	#
164	itk_component add area {
165	blt::scrollset $itk_component(sidebar).area \
166	-xscrollbar $itk_component(sidebar).area.xs \
167	-yscrollbar $itk_component(sidebar).area.ys \
168	-window $itk_component(sidebar).area.frame
169	}
170	frame $itk_component(area).frame
171	blt::tk::scrollbar $itk_component(sidebar).area.xs
172	blt::tk::scrollbar $itk_component(sidebar).area.ys
173	itk_component add controlbar {
174	frame $itk_component(sidebar).cbar
175	} {
176	usual
177	rename -background -controlbackground controlBackground Background
178	}
179	pack $itk_component(controlbar) -side left -fill y
180
181	#
182	# Control area above the tabs
183	#
184	itk_component add controls {
185	frame $itk_component(controlbar).cntls -height 20
186	} {
187	usual
188	rename -background -controlbackground controlBackground Background
189	}
190	pack $itk_component(controls) -side top -pady {8 20}
191
192	#
193	# Tabs used to select sidebar panels.
194	#
195	# Note: Bugs in BLT 2.4 tabset/VNC server crashes the server
196	# when -outerpad is set to 0.
197	#
198	itk_component add tabs {
199	blt::tabset $itk_component(controlbar).tabs \
200	-highlightthickness 0 -tearoff 0 -side left \
201	-bd 1 -gap 1 -outerborderwidth 0 \
202	-outerpad 0 -justify center
203	} {
204	keep -background -cursor
205	ignore -highlightthickness -borderwidth
206	rename -highlightbackground -controlbackground controlBackground \
207	Background
208	rename -troughcolor -controlbackground controlBackground \
209	Background
210	}
211	pack $itk_component(tabs) -side top -expand yes -anchor e -padx {4 0} -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).frame
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).frame
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: