Context Navigation

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

Last change on this file since 1970 was 1923, checked in by gah, 14 years ago

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

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

Download in other formats: