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

Last change on this file since 1399 was 1399, checked in by gah, 16 years ago

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