source: trunk/gui/scripts/resultselector.tcl @ 5157

Last change on this file since 5157 was 4672, checked in by ldelgass, 9 years ago

merge fix from release 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            set _cntlInfo($this-$_active-value) ""
468            activate simnum
469        }
470
471        # figure out where we were in the active control, and
472        # what value we should display now that this was deleted
473        if {[info exists params($_active)]} {
474            set current $params($_active)
475            if {$current eq [$shortlist.dial get -format label current]} {
476                # result deleted is the current result
477                set vlist [$shortlist.dial get]
478                set i [lsearch -exact $vlist $current]
479                if {$i >= 0} {
480                    if {$i+1 < [llength $vlist]} {
481                        set newControlValue [lindex $vlist [expr {$i+1}]]
482                    } elseif {$i-1 >= 0} {
483                        set newControlValue [lindex $vlist [expr {$i-1}]]
484                    }
485                }
486            }
487        }
488
489        if {[info exists newControlValue]} {
490            # Set the control to a value we were able to find.
491            # Disconnect the current variable, then plug in the
492            # new (legal) value, then reload the controls.
493            # This will trigger !settings and other adjustments.
494            $shortlist.dial configure -variable ""
495            set _cntlInfo($this-$_active-value) $newControlValue
496            _control load $shortlist.dial $_active
497        } else {
498            # if all else fails, show solution #1
499            set xmlobj0 [lindex [$_resultset find * *] 0]
500            set simnum0 [$_resultset get simnum $xmlobj0]
501            set _cntlInfo($this-simnum-value) $simnum0
502            activate simnum
503        }
504
505        # if clearing this dataset changed the controls, then
506        # fix the layout
507        set numcntls [expr {[llength [$_resultset diff names]]-1}]
508        if {$numcntls != $_layout(numcntls)} {
509            $_dispatcher event -idle !layout why data
510        }
511        return
512    }
513
514    # must have added something...
515    set shortlist $itk_component(dials)
516    grid columnconfigure $shortlist 1 -weight 1
517
518    #
519    # Scan through all columns in the data and create any
520    # controls that just appeared.
521    #
522    set nadded 0
523    foreach col [$_resultset diff names] {
524        if {$col eq "xmlobj"} {
525            continue  ;# never create a control for this column
526        }
527
528        #
529        # If this column doesn't have a control yet, then
530        # create one.
531        #
532        if {![info exists _cntlInfo($this-$col-id)]} {
533            set tip ""
534            if {$col eq "simnum"} {
535                set quantity "Simulation"
536                set tip "List of all simulations that you have performed so far."
537            } else {
538                # search for the first XML object with this element defined
539                foreach xmlobj [$_resultset find * *] {
540                    set quantity [$xmlobj get $col.about.label]
541                    set tip [$xmlobj get $col.about.description]
542                    if {"" != $quantity} {
543                        break
544                    }
545                }
546                if {"" == $quantity && "" != $xmlobj} {
547                    set quantity [$xmlobj element -as id $col]
548                }
549            }
550
551            # Create the controls for the "short list" area.
552            set fn $itk_option(-textfont)
553            set w $shortlist.label$_counter
554            set row [lindex [grid size $shortlist] 1]
555            frame $w
556            grid $w -row $row -column 1 -sticky ew
557            label $w.arrow -bitmap [Rappture::icon empty] -borderwidth 0
558            pack $w.arrow -side left -fill y
559            _control bind $w.arrow $col
560
561            label $w.name -text $quantity -anchor w \
562                -borderwidth 0 -padx 0 -pady 1 -font $fn
563            pack $w.name -side left
564            bind $w.name <Configure> [itcl::code $this _fixValue $col resize]
565            _control bind $w.name $col
566
567            label $w.value -anchor w \
568                -borderwidth 0 -padx 0 -pady 1 -font $fn
569            pack $w.value -side left
570            bind $w.value <Configure> [itcl::code $this _fixValue $col resize]
571            _control bind $w.value $col
572
573            Rappture::Tooltip::for $w \
574                "@[itcl::code $this _getTooltip label $col]"
575
576            # create a record for this control
577            lappend _cntlInfo($this-all) $col
578            set _cntlInfo($this-$col-id) $_counter
579            set _cntlInfo($this-$col-label) $quantity
580            set _cntlInfo($this-$col-tip) $tip
581            set _cntlInfo($this-$col-value) ""
582            set _cntlInfo($this-$col-usage) 0
583            set _cntlInfo($this-$col) ""
584
585            trace add variable _cntlInfo($this-$col-value) write \
586                "[itcl::code $this _fixValue $col value]; list"
587
588            incr _counter
589
590            incr nadded
591        }
592
593        #
594        # Determine the unique values for this column and load
595        # them into the control.
596        #
597        set id $_cntlInfo($this-$col-id)
598
599        if {$col == $_layout(active)} {
600            _control load $shortlist.dial $col
601        }
602    }
603
604    #
605    # Activate the most recent control.  If a bunch of controls
606    # were just added, then activate the "Simulation" control,
607    # since that's the easiest way to page through results.
608    #
609    set numcntls [expr {[llength [$_resultset diff names]]-1}]
610    if {$nadded > 0 || $numcntls != $_layout(numcntls)} {
611        if {$numcntls == 2 || $nadded == 1} {
612            activate [lindex [$_resultset diff names] end]
613        } else {
614            activate simnum
615        }
616
617        # fix the shortlist layout to show as many controls as we can
618        $_dispatcher event -idle !layout why data
619    }
620
621    #
622    # Set all controls to the settings of the most recent addition.
623    # Setting the value slot will trigger the !settings event, which
624    # will then fix all other controls to match the one that changed.
625    #
626    if {[info exists eventData(what)]} {
627        set xmlobj $eventData(what)
628        set simnum [$_resultset get simnum $xmlobj]
629        set _cntlInfo($this-simnum-value) $simnum
630    }
631}
632
633# ----------------------------------------------------------------------
634# USAGE: _fixLayout ?<eventArgs...>?
635#
636# Called automatically at the idle point after the controls have
637# changed, or the size of the window has changed.  Fixes the layout
638# so that the active control is displayed, and other recent controls
639# are shown above and/or below.  At the very least, we must show the
640# "more options..." control.
641# ----------------------------------------------------------------------
642itcl::body Rappture::ResultSelector::_fixLayout {args} {
643    array set eventdata $args
644
645    set shortlist $itk_component(dials)
646
647    # clear out the short list area
648    foreach w [grid slaves $shortlist] {
649        grid forget $w
650    }
651
652    # reset all labels back to an ordinary font/background
653    set fn $itk_option(-textfont)
654    set bg $itk_option(-background)
655    set fg $itk_option(-foreground)
656    foreach col $_cntlInfo($this-all) {
657        set id $_cntlInfo($this-$col-id)
658        $shortlist.label$id configure -background $bg
659        $shortlist.label$id.arrow configure -background $bg \
660            -bitmap [Rappture::icon empty]
661        $shortlist.label$id.name configure -font $fn -background $bg
662        $shortlist.label$id.value configure -background $bg
663    }
664
665    # only 1 result? then we don't need any controls
666    if {$_resultset eq "" || [$_resultset size] < 2} {
667        set _layout(active) $_active
668
669        # let clients know that the layout has changed
670        # so they can fix the overall size accordingly
671        if {![info exists eventdata(why)] || $eventdata(why) ne "resize"} {
672            event generate $itk_component(hull) <<Layout>>
673        }
674
675        return
676    }
677
678    # compute the number of controls that will fit in the shortlist area
679    set dials $itk_component(dials)
680    set h [winfo height $dials]
681    set normalLine [font metrics $itk_option(-textfont) -linespace]
682    set boldLine [font metrics $itk_option(-boldfont) -linespace]
683    set active [expr {$boldLine+[winfo reqheight $dials.dial]+4}]
684
685    if {$h < $active+$normalLine} {
686        # active control kinda big? then show parameter values only
687        set _layout(mode) abbreviated
688        set ncntls [expr {int(floor(double($h)/$normalLine))}]
689    } else {
690        set _layout(mode) usual
691        set ncntls [expr {int(floor(double($h-$active)/$normalLine))+1}]
692    }
693
694    # find the controls with the most usage
695    set order ""
696    foreach col [lrange [$_resultset diff names] 1 end] {
697        lappend order [list $col $_cntlInfo($this-$col-usage)]
698    }
699    set order [lsort -integer -decreasing -index 1 $order]
700
701    set mostUsed ""
702    if {[llength $order] <= $ncntls} {
703        # plenty of space? then show all controls
704        foreach item $order {
705            lappend mostUsed [lindex $item 0]
706        }
707    } else {
708        # otherwise, limit to the most-used controls
709        foreach item [lrange $order 0 [expr {$ncntls-1}]] {
710            lappend mostUsed [lindex $item 0]
711        }
712
713        # make sure the active control is included
714        if {"" != $_active && [lsearch -exact $mostUsed $_active] < 0} {
715            set mostUsed [lreplace [linsert $mostUsed 0 $_active] end end]
716        }
717
718        # if there are more controls, add the "more parameters..." entry
719        if {$ncntls >= 2} {
720            set mostUsed [lreplace $mostUsed end end @more]
721            set rest [expr {[llength $order]-($ncntls-1)}]
722            if {$rest == 1} {
723                $dials.labelmore.name configure -text "1 more parameter..."
724            } else {
725                $dials.labelmore.name configure -text "$rest more parameters..."
726            }
727        }
728    }
729
730    # show controls associated with diffs and put up the radiodial
731    # for the "active" column
732    set row 0
733    foreach col [concat [lrange [$_resultset diff names] 1 end] @more] {
734        # this control not on the short list? then ignore it
735        if {[lsearch $mostUsed $col] < 0} {
736            continue
737        }
738
739        if {[string index $col 0] == "@"} {
740            set id [string range $col 1 end]
741        } else {
742            set id $_cntlInfo($this-$col-id)
743        }
744        grid $shortlist.label$id -row $row -column 1 -sticky ew -padx 4
745
746        if {$col == $_active} {
747            if {$_layout(mode) == "usual"} {
748                # put the background behind the active control in the shortlist
749                grid $shortlist.bg -row $row -rowspan 2 \
750                    -column 0 -columnspan 2 -sticky nsew
751                lower $shortlist.bg
752
753                # place the All and dial in the shortlist area
754                grid $shortlist.all -row $row -rowspan 2 -column 0 \
755                    -sticky nsew -padx 2 -pady 2
756                grid $shortlist.dial -row [expr {$row+1}] -column 1 \
757                    -sticky ew -padx 4
758                incr row
759
760                if {$_layout(active) != $_active} {
761                    $shortlist.dial configure -variable ""
762                    _control load $shortlist.dial $col
763                    $shortlist.dial configure -variable \
764                      "::Rappture::ResultSelector::_cntlInfo($this-$col-value)"
765                    set _layout(active) $_active
766                }
767            }
768        }
769        incr row
770    }
771
772    # highlight the active control
773    if {[info exists _cntlInfo($this-$_active-id)]} {
774        set id $_cntlInfo($this-$_active-id)
775        set bf $itk_option(-boldfont)
776        set fg $itk_option(-activecontrolforeground)
777        set bg $itk_option(-activecontrolbackground)
778
779        if {$_layout(mode) == "usual"} {
780            $shortlist.label$id configure -background $bg
781            $shortlist.label$id.arrow configure -foreground $fg \
782                -background $bg -bitmap [Rappture::icon rarrow]
783            $shortlist.label$id.name configure -foreground $fg \
784                -background $bg -font $bf
785            $shortlist.label$id.value configure -foreground $fg \
786                -background $bg
787            $shortlist.dial configure -background $bg
788            $shortlist.bg configure -background $bg
789
790            if {[$shortlist.all cget -relief] == "raised"} {
791                $shortlist.all configure -foreground $fg -background $bg
792            }
793        }
794    }
795
796    # let clients know that the layout has changed
797    # so they can fix the overall size accordingly
798    if {![info exists eventdata(why)] || $eventdata(why) ne "resize"} {
799        event generate $itk_component(hull) <<Layout>>
800    }
801}
802
803# ----------------------------------------------------------------------
804# USAGE: _fixNumResults
805#
806# Used internally to update the number of results displayed near the
807# top of this widget.  If there is only 1 result, then there is also
808# a single "Clear" button.  If there are no results, the clear button
809# is diabled.
810# ----------------------------------------------------------------------
811itcl::body Rappture::ResultSelector::_fixNumResults {} {
812    set size 0
813    if {$_resultset ne ""} {
814        set size [$_resultset size]
815    }
816
817    switch $size {
818        0 {
819            $itk_component(status) configure -text "No results"
820            $itk_component(clearall) configure -state disabled -text "Clear"
821            pack forget $itk_component(clear)
822        }
823        1 {
824            $itk_component(status) configure -text "1 result"
825            $itk_component(clearall) configure -state normal -text "Clear"
826            pack forget $itk_component(clear)
827        }
828        default {
829            $itk_component(status) configure -text "$size results"
830            $itk_component(clearall) configure -state normal -text "Clear All"
831            $itk_component(clear) configure -state normal
832            pack $itk_component(clear) -side right \
833                -after $itk_component(clearall) -padx {0 6}
834        }
835    }
836}
837
838# ----------------------------------------------------------------------
839# USAGE: _fixSettings ?<eventArgs...>?
840#
841# Called automatically at the idle point after a control has changed
842# to load new data into the plotting area at the top of this result
843# set.  Extracts the current tuple of control values from the control
844# area, then finds the corresponding data values.  Loads the data
845# by invoking a -settingscommand callback with parameters that
846# describe what data should be plotted.
847# ----------------------------------------------------------------------
848itcl::body Rappture::ResultSelector::_fixSettings {args} {
849    array set eventdata $args
850    if {[info exists eventdata(column)]} {
851        set changed $eventdata(column)
852    } else {
853        set changed ""
854    }
855
856    if {[info exists _cntlInfo($this-$_active-label)]} {
857        lappend params $_cntlInfo($this-$_active-label)
858    } else {
859        lappend params "???"
860    }
861    if {$_active == ""} {
862        return   ;# nothing active -- don't do anything
863    }
864    eval lappend params [_getValues $_active all]
865
866    if {$_resultset eq "" || [$_resultset size] == 0} {
867        # no data? then do nothing
868        return
869    } elseif {[$_resultset size] == 1} {
870        # only one data set? then plot it
871        set xmlobj [$_resultset find * *]
872        set simnum [lindex [$_resultset get simnum $xmlobj] 0]
873
874        _doSettings [list \
875            $simnum [list -width 2 \
876                    -param [_getValues $_active current] \
877                    -description [_getParamDesc all] \
878              ] \
879            params $params \
880        ]
881        return
882    }
883
884    #
885    # Find the selected run.  If the run setting changed, then
886    # look at its current value.  Otherwise, search the results
887    # for a tuple that matches the current settings.
888    #
889    if {$changed == "xmlobj" || $changed == "simnum"} {
890        set xmlobj [$_resultset find simnum $_cntlInfo($this-simnum-value)]
891    } else {
892        set format ""
893        set tuple ""
894        foreach col [lrange [$_resultset diff names] 2 end] {
895            lappend format $col
896            lappend tuple $_cntlInfo($this-$col-value)
897        }
898        set xmlobj [lindex [$_resultset find $format $tuple] 0]
899
900        if {$xmlobj eq "" && $changed ne ""} {
901            #
902            # No data for these settings.  Try leaving the next
903            # column open, then the next, and so forth, until
904            # we find some data.
905            #
906            # allcols:  foo bar baz qux
907            #               ^^^changed
908            #
909            # search:   baz qux foo
910            #
911            set val $_cntlInfo($this-$changed-value)
912            set allcols [lrange [$_resultset diff names] 2 end]
913            set i [lsearch -exact $allcols $changed]
914            set search [concat \
915                [lrange $allcols [expr {$i+1}] end] \
916                [lrange $allcols 0 [expr {$i-1}]] \
917            ]
918            set nsearch [llength $search]
919
920            for {set i 0} {$i < $nsearch} {incr i} {
921                set format $changed
922                set tuple [list $val]
923                for {set j [expr {$i+1}]} {$j < $nsearch} {incr j} {
924                    set col [lindex $search $j]
925                    lappend format $col
926                    lappend tuple $_cntlInfo($this-$col-value)
927                }
928                set xmlobj [lindex [$_resultset find $format $tuple] 0]
929                if {$xmlobj ne ""} {
930                    break
931                }
932            }
933        }
934    }
935
936    #
937    # If we found a particular run, then load its values into all
938    # controls.
939    #
940    if {$xmlobj ne ""} {
941        # stop reacting to value changes
942        set _settings 1
943
944        set format [lrange [$_resultset diff names] 2 end]
945        if {[llength $format] == 1} {
946            set data [list [$_resultset get $format $xmlobj]]
947        } else {
948            set data [$_resultset get $format $xmlobj]
949        }
950
951        foreach col $format val $data {
952            set _cntlInfo($this-$col-value) $val
953        }
954
955        set simnum [$_resultset get simnum $xmlobj]
956        set _cntlInfo($this-simnum-value) $simnum
957
958        # okay, react to value changes again
959        set _settings 0
960    }
961
962    #
963    # Search for tuples matching the current setting and
964    # plot them.
965    #
966    if {$_plotall && $_active eq "simnum"} {
967        set format ""
968    } else {
969        set format ""
970        set tuple ""
971        foreach col [lrange [$_resultset diff names] 2 end] {
972            if {!$_plotall || $col ne $_active} {
973                lappend format $col
974                lappend tuple $_cntlInfo($this-$col-value)
975            }
976        }
977    }
978
979    if {$format ne ""} {
980        set xolist [$_resultset find $format $tuple]
981    } else {
982        set xolist [$_resultset find * *]
983    }
984
985    if {[llength $xolist] > 0} {
986        # search for the result for these settings
987        set format ""
988        set tuple ""
989        foreach col [lrange [$_resultset diff names] 2 end] {
990            lappend format $col
991            lappend tuple $_cntlInfo($this-$col-value)
992        }
993        set curr [$_resultset find $format $tuple]
994
995        if {[llength $xolist] == 1} {
996            # single result -- always use active color
997            set xmlobj [lindex $xolist 0]
998            set simnum [$_resultset get simnum $xmlobj]
999            set plist [list \
1000                $simnum [list -width 2 \
1001                         -param [_getValues $_active $xmlobj] \
1002                         -description [_getParamDesc all $xmlobj] \
1003                   ] \
1004                params $params \
1005            ]
1006        } else {
1007            #
1008            # Get the color for all points according to
1009            # the color spectrum.
1010            #
1011            set plist [list params $params]
1012            foreach xmlobj $xolist {
1013                set simnum [$_resultset get simnum $xmlobj]
1014                if {$xmlobj eq $curr} {
1015                    lappend plist $simnum [list -width 3 -raise 1 \
1016                        -param [_getValues $_active $xmlobj] \
1017                        -description [_getParamDesc all $xmlobj]]
1018                } else {
1019                    lappend plist $simnum [list -brightness 0.7 -width 1 \
1020                        -param [_getValues $_active $xmlobj] \
1021                        -description [_getParamDesc all $xmlobj]]
1022                }
1023            }
1024        }
1025
1026        #
1027        # Load up the matching plots
1028        #
1029        _doSettings $plist
1030    }
1031}
1032
1033# ----------------------------------------------------------------------
1034# USAGE: _fixValue <columnName> <why>
1035#
1036# Called automatically whenver a value for a parameter dial changes.
1037# Updates the interface to display the new value.  The <why> is a
1038# reason for the change, which may be "resize" (draw old value in
1039# new size) or "value" (value changed).
1040# ----------------------------------------------------------------------
1041itcl::body Rappture::ResultSelector::_fixValue {col why} {
1042    if {[info exists _cntlInfo($this-$col-id)]} {
1043        set id $_cntlInfo($this-$col-id)
1044
1045        set widget $itk_component(dials).label$id
1046        set wmax [winfo width $itk_component(dials).dial]
1047        if {$wmax <= 1} {
1048            set wmax [expr {round(0.9*[winfo width $itk_component(cntls)])}]
1049        }
1050        _drawValue $col $widget $wmax
1051
1052        if {$why == "value" && !$_settings} {
1053            # keep track of usage, so we know which controls are popular
1054            incr _cntlInfo($this-$col-usage)
1055
1056            # adjust the settings according to the value in the column
1057            $_dispatcher event -idle !settings column $col
1058        }
1059    }
1060}
1061
1062# ----------------------------------------------------------------------
1063# USAGE: _drawValue <columnName> <widget> <widthMax>
1064#
1065# Used internally to fix the rendering of a "quantity = value" display.
1066# If the name/value in <widget> are smaller than <widthMax>, then the
1067# full "quantity = value" string is displayed.  Otherwise, an
1068# abbreviated form is displayed.
1069# ----------------------------------------------------------------------
1070itcl::body Rappture::ResultSelector::_drawValue {col widget wmax} {
1071    set quantity $_cntlInfo($this-$col-label)
1072    regsub -all {\n} $quantity " " quantity  ;# take out newlines
1073
1074    set newval $_cntlInfo($this-$col-value)
1075    regsub -all {\n} $newval " " newval  ;# take out newlines
1076
1077    set lfont [$widget.name cget -font]
1078    set vfont [$widget.value cget -font]
1079
1080    set wn [font measure $lfont $quantity]
1081    set wv [font measure $lfont " = $newval"]
1082    set w [expr {$wn + $wv}]
1083
1084    if {$w <= $wmax} {
1085        # if the text fits, then shown "quantity = value"
1086        $widget.name configure -text $quantity
1087        $widget.value configure -text " = $newval"
1088    } else {
1089        # Otherwise, we'll have to appreviate.
1090        # If the value is really long, then just show a little bit
1091        # of it.  Otherwise, show as much of the value as we can.
1092        if {[string length $newval] > 30} {
1093            set frac 0.8
1094        } else {
1095            set frac 0.2
1096        }
1097        set wNameSpace [expr {round($frac*$wmax)}]
1098        set wValueSpace [expr {$wmax-$wNameSpace}]
1099
1100        # fit as much of the "quantity" label in the space available
1101        if {$wn < $wNameSpace} {
1102            $widget.name configure -text $quantity
1103            set wValueSpace [expr {$wmax-$wn}]
1104        } else {
1105            set wDots [font measure $lfont "..."]
1106            set wchar [expr {double($wn)/[string length $quantity]}]
1107            while {1} {
1108                # figure out a good size for the abbreviated string
1109                set cmax [expr {round(($wNameSpace-$wDots)/$wchar)}]
1110                if {$cmax < 0} {set cmax 0}
1111                set str "[string range $quantity 0 $cmax]..."
1112                if {[font measure $lfont $str] <= $wNameSpace
1113                      || $wDots >= $wNameSpace} {
1114                    break
1115                }
1116                # we're measuring with average chars, so we may have
1117                # to shave a little off and do this again
1118                set wDots [expr {$wDots+2*$wchar}]
1119            }
1120            $widget.name configure -text $str
1121            set wValueSpace [expr {$wmax-[font measure $lfont $str]}]
1122        }
1123
1124        if {$wv < $wValueSpace} {
1125            $widget.value configure -text " = $newval"
1126        } else {
1127            set wDots [font measure $vfont "..."]
1128            set wEq [font measure $vfont " = "]
1129            set wchar [expr {double($wv)/[string length " = $newval"]}]
1130            while {1} {
1131                # figure out a good size for the abbreviated string
1132                set cmax [expr {round(($wValueSpace-$wDots-$wEq)/$wchar)}]
1133                if {$cmax < 0} {set cmax 0}
1134                set str " = [string range $newval 0 $cmax]..."
1135                if {[font measure $vfont $str] <= $wValueSpace
1136                      || $wDots >= $wValueSpace} {
1137                    break
1138                }
1139                # we're measuring with average chars, so we may have
1140                # to shave a little off and do this again
1141                set wDots [expr {$wDots+2*$wchar}]
1142            }
1143            $widget.value configure -text $str
1144        }
1145    }
1146}
1147
1148# ----------------------------------------------------------------------
1149# USAGE: _toggleAll ?<columnName>?
1150#
1151# Called automatically whenever the user clicks on an "All" button.
1152# Toggles the button between its on/off states.  In the "on" state,
1153# all results associated with the current control are sent to the
1154# result viewer.
1155# ----------------------------------------------------------------------
1156itcl::body Rappture::ResultSelector::_toggleAll {{col "current"}} {
1157    if {$col == "current"} {
1158        set col $_active
1159    }
1160    if {![info exists _cntlInfo($this-$col-id)]} {
1161        return
1162    }
1163    set id $_cntlInfo($this-$col-id)
1164    set sbutton $itk_component(dials).all
1165    set current [$sbutton cget -relief]
1166
1167    if {$current == "sunken"} {
1168        $sbutton configure -relief raised \
1169            -background $itk_option(-activecontrolbackground) \
1170            -foreground $itk_option(-activecontrolforeground)
1171        set _plotall 0
1172        Rappture::Logger::log result -all off
1173    } else {
1174        $sbutton configure -relief sunken \
1175            -background $itk_option(-togglebackground) \
1176            -foreground $itk_option(-toggleforeground)
1177        set _plotall 1
1178        Rappture::Logger::log result -all on
1179
1180        if {$col != $_active} {
1181            # clicked on an inactive "All" button? then activate that column
1182            activate $col
1183        }
1184    }
1185    $_dispatcher event -idle !settings
1186}
1187
1188# ----------------------------------------------------------------------
1189# USAGE: _getValues <column> ?<which>?
1190#
1191# Returns one or more value names associated with the given <column>.
1192# If the <which> parameter is "all", then it returns values for all
1193# results in the ResultSet.  Each value appears as two values in the
1194# flattened list: the normalized value and the value label.  If the
1195# <which> parameter is "current"
1196# ----------------------------------------------------------------------
1197itcl::body Rappture::ResultSelector::_getValues {col {which "all"}} {
1198    switch -- $which {
1199        current {
1200            set simnum $_cntlInfo($this-simnum-value)
1201            set xmlobj [$_resultset find simnum $simnum]
1202            if {$xmlobj ne ""} {
1203                return [$_resultset diff values $col $xmlobj]
1204            }
1205            return ""
1206        }
1207        all {
1208            return [$_resultset diff values $col all]
1209        }
1210        default {
1211            return [$_resultset diff values $col $which]
1212        }
1213    }
1214}
1215
1216# ----------------------------------------------------------------------
1217# USAGE: _getTooltip <role> <column>
1218#
1219# Called automatically whenever the user hovers on a control within
1220# this widget.  Returns the tooltip associated with the control.
1221# ----------------------------------------------------------------------
1222itcl::body Rappture::ResultSelector::_getTooltip {role column} {
1223    set label ""
1224    set tip ""
1225    if {$column eq "active"} {
1226        set column $_active
1227    }
1228    if {[info exists _cntlInfo($this-$column-label)]} {
1229        set label $_cntlInfo($this-$column-label)
1230    }
1231    if {[info exists _cntlInfo($this-$column-tip)]} {
1232        set tip $_cntlInfo($this-$column-tip)
1233    }
1234
1235    switch -- $role {
1236        label {
1237            if {$column ne $_active} {
1238                append tip "\n\nClick to activate this control."
1239            }
1240        }
1241        dial {
1242            append tip "\n\nClick to change the value of this parameter."
1243        }
1244        all {
1245            if {$label eq ""} {
1246                set tip "Plot all values for this quantity."
1247            } else {
1248                set tip "Plot all values for $label."
1249            }
1250            if {$_plotall} {
1251                set what "all values"
1252            } else {
1253                set what "one value"
1254            }
1255            append tip "\n\nCurrently, plotting $what.  Click to toggle."
1256        }
1257    }
1258    return [string trim $tip]
1259}
1260
1261# ----------------------------------------------------------------------
1262# USAGE: _getParamDesc <which> ?<xmlobj>?
1263#
1264# Used internally to build a descripton of parameters for the data
1265# tuple for the specified <xmlobj>.  This is passed on to the underlying
1266# results viewer, so it will know what data is being viewed.
1267# ----------------------------------------------------------------------
1268itcl::body Rappture::ResultSelector::_getParamDesc {which {xmlobj "current"}} {
1269    if {$_resultset eq ""} {
1270        return ""
1271    }
1272
1273    if {$xmlobj eq "current"} {
1274        # search for the result for these settings
1275        set format ""
1276        set tuple ""
1277        foreach col [lrange [$_resultset diff names] 2 end] {
1278            lappend format $col
1279            lappend tuple $_cntlInfo($this-$col-value)
1280        }
1281        set xmlobj [$_resultset find $format $tuple]
1282        if {$xmlobj eq ""} {
1283            return ""  ;# somethings wrong -- bail out!
1284        }
1285    }
1286
1287    switch -- $which {
1288        active {
1289            if {$_active eq ""} {
1290                return ""
1291            }
1292        }
1293        all {
1294            set desc ""
1295            foreach col [lrange [$_resultset diff names] 1 end] {
1296                set quantity $_cntlInfo($this-$col-label)
1297                set val [$_resultset get $col $xmlobj]
1298                append desc "$quantity = $val\n"
1299            }
1300            return [string trim $desc]
1301        }
1302        default {
1303            error "bad value \"$which\": should be active or all"
1304        }
1305    }
1306}
1307
1308# ----------------------------------------------------------------------
1309# USAGE: _log <col>
1310#
1311# Used internally to log the event when a user switches to a different
1312# result in the result selector.
1313# ----------------------------------------------------------------------
1314itcl::body Rappture::ResultSelector::_log {col} {
1315    Rappture::Logger::log result -select $col $_cntlInfo($this-$col-value)
1316}
1317
1318# ----------------------------------------------------------------------
1319# OPTION: -resultset
1320# ----------------------------------------------------------------------
1321itcl::configbody Rappture::ResultSelector::resultset {
1322    set obj $itk_option(-resultset)
1323    if {$obj ne ""} {
1324        if {[catch {$obj isa ::Rappture::ResultSet} valid] || !$valid} {
1325            error "bad value \"$obj\": should be Rappture::ResultSet object"
1326        }
1327    }
1328
1329    # disconnect the existing ResultSet and install the new one
1330    if {$_resultset ne ""} {
1331        $_resultset notify remove $this
1332        _fixControls op clear
1333    }
1334    set _resultset $obj
1335
1336    if {$_resultset ne ""} {
1337        $_resultset notify add $this !change \
1338            [itcl::code $this _fixControls]
1339    }
1340
1341    _fixControls op add
1342    activate simnum
1343}
1344
1345# ----------------------------------------------------------------------
1346# OPTION: -activecontrolbackground
1347# ----------------------------------------------------------------------
1348itcl::configbody Rappture::ResultSelector::activecontrolbackground {
1349    $_dispatcher event -idle !layout
1350}
1351
1352# ----------------------------------------------------------------------
1353# OPTION: -activecontrolforeground
1354# ----------------------------------------------------------------------
1355itcl::configbody Rappture::ResultSelector::activecontrolforeground {
1356    $_dispatcher event -idle !layout
1357}
1358
Note: See TracBrowser for help on using the repository browser.