Changeset 6021 for trunk/gui


Ignore:
Timestamp:
Feb 18, 2016 4:13:14 PM (8 years ago)
Author:
ldelgass
Message:

Merge UQ and fixes from 1.4 branch

Location:
trunk
Files:
13 edited
8 copied

Legend:

Unmodified
Added
Removed

  • trunk

  • trunk/gui/apps/rappture.use.in

    r4657 r6021  
    11
    22conflict RAPPTURE_CHOICE
     3
     4use -r -e anaconda-2.3.0
     5use -r -e puq-2.2.14
    36
    47desc "The Rappture tool environment (released version)."

  • trunk/gui/scripts/Makefile.in

    r5959 r6021  
    9494                $(srcdir)/periodictable.tcl \
    9595                $(srcdir)/postern.tcl \
     96                $(srcdir)/probdisteditor.tcl \
    9697                $(srcdir)/progress.tcl \
    9798                $(srcdir)/pushbutton.tcl \
    9899                $(srcdir)/radiodial.tcl \
    99100                $(srcdir)/resultset.tcl \
     101                $(srcdir)/response.tcl \
     102                $(srcdir)/responseviewer.tcl \
    100103                $(srcdir)/resultselector.tcl \
    101104                $(srcdir)/resultviewer.tcl \
    … …  
    121124                $(srcdir)/units.tcl \
    122125                $(srcdir)/utils.tcl \
     126                $(srcdir)/uq.tcl \
     127                $(srcdir)/uqcurve.tcl \
     128                $(srcdir)/uqinfo.tcl \
     129                $(srcdir)/uqnotebook.tcl \
    123130                $(srcdir)/valueresult.tcl \
    124131                $(srcdir)/videochooser.tcl \
    … …  
    157164                --outfile tclIndex
    158165
    159 install: all install_scripts install_images 
     166install: all install_scripts install_images
    160167
    161 install_scripts: 
     168install_scripts:
    162169        $(MKDIR_P) -m 0755 $(destdir)
    163170        @for i in $(FILES); do \
    164171            echo "Installing $$i" ; \
    165172            $(INSTALL) -m 0444 $$i $(destdir) ; \
    166         done 
     173        done
    167174        $(INSTALL) -m 0444 tclIndex $(destdir)
    168175
    … …  
    172179            echo "Installing $$i" ; \
    173180            $(INSTALL) -m 0444 $$i $(destdir)/images ; \
    174         done 
     181        done
    175182
    176183clean:

  • trunk/gui/scripts/analyzer.tcl

    r5880 r6021  
    7979    protected method _lammpsToSequence {xmlobj path id child data}
    8080    protected method _trajToSequence {xmlobj {path ""}}
     81    protected method _pop_uq_dialog {win}
     82    protected method _setWaitVariable {state}
     83    protected method _adjust_level {win}
    8184
    8285    private variable _tool ""          ;# belongs to this tool
    … …  
    9295    private variable _lastPlot
    9396    private common job                 ;# array var used for blt::bgexec jobs
     97    private variable _uq_active 0      ;# a UQ variables has been used
     98    private variable _wait_uq 0
    9499}
    95100
    … …  
    328333    }
    329334    pack $itk_component(resultpages) -expand yes -fill both
    330 
    331     set f [$itk_component(results) insert end -fraction 0.1]
     335   set f [$itk_component(results) insert end -fraction 0.1]
    332336    itk_component add resultselector {
    333337        Rappture::ResultSelector $f.rsel -resultset $_resultset \
    … …  
    395399# ----------------------------------------------------------------------
    396400itcl::body Rappture::Analyzer::simulate {args} {
    397     if {$args == "-ifneeded"} {
     401    #puts "simulate args='$args'"
     402
     403    set uq [$_tool get_uq -uq_type smolyak -uq_args 2]
     404
     405    # pop up UQ window
     406    if {[$uq num_runs] > 1} {
     407        set _uq_active 1
     408        set status [$uq run_dialog $itk_component(simulate)]
     409        if {$status == 0} {
     410            # cancelled
     411            return
     412        }
     413        lappend args -uq_type [$uq type]
     414        lappend args -uq_args [$uq args]
     415        # Need to put these UQ values into the driver file
     416        # so the call to resultset::contains will be correct.
     417        set _xml [$_tool xml object]
     418        $_xml put uq.type.current [$uq type]
     419        $_xml put uq.args.current [$uq args]
     420        $_xml put uq.args.about.label "level"
     421        $_xml put uq.args.about.description "Polynomial Degree of Smolyak GPC method."
     422    }
     423    #puts "simulate args=$args"
     424
     425    if {[lindex $args 0] == "-ifneeded"} {
    398426        # check to see if simulation is really needed
    399427        $_tool sync
    … …  
    404432            return
    405433        }
    406         set args ""
     434        set args [lreplace $args 0 0]
    407435    }
    408436
    … …  
    427455
    428456    # execute the job
     457    #puts "$_tool run $args"
     458
    429459    foreach {status result} [eval $_tool run $args] break
    430460
    … …  
    470500}
    471501
     502
    472503# ----------------------------------------------------------------------
    473504# USAGE: reset ?-eventually|-now?
    … …  
    515546        clear
    516547    }
     548    #puts "Analyzer::load"
    517549    $_resultset add $xmlobj
    518550
    … …  
    652684# ----------------------------------------------------------------------
    653685itcl::body Rappture::Analyzer::_plot {args} {
     686    #puts "analyzer::_plot"
    654687    set _plotlist $args
    655688
    … …  
    755788    } elseif {$page != ""} {
    756789        set _lastlabel $name
    757         set win [winfo toplevel $itk_component(hull)]
    758790        $itk_component(resultpages) current $page
    759791        set f [$itk_component(resultpages) page $page]
    760 
    761792        # We don't want to replot if we're using an existing viewer with the
    762793        # the same list of objects to plot.  So track the viewer and the list.
    763794        if { ![info exists _lastPlot($f)] || $_plotlist != $_lastPlot($f) } {
    764795            set _lastPlot($f) $_plotlist
     796            set win [winfo toplevel $itk_component(hull)]
    765797            blt::busy hold $win
     798            #puts "rviewer = $f.rviewer"
     799            #puts "_plotlist = $_plotlist"
    766800            $f.rviewer plot clear
    767801            eval $f.rviewer plot add $_plotlist
    768             blt::busy release [winfo toplevel $itk_component(hull)]
     802            blt::busy release $win
    769803        }
    770804        Rappture::Logger::log output $_label2item($name)
    … …  
    782816# ----------------------------------------------------------------------
    783817itcl::body Rappture::Analyzer::_fixResultSet {args} {
     818    #puts "Analyzer::_fixResultSet $args"
    784819    array set eventData $args
    785820    switch -- $eventData(op) {
    … …  
    794829            set haveresults 0
    795830            foreach item [_reorder [$xmlobj children output]] {
    796                 switch -glob -- $item {
    797                     log* {
    798                         _autoLabel $xmlobj output.$item "Output Log" counters
    799                     }
    800                     number* {
    801                         _autoLabel $xmlobj output.$item "Number" counters
    802                     }
    803                     integer* {
    804                         _autoLabel $xmlobj output.$item "Integer" counters
    805                     }
    806                     mesh* {
    807                         _autoLabel $xmlobj output.$item "Mesh" counters
    808                     }
    809                     string* {
    810                         _autoLabel $xmlobj output.$item "String" counters
    811                     }
    812                     histogram* - curve* - field* {
    813                         _autoLabel $xmlobj output.$item "Plot" counters
    814                     }
    815                     map* {
    816                         _autoLabel $xmlobj output.$item "Map" counters
    817                     }
    818                     drawing* {
    819                         _autoLabel $xmlobj output.$item "Drawing" counters
    820                     }
    821                     structure* {
    822                         _autoLabel $xmlobj output.$item "Structure" counters
    823                     }
    824                     table* {
    825                         _autoLabel $xmlobj output.$item "Energy Levels" counters
    826                     }
    827                     sequence* {
    828                         _autoLabel $xmlobj output.$item "Sequence" counters
     831                if {[$xmlobj get output.$item.about.uqtype] == ""} {
     832                    switch -glob -- $item {
     833                        log* {
     834                            _autoLabel $xmlobj output.$item "Output Log" counters
     835                        }
     836                        number* {
     837                            _autoLabel $xmlobj output.$item "Number" counters
     838                        }
     839                        integer* {
     840                            _autoLabel $xmlobj output.$item "Integer" counters
     841                        }
     842                        mesh* {
     843                            _autoLabel $xmlobj output.$item "Mesh" counters
     844                        }
     845                        string* {
     846                            _autoLabel $xmlobj output.$item "String" counters
     847                        }
     848                        histogram* - curve* - field* {
     849                            _autoLabel $xmlobj output.$item "Plot" counters
     850                        }
     851                        drawing* {
     852                            _autoLabel $xmlobj output.$item "Drawing" counters
     853                        }
     854                        structure* {
     855                            _autoLabel $xmlobj output.$item "Structure" counters
     856                        }
     857                        table* {
     858                            _autoLabel $xmlobj output.$item "Energy Levels" counters
     859                        }
     860                        sequence* {
     861                            _autoLabel $xmlobj output.$item "Sequence" counters
     862                        }
    829863                    }
    830864                }
    … …  
    853887                    }
    854888                    set hidden [$xmlobj get output.$item.hide]
    855                     if { $hidden == "" } {
     889                    if {$hidden == ""} {
    856890                        set hidden 0
    857891                    }
    858892                    if {"" != $label && !$hidden} {
     893                        set uq_part [$xmlobj get output.$item.about.uqtype]
     894
     895                        #puts "label=$label uq_part=$uq_part"
     896
    859897                        if {![info exists _label2page($label)]} {
     898                            #puts "Adding label: '$label'"
    860899                            set name "page[incr _pages]"
     900                            #puts "Inserting $name into resultpages"
    861901                            set page [$itk_component(resultpages) \
    862902                                insert end $name]
    … …  
    884924                            set reset($page) 1
    885925                        }
    886                         $page.rviewer add $index $xmlobj output.$item
     926                        $page.rviewer add $index $xmlobj output.$item $label $uq_part
    887927                    }
    888928                }
    … …  
    10371077        configure -simcontrolcolor $simcbg
    10381078
    1039         $itk_component(simulate) configure -state disabled
     1079        if {$_uq_active == 0} {
     1080            $itk_component(simulate) configure -state disabled
     1081        }
    10401082        $itk_component(abort) configure -state normal
    10411083
    … …  
    10651107    # Scan through and pick out any =RAPPTURE-PROGRESS=> messages first.
    10661108    #
     1109
    10671110    while {[regexp -indices \
    10681111               {=RAPPTURE-PROGRESS=> *([-+]?[0-9]+) +([^\n]*)(\n|$)} $message \
    … …  
    10801123        foreach {i0 i1} $match break
    10811124        set message [string replace $message $i0 $i1]
     1125    }
     1126
     1127    #
     1128    # Now handle SUBMIT-PROGRESS
     1129    #
     1130    while {[regexp -indices {=SUBMIT-PROGRESS=> aborted=([0-9]+) finished=([0-9]+) failed=([0-9]+) executing=([0-9]+)\
     1131        waiting=([0-9]+) setting_up=([0-9]+) setup=([0-9]+) %done=([0-9.]+) timestamp=([0-9.]+)(\n|$)} $message \
     1132        match aborted finished failed executing waiting setting_up setup percent ts mesg]} {
     1133
     1134        set mesg ""
     1135        foreach {i0 i1} $percent break
     1136        set percent [string range $message $i0 $i1]
     1137        foreach {i0 i1} $failed break
     1138        set failed [string range $message $i0 $i1]
     1139        foreach {i0 i1} $match break
     1140        set message [string replace $message $i0 $i1]
     1141
     1142        if {$failed != 0} {set mesg "$failed jobs failed!"}
     1143        if {$percent >= 100} { set mesg "Jobs finished.  Analyzing results..."}
     1144
     1145        pack $itk_component(progress) -fill x -padx 10 -pady 10
     1146        $itk_component(progress) settings -percent $percent -message $mesg
    10821147    }
    10831148

  • trunk/gui/scripts/gauge.tcl

    r5659 r6021  
    4242    itk_option define -sampleheight sampleHeight SampleHeight 0
    4343    itk_option define -log log Log ""
     44    itk_option define -varname varname Varname ""
     45    itk_option define -label label Label ""
    4446    itk_option define -validatecommand validateCommand ValidateCommand ""
     47    itk_option define -uq uq Uq no
    4548
    4649    constructor {args} { # defined below }
    … …  
    5760    protected method _layout {}
    5861    protected method _log {event args}
     62    protected method _change_param_type {choice}
     63    protected method _pop_uq {win}
     64    protected method _pop_uq_deactivate {}
    5965
    6066    private variable _value 0  ;# value for this widget
     67    private variable _mode exact ;# current mode
     68    private variable _pde ""   ;# ProbDistEditor
     69    private variable _val ""   ;# value choice combobox
     70    private variable uq no
    6171
    6272    blt::bitmap define GaugeArrow {
    … …  
    7787# ----------------------------------------------------------------------
    7888itcl::body Rappture::Gauge::constructor {args} {
     89    # puts "GAUGE CONS: $args"
     90    array set attrs $args
     91
    7992    itk_option remove hull.borderwidth hull.relief
    8093    component hull configure -borderwidth 0
    … …  
    90103    bind $itk_component(icon) <Configure> [itcl::code $this _redraw]
    91104
     105    if {[info exists attrs(-uq)]} {
     106        set uq $attrs(-uq)
     107        if {[string is true $uq]} {
     108            set uq 1
     109            itk_component add uq {
     110                button $itk_interior.uq -image [Rappture::icon UQ] \
     111                    -command [itcl::code $this _pop_uq $itk_interior]
     112            }
     113            pack $itk_component(uq) -side right -padx 10
     114        } else {
     115            set uq 0
     116        }
     117    } else {
     118        set uq 0
     119    }
     120
    92121    itk_component add -protected vframe {
    93122        frame $itk_interior.vframe
    … …  
    97126
    98127    itk_component add value {
    99         label $itk_component(vframe).value -width 7 \
     128        label $itk_component(vframe).value -width 20 \
    100129            -borderwidth 1 -relief flat -textvariable [itcl::scope _value]
    101130    } {
    … …  
    199228# ----------------------------------------------------------------------
    200229itcl::body Rappture::Gauge::value {args} {
    201     set onlycheck 0
     230    #puts "Gauge value: $args"
     231
     232    # Query.  Just return the current value.
     233    if {[llength $args] == 0} {
     234        return $_value
     235    }
     236
    202237    set i [lsearch -exact $args -check]
    203238    if {$i >= 0} {
    204239        set onlycheck 1
    205240        set args [lreplace $args $i $i]
    206     }
    207 
    208     if {[llength $args] == 1} {
    209         #
    210         # If this gauge has -units, try to convert the incoming
    211         # value to that system of units.  Also, make sure that
    212         # the value is bound by any min/max value constraints.
    213         #
    214         # Keep track of the inputted units so we can give a
    215         # response about min and max values in familiar units.
    216         #
    217         set newval [set nv [string trim [lindex $args 0]]]
    218         set units $itk_option(-units)
    219         if {"" != $units} {
    220             set newval [Rappture::Units::convert $newval -context $units]
    221             set nvUnits [Rappture::Units::Search::for $newval]
    222             if { "" == $nvUnits} {
    223                 set msg [Rappture::Units::description $units]
    224                 error "unrecognized units in value \"$newval\": should be value with units of $msg"
    225             }
    226             set nv [Rappture::Units::convert $nv \
    227                 -context $units -to $units -units off]
    228 
    229             # Normalize the units name
    230             set newval [Rappture::Units::convert $newval -units off]$nvUnits
    231         }
    232 
    233         switch -- $itk_option(-type) {
    234             integer {
    235                 if { [scan $nv "%g" value] != 1 || int($nv) != $value } {
    236                     error "bad value \"$nv\": should be an integer value"
    237                 }
    238             }
    239             real {
    240                 # "scan" will reject the number if the string is "NaN" or
    241                 # "Inf" or the empty string.  It also is accepts large numbers
    242                 # (e.g. 111111111111111111111) that "string is double"
    243                 # rejects.  The problem with "scan" is that it doesn't care if
    244                 # there are extra characters trailing the number (eg. "123a").
    245                 # The extra %s substitution is used to detect this case.
    246                 if { [scan $nv "%g%s" dummy1 dummy2] != 1 } {
    247                     error "bad value \"$nv\": should be a real number"
    248                 }
    249             }
    250         }
    251 
    252         if {"" != $itk_option(-minvalue)} {
    253             set convMinVal [set minv $itk_option(-minvalue)]
    254             if {"" != $units} {
    255                 set minv [Rappture::Units::convert $minv \
    256                     -context $units -to $units -units off]
    257                 set convMinVal [Rappture::Units::convert \
    258                     $itk_option(-minvalue) -context $units -to $nvUnits]
    259             } else {
    260                 set newval [format "%g" $newval]
    261             }
    262 
    263             # fix for the case when the user tries to
    264             # compare values like minv=-500 nv=-0600
    265             set nv [format "%g" $nv]
    266             set minv [format "%g" $minv]
    267 
    268             if {$nv < $minv} {
    269                 error "minimum value allowed here is $convMinVal"
    270             }
    271         }
    272 
    273         if {"" != $itk_option(-maxvalue)} {
    274             set convMaxVal [set maxv $itk_option(-maxvalue)]
    275             if {"" != $units} {
    276                 set maxv [Rappture::Units::convert $maxv \
    277                     -context $units -to $units -units off]
    278                 set convMaxVal [Rappture::Units::convert \
    279                     $itk_option(-maxvalue) -context $units -to $nvUnits]
    280             } else {
    281                 set newval [format "%g" $newval]
    282             }
    283 
    284             # fix for the case when the user tries to
    285             # compare values like maxv=500 nv=0600
    286             set nv [format "%g" $nv]
    287             set maxv [format "%g" $maxv]
    288 
    289             if {$nv > $maxv} {
    290                 error "maximum value allowed here is $convMaxVal"
    291             }
    292         }
    293 
    294         #
    295         # If there's a -validatecommand option, then invoke the code
    296         # now to check the new value.
    297         #
    298         if {[string length $itk_option(-validatecommand)] > 0} {
    299             set cmd "uplevel #0 [list $itk_option(-validatecommand) [list $newval]]"
    300             set result [eval $cmd]
    301         }
    302 
    303         if {$onlycheck} {
    304             return
    305         }
    306 
    307         set _value $newval
    308 
    309         _redraw
    310         event generate $itk_component(hull) <<Value>>
    311 
    312     } elseif {[llength $args] != 0} {
     241    } else {
     242        set onlycheck 0
     243    }
     244
     245    if {[llength $args] != 1} {
    313246        error "wrong # args: should be \"value ?-check? ?newval?\""
     247    }
     248
     249    set newval [Rappture::Units::mcheck_range [lindex $args 0] \
     250    $itk_option(-minvalue) $itk_option(-maxvalue) $itk_option(-units)]
     251
     252    set newmode [lindex $newval 0]
     253    switch -- $newmode {
     254        uniform -
     255        gaussian {
     256            set _mode $newmode
     257        }
     258        exact -
     259        default {
     260            set _mode exact
     261        }
     262    }
     263
     264    switch -- $itk_option(-type) {
     265        integer {
     266            if { [scan $newval "%g" value] != 1 || int($newval) != $value } {
     267                error "bad value \"$newval\": should be an integer value"
     268            }
     269        }
     270    }
     271
     272    #
     273    # If there's a -validatecommand option, then invoke the code
     274    # now to check the new value.
     275    #
     276    if {[string length $itk_option(-validatecommand)] > 0} {
     277        set cmd "uplevel #0 [list $itk_option(-validatecommand) [list $newval]]"
     278        set result [eval $cmd]
     279    }
     280
     281    if {$onlycheck} {
     282        return
     283    }
     284
     285    set _value $newval
     286    $itk_component(value) configure -width [string length $_value]
     287    _redraw
     288    event generate $itk_component(hull) <<Value>>
     289
     290    if {"" != $_pde} {
     291        set val [$_val translate [$_val value]]
     292        $_val value $_mode
     293        $_pde value $_value
     294
    314295    }
    315296    return $_value
    … …  
    494475# ----------------------------------------------------------------------
    495476itcl::body Rappture::Gauge::_editor {option args} {
     477    # puts "Gauge::editor option=$option args=$args"
    496478    if {$itk_option(-state) == "disabled"} {
    497479        return  ;# disabled? then bail out here!
    … …  
    515497            }
    516498            set val [lindex $args 0]
    517 
    518499            if {[catch {value -check $val} result]} {
    519500                if {[regexp {allowed here is (.+)} $result match newval]} {
    … …  
    597578    }
    598579
     580    if {$itk_option(-type) != "integer" && $uq} {
     581        pack $itk_component(uq) -side right -padx 10
     582    }
     583
    599584    array set side2anchor {
    600585        left   e
    … …  
    744729    }
    745730}
     731
     732itcl::body Rappture::Gauge::_pop_uq {win} {
     733    # puts "min=$itk_option(-minvalue) max=$itk_option(-maxvalue) units=$itk_option(-units)"
     734    set varname $itk_option(-varname)
     735    set popup .pop_uq_$varname
     736    if { ![winfo exists $popup] } {
     737        Rappture::Balloon $popup -title $itk_option(-label)
     738        set inner [$popup component inner]
     739        frame $inner.type
     740        pack $inner.type -side top -fill x
     741        label $inner.type.l -text "Parameter Value:"
     742        pack $inner.type.l -side left
     743
     744        set _val [Rappture::Combobox $inner.type.val -width 20 -editable no]
     745        pack $_val -side left -expand yes -fill x
     746        $_val choices insert end exact "Exact Value"
     747        $_val choices insert end uniform "Uniform Distribution"
     748        $_val choices insert end gaussian "Gaussian Distribution"
     749        bind $_val <<Value>> [itcl::code $this _change_param_type $inner]
     750
     751        set _pde [Rappture::ProbDistEditor $inner.entry \
     752        $itk_option(-minvalue) $itk_option(-maxvalue) $itk_option(-units) $_value]
     753        $_val value $_mode
     754        $_pde value $_value
     755        pack $inner.entry -expand yes -fill both -pady {10 0}
     756
     757        $popup configure \
     758        -deactivatecommand [itcl::code $this _pop_uq_deactivate]
     759    }
     760    update
     761    $popup activate $win right
     762}
     763
     764itcl::body Rappture::Gauge::_pop_uq_deactivate {} {
     765    # puts "deactivate [$_pde value]"
     766    value [$_pde value]
     767}
     768
     769itcl::body Rappture::Gauge::_change_param_type {inner} {
     770    set val [$_val translate [$_val value]]
     771    $_pde mode $val
     772}

  • trunk/gui/scripts/main.tcl

    r5659 r6021  
    9797}
    9898
     99proc ReadToolParameters { numTries } {
     100    incr numTries -1
     101    if { $numTries < 0 } {
     102        return
     103    }
     104    global env
     105    set paramsFile $env(TOOL_PARAMETERS)
     106    if { ![file readable $paramsFile] } {
     107        after 500 ReadToolParmeters $numTries
     108        return
     109    }
     110    catch {
     111        set f [open $paramsFile "r"]
     112        set contents [read $f]
     113        close $f
     114        set pattern {^file\((.*)\):(.*)$}
     115        foreach line [split $contents "\n"] {
     116            if { [regexp $pattern $line match path rest] } {
     117                set ::Rappture::parameters($path) $rest
     118            }
     119        }
     120    }
     121}
     122
     123if { [info exists env(TOOL_PARAMETERS)] } {
     124    ReadToolParameters 10
     125}
     126
    99127set loadobjs {}
    100128foreach runfile $params(-load) {
    … …  
    163191set installdir [file normalize [file dirname $params(-tool)]]
    164192$xmlobj put tool.version.application.directory(tool) $installdir
    165 
    166193set tool [Rappture::Tool ::#auto $xmlobj $installdir]
    167194

  • trunk/gui/scripts/numberentry.tcl

    r5659 r6021  
    2525    public method label {}
    2626    public method tooltip {}
    27 
    2827    protected method _newValue {}
    2928
    … …  
    4342# ----------------------------------------------------------------------
    4443itcl::body Rappture::NumberEntry::constructor {owner path args} {
     44    set varname [lindex [split $path ()] end-1]
    4545    if {[catch {$owner isa Rappture::ControlOwner} valid] != 0 || !$valid} {
    4646        error "bad object \"$owner\": should be Rappture::ControlOwner"
    … …  
    6868    }
    6969
     70    # check for number UQ flag
     71    set use_uq [$_owner xml get $path.uq]
     72    if {$use_uq == ""} {
     73        # check for global UQ flag
     74        set use_uq [[$_owner tool] xml get tool.uq]
     75    }
     76
     77    if {$use_uq == ""} {
     78        set use_uq no
     79    } else {
     80        set use_uq [string trim $use_uq]
     81    }
     82
    7083    #
    7184    # Create the widget and configure it properly based on other
    … …  
    7386    #
    7487    itk_component add gauge {
    75         $class $itk_interior.gauge -units $units -presets $presets -log $path
     88        $class $itk_interior.gauge -uq $use_uq -units $units -presets $presets \
     89            -log $path -varname $varname -label [label]
    7690    }
    7791    pack $itk_component(gauge) -expand yes -fill both

  • trunk/gui/scripts/probdisteditor.tcl

    r5120 r6021  
    5050# CONSTRUCTOR
    5151# ----------------------------------------------------------------------
    52 itcl::body Rappture::ProbDistEditor::constructor {min max} {
     52itcl::body Rappture::ProbDistEditor::constructor {min max units default} {
    5353    # create a dispatcher for events
    54     puts "PDE::constructor $min $max"
     54    #puts "PDE::constructor $min $max $default"
    5555
    5656    # These are the tool min and max values.  May be empty.
    5757    set _umin $min
    5858    set _umax $max
    59     set _units [Rappture::Units::Search::for $_umin]
     59    set _units $units
     60    set _uvalue(central) $default
    6061
    6162    Rappture::dispatcher _dispatcher
    … …  
    199200# ----------------------------------------------------------------------
    200201itcl::body Rappture::ProbDistEditor::value {{newval ""}} {
    201     puts "PDE::value $newval"
     202    # puts "PDE::value $newval"
    202203
    203204    #FIXME: _value has numerical values _uvalue has value with units
    … …  
    243244            if {"" != $_umin} {
    244245                if {"" != $units} {
    245                     set tmp(min) [Rappture::Units::convert $_umin -to $units -units off]
     246                    set tmp(min) [Rappture::Units::convert $_umin -to $units -context $units -units off]
    246247                } else {
    247248                    set tmp(min) $_umin
    … …  
    250251            if {"" != $_umax} {
    251252                if {"" != $units} {
    252                     set tmp(max) [Rappture::Units::convert $_umax -to $units -units off]
     253                    set tmp(max) [Rappture::Units::convert $_umax -to $units -context $units -units off]
    253254                } else {
    254255                    set tmp(max) $_umax
    … …  
    285286# ----------------------------------------------------------------------
    286287itcl::body Rappture::ProbDistEditor::mode {{newval ""}} {
    287     puts "PDE::mode mode=$newval min=$_umin max=$_umax units=$_units"
     288    # puts "PDE::mode mode=$newval min=$_umin max=$_umax units=$_units"
    288289
    289290    set modes {exact uniform gaussian custom}
    … …  
    291292        return $modes
    292293    }
     294
     295    set check 0
     296    if {$newval == "check"} {
     297        set newval $_mode
     298        set check 1
     299    }
     300
    293301    if {[lsearch $modes $newval] < 0} {
    294302        error "bad value \"$newval\": should be [join $modes {, }]"
    … …  
    303311            set min ""
    304312        } else {
    305             set min [Rappture::Units::convert $_umin -units off]
     313            set min [Rappture::Units::convert $_umin -context $_units -units off]
    306314        }
    307315        if {$_umax == ""} {
    308316            set max ""
    309317        } else {
    310             set max [Rappture::Units::convert $_umax -units off]
     318            set max [Rappture::Units::convert $_umax -context $_units -units off]
    311319        }
    312320    }
    … …  
    326334        uniform {
    327335            if {![info exists _value(min)] || ![info exists _value(max)]} {
    328                 # puts "UNIFORM min=$min max=$max"
    329                 if {$min != "" && $max != ""} {
    330                     set _value(min) $min
    331                     set _value(max) $max
    332                 } elseif {$min != ""} {
    333                     set _value(min) $min
    334                     set _value(max) [expr $min + 1]
    335                 } elseif {$max != ""} {
    336                     set _value(max) $max
    337                     set _value(min) [expr $max - 1]
     336                set _value(max) [expr $_value(central) * 1.1]
     337                set _value(min) [expr $_value(central) * 0.9]
     338                if {$_value(central) == 0.0} {
     339                    set _value(max) 1.0
     340                }
     341                if {$min != ""} {
     342                    if {$_value(min) < $min} {
     343                        set $_value(min) $min
     344                    }
     345                }
     346                if {$max != ""} {
     347                    if {$_value(max) > $max} {
     348                        set $_value(max) $max
     349                    }
    338350                }
    339351                set _uvalue(min) $_value(min)$_units
    … …  
    342354        }
    343355        gaussian {
    344             # puts "GAUSSIAN min=$min max=$max"
     356            #puts "GAUSSIAN min=$min max=$max"
    345357            if {![info exists _value(central)]} {
    346358                if {[info exists _value(min)] && [info exists _value(max)]} {
    … …  
    350362                }
    351363            }
    352             # puts "central=$_value(central)"
     364            #puts "central=$_value(central)"
    353365            if {![info exists _value(stddev)]} {
    354                 if {[info exists _value(min)] && [info exists _value(max)]} {
    355                     set _value(stddev) [expr {0.3*($_value(max) - $_value(min))}]
    356                 } elseif {$min != "" && $max != ""} {
    357                     set _value(stddev) [expr {0.3*($max - $min)}]
    358                 } else {
    359                     set _value(stddev)  [expr $_value(central) * 0.10]
    360                 }
     366                set _value(stddev)  [expr $_value(central) * 0.10]
    361367            }
    362368            if {$_value(stddev) <= 0} {
    363369                set _value(stddev) 1.0
    364370            }
    365             # puts "stddev=$_value(stddev)"
     371            #puts "stddev=$_value(stddev)"
    366372            # lower bound is -3 deviations or tool min
    367373            set trunc [expr {$_value(central) - 3*$_value(stddev)}]
    … …  
    387393    }
    388394
     395    if {$check == 1} {
     396        return
     397    }
    389398    # pop up the panel of editing options for this mode
    390399    foreach w [pack slaves $itk_component(vals)] {
    … …  
    452461# ----------------------------------------------------------------------
    453462itcl::body Rappture::ProbDistEditor::_redraw {} {
     463    #puts "PDE::_redraw"
     464
    454465    set g $itk_component(graph)
    455466    eval $g element delete [$g element names]
    … …  
    486497        }
    487498        gaussian {
     499            #puts "min=$_value(min) max=$_value(max)"
     500            #puts "mean=$_value(central) dev=$_value(stddev)"
     501
    488502            set min $_value(min)
    489503            set max $_value(max)
    … …  
    592606# ----------------------------------------------------------------------
    593607itcl::body Rappture::ProbDistEditor::_apply {op {widget ""}} {
    594     puts "_apply $op $widget"
     608    #puts "PDE::_apply $op $widget"
    595609    if {$op != "bindings"} {
    596610        # need this for value/finalize
    … …  
    640654                set newval [Rappture::Units::convert [$widget get] -context $_units]
    641655            }
    642             puts "widget=$widget"
    643656            set itk $itk_component(gaussianvals).stddev
    644             puts "itk=$itk"
    645657            if {$widget != $itk && [catch {Rappture::Units::mcheck_range $newval $_umin $_umax $_units} err]} {
    646658                # oops! value is bad -- edit again
    … …  
    658670            set $uvar $newval
    659671
     672            #if {$widget == $itk_component(gaussianvals).mean} {
     673                # need new min and max
     674                #set $_uvalue(min)
     675                #set $_uvalue(max) ...
     676            #}
     677
    660678            if {[catch {Rappture::Units::convert $newval -units off} nvar]} {
    661679                set nvar $newval
    … …  
    663681            set $var $nvar
    664682
     683            mode check
    665684            $_dispatcher event -idle !redraw
    666685        }

  • trunk/gui/scripts/responseviewer.tcl

    r5849 r6021  
    167167
    168168    if {$var1 == $var2} {
     169        set path "output.curve(scatter)"
     170        set _dobj [Rappture::Curve ::#auto $xmlobj $path]
     171        Rappture::XyResult $w
     172        $w add $_dobj {-color red}
     173
    169174        set path "output.curve(response)"
    170175        set _dobj [Rappture::Curve ::#auto $xmlobj $path]
    171         Rappture::XyResult $w
     176
    172177    } else {
    173178        set path "output.field(f2d)"

  • trunk/gui/scripts/resultviewer.tcl

    r5659 r6021  
    2626
    2727    constructor {args} {
    28         # defined below
     28        # defined below
    2929    }
    3030    destructor {
    3131        # defined below
    3232    }
    33     public method add {index xmlobj path}
     33    public method add {index xmlobj path label {uq_part ""}}
    3434    public method clear {{index ""}}
    3535    public method value {xmlobj}
    … …  
    4040    protected method _plotAdd {xmlobj {settings ""}}
    4141    protected method _fixScale {args}
    42     protected method _xml2data {xmlobj path}
     42    protected method _xml2data {xmlobj path label {uq_part ""}}
    4343    protected method _cleanIndex {index}
    4444
    … …  
    5858# ----------------------------------------------------------------------
    5959itcl::body Rappture::ResultViewer::constructor {args} {
     60    #puts "Creating RV $args"
    6061    # create a dispatcher for events
    6162    Rappture::dispatcher _dispatcher
    … …  
    8485# Data is taken from the <xmlobj> object at the <path>.
    8586# ----------------------------------------------------------------------
    86 itcl::body Rappture::ResultViewer::add {index xmlobj path} {
     87itcl::body Rappture::ResultViewer::add {index xmlobj path label {uq_part ""}} {
     88    #puts "RV add index=$index path=$path label=$label uq_part=$uq_part"
    8789    set index [_cleanIndex $index]
    88     set dobj [_xml2data $xmlobj $path]
     90    set dobj [_xml2data $xmlobj $path $label $uq_part]
    8991
    9092    #
    … …  
    9597        lappend _dataslots ""
    9698    }
     99
    97100    set slot [lindex $_dataslots $index]
    98     lappend slot $dobj
    99     set _dataslots [lreplace $_dataslots $index $index $slot]
    100 
    101     $_dispatcher event -idle !scale
     101
     102    # only add dobj if it isn't already there.
     103    if {[lsearch -exact $slot $dobj] < 0} {
     104        lappend slot $dobj
     105        #puts "slot=$slot"
     106        set _dataslots [lreplace $_dataslots $index $index $slot]
     107        $_dispatcher event -idle !scale
     108    }
    102109}
    103110
    … …  
    112119# ----------------------------------------------------------------------
    113120itcl::body Rappture::ResultViewer::clear {{index ""}} {
     121    #puts "RV::clear $index"
    114122    if {$index ne ""} {
    115123        # clear one result
    … …  
    191199# ----------------------------------------------------------------------
    192200itcl::body Rappture::ResultViewer::plot {option args} {
     201    #puts "RV plot option=$option args=$args"
    193202    switch -- $option {
    194203        add {
    … …  
    250259# ----------------------------------------------------------------------
    251260itcl::body Rappture::ResultViewer::_plotAdd {dataobj {settings ""}} {
     261    #puts "RV _plotAdd $dataobj : [$dataobj info class] : $settings"
    252262    switch -- [$dataobj info class] {
     263        ::Rappture::UqInfo {
     264            set mode "uq"
     265            if {![info exists _mode2widget($mode)]} {
     266                set w $itk_interior.uq
     267                Rappture::UqNotebook $w
     268                set _mode2widget($mode) $w
     269            }
     270        }
    253271        ::Rappture::DataTable {
    254272            set mode "datatable"
    … …  
    411429    }
    412430
    413     if {$mode != $_mode && $_mode != ""} {
    414         set nactive [llength [$_mode2widget($_mode) get]]
    415         if {$nactive > 0} {
    416             return  ;# mixing data that doesn't mix -- ignore it!
    417         }
    418     }
    419431    # Are we plotting in a new mode? then change widgets
    420432    if {$_mode2widget($mode) != [pack slaves $itk_interior]} {
    … …  
    442454    if {"" != $_mode} {
    443455        set dlist ""
     456        set objclass ""
    444457        foreach slot $_dataslots {
    445458            foreach dobj $slot {
     459                if {$objclass == ""} {
     460                    set objclass [$dobj info class]
     461                } else {
     462                    if {$objclass != [$dobj info class]} {
     463                        # If some of the objects are different classes
     464                        # then we cannot use the same scale, so give up.
     465                        return
     466                    }
     467                }
    446468                lappend dlist $dobj
    447469            }
    … …  
    474496# specified <path> in the <xmlobj>.
    475497# ----------------------------------------------------------------------
    476 itcl::body Rappture::ResultViewer::_xml2data {xmlobj path} {
    477     if {[info exists _xml2data($xmlobj-$path)]} {
     498itcl::body Rappture::ResultViewer::_xml2data {xmlobj path label {uq_part ""}} {
     499    #puts "RV:_xml2data $path ([$xmlobj element -as type $path]) label=$label uq_part=$uq_part"
     500
     501    if {$uq_part != ""} {
     502        if {[info exists _xml2data($xmlobj-$label)]} {
     503            $_xml2data($xmlobj-$label) add $xmlobj $path $uq_part
     504            return $_xml2data($xmlobj-$label)
     505        }
     506    } elseif {[info exists _xml2data($xmlobj-$path]} {
    478507        return $_xml2data($xmlobj-$path)
    479508    }
    480509
    481     set type [$xmlobj element -as type $path]
     510    if {$uq_part != ""} {
     511        set type "UQ"
     512    } else {
     513        set type [$xmlobj element -as type $path]
     514    }
     515
    482516    switch -- $type {
     517        UQ {
     518            set dobj [Rappture::UqInfo ::#auto $xmlobj $path $uq_part]
     519            set path $label
     520        }
    483521        curve {
    484522            set dobj [Rappture::Curve ::#auto $xmlobj $path]

  • trunk/gui/scripts/spectrum.tcl

    r5659 r6021  
    199199
    200200    set value [lindex $args 0]
    201     if {$units != ""} {
    202         set value [Rappture::Units::convert $value \
    203             -context $units -to $units -units off]
     201
     202    switch -- [lindex $value 0] {
     203        gaussian {
     204            set value [lindex $value 1]
     205            if {$units != ""} {
     206                set value [Rappture::Units::convert $value \
     207                -context $units -to $units -units off]
     208            }
     209        }
     210        uniform {
     211            set min [lindex $value 1]
     212            set max [lindex $value 2]
     213            if {$units != ""} {
     214                set min [Rappture::Units::convert $min \
     215                -context $units -to $units -units off]
     216                set max [Rappture::Units::convert $max \
     217                -context $units -to $units -units off]
     218            }
     219            set value [expr {0.5 * ($min + $max)}]
     220        }
     221        default {
     222            if {$units != ""} {
     223                set value [Rappture::Units::convert $value \
     224                -context $units -to $units -units off]
     225            }
     226        }
    204227    }
    205228

  • trunk/gui/scripts/tempgauge.tcl

    r5659 r6021  
    2626    inherit Rappture::Gauge
    2727
    28     constructor {args} { # defined below }
    29 
     28    constructor {args} {
     29        array set attrs $args
     30        Rappture::Gauge::constructor -uq $attrs(-uq)
     31    } {
     32        eval itk_initialize -spectrum $_spectrum -units K $args
     33    }
    3034    protected method _redraw {}
    3135    protected method _resize {}
    … …  
    4044
    4145itk::usual TemperatureGauge {
    42 }
    43 
    44 # ----------------------------------------------------------------------
    45 # CONSTRUCTOR
    46 # ----------------------------------------------------------------------
    47 itcl::body Rappture::TemperatureGauge::constructor {args} {
    48     eval itk_initialize -spectrum $_spectrum -units K $args
    4946}
    5047

  • trunk/gui/scripts/tool.tcl

    r5659 r6021  
    2828    public method installdir {} {
    2929        return [$_task installdir]
     30    }
     31    public method get_uq {args} {
     32        sync  ;# sync all widget values to XML
     33        return [eval $_task get_uq $args]
    3034    }
    3135    public method run {args} {

  • trunk/gui/scripts/units.tcl

    r5659 r6021  
    6161}
    6262
     63
     64# ----------------------------------------------------------------------
     65# USAGE: mcheck_range value {min ""} {max ""}
     66#
     67# Checks a value or PDF to determine if is is in a required range.
     68# Automatically does unit conversion if necessary.
     69# Returns value if OK.  Error if out-of-range
     70# Examples:
     71#    [mcheck_range "gaussian 0C 1C" 200K 500K] returns 1
     72#    [mcheck_range "uniform 100 200" 150 250] returns 0
     73#    [mcheck_range 100 0 200] returns 1
     74# ----------------------------------------------------------------------
     75
     76proc Rappture::Units::_check_range {value min max units} {
     77    # puts "_check_range $value min=$min max=$max units=$units"
     78    # make sure the value has units
     79    if {$units != ""} {
     80        set value [Rappture::Units::convert $value -context $units]
     81        # for comparisons, remove units
     82        set nv [Rappture::Units::convert $value -context $units -units off]
     83        # get the units for the value
     84        set newunits [Rappture::Units::Search::for $value]
     85    } else {
     86        set nv $value
     87    }
     88
     89    if {"" != $min} {
     90        if {"" != $units} {
     91            # compute the minimum in the new units
     92            set minv [Rappture::Units::convert $min -to $newunits -context $units  -units off]
     93            # same, but include units for printing
     94            set convMinVal [Rappture::Units::convert $min -to $newunits -context $units]
     95        } else {
     96            set minv $min
     97            set convMinVal $min
     98        }
     99        if {$nv < $minv} {
     100            error "Minimum value allowed here is $convMinVal"
     101        }
     102    }
     103    if {"" != $max} {
     104        if {"" != $units} {
     105            # compute the maximum in the new units
     106            set maxv [Rappture::Units::convert $max -to $newunits -context $units -units off]
     107            # same, but include units for printing
     108            set convMaxVal [Rappture::Units::convert $max -to $newunits -context $units ]
     109        } else {
     110            set maxv $max
     111            set convMaxVal $max
     112        }
     113        if {$nv > $maxv} {
     114            error "Maximum value allowed here is $convMaxVal"
     115        }
     116    }
     117    return $value
     118}
     119
     120proc Rappture::Units::mcheck_range {value {min ""} {max ""} {units ""}} {
     121    # puts "mcheck_range $value min=$min max=$max units=$units"
     122
     123    switch -- [lindex $value 0] {
     124        normal -
     125        gaussian {
     126            # get the mean
     127            set mean [_check_range [lindex $value 1] $min $max $units]
     128            if {$units == ""} {
     129                set dev [lindex $value 2]
     130                set ndev $dev
     131            } else {
     132                set dev [Rappture::Units::convert [lindex $value 2] -context $units]
     133                set ndev [Rappture::Units::convert $dev -units off]
     134            }
     135            if {$ndev <= 0} {
     136                error "Deviation must be positive."
     137            }
     138            return [list gaussian $mean $dev]
     139        }
     140        uniform {
     141            set min [_check_range [lindex $value 1] $min $max $units]
     142            set max [_check_range [lindex $value 2] $min $max $units]
     143            return [list uniform $min $max]
     144        }
     145        exact  {
     146            return [_check_range [lindex $value 1] $min $max $units]
     147        }
     148        default {
     149            return [_check_range [lindex $value 0] $min $max $units]
     150        }
     151    }
     152}
     153
     154# ----------------------------------------------------------------------
     155# USAGE: mconvert value ?-context units? ?-to units? ?-units on/off?
     156#
     157# This version of convert() converts multiple values.  Used when the
     158# value could be a range or probability density function (PDF).
     159# Examples:
     160#    gaussian 100k 1k
     161#    uniform 0eV 10eV
     162#    42
     163#    exact 42
     164# ----------------------------------------------------------------------
     165
     166proc Rappture::Units::mconvert {value args} {
     167    # puts "mconvert $value : $args"
     168    array set opts {
     169        -context ""
     170        -to ""
     171        -units "on"
     172    }
     173
     174    set value [split $value]
     175
     176    switch -- [lindex $value 0] {
     177        normal - gaussian {
     178            set valtype gaussian
     179            set vals [lrange $value 1 2]
     180            set convtype {0 1}
     181        }
     182        uniform {
     183            set valtype uniform
     184            set vals [lrange $value 1 2]
     185            set convtype {0 0}
     186        }
     187        exact  {
     188            set valtype ""
     189            set vals [lindex $value 1]
     190            set convtype {0}
     191        }
     192        default {
     193            set valtype ""
     194            set vals $value
     195            set convtype {0}
     196        }
     197    }
     198
     199    foreach {key val} $args {
     200        if {![info exists opts($key)]} {
     201            error "bad option \"$key\": should be [join [lsort [array names opts]] {, }]"
     202        }
     203        set opts($key) $val
     204    }
     205
     206    set newval $valtype
     207    foreach val $vals ctype $convtype {
     208        if {$ctype == 1} {
     209            # This code handles unit conversion for deltas (changes).
     210            # For example, if we want a standard deviation of 10C converted
     211            # to Kelvin, that is 10K, NOT a standard deviation of 283.15K.
     212            set units [Rappture::Units::Search::for $val]
     213            set base [eval Rappture::Units::convert 0$units $args -units off]
     214            set new [eval Rappture::Units::convert $val $args -units off]
     215            set delta [expr $new - $base]
     216            set val $delta$opts(-to)
     217        }
     218        # tcl 8.5 allows us to do this:
     219        # lappend newval [Rappture::Units::convert $val {*}$args]
     220        # but we are using tcl8.4 so we use eval :^(
     221        lappend newval [eval Rappture::Units::convert $val $args]
     222    }
     223    return $newval
     224}
     225
    63226# ----------------------------------------------------------------------
    64227# USAGE: convert value ?-context units? ?-to units? ?-units on/off?
    … …  
    70233# current system.
    71234# ----------------------------------------------------------------------
    72 proc Rappture::Units::convert {value args} {
    73     array set opts {
    74         -context ""
    75         -to ""
    76         -units "on"
    77     }
    78     foreach {key val} $args {
    79         if {![info exists opts($key)]} {
    80             error "bad option \"$key\": should be [join [lsort [array names opts]] {, }]"
    81         }
    82         set opts($key) $val
    83     }
    84 
    85     #
    86     # Parse the value into the number part and the units part.
    87     #
    88     set value [string trim $value]
    89     if {![regexp {^([-+]?[0-9]+\.?([0-9]+)?([eEdD][-+]?[0-9]+)?) *(/?[a-zA-Z]+[0-9]*)?$} $value match number dummy1 dummy2 units]} {
    90         set mesg "bad value \"$value\": should be real number with units"
    91         if {$opts(-context) != ""} {
    92             append mesg " of [Rappture::Units::description $opts(-context)]"
    93         }
    94         error $mesg
    95     }
    96     if {$units == ""} {
    97         set units $opts(-context)
    98     }
    99 
    100     #
    101     # Try to find the object representing the current system of units.
    102     #
    103     set units [Rappture::Units::System::regularize $units]
    104     set oldsys [Rappture::Units::System::for $units]
    105     if {$oldsys == ""} {
    106         set mesg "value \"$value\" has unrecognized units"
    107         if {$opts(-context) != ""} {
    108             append mesg ".\nShould be units of [Rappture::Units::description $opts(-context)]"
    109         }
    110         error $mesg
    111     }
    112 
    113     #
    114     # Convert the number to the new system of units.
    115     #
    116     if {$opts(-to) == ""} {
    117         # no units -- return the number as is
    118         return "$number$units"
    119     }
    120     return [$oldsys convert "$number$units" $opts(-to) $opts(-units)]
    121 }
     235# proc Rappture::Units::convert {value args} {}
     236# Actual implementation is in rappture/lang/tcl/src/RpUnitsTclInterface.cc.
     237
    122238
    123239# ----------------------------------------------------------------------
    … …  
    128244# along with a list of all compatible systems.
    129245# ----------------------------------------------------------------------
    130 proc Rappture::Units::description {units} {
    131     set sys [Rappture::Units::System::for $units]
    132     if {$sys == ""} {
    133         return ""
    134     }
    135     set mesg [$sys cget -type]
    136     set ulist [Rappture::Units::System::all $units]
    137     if {"" != $ulist} {
    138         append mesg " ([join $ulist {, }])"
    139     }
    140     return $mesg
    141 }
     246# proc Rappture::Units::description {units} {}
     247# Actual implementation is in rappture/lang/tcl/src/RpUnitsTclInterface.cc.
     248
    142249
    143250# ----------------------------------------------------------------------
    … …  
    154261    private variable _system ""  ;# this system of units
    155262
    156     public proc for {units}
    157     public proc all {units}
     263    # These are in rappture/lang/tcl/src/RpUnitsTclInterface.cc.
     264    # public proc for {units}
     265    # public proc all {units}
     266
    158267    public proc regularize {units}
    159268
    … …  
    361470# if there is no system that matches the units string.
    362471# ----------------------------------------------------------------------
    363 itcl::body Rappture::Units::System::for {units} {
    364     #
    365     # See if the units are a recognized system.  If not, then try to
    366     # extract any metric prefix and see if what's left is a recognized
    367     # system.  If all else fails, see if we can find a system without
    368     # the exact capitalization.  The user might say "25c" instead of
    369     # "25C".  Try to allow that.
    370     #
    371     if {[info exists _base($units)]} {
    372         return $_base($units)
    373     } else {
    374         set orig $units
    375         if {[regexp {^(/?)[cCmMuUnNpPfFaAkKgGtT](.+)$} $units match slash tail]} {
    376             set base "$slash$tail"
    377             if {[info exists _base($base)]} {
    378                 set sys $_base($base)
    379                 if {[$sys cget -metric]} {
    380                     return $sys
    381                 }
    382             }
    383 
    384             # check the base part for improper capitalization below...
    385             set units $base
    386         }
    387 
    388         set matching ""
    389         foreach u [array names _base] {
    390             if {[string equal -nocase $u $units]} {
    391                 lappend matching $_base($u)
    392             }
    393         }
    394         if {[llength $matching] == 1} {
    395             set sys [lindex $matching 0]
    396             #
    397             # If we got rid of a metric prefix above, make sure
    398             # that the system is metric.  If not, then we don't
    399             # have a match.
    400             #
    401             if {[string equal $units $orig] || [$sys cget -metric]} {
    402                 return $sys
    403             }
    404         }
    405     }
    406     return ""
    407 }
     472# itcl::body Rappture::Units::System::for {units} {}
     473# Actual implementation is in rappture/lang/tcl/src/RpUnitsTclInterface.cc.
     474
    408475
    409476# ----------------------------------------------------------------------
    … …  
    414481# relationships that lead to the same base system.
    415482# ----------------------------------------------------------------------
    416 itcl::body Rappture::Units::System::all {units} {
    417     set sys [Rappture::Units::System::for $units]
    418     if {$sys == ""} {
    419         return ""
    420     }
    421 
    422     if {"" != [$sys cget -basis]} {
    423         set basis [lindex [$sys cget -basis] 0]
    424     } else {
    425         set basis $units
    426     }
    427 
    428     set ulist $basis
    429     foreach u [array names _base] {
    430         set obj $_base($u)
    431         set b [lindex [$obj cget -basis] 0]
    432         if {$b == $basis} {
    433             lappend ulist $u
    434         }
    435     }
    436     return $ulist
    437 }
     483# itcl::body Rappture::Units::System::all {units} {}
     484# Actual implementation is in rappture/lang/tcl/src/RpUnitsTclInterface.cc.
     485
    438486
    439487# ----------------------------------------------------------------------

  • trunk/gui/scripts/uq.tcl

    r5120 r6021  
    44itcl::class Rappture::UQ {
    55
    6     constructor {varlist type uqargs} {
    7         puts "Rappture::UQ constructor $varlist:$type:$uqargs"
     6    constructor {varlist num type uqargs} {
     7        #puts "Rappture::UQ constructor $varlist:$type:$uqargs"
    88        set _varlist $varlist
    99        set _type $type
    1010        set _args $uqargs
     11        set _num $num
    1112    }
    1213
    … …  
    3031    private variable _num_pts {}
    3132    private variable _go ""
     33    private variable _num 0
    3234}
    3335
    … …  
    6466        label $fr.text
    6567
    66 
    6768        #     bind $_val <<Value>> [itcl::code $this _change_param_type $inner]
    6869
    6970        button $fr.cancel -text Cancel -command  [itcl::code $this _setWaitVariable 0]
    7071        set _go $fr.go
    71         button $_go -text Continue -command  [itcl::code $this _setWaitVariable 1]
     72        button $_go -text "Launch Jobs" -command  [itcl::code $this _setWaitVariable 1]
    7273        _set_text $inner
    7374
    … …  
    119120
    120121itcl::body Rappture::UQ::num_runs {} {
    121     set numvars  [llength $_varlist]
    122     puts "UQ num_runs $numvars $_type $_args"
     122    #puts "varlist=$_varlist"
     123    set numvars  $_num
     124    #puts "UQ num_runs $numvars $_type $_args"
    123125    if {![array exists _num_pts]} { _init_num_pts_array }
    124126    switch $_type {

  • trunk/gui/scripts/xyresult.tcl

    r5659 r6021  
    249249    }
    250250    if { $color == "auto" || $color == "autoreset" } {
    251 #        if { $color == "autoreset" } {
    252 #            set _nextColorIndex 0
    253 #        }
     251        if { $color == "autoreset" } {
     252            set _nextColorIndex 0
     253        }
    254254        set color [lindex $itk_option(-autocolors) $_nextColorIndex]
    255255        if { "" == $color} {
Note: See TracChangeset for help on using the changeset viewer.