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

Last change on this file since 4187 was 3330, checked in by gah, 12 years ago

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