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

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