Context Navigation

source: branches/1.3/gui/scripts/resultselector.tcl @ 4531

Last change on this file since 4531 was 4215, checked in by mmc, 10 years ago
Fix for ticket #266315, which occurred when you simulate two results, delete one, then simulate again. An old value from the deleted simulation was hanging around and causing an internal error. This fix clears the value so it works properly.
File size: 49.2 KB

Line
1	# -- mode: tcl; indent-tabs-mode: nil --
2	# ----------------------------------------------------------------------
3	# COMPONENT: ResultSelector - controls for a ResultSet
4	#
5	# This widget displays a collection of results stored in a ResultSet
6	# object. It manages the controls to select and visualize the data.
7	# ======================================================================
8	# AUTHOR: Michael McLennan, Purdue University
9	# Copyright (c) 2004-2012 HUBzero Foundation, LLC
10	#
11	# See the file "license.terms" for information on usage and
12	# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13	# ======================================================================
14	package require Itk
15
16	option add *ResultSelector.width 4i widgetDefault
17	option add *ResultSelector.height 4i widgetDefault
18	option add *ResultSelector.missingData skip widgetDefault
19	option add *ResultSelector.controlbarBackground gray widgetDefault
20	option add *ResultSelector.controlbarForeground white widgetDefault
21	option add *ResultSelector.activeControlBackground #ffffcc widgetDefault
22	option add *ResultSelector.activeControlForeground black widgetDefault
23	option add *ResultSelector.controlActiveForeground blue widgetDefault
24	option add *ResultSelector.toggleBackground gray widgetDefault
25	option add *ResultSelector.toggleForeground white widgetDefault
26	option add *ResultSelector.textFont \
27	--helvetica-medium-r-normal--12-* widgetDefault
28	option add *ResultSelector.boldFont \
29	--helvetica-bold-r-normal--12-* widgetDefault
30
31	itcl::class Rappture::ResultSelector {
32	inherit itk::Widget
33
34	itk_option define -resultset resultSet ResultSet ""
35	itk_option define -activecontrolbackground activeControlBackground Background ""
36	itk_option define -activecontrolforeground activeControlForeground Foreground ""
37	itk_option define -controlactiveforeground controlActiveForeground Foreground ""
38	itk_option define -togglebackground toggleBackground Background ""
39	itk_option define -toggleforeground toggleForeground Foreground ""
40	itk_option define -textfont textFont Font ""
41	itk_option define -boldfont boldFont Font ""
42	itk_option define -foreground foreground Foreground ""
43	itk_option define -settingscommand settingsCommand SettingsCommand ""
44
45	constructor {args} { # defined below }
46	destructor { # defined below }
47
48	public method activate {column}
49	public method size {{what -results}}
50
51	protected method _doClear {what}
52	protected method _doSettings {{cmd ""}}
53	protected method _control {option args}
54	protected method _fixControls {args}
55	protected method _fixLayout {args}
56	protected method _fixNumResults {}
57	protected method _fixSettings {args}
58	protected method _fixValue {column why}
59	protected method _drawValue {column widget wmax}
60	protected method _toggleAll {{column "current"}}
61	protected method _getValues {column {which "all"}}
62	protected method _getTooltip {role column}
63	protected method _getParamDesc {which {index "current"}}
64	protected method _log {col}
65
66	private variable _dispatcher "" ;# dispatchers for !events
67	private variable _resultset "" ;# object containing results
68	private variable _active "" ;# name of active control
69	private variable _plotall 0 ;# non-zero => plot all active results
70	private variable _layout ;# info used in _fixLayout
71	private variable _counter 0 ;# counter for unique control names
72	private variable _settings 0 ;# non-zero => _fixSettings in progress
73
74	private common _cntlInfo ;# maps column name => control info
75	}
76
77	itk::usual ResultSelector {
78	keep -background -foreground -cursor -font
79	}
80
81	# ----------------------------------------------------------------------
82	# CONSTRUCTOR
83	# ----------------------------------------------------------------------
84	itcl::body Rappture::ResultSelector::constructor {args} {
85	option add hull.width hull.height
86	pack propagate $itk_component(hull) no
87
88	# create a dispatcher for events
89	Rappture::dispatcher _dispatcher
90
91	$_dispatcher register !layout
92	$_dispatcher dispatch $this !layout \
93	[itcl::code $this _fixLayout]
94
95	$_dispatcher register !settings
96	$_dispatcher dispatch $this !settings \
97	[itcl::code $this _fixSettings]
98
99	# initialize controls info
100	set _cntlInfo($this-all) ""
101
102	# initialize layout info
103	set _layout(mode) "usual"
104	set _layout(active) ""
105	set _layout(numcntls) 0
106
107	itk_component add cntls {
108	frame $itk_interior.cntls
109	} {
110	usual
111	rename -background -controlbarbackground controlbarBackground Background
112	rename -highlightbackground -controlbarbackground controlbarBackground Background
113	}
114	pack $itk_component(cntls) -fill x -pady {0 2}
115
116	itk_component add clearall {
117	button $itk_component(cntls).clearall -text "Clear" -state disabled \
118	-padx 1 -pady 1 \
119	-relief flat -overrelief raised \
120	-command [itcl::code $this _doClear all]
121	} {
122	usual
123	rename -background -controlbarbackground controlbarBackground Background
124	rename -foreground -controlbarforeground controlbarForeground Foreground
125	rename -highlightbackground -controlbarbackground controlbarBackground Background
126	}
127	pack $itk_component(clearall) -side right -padx 2 -pady 1
128	Rappture::Tooltip::for $itk_component(clearall) \
129	"Clears all results collected so far."
130
131	itk_component add clear {
132	button $itk_component(cntls).clear -text "Clear One" -state disabled \
133	-padx 1 -pady 1 \
134	-relief flat -overrelief raised \
135	-command [itcl::code $this _doClear current]
136	} {
137	usual
138	rename -background -controlbarbackground controlbarBackground Background
139	rename -foreground -controlbarforeground controlbarForeground Foreground
140	rename -highlightbackground -controlbarbackground controlbarBackground Background
141	}
142	pack $itk_component(clear) -side right -padx 2 -pady 1
143	Rappture::Tooltip::for $itk_component(clear) \
144	"Clears the result that is currently selected."
145
146	itk_component add status {
147	label $itk_component(cntls).status -anchor w \
148	-text "No results" -padx 0 -pady 0
149	} {
150	usual
151	rename -background -controlbarbackground controlbarBackground Background
152	rename -foreground -controlbarforeground controlbarForeground Foreground
153	rename -highlightbackground -controlbarbackground controlbarBackground Background
154	}
155	pack $itk_component(status) -side left -padx 2 -pady {2 0}
156
157	itk_component add dials {
158	frame $itk_interior.dials
159	}
160	pack $itk_component(dials) -expand yes -fill both
161	bind $itk_component(dials) <Configure> \
162	[list $_dispatcher event -after 10 !layout why resize]
163
164	# create the permanent controls in the "short list" area
165	set dials $itk_component(dials)
166	frame $dials.bg
167	Rappture::Radiodial $dials.dial -valuewidth 0
168	Rappture::Tooltip::for $dials.dial \
169	"@[itcl::code $this _getTooltip dial active]"
170
171	set fn [option get $itk_component(hull) textFont Font]
172	label $dials.all -text "All" -padx 8 \
173	-borderwidth 1 -relief raised -font $fn
174	Rappture::Tooltip::for $dials.all \
175	"@[itcl::code $this _getTooltip all active]"
176	bind $dials.all <ButtonRelease> [itcl::code $this _toggleAll]
177
178	frame $dials.labelmore
179	label $dials.labelmore.arrow -bitmap [Rappture::icon empty] -borderwidth 0
180	pack $dials.labelmore.arrow -side left -fill y
181	label $dials.labelmore.name -text "more parameters..." -font $fn \
182	-borderwidth 0 -padx 0 -pady 1
183	pack $dials.labelmore.name -side left
184	label $dials.labelmore.value
185	pack $dials.labelmore.value -side left
186
187	eval itk_initialize $args
188	}
189
190	# ----------------------------------------------------------------------
191	# DESTRUCTOR
192	# ----------------------------------------------------------------------
193	itcl::body Rappture::ResultSelector::destructor {} {
194	# disconnect any existing resultset to stop notifications
195	configure -resultset ""
196	}
197
198	# ----------------------------------------------------------------------
199	# USAGE: activate <column>
200	#
201	# Clients use this to activate a particular column in the set of
202	# controls. When a column is active, its label is bold and its
203	# value has a radiodial in the "short list" area.
204	# ----------------------------------------------------------------------
205	itcl::body Rappture::ResultSelector::activate {column} {
206	if {$_resultset ne ""} {
207	set allowed [$_resultset diff names]
208	if {[lsearch $allowed $column] < 0} {
209	error "bad value \"$column\": should be one of [join $allowed {, }]"
210	}
211
212	# column is now active
213	set _active $column
214
215	# keep track of usage, so we know which controls are popular
216	incr _cntlInfo($this-$column-usage)
217
218	# fix controls at next idle point
219	$_dispatcher event -idle !layout why data
220	$_dispatcher event -idle !settings column $_active
221	}
222	}
223
224	# ----------------------------------------------------------------------
225	# USAGE: size ?-results\|-controls\|-controlarea?
226	#
227	# Returns various measures for the size of this area:
228	# -results ....... number of results loaded
229	# -controls ...... number of distinct control parameters
230	# -controlarea ... minimum size of usable control area, in pixels
231	# ----------------------------------------------------------------------
232	itcl::body Rappture::ResultSelector::size {{what -results}} {
233	switch -- $what {
234	-results {
235	if {$_resultset eq ""} {
236	return 0
237	}
238	return [$_resultset size]
239	}
240	-controls {
241	return [expr {[llength [$_resultset diff names]]-1}]
242	}
243	-controlarea {
244	set ht [winfo reqheight $itk_component(cntls)]
245	incr ht 2 ;# padding below controls
246
247	set normalLine [font metrics $itk_option(-textfont) -linespace]
248	incr normalLine 2 ;# padding
249	set boldLine [font metrics $itk_option(-boldfont) -linespace]
250	incr boldLine 2 ;# padding
251
252	set numcntls [expr {[llength [$_resultset diff names]]-1}]
253	switch -- $numcntls {
254	0 - 1 {
255	# 0 = no controls (no data at all)
256	# 1 = run control, but only 1 run so far
257	# add nothing
258	}
259	default {
260	# non-active controls
261	incr ht [expr {($numcntls-1)*$normalLine}]
262	# active control
263	incr ht $boldLine
264	# dial for active control
265	incr ht [winfo reqheight $itk_component(dials).dial]
266	# padding around active control
267	incr ht 4
268	}
269	}
270	return $ht
271	}
272	default {
273	error "bad option \"$what\": should be -results, -controls, or -controlarea"
274	}
275	}
276	}
277
278	# ----------------------------------------------------------------------
279	# USAGE: _doClear all\|current
280	#
281	# Invoked automatically when the user presses the "Clear One" or
282	# "Clear All" buttons. Clears results from the ResultSet and then
283	# waits for an event to react to the change.
284	# ----------------------------------------------------------------------
285	itcl::body Rappture::ResultSelector::_doClear {what} {
286	if {$_resultset ne ""} {
287	switch -- $what {
288	current {
289	set simnum $_cntlInfo($this-simnum-value)
290	foreach xmlobj [$_resultset find simnum $simnum] {
291	$_resultset clear $xmlobj
292	}
293	Rappture::Logger::log result -clear one
294	}
295	all {
296	$_resultset clear
297	Rappture::Logger::log result -clear all
298	}
299	default { error "bad option \"$what\": should be current or all" }
300	}
301	}
302	}
303
304	# ----------------------------------------------------------------------
305	# USAGE: _doSettings ?<command>?
306	#
307	# Used internally whenever the result selection changes to invoke
308	# the -settingscommand. This will notify some external widget, which
309	# with perform the plotting action specified in the <command>.
310	# ----------------------------------------------------------------------
311	itcl::body Rappture::ResultSelector::_doSettings {{cmd ""}} {
312	if {[string length $itk_option(-settingscommand)] > 0} {
313	uplevel #0 $itk_option(-settingscommand) $cmd
314	}
315	}
316
317	# ----------------------------------------------------------------------
318	# USAGE: _control bind <widget> <column>
319	# USAGE: _control hilite <state> <column> <panel>
320	# USAGE: _control load <widget> <column>
321	#
322	# Used internally to manage the interactivity of controls. The "bind"
323	# operation sets up bindings on the label/value for each control, so
324	# you can mouse over and click on a control to activate it. The
325	# "hilite" operation controls highlighting of the control. The "load"
326	# operation loads data into the specified radiodial <widget>.
327	# ----------------------------------------------------------------------
328	itcl::body Rappture::ResultSelector::_control {option args} {
329	switch -- $option {
330	bind {
331	if {[llength $args] != 2} {
332	error "wrong # args: should be _control bind widget column"
333	}
334	set widget [lindex $args 0]
335	set col [lindex $args 1]
336
337	set panel [winfo parent $widget]
338	if {[string match label* [winfo name $panel]]} {
339	set panel [winfo parent $panel]
340	}
341
342	bind $widget <Enter> \
343	[itcl::code $this _control hilite on $col $panel]
344	bind $widget <Leave> \
345	[itcl::code $this _control hilite off $col $panel]
346	bind $widget <ButtonRelease> "
347	[itcl::code $this activate $col]
348	[list Rappture::Logger::log result -active $col]
349	"
350	}
351	hilite {
352	if {[llength $args] != 3} {
353	error "wrong # args: should be _control hilite state column panel"
354	}
355	if {$_layout(mode) != "usual"} {
356	# abbreviated controls? then skip highlighting
357	return
358	}
359	set state [lindex $args 0]
360	set col [lindex $args 1]
361	set panel [lindex $args 2]
362
363	if {[string index $col 0] == "@"} {
364	# handle artificial names like "@more"
365	set id [string range $col 1 end]
366	} else {
367	# get id for ordinary columns
368	set id $_cntlInfo($this-$col-id)
369	}
370
371	# highlight any non-active entries
372	if {$col != $_active} {
373	if {$state} {
374	set fg $itk_option(-controlactiveforeground)
375	$panel.label$id.name configure -fg $fg
376	$panel.label$id.value configure -fg $fg
377	$panel.label$id.arrow configure -fg $fg \
378	-bitmap [Rappture::icon rarrow2]
379	} else {
380	set fg $itk_option(-foreground)
381	$panel.label$id.name configure -fg $fg
382	$panel.label$id.value configure -fg $fg
383	$panel.label$id.arrow configure -fg $fg \
384	-bitmap [Rappture::icon empty]
385	}
386	}
387	}
388	load {
389	if {[llength $args] != 2} {
390	error "wrong # args: should be _control load widget column"
391	}
392	set dial [lindex $args 0]
393	set col [lindex $args 1]
394
395	set shortlist $itk_component(dials)
396	$shortlist.dial configure -variable ""
397	$dial clear
398	foreach {label val} [_getValues $col all] {
399	$dial add $label $val
400	}
401	$shortlist.dial configure -variable \
402	"::Rappture::ResultSelector::_cntlInfo($this-$col-value)" \
403	-interactcommand [itcl::code $this _log $col]
404	}
405	default {
406	error "bad option \"$option\": should be bind, hilite, or load"
407	}
408	}
409	}
410
411	# ----------------------------------------------------------------------
412	# USAGE: _fixControls ?<eventArgs...>?
413	#
414	# Called automatically at the idle point after one or more results
415	# have been added to this result set. Scans through all existing
416	# data and updates controls used to select the data.
417	# ----------------------------------------------------------------------
418	itcl::body Rappture::ResultSelector::_fixControls {args} {
419	array set eventData $args
420	if {![info exists itk_component(dials)]} {
421	# no controls? then nothing to fix
422	# this happens when the widget is being destroyed
423	return
424	}
425	set shortlist $itk_component(dials)
426
427	# added or cleared something -- update number of results
428	_fixNumResults
429
430	if {$_resultset eq ""} {
431	return
432	}
433
434	# cleared something?
435	if {$eventData(op) eq "clear"} {
436	if {[$_resultset size] == 0} {
437	# cleared everything? then reset controls to initial state
438	array unset _cntlInfo $this-*
439	set _cntlInfo($this-all) ""
440	set _active ""
441	set _plotall 0
442	$itk_component(dials).all configure -relief raised \
443	-background $itk_option(-background) \
444	-foreground $itk_option(-foreground)
445
446	# clean up all of the label/value widgets
447	foreach w [winfo children $itk_component(dials)] {
448	if {[string match {label[0-9]*} [winfo name $w]]} {
449	destroy $w
450	}
451	}
452	set _counter 0
453
454	$_dispatcher event -idle !layout why data
455
456	return
457	}
458
459	# cleared a single value? then move to another one
460	array set params $eventData(what)
461
462	# clear any currently highlighted result
463	_doSettings
464
465	# did the active control go away? then switch to simnum
466	if {[lsearch -exact [$_resultset diff names] $_active] < 0} {
467	set _cntlInfo($this-$_active-value) ""
468	activate simnum
469	}
470
471	# figure out where we were in the active control, and
472	# what value we should display now that this was deleted
473	if {[info exists params($_active)]} {
474	set current $params($_active)
475	if {$current eq [$shortlist.dial get -format label current]} {
476	# result deleted is the current result
477	set vlist [$shortlist.dial get]
478	set i [lsearch -exact $vlist $current]
479	if {$i >= 0} {
480	if {$i+1 < [llength $vlist]} {
481	set newControlValue [lindex $vlist [expr {$i+1}]]
482	} elseif {$i-1 >= 0} {
483	set newControlValue [lindex $vlist [expr {$i-1}]]
484	}
485	}
486	}
487	}
488
489	if {[info exists newControlValue]} {
490	# Set the control to a value we were able to find.
491	# Disconnect the current variable, then plug in the
492	# new (legal) value, then reload the controls.
493	# This will trigger !settings and other adjustments.
494	$shortlist.dial configure -variable ""
495	set _cntlInfo($this-$_active-value) $newControlValue
496	_control load $shortlist.dial $_active
497	} else {
498	# if all else fails, show solution #1
499	set xmlobj0 [lindex [$_resultset find * *] 0]
500	set simnum0 [$_resultset get simnum $xmlobj0]
501	set _cntlInfo($this-simnum-value) $simnum0
502	activate simnum
503	}
504
505	# if clearing this dataset changed the controls, then
506	# fix the layout
507	set numcntls [expr {[llength [$_resultset diff names]]-1}]
508	if {$numcntls != $_layout(numcntls)} {
509	$_dispatcher event -idle !layout why data
510	}
511	return
512	}
513
514	# must have added something...
515	set shortlist $itk_component(dials)
516	grid columnconfigure $shortlist 1 -weight 1
517
518	#
519	# Scan through all columns in the data and create any
520	# controls that just appeared.
521	#
522	set nadded 0
523	foreach col [$_resultset diff names] {
524	if {$col eq "xmlobj"} {
525	continue ;# never create a control for this column
526	}
527
528	#
529	# If this column doesn't have a control yet, then
530	# create one.
531	#
532	if {![info exists _cntlInfo($this-$col-id)]} {
533	set tip ""
534	if {$col eq "simnum"} {
535	set quantity "Simulation"
536	set tip "List of all simulations that you have performed so far."
537	} else {
538	# search for the first XML object with this element defined
539	foreach xmlobj [$_resultset find * *] {
540	set quantity [$xmlobj get $col.about.label]
541	set tip [$xmlobj get $col.about.description]
542	if {"" != $quantity} {
543	break
544	}
545	}
546	if {"" == $quantity && "" != $xmlobj} {
547	set quantity [$xmlobj element -as id $col]
548	}
549	}
550
551	# Create the controls for the "short list" area.
552	set fn $itk_option(-textfont)
553	set w $shortlist.label$_counter
554	set row [lindex [grid size $shortlist] 1]
555	frame $w
556	grid $w -row $row -column 1 -sticky ew
557	label $w.arrow -bitmap [Rappture::icon empty] -borderwidth 0
558	pack $w.arrow -side left -fill y
559	_control bind $w.arrow $col
560
561	label $w.name -text $quantity -anchor w \
562	-borderwidth 0 -padx 0 -pady 1 -font $fn
563	pack $w.name -side left
564	bind $w.name <Configure> [itcl::code $this _fixValue $col resize]
565	_control bind $w.name $col
566
567	label $w.value -anchor w \
568	-borderwidth 0 -padx 0 -pady 1 -font $fn
569	pack $w.value -side left
570	bind $w.value <Configure> [itcl::code $this _fixValue $col resize]
571	_control bind $w.value $col
572
573	Rappture::Tooltip::for $w \
574	"@[itcl::code $this _getTooltip label $col]"
575
576	# create a record for this control
577	lappend _cntlInfo($this-all) $col
578	set _cntlInfo($this-$col-id) $_counter
579	set _cntlInfo($this-$col-label) $quantity
580	set _cntlInfo($this-$col-tip) $tip
581	set _cntlInfo($this-$col-value) ""
582	set _cntlInfo($this-$col-usage) 0
583	set _cntlInfo($this-$col) ""
584
585	trace add variable _cntlInfo($this-$col-value) write \
586	"[itcl::code $this _fixValue $col value]; list"
587
588	incr _counter
589
590	incr nadded
591	}
592
593	#
594	# Determine the unique values for this column and load
595	# them into the control.
596	#
597	set id $_cntlInfo($this-$col-id)
598
599	if {$col == $_layout(active)} {
600	_control load $shortlist.dial $col
601	}
602	}
603
604	#
605	# Activate the most recent control. If a bunch of controls
606	# were just added, then activate the "Simulation" control,
607	# since that's the easiest way to page through results.
608	#
609	set numcntls [expr {[llength [$_resultset diff names]]-1}]
610	if {$nadded > 0 \|\| $numcntls != $_layout(numcntls)} {
611	if {$numcntls == 2 \|\| $nadded == 1} {
612	activate [lindex [$_resultset diff names] end]
613	} else {
614	activate simnum
615	}
616
617	# fix the shortlist layout to show as many controls as we can
618	$_dispatcher event -idle !layout why data
619	}
620
621	#
622	# Set all controls to the settings of the most recent addition.
623	# Setting the value slot will trigger the !settings event, which
624	# will then fix all other controls to match the one that changed.
625	#
626	if {[info exists eventData(what)]} {
627	set xmlobj $eventData(what)
628	set simnum [$_resultset get simnum $xmlobj]
629	set _cntlInfo($this-simnum-value) $simnum
630	}
631	}
632
633	# ----------------------------------------------------------------------
634	# USAGE: _fixLayout ?<eventArgs...>?
635	#
636	# Called automatically at the idle point after the controls have
637	# changed, or the size of the window has changed. Fixes the layout
638	# so that the active control is displayed, and other recent controls
639	# are shown above and/or below. At the very least, we must show the
640	# "more options..." control.
641	# ----------------------------------------------------------------------
642	itcl::body Rappture::ResultSelector::_fixLayout {args} {
643	array set eventdata $args
644
645	set shortlist $itk_component(dials)
646
647	# clear out the short list area
648	foreach w [grid slaves $shortlist] {
649	grid forget $w
650	}
651
652	# reset all labels back to an ordinary font/background
653	set fn $itk_option(-textfont)
654	set bg $itk_option(-background)
655	set fg $itk_option(-foreground)
656	foreach col $_cntlInfo($this-all) {
657	set id $_cntlInfo($this-$col-id)
658	$shortlist.label$id configure -background $bg
659	$shortlist.label$id.arrow configure -background $bg \
660	-bitmap [Rappture::icon empty]
661	$shortlist.label$id.name configure -font $fn -background $bg
662	$shortlist.label$id.value configure -background $bg
663	}
664
665	# only 1 result? then we don't need any controls
666	if {$_resultset eq "" \|\| [$_resultset size] < 2} {
667	set _layout(active) $_active
668
669	# let clients know that the layout has changed
670	# so they can fix the overall size accordingly
671	if {![info exists eventdata(why)] \|\| $eventdata(why) ne "resize"} {
672	event generate $itk_component(hull) <<Layout>>
673	}
674
675	return
676	}
677
678	# compute the number of controls that will fit in the shortlist area
679	set dials $itk_component(dials)
680	set h [winfo height $dials]
681	set normalLine [font metrics $itk_option(-textfont) -linespace]
682	set boldLine [font metrics $itk_option(-boldfont) -linespace]
683	set active [expr {$boldLine+[winfo reqheight $dials.dial]+4}]
684
685	if {$h < $active+$normalLine} {
686	# active control kinda big? then show parameter values only
687	set _layout(mode) abbreviated
688	set ncntls [expr {int(floor(double($h)/$normalLine))}]
689	} else {
690	set _layout(mode) usual
691	set ncntls [expr {int(floor(double($h-$active)/$normalLine))+1}]
692	}
693
694	# find the controls with the most usage
695	set order ""
696	foreach col [lrange [$_resultset diff names] 1 end] {
697	lappend order [list $col $_cntlInfo($this-$col-usage)]
698	}
699	set order [lsort -integer -decreasing -index 1 $order]
700
701	set mostUsed ""
702	if {[llength $order] <= $ncntls} {
703	# plenty of space? then show all controls
704	foreach item $order {
705	lappend mostUsed [lindex $item 0]
706	}
707	} else {
708	# otherwise, limit to the most-used controls
709	foreach item [lrange $order 0 [expr {$ncntls-1}]] {
710	lappend mostUsed [lindex $item 0]
711	}
712
713	# make sure the active control is included
714	if {"" != $_active && [lsearch -exact $mostUsed $_active] < 0} {
715	set mostUsed [lreplace [linsert $mostUsed 0 $_active] end end]
716	}
717
718	# if there are more controls, add the "more parameters..." entry
719	if {$ncntls >= 2} {
720	set mostUsed [lreplace $mostUsed end end @more]
721	set rest [expr {[llength $order]-($ncntls-1)}]
722	if {$rest == 1} {
723	$dials.labelmore.name configure -text "1 more parameter..."
724	} else {
725	$dials.labelmore.name configure -text "$rest more parameters..."
726	}
727	}
728	}
729
730	# show controls associated with diffs and put up the radiodial
731	# for the "active" column
732	set row 0
733	foreach col [concat [lrange [$_resultset diff names] 1 end] @more] {
734	# this control not on the short list? then ignore it
735	if {[lsearch $mostUsed $col] < 0} {
736	continue
737	}
738
739	if {[string index $col 0] == "@"} {
740	set id [string range $col 1 end]
741	} else {
742	set id $_cntlInfo($this-$col-id)
743	}
744	grid $shortlist.label$id -row $row -column 1 -sticky ew -padx 4
745
746	if {$col == $_active} {
747	if {$_layout(mode) == "usual"} {
748	# put the background behind the active control in the shortlist
749	grid $shortlist.bg -row $row -rowspan 2 \
750	-column 0 -columnspan 2 -sticky nsew
751	lower $shortlist.bg
752
753	# place the All and dial in the shortlist area
754	grid $shortlist.all -row $row -rowspan 2 -column 0 \
755	-sticky nsew -padx 2 -pady 2
756	grid $shortlist.dial -row [expr {$row+1}] -column 1 \
757	-sticky ew -padx 4
758	incr row
759
760	if {$_layout(active) != $_active} {
761	$shortlist.dial configure -variable ""
762	_control load $shortlist.dial $col
763	$shortlist.dial configure -variable \
764	"::Rappture::ResultSelector::_cntlInfo($this-$col-value)"
765	set _layout(active) $_active
766	}
767	}
768	}
769	incr row
770	}
771
772	# highlight the active control
773	if {[info exists _cntlInfo($this-$_active-id)]} {
774	set id $_cntlInfo($this-$_active-id)
775	set bf $itk_option(-boldfont)
776	set fg $itk_option(-activecontrolforeground)
777	set bg $itk_option(-activecontrolbackground)
778
779	if {$_layout(mode) == "usual"} {
780	$shortlist.label$id configure -background $bg
781	$shortlist.label$id.arrow configure -foreground $fg \
782	-background $bg -bitmap [Rappture::icon rarrow]
783	$shortlist.label$id.name configure -foreground $fg \
784	-background $bg -font $bf
785	$shortlist.label$id.value configure -foreground $fg \
786	-background $bg
787	$shortlist.dial configure -background $bg
788	$shortlist.bg configure -background $bg
789
790	if {[$shortlist.all cget -relief] == "raised"} {
791	$shortlist.all configure -foreground $fg -background $bg
792	}
793	}
794	}
795
796	# let clients know that the layout has changed
797	# so they can fix the overall size accordingly
798	if {![info exists eventdata(why)] \|\| $eventdata(why) ne "resize"} {
799	event generate $itk_component(hull) <<Layout>>
800	}
801	}
802
803	# ----------------------------------------------------------------------
804	# USAGE: _fixNumResults
805	#
806	# Used internally to update the number of results displayed near the
807	# top of this widget. If there is only 1 result, then there is also
808	# a single "Clear" button. If there are no results, the clear button
809	# is diabled.
810	# ----------------------------------------------------------------------
811	itcl::body Rappture::ResultSelector::_fixNumResults {} {
812	set size 0
813	if {$_resultset ne ""} {
814	set size [$_resultset size]
815	}
816
817	switch $size {
818	0 {
819	$itk_component(status) configure -text "No results"
820	$itk_component(clearall) configure -state disabled -text "Clear"
821	pack forget $itk_component(clear)
822	}
823	1 {
824	$itk_component(status) configure -text "1 result"
825	$itk_component(clearall) configure -state normal -text "Clear"
826	pack forget $itk_component(clear)
827	}
828	default {
829	$itk_component(status) configure -text "$size results"
830	$itk_component(clearall) configure -state normal -text "Clear All"
831	$itk_component(clear) configure -state normal
832	pack $itk_component(clear) -side right \
833	-after $itk_component(clearall) -padx {0 6}
834	}
835	}
836	}
837
838	# ----------------------------------------------------------------------
839	# USAGE: _fixSettings ?<eventArgs...>?
840	#
841	# Called automatically at the idle point after a control has changed
842	# to load new data into the plotting area at the top of this result
843	# set. Extracts the current tuple of control values from the control
844	# area, then finds the corresponding data values. Loads the data
845	# by invoking a -settingscommand callback with parameters that
846	# describe what data should be plotted.
847	# ----------------------------------------------------------------------
848	itcl::body Rappture::ResultSelector::_fixSettings {args} {
849	array set eventdata $args
850	if {[info exists eventdata(column)]} {
851	set changed $eventdata(column)
852	} else {
853	set changed ""
854	}
855
856	if {[info exists _cntlInfo($this-$_active-label)]} {
857	lappend params $_cntlInfo($this-$_active-label)
858	} else {
859	lappend params "???"
860	}
861	if {$_active == ""} {
862	return ;# nothing active -- don't do anything
863	}
864	eval lappend params [_getValues $_active all]
865
866	if {$_resultset eq "" \|\| [$_resultset size] == 0} {
867	# no data? then do nothing
868	return
869	} elseif {[$_resultset size] == 1} {
870	# only one data set? then plot it
871	set xmlobj [$_resultset find * *]
872	set simnum [lindex [$_resultset get simnum $xmlobj] 0]
873
874	_doSettings [list \
875	$simnum [list -width 2 \
876	-param [_getValues $_active current] \
877	-description [_getParamDesc all] \
878	] \
879	params $params \
880	]
881	return
882	}
883
884	#
885	# Find the selected run. If the run setting changed, then
886	# look at its current value. Otherwise, search the results
887	# for a tuple that matches the current settings.
888	#
889	if {$changed == "xmlobj" \|\| $changed == "simnum"} {
890	set xmlobj [$_resultset find simnum $_cntlInfo($this-simnum-value)]
891	} else {
892	set format ""
893	set tuple ""
894	foreach col [lrange [$_resultset diff names] 2 end] {
895	lappend format $col
896	lappend tuple $_cntlInfo($this-$col-value)
897	}
898	set xmlobj [lindex [$_resultset find $format $tuple] 0]
899
900	if {$xmlobj eq "" && $changed ne ""} {
901	#
902	# No data for these settings. Try leaving the next
903	# column open, then the next, and so forth, until
904	# we find some data.
905	#
906	# allcols: foo bar baz qux
907	# ^^^changed
908	#
909	# search: baz qux foo
910	#
911	set val $_cntlInfo($this-$changed-value)
912	set allcols [lrange [$_resultset diff names] 2 end]
913	set i [lsearch -exact $allcols $changed]
914	set search [concat \
915	[lrange $allcols [expr {$i+1}] end] \
916	[lrange $allcols 0 [expr {$i-1}]] \
917	]
918	set nsearch [llength $search]
919
920	for {set i 0} {$i < $nsearch} {incr i} {
921	set format $changed
922	set tuple [list $val]
923	for {set j [expr {$i+1}]} {$j < $nsearch} {incr j} {
924	set col [lindex $search $j]
925	lappend format $col
926	lappend tuple $_cntlInfo($this-$col-value)
927	}
928	set xmlobj [lindex [$_resultset find $format $tuple] 0]
929	if {$xmlobj ne ""} {
930	break
931	}
932	}
933	}
934	}
935
936	#
937	# If we found a particular run, then load its values into all
938	# controls.
939	#
940	if {$xmlobj ne ""} {
941	# stop reacting to value changes
942	set _settings 1
943
944	set format [lrange [$_resultset diff names] 2 end]
945	if {[llength $format] == 1} {
946	set data [list [$_resultset get $format $xmlobj]]
947	} else {
948	set data [$_resultset get $format $xmlobj]
949	}
950
951	foreach col $format val $data {
952	set _cntlInfo($this-$col-value) $val
953	}
954
955	set simnum [$_resultset get simnum $xmlobj]
956	set _cntlInfo($this-simnum-value) $simnum
957
958	# okay, react to value changes again
959	set _settings 0
960	}
961
962	#
963	# Search for tuples matching the current setting and
964	# plot them.
965	#
966	if {$_plotall && $_active eq "simnum"} {
967	set format ""
968	} else {
969	set format ""
970	set tuple ""
971	foreach col [lrange [$_resultset diff names] 2 end] {
972	if {!$_plotall \|\| $col ne $_active} {
973	lappend format $col
974	lappend tuple $_cntlInfo($this-$col-value)
975	}
976	}
977	}
978
979	if {$format ne ""} {
980	set xolist [$_resultset find $format $tuple]
981	} else {
982	set xolist [$_resultset find * *]
983	}
984
985	if {[llength $xolist] > 0} {
986	# search for the result for these settings
987	set format ""
988	set tuple ""
989	foreach col [lrange [$_resultset diff names] 2 end] {
990	lappend format $col
991	lappend tuple $_cntlInfo($this-$col-value)
992	}
993	set curr [$_resultset find $format $tuple]
994
995	if {[llength $xolist] == 1} {
996	# single result -- always use active color
997	set xmlobj [lindex $xolist 0]
998	set simnum [$_resultset get simnum $xmlobj]
999	set plist [list \
1000	$simnum [list -width 2 \
1001	-param [_getValues $_active $xmlobj] \
1002	-description [_getParamDesc all $xmlobj] \
1003	] \
1004	params $params \
1005	]
1006	} else {
1007	#
1008	# Get the color for all points according to
1009	# the color spectrum.
1010	#
1011	set plist [list params $params]
1012	foreach xmlobj $xolist {
1013	set simnum [$_resultset get simnum $xmlobj]
1014	if {$xmlobj eq $curr} {
1015	lappend plist $simnum [list -width 3 -raise 1 \
1016	-param [_getValues $_active $xmlobj] \
1017	-description [_getParamDesc all $xmlobj]]
1018	} else {
1019	lappend plist $simnum [list -brightness 0.7 -width 1 \
1020	-param [_getValues $_active $xmlobj] \
1021	-description [_getParamDesc all $xmlobj]]
1022	}
1023	}
1024	}
1025
1026	#
1027	# Load up the matching plots
1028	#
1029	_doSettings $plist
1030	}
1031	}
1032
1033	# ----------------------------------------------------------------------
1034	# USAGE: _fixValue <columnName> <why>
1035	#
1036	# Called automatically whenver a value for a parameter dial changes.
1037	# Updates the interface to display the new value. The <why> is a
1038	# reason for the change, which may be "resize" (draw old value in
1039	# new size) or "value" (value changed).
1040	# ----------------------------------------------------------------------
1041	itcl::body Rappture::ResultSelector::_fixValue {col why} {
1042	if {[info exists _cntlInfo($this-$col-id)]} {
1043	set id $_cntlInfo($this-$col-id)
1044
1045	set widget $itk_component(dials).label$id
1046	set wmax [winfo width $itk_component(dials).dial]
1047	if {$wmax <= 1} {
1048	set wmax [expr {round(0.9*[winfo width $itk_component(cntls)])}]
1049	}
1050	_drawValue $col $widget $wmax
1051
1052	if {$why == "value" && !$_settings} {
1053	# keep track of usage, so we know which controls are popular
1054	incr _cntlInfo($this-$col-usage)
1055
1056	# adjust the settings according to the value in the column
1057	$_dispatcher event -idle !settings column $col
1058	}
1059	}
1060	}
1061
1062	# ----------------------------------------------------------------------
1063	# USAGE: _drawValue <columnName> <widget> <widthMax>
1064	#
1065	# Used internally to fix the rendering of a "quantity = value" display.
1066	# If the name/value in <widget> are smaller than <widthMax>, then the
1067	# full "quantity = value" string is displayed. Otherwise, an
1068	# abbreviated form is displayed.
1069	# ----------------------------------------------------------------------
1070	itcl::body Rappture::ResultSelector::_drawValue {col widget wmax} {
1071	set quantity $_cntlInfo($this-$col-label)
1072	regsub -all {\n} $quantity " " quantity ;# take out newlines
1073
1074	set newval $_cntlInfo($this-$col-value)
1075	regsub -all {\n} $newval " " newval ;# take out newlines
1076
1077	set lfont [$widget.name cget -font]
1078	set vfont [$widget.value cget -font]
1079
1080	set wn [font measure $lfont $quantity]
1081	set wv [font measure $lfont " = $newval"]
1082	set w [expr {$wn + $wv}]
1083
1084	if {$w <= $wmax} {
1085	# if the text fits, then shown "quantity = value"
1086	$widget.name configure -text $quantity
1087	$widget.value configure -text " = $newval"
1088	} else {
1089	# Otherwise, we'll have to appreviate.
1090	# If the value is really long, then just show a little bit
1091	# of it. Otherwise, show as much of the value as we can.
1092	if {[string length $newval] > 30} {
1093	set frac 0.8
1094	} else {
1095	set frac 0.2
1096	}
1097	set wNameSpace [expr {round($frac*$wmax)}]
1098	set wValueSpace [expr {$wmax-$wNameSpace}]
1099
1100	# fit as much of the "quantity" label in the space available
1101	if {$wn < $wNameSpace} {
1102	$widget.name configure -text $quantity
1103	set wValueSpace [expr {$wmax-$wn}]
1104	} else {
1105	set wDots [font measure $lfont "..."]
1106	set wchar [expr {double($wn)/[string length $quantity]}]
1107	while {1} {
1108	# figure out a good size for the abbreviated string
1109	set cmax [expr {round(($wNameSpace-$wDots)/$wchar)}]
1110	if {$cmax < 0} {set cmax 0}
1111	set str "[string range $quantity 0 $cmax]..."
1112	if {[font measure $lfont $str] <= $wNameSpace
1113	\|\| $wDots >= $wNameSpace} {
1114	break
1115	}
1116	# we're measuring with average chars, so we may have
1117	# to shave a little off and do this again
1118	set wDots [expr {$wDots+2*$wchar}]
1119	}
1120	$widget.name configure -text $str
1121	set wValueSpace [expr {$wmax-[font measure $lfont $str]}]
1122	}
1123
1124	if {$wv < $wValueSpace} {
1125	$widget.value configure -text " = $newval"
1126	} else {
1127	set wDots [font measure $vfont "..."]
1128	set wEq [font measure $vfont " = "]
1129	set wchar [expr {double($wv)/[string length " = $newval"]}]
1130	while {1} {
1131	# figure out a good size for the abbreviated string
1132	set cmax [expr {round(($wValueSpace-$wDots-$wEq)/$wchar)}]
1133	if {$cmax < 0} {set cmax 0}
1134	set str " = [string range $newval 0 $cmax]..."
1135	if {[font measure $vfont $str] <= $wValueSpace
1136	\|\| $wDots >= $wValueSpace} {
1137	break
1138	}
1139	# we're measuring with average chars, so we may have
1140	# to shave a little off and do this again
1141	set wDots [expr {$wDots+2*$wchar}]
1142	}
1143	$widget.value configure -text $str
1144	}
1145	}
1146	}
1147
1148	# ----------------------------------------------------------------------
1149	# USAGE: _toggleAll ?<columnName>?
1150	#
1151	# Called automatically whenever the user clicks on an "All" button.
1152	# Toggles the button between its on/off states. In the "on" state,
1153	# all results associated with the current control are sent to the
1154	# result viewer.
1155	# ----------------------------------------------------------------------
1156	itcl::body Rappture::ResultSelector::_toggleAll {{col "current"}} {
1157	if {$col == "current"} {
1158	set col $_active
1159	}
1160	if {![info exists _cntlInfo($this-$col-id)]} {
1161	return
1162	}
1163	set id $_cntlInfo($this-$col-id)
1164	set sbutton $itk_component(dials).all
1165	set current [$sbutton cget -relief]
1166
1167	if {$current == "sunken"} {
1168	$sbutton configure -relief raised \
1169	-background $itk_option(-activecontrolbackground) \
1170	-foreground $itk_option(-activecontrolforeground)
1171	set _plotall 0
1172	Rappture::Logger::log result -all off
1173	} else {
1174	$sbutton configure -relief sunken \
1175	-background $itk_option(-togglebackground) \
1176	-foreground $itk_option(-toggleforeground)
1177	set _plotall 1
1178	Rappture::Logger::log result -all on
1179
1180	if {$col != $_active} {
1181	# clicked on an inactive "All" button? then activate that column
1182	activate $col
1183	}
1184	}
1185	$_dispatcher event -idle !settings
1186	}
1187
1188	# ----------------------------------------------------------------------
1189	# USAGE: _getValues <column> ?<which>?
1190	#
1191	# Returns one or more value names associated with the given <column>.
1192	# If the <which> parameter is "all", then it returns values for all
1193	# results in the ResultSet. Each value appears as two values in the
1194	# flattened list: the normalized value and the value label. If the
1195	# <which> parameter is "current"
1196	# ----------------------------------------------------------------------
1197	itcl::body Rappture::ResultSelector::_getValues {col {which "all"}} {
1198	switch -- $which {
1199	current {
1200	set simnum $_cntlInfo($this-simnum-value)
1201	set xmlobj [$_resultset find simnum $simnum]
1202	if {$xmlobj ne ""} {
1203	return [$_resultset diff values $col $xmlobj]
1204	}
1205	return ""
1206	}
1207	all {
1208	return [$_resultset diff values $col all]
1209	}
1210	default {
1211	return [$_resultset diff values $col $which]
1212	}
1213	}
1214	}
1215
1216	# ----------------------------------------------------------------------
1217	# USAGE: _getTooltip <role> <column>
1218	#
1219	# Called automatically whenever the user hovers on a control within
1220	# this widget. Returns the tooltip associated with the control.
1221	# ----------------------------------------------------------------------
1222	itcl::body Rappture::ResultSelector::_getTooltip {role column} {
1223	set label ""
1224	set tip ""
1225	if {$column eq "active"} {
1226	set column $_active
1227	}
1228	if {[info exists _cntlInfo($this-$column-label)]} {
1229	set label $_cntlInfo($this-$column-label)
1230	}
1231	if {[info exists _cntlInfo($this-$column-tip)]} {
1232	set tip $_cntlInfo($this-$column-tip)
1233	}
1234
1235	switch -- $role {
1236	label {
1237	if {$column ne $_active} {
1238	append tip "\n\nClick to activate this control."
1239	}
1240	}
1241	dial {
1242	append tip "\n\nClick to change the value of this parameter."
1243	}
1244	all {
1245	if {$label eq ""} {
1246	set tip "Plot all values for this quantity."
1247	} else {
1248	set tip "Plot all values for $label."
1249	}
1250	if {$_plotall} {
1251	set what "all values"
1252	} else {
1253	set what "one value"
1254	}
1255	append tip "\n\nCurrently, plotting $what. Click to toggle."
1256	}
1257	}
1258	return [string trim $tip]
1259	}
1260
1261	# ----------------------------------------------------------------------
1262	# USAGE: _getParamDesc <which> ?<xmlobj>?
1263	#
1264	# Used internally to build a descripton of parameters for the data
1265	# tuple for the specified <xmlobj>. This is passed on to the underlying
1266	# results viewer, so it will know what data is being viewed.
1267	# ----------------------------------------------------------------------
1268	itcl::body Rappture::ResultSelector::_getParamDesc {which {xmlobj "current"}} {
1269	if {$_resultset eq ""} {
1270	return ""
1271	}
1272
1273	if {$xmlobj eq "current"} {
1274	# search for the result for these settings
1275	set format ""
1276	set tuple ""
1277	foreach col [lrange [$_resultset diff names] 2 end] {
1278	lappend format $col
1279	lappend tuple $_cntlInfo($this-$col-value)
1280	}
1281	set xmlobj [$_resultset find $format $tuple]
1282	if {$xmlobj eq ""} {
1283	return "" ;# somethings wrong -- bail out!
1284	}
1285	}
1286
1287	switch -- $which {
1288	active {
1289	if {$_active eq ""} {
1290	return ""
1291	}
1292	}
1293	all {
1294	set desc ""
1295	foreach col [lrange [$_resultset diff names] 1 end] {
1296	set quantity $_cntlInfo($this-$col-label)
1297	set val [lindex [$_resultset get $col $xmlobj] 0]
1298	append desc "$quantity = $val\n"
1299	}
1300	return [string trim $desc]
1301	}
1302	default {
1303	error "bad value \"$which\": should be active or all"
1304	}
1305	}
1306	}
1307
1308	# ----------------------------------------------------------------------
1309	# USAGE: _log <col>
1310	#
1311	# Used internally to log the event when a user switches to a different
1312	# result in the result selector.
1313	# ----------------------------------------------------------------------
1314	itcl::body Rappture::ResultSelector::_log {col} {
1315	Rappture::Logger::log result -select $col $_cntlInfo($this-$col-value)
1316	}
1317
1318	# ----------------------------------------------------------------------
1319	# OPTION: -resultset
1320	# ----------------------------------------------------------------------
1321	itcl::configbody Rappture::ResultSelector::resultset {
1322	set obj $itk_option(-resultset)
1323	if {$obj ne ""} {
1324	if {[catch {$obj isa ::Rappture::ResultSet} valid] \|\| !$valid} {
1325	error "bad value \"$obj\": should be Rappture::ResultSet object"
1326	}
1327	}
1328
1329	# disconnect the existing ResultSet and install the new one
1330	if {$_resultset ne ""} {
1331	$_resultset notify remove $this
1332	_fixControls op clear
1333	}
1334	set _resultset $obj
1335
1336	if {$_resultset ne ""} {
1337	$_resultset notify add $this !change \
1338	[itcl::code $this _fixControls]
1339	}
1340
1341	_fixControls op add
1342	activate simnum
1343	}
1344
1345	# ----------------------------------------------------------------------
1346	# OPTION: -activecontrolbackground
1347	# ----------------------------------------------------------------------
1348	itcl::configbody Rappture::ResultSelector::activecontrolbackground {
1349	$_dispatcher event -idle !layout
1350	}
1351
1352	# ----------------------------------------------------------------------
1353	# OPTION: -activecontrolforeground
1354	# ----------------------------------------------------------------------
1355	itcl::configbody Rappture::ResultSelector::activecontrolforeground {
1356	$_dispatcher event -idle !layout
1357	}
1358

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

Download in other formats: