Context Navigation

source: trunk/gui/scripts/controls.tcl @ 120

Last change on this file since 120 was 120, checked in by mmc, 19 years ago

Fixed the Controls widget to resize itself properly the controls within it change size. This allows you to put a <structure> in a <group> and have it resize properly as new structures are loaded.

Fixed the loader to label unnamed files properly as "Example #1", "Example #2", etc.

File size: 17.4 KB

Rev	Line
[11]	1	# ----------------------------------------------------------------------
	2	# COMPONENT: controls - a container for various Rappture controls
	3	#
	4	# This widget is a smart frame acting as a container for controls.
	5	# Controls are added to this panel, and the panel itself decides
	6	# how to arrange them given available space.
	7	# ======================================================================
	8	# AUTHOR: Michael McLennan, Purdue University
[115]	9	# Copyright (c) 2004-2005 Purdue Research Foundation
	10	#
	11	# See the file "license.terms" for information on usage and
	12	# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
[11]	13	# ======================================================================
	14	package require Itk
[26]	15	package require BLT
[11]	16
	17	option add *Controls.padding 4 widgetDefault
	18	option add *Controls.labelFont \
	19	--helvetica-medium-r-normal---120- widgetDefault
	20
	21	itcl::class Rappture::Controls {
	22	inherit itk::Widget
	23
	24	itk_option define -padding padding Padding 0
	25
[13]	26	constructor {owner args} { # defined below }
[11]	27
[22]	28	public method insert {pos path}
[11]	29	public method delete {first {last ""}}
	30	public method index {name}
	31	public method control {args}
	32
	33	protected method _layout {}
[120]	34	protected method _monitor {name state}
[11]	35	protected method _controlChanged {path}
	36	protected method _formatLabel {str}
[26]	37	protected method _changeTabs {}
[120]	38	protected method _resize {}
[11]	39
[13]	40	private variable _owner "" ;# controls belong to this owner
[26]	41	private variable _tabs "" ;# optional tabset for groups
	42	private variable _frame "" ;# pack controls into this frame
[11]	43	private variable _counter 0 ;# counter for control names
	44	private variable _dispatcher "" ;# dispatcher for !events
	45	private variable _controls "" ;# list of known controls
	46	private variable _name2info ;# maps control name => info
[120]	47	private variable _scheme "" ;# layout scheme (tabs/hlabels)
[11]	48	}
	49
	50	itk::usual Controls {
	51	}
	52
	53	# ----------------------------------------------------------------------
	54	# CONSTRUCTOR
	55	# ----------------------------------------------------------------------
[13]	56	itcl::body Rappture::Controls::constructor {owner args} {
[11]	57	Rappture::dispatcher _dispatcher
	58	$_dispatcher register !layout
	59	$_dispatcher dispatch $this !layout "[itcl::code $this _layout]; list"
[120]	60	$_dispatcher register !resize
	61	$_dispatcher dispatch $this !resize "[itcl::code $this _resize]; list"
[11]	62
[13]	63	set _owner $owner
[11]	64
[26]	65	Rappture::Scroller $itk_interior.sc -xscrollmode none -yscrollmode auto
	66	pack $itk_interior.sc -expand yes -fill both
	67	set f [$itk_interior.sc contents frame]
	68
	69	set _tabs [blt::tabset $f.tabs -borderwidth 0 -relief flat \
	70	-side top -tearoff 0 -highlightthickness 0 \
	71	-selectbackground $itk_option(-background) \
	72	-selectcommand [itcl::code $this _changeTabs]]
	73
	74	set _frame [frame $f.inner]
	75	pack $_frame -expand yes -fill both
	76
[74]	77	#
	78	# Put this frame in whenever the control frame is empty.
	79	# It forces the size to contract back now when controls are deleted.
	80	#
	81	frame $_frame.empty -width 1 -height 1
	82
[120]	83	#
	84	# Set up a binding that all inserted widgets will use so that
	85	# we can monitor their size changes.
	86	#
	87	bind Controls-$this <Configure> \
	88	[list $_dispatcher event -idle !resize]
	89
[11]	90	eval itk_initialize $args
	91	}
	92
	93	# ----------------------------------------------------------------------
[22]	94	# USAGE: insert <pos> <path>
[11]	95	#
	96	# Clients use this to insert a control into this panel. The control
	97	# is inserted into the list at position <pos>, which can be an integer
	98	# starting from 0 or the keyword "end". Information about the control
[22]	99	# is taken from the specified <path>.
[11]	100	#
	101	# Returns a name that can be used to identify the control in other
	102	# methods.
	103	# ----------------------------------------------------------------------
[22]	104	itcl::body Rappture::Controls::insert {pos path} {
[11]	105	if {"end" == $pos} {
	106	set pos [llength $_controls]
	107	} elseif {![string is integer $pos]} {
	108	error "bad index \"$pos\": should be integer or \"end\""
	109	}
	110
	111	incr _counter
	112	set name "control$_counter"
	113
	114	set _name2info($name-path) $path
	115	set _name2info($name-label) ""
[26]	116	set _name2info($name-value) [set w $_frame.v$name]
[11]	117
[22]	118	set type [$_owner xml element -as type $path]
[11]	119	switch -- $type {
	120	choice {
[22]	121	Rappture::ChoiceEntry $w $_owner $path
[11]	122	bind $w <<Value>> [itcl::code $this _controlChanged $path]
	123	}
	124	group {
[22]	125	Rappture::GroupEntry $w $_owner $path
[11]	126	}
	127	loader {
[22]	128	Rappture::Loader $w $_owner $path -tool [$_owner tool]
[11]	129	bind $w <<Value>> [itcl::code $this _controlChanged $path]
	130	}
	131	number {
[22]	132	Rappture::NumberEntry $w $_owner $path
[11]	133	bind $w <<Value>> [itcl::code $this _controlChanged $path]
	134	}
[22]	135	integer {
	136	Rappture::IntegerEntry $w $_owner $path
	137	bind $w <<Value>> [itcl::code $this _controlChanged $path]
	138	}
[13]	139	boolean {
[22]	140	Rappture::BooleanEntry $w $_owner $path
[13]	141	bind $w <<Value>> [itcl::code $this _controlChanged $path]
	142	}
[11]	143	string {
[22]	144	Rappture::TextEntry $w $_owner $path
[11]	145	bind $w <<Value>> [itcl::code $this _controlChanged $path]
	146	}
[22]	147	control {
	148	set label [$_owner xml get $path.label]
	149	if {"" == $label} { set label "Simulate" }
	150	set service [$_owner xml get $path.service]
	151	button $w -text $label -command [list $service run]
	152	}
[69]	153	separator {
	154	# no widget to create
	155	set _name2info($name-value) "--"
	156	}
[11]	157	default {
	158	error "don't know how to add control type \"$type\""
	159	}
	160	}
	161
[111]	162	if {$type != "control" && $type != "group" && $type != "separator"} {
[22]	163	$_owner widgetfor $path $w
[11]	164
[22]	165	# make a label for this control
	166	set label [$w label]
	167	if {"" != $label} {
[26]	168	set _name2info($name-label) $_frame.l$name
[22]	169	set font [option get $itk_component(hull) labelFont Font]
	170	label $_name2info($name-label) -text [_formatLabel $label] \
	171	-font $font
	172	}
[11]	173
[22]	174	# register the tooltip for this control
	175	set tip [$w tooltip]
	176	if {"" != $tip} {
	177	Rappture::Tooltip::for $w $tip
	178
	179	# add the tooltip to the label too, if there is one
	180	if {$_name2info($name-label) != ""} {
	181	Rappture::Tooltip::for $_name2info($name-label) $tip
	182	}
[11]	183	}
	184	}
	185
	186	# insert the new control onto the known list
	187	set _controls [linsert $_controls $pos $name]
[120]	188	_monitor $name on
[11]	189
	190	# now that we have a new control, we should fix the layout
	191	$_dispatcher event -idle !layout
	192
	193	return $name
	194	}
	195
	196	# ----------------------------------------------------------------------
	197	# USAGE: delete <first> ?<last>?
	198	#
	199	# Clients use this to delete one or more controls from this widget.
	200	# The <first> and <last> represent the integer index of the desired
	201	# control. You can use the "index" method to convert a control name to
	202	# its integer index. If only <first> is specified, then that one
	203	# control is deleted. If <last> is specified, then all controls in the
	204	# range <first> to <last> are deleted.
	205	# ----------------------------------------------------------------------
	206	itcl::body Rappture::Controls::delete {first {last ""}} {
	207	if {$last == ""} {
	208	set last $first
	209	}
	210	if {![regexp {^[0-9]+\|end$} $first]} {
	211	error "bad index \"$first\": should be integer or \"end\""
	212	}
	213	if {![regexp {^[0-9]+\|end$} $last]} {
	214	error "bad index \"$last\": should be integer or \"end\""
	215	}
	216
	217	foreach name [lrange $_controls $first $last] {
[120]	218	_monitor $name off
	219
[11]	220	if {"" != $_name2info($name-label)} {
	221	destroy $_name2info($name-label)
	222	}
	223	if {"" != $_name2info($name-value)} {
	224	destroy $_name2info($name-value)
	225	}
[23]	226	$_owner widgetfor $_name2info($name-path) ""
	227
[11]	228	unset _name2info($name-path)
	229	unset _name2info($name-label)
	230	unset _name2info($name-value)
	231	}
	232	set _controls [lreplace $_controls $first $last]
	233
	234	$_dispatcher event -idle !layout
	235	}
	236
	237	# ----------------------------------------------------------------------
	238	# USAGE: index <name>\|@n
	239	#
	240	# Clients use this to convert a control <name> into its corresponding
	241	# integer index. Returns an error if the <name> is not recognized.
	242	# ----------------------------------------------------------------------
	243	itcl::body Rappture::Controls::index {name} {
	244	set i [lsearch $_controls $name]
	245	if {$i >= 0} {
	246	return $i
	247	}
	248	if {[regexp {^@([0-9]+)$} $name match i]} {
	249	return $i
	250	}
	251	error "bad control name \"$name\": should be @int or one of [join [lsort $_controls] {, }]"
	252	}
	253
	254	# ----------------------------------------------------------------------
[22]	255	# USAGE: control ?-label\|-value\|-path? ?<name>\|@n?
[11]	256	#
	257	# Clients use this to get information about controls. With no args, it
	258	# returns a list of all control names. Otherwise, it returns the frame
	259	# associated with a control name. The -label option requests the label
[22]	260	# widget instead of the value widget. The -path option requests the
	261	# path within the XML that the control affects.
[11]	262	# ----------------------------------------------------------------------
	263	itcl::body Rappture::Controls::control {args} {
	264	if {[llength $args] == 0} {
	265	return $_controls
	266	}
	267	Rappture::getopts args params {
	268	flag switch -value default
	269	flag switch -label
	270	flag switch -path
	271	}
	272	if {[llength $args] == 0} {
	273	error "missing control name"
	274	}
	275	set i [index [lindex $args 0]]
	276	set name [lindex $_controls $i]
	277
	278	set opt $params(switch)
	279	return $_name2info($name$opt)
	280	}
	281
	282	# ----------------------------------------------------------------------
	283	# USAGE: _layout
	284	#
	285	# Used internally to fix the layout of controls whenever controls
	286	# are added or deleted, or when the control arrangement changes.
	287	# There are a lot of heuristics here trying to achieve a "good"
	288	# arrangement of controls.
	289	# ----------------------------------------------------------------------
	290	itcl::body Rappture::Controls::_layout {} {
	291	#
	292	# Clear any existing layout
	293	#
	294	foreach name $_controls {
	295	foreach elem {label value} {
	296	set w $_name2info($name-$elem)
	297	if {$w != "" && [winfo exists $w]} {
	298	grid forget $w
	299	}
	300	}
	301	}
[26]	302	if {[$_tabs size] > 0} {
	303	$_tabs delete 0 end
	304	}
[74]	305	grid forget $_frame.empty
[11]	306
	307	#
[26]	308	# Decide on a layout scheme:
	309	# tabs ...... best if all elements within are groups
	310	# hlabels ... horizontal labels (label: value)
[11]	311	#
[26]	312	if {[llength $_controls] >= 2} {
	313	# assume tabs for multiple groups
[120]	314	set _scheme tabs
[26]	315	foreach name $_controls {
	316	set w $_name2info($name-value)
	317
[82]	318	if {$w == "--" \|\| [winfo class $w] != "GroupEntry"} {
[26]	319	# something other than a group? then fall back on hlabels
[120]	320	set _scheme hlabels
[26]	321	break
	322	}
[11]	323	}
[26]	324	} else {
[120]	325	set _scheme hlabels
[26]	326	}
[11]	327
[120]	328	switch -- $_scheme {
[26]	329	tabs {
	330	#
	331	# SCHEME: tabs
	332	# put a series of groups into a tabbed notebook
	333	#
[11]	334
[26]	335	# use inner frame within tabs to show current group
	336	pack $_tabs -before $_frame -fill x
[11]	337
[26]	338	set gn 1
	339	foreach name $_controls {
	340	set wv $_name2info($name-value)
	341	$wv configure -heading no
	342
	343	set label [$wv component heading cget -text]
	344	if {"" == $label} {
	345	set label "Group #$gn"
	346	}
	347	set _name2info($name-label) $label
	348
	349	$_tabs insert end $label \
	350	-activebackground $itk_option(-background)
	351
	352	incr gn
	353	}
	354
	355	# compute the overall size
	356	# BE CAREFUL: do this after setting "-heading no" above
[120]	357	$_dispatcher event -now !resize
[26]	358
	359	grid propagate $_frame off
	360	grid columnconfigure $_frame 0 -weight 1
	361	grid rowconfigure $_frame 0 -weight 1
	362
	363	$_tabs select 0; _changeTabs
	364	}
	365
	366	hlabels {
	367	#
	368	# SCHEME: hlabels
	369	# simple "Label: Value" layout
	370	#
	371	pack forget $_tabs
	372	grid propagate $_frame on
	373	grid columnconfigure $_frame 0 -weight 0
	374	grid rowconfigure $_frame 0 -weight 0
	375
	376	set row 0
	377	foreach name $_controls {
	378	set wl $_name2info($name-label)
	379	if {$wl != "" && [winfo exists $wl]} {
	380	grid $wl -row $row -column 0 -sticky e
	381	}
	382
	383	set wv $_name2info($name-value)
	384	if {$wv != "" && [winfo exists $wv]} {
	385	if {$wl != ""} {
	386	grid $wv -row $row -column 1 -sticky ew
	387	} else {
	388	grid $wv -row $row -column 0 -columnspan 2 -sticky ew
	389	}
	390
[82]	391	grid rowconfigure $_frame $row -weight 0
	392	grid rowconfigure $_frame $row -weight 0
[26]	393
	394	switch -- [winfo class $wv] {
	395	TextEntry {
	396	if {[regexp {[0-9]+x[0-9]+} [$wv size]]} {
	397	grid $wl -sticky n -pady 4
	398	grid $wv -sticky nsew
[82]	399	grid rowconfigure $_frame $row -weight 1
	400	grid columnconfigure $_frame 1 -weight 1
[26]	401	}
[11]	402	}
[26]	403	GroupEntry {
	404	$wv configure -heading yes
	405	}
[11]	406	}
[82]	407	grid columnconfigure $_frame 1 -weight 1
[69]	408	} elseif {$wv == "--"} {
[82]	409	grid rowconfigure $_frame $row -minsize 10
[11]	410	}
	411
[26]	412	incr row
[82]	413	grid rowconfigure $_frame $row -minsize $itk_option(-padding)
[26]	414	incr row
	415	}
[74]	416	grid $_frame.empty -row $row
[26]	417	}
[11]	418	}
	419	}
	420
	421	# ----------------------------------------------------------------------
[120]	422	# USAGE: _monitor <name> <state>
	423	#
	424	# Used internally to add/remove bindings that cause the widget
	425	# associated with <name> to notify this controls widget of size
	426	# changes. Whenever there is a size change, this controls widget
	427	# should fix its layout.
	428	# ----------------------------------------------------------------------
	429	itcl::body Rappture::Controls::_monitor {name state} {
	430	set tag "Controls-$this"
	431	set wv $_name2info($name-value)
	432	if {$wv == "--"} return
	433	set btags [bindtags $wv]
	434	set i [lsearch $btags $tag]
	435
	436	if {$state} {
	437	if {$i < 0} {
	438	bindtags $wv [linsert $btags 0 $tag]
	439	}
	440	} else {
	441	if {$i >= 0} {
	442	bindtags $wv [lreplace $btags $i $i]
	443	}
	444	}
	445	}
	446
	447	# ----------------------------------------------------------------------
[11]	448	# USAGE: _controlChanged <path>
	449	#
	450	# Invoked automatically whenever the value for the control with the
	451	# XML <path> changes. Sends a notification along to the tool
	452	# controlling this panel.
	453	# ----------------------------------------------------------------------
	454	itcl::body Rappture::Controls::_controlChanged {path} {
[13]	455	if {"" != $_owner} {
	456	$_owner changed $path
[11]	457	}
	458	}
	459
	460	# ----------------------------------------------------------------------
	461	# USAGE: _formatLabel <string>
	462	#
	463	# Used internally to format a label <string>. Trims any excess
	464	# white space and adds a ":" to the end. That way, all labels
	465	# have a uniform look.
	466	# ----------------------------------------------------------------------
	467	itcl::body Rappture::Controls::_formatLabel {str} {
	468	set str [string trim $str]
	469	if {"" != $str && [string index $str end] != ":"} {
	470	append str ":"
	471	}
	472	return $str
	473	}
	474
	475	# ----------------------------------------------------------------------
[26]	476	# USAGE: _changeTabs
	477	#
	478	# Used internally to change tabs when the user clicks on a tab
	479	# in the "tabs" layout mode. This mode is used when the widget
	480	# contains nothing but groups, as a compact way of representing
	481	# the groups.
	482	# ----------------------------------------------------------------------
	483	itcl::body Rappture::Controls::_changeTabs {} {
	484	set i [$_tabs index select]
	485	set name [lindex $_controls $i]
	486	if {"" != $name} {
	487	foreach w [grid slaves $_frame] {
	488	grid forget $w
	489	}
	490
	491	set wv $_name2info($name-value)
	492	grid $wv -row 0 -column 0 -sticky new
	493	}
	494	}
	495
	496	# ----------------------------------------------------------------------
[120]	497	# USAGE: _resize
	498	#
	499	# Used internally to resize the widget when its contents change.
	500	# ----------------------------------------------------------------------
	501	itcl::body Rappture::Controls::_resize {} {
	502	switch -- $_scheme {
	503	tabs {
	504	# compute the overall size
	505	# BE CAREFUL: do this after setting "-heading no" above
	506	set maxw 0
	507	set maxh 0
	508	update idletasks
	509	foreach name $_controls {
	510	set wv $_name2info($name-value)
	511	set w [winfo reqwidth $wv]
	512	if {$w > $maxw} { set maxw $w }
	513	set h [winfo reqheight $wv]
	514	if {$h > $maxh} { set maxh $h }
	515	}
	516	$_frame configure -width $maxw -height $maxh
	517	}
	518	hlabels {
	519	# do nothing
	520	}
	521	}
	522	}
	523
	524	# ----------------------------------------------------------------------
[11]	525	# OPTION: -padding
	526	# ----------------------------------------------------------------------
	527	itcl::configbody Rappture::Controls::padding {
	528	$_dispatcher event -idle !layout
	529	}

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

Download in other formats: