source: trunk/gui/scripts/resultset.tcl @ 3021

Last change on this file since 3021 was 2977, checked in by gah, 12 years ago

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