source: branches/blt4/gui/scripts/resultset.tcl @ 2287

Last change on this file since 2287 was 2048, checked in by gah, 13 years ago

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