Changeset 5029


Ignore:
Timestamp:
Feb 17, 2015 5:49:36 PM (9 years ago)
Author:
mmh
Message:

puq integration snap

Location:
branches/uq
Files:
6 added
18 edited

Legend:

Unmodified
Added
Removed

  • branches/uq/Makefile.in

    r4544 r5029  
    4040endif
    4141ifneq ($(ENABLE_GUI),)
    42   TARGETS += gui builder tester examples
     42  TARGETS += gui builder tester examples puq
    4343endif
    4444ifneq ($(HAVE_FFMPEG),)
    … …  
    5757        $(MAKE) -C test all
    5858
    59 install: 
     59install:
    6060        for i in $(TARGETS) ; do \
    6161          $(MAKE) -C $$i install || exit 1 ;\
    6262        done
    6363
    64 clean: 
     64clean:
    6565        for i in $(TARGETS) ; do \
    6666          $(MAKE) -C $$i clean || exit 1 ;\
    … …  
    7373        done
    7474
    75 package: 
     75package:
    7676        tar -C $(pkg_path) -czlf $(rappture_binary_tarfile) $(pkg_name)
    7777
    78 distrib: 
     78distrib:
    7979        $(RM) -r exported
    8080        $(MKDIR_P) -m 0755 exported

  • branches/uq/configure

    r4798 r5029  
    1021310213
    1021410214
    10215 ac_config_files="$ac_config_files Makefile packages/Makefile src/Makefile src/core/Makefile src/core2/Makefile src/objects/Makefile src/objects/RpHash.h gui/Makefile gui/apps/Makefile gui/apps/about gui/apps/copy_rappture_examples gui/apps/encodedata gui/apps/rappture gui/apps/rappture-csh.env gui/apps/rappture.env gui/apps/rappture.use gui/apps/rerun gui/apps/simsim gui/apps/xmldiff gui/pkgIndex.tcl gui/scripts/Makefile gui/src/Makefile builder/Makefile builder/pkgIndex.tcl builder/scripts/Makefile tester/Makefile tester/pkgIndex.tcl tester/scripts/Makefile lang/Makefile lang/java/Makefile lang/java/rappture/Makefile lang/perl/Makefile lang/perl/Makefile.PL lang/python/Makefile lang/python/setup.py lang/matlab/Makefile lang/octave/Makefile lang/octave/octave2/Makefile lang/octave/octave3/Makefile lang/R/Makefile lang/ruby/Makefile lang/ruby/build.rb lang/tcl/Makefile lang/tcl/pkgIndex.tcl lang/tcl/scripts/Makefile lang/tcl/src/Makefile lang/tcl/tests/Makefile lib/Makefile examples/3D/Makefile examples/Makefile examples/app-fermi/2.0/Makefile examples/app-fermi/Makefile examples/app-fermi/cee/Makefile examples/app-fermi/fortran/Makefile examples/app-fermi/java/Makefile examples/app-fermi/matlab/Makefile examples/app-fermi/matlab/compiled/Makefile examples/app-fermi/matlab/uncompiled/Makefile examples/app-fermi/octave/octave2/Makefile examples/app-fermi/octave/octave3/Makefile examples/app-fermi/octave/Makefile examples/app-fermi/perl/Makefile examples/app-fermi/python/Makefile examples/app-fermi/ruby/Makefile examples/app-fermi/tcl/Makefile examples/app-fermi/wrapper/Makefile examples/app-fermi/wrapper/cee/Makefile examples/app-fermi/wrapper/perl/Makefile examples/app-fermi/wrapper/python/Makefile examples/app-fermi/wrapper/tcl/Makefile examples/app-fermi/R/Makefile examples/c-example/Makefile examples/canvas/Makefile examples/demo.bash examples/flow/Makefile examples/flow/demo1/Makefile examples/flow/demo2/Makefile examples/flow/demo3/Makefile examples/graph/Makefile examples/objects/Makefile examples/objects/axis/Makefile examples/objects/curve/Makefile examples/objects/dxWriter/Makefile examples/objects/floatBuffer/Makefile examples/objects/histogram/Makefile examples/objects/library/Makefile examples/objects/number/Makefile examples/objects/path/Makefile examples/objects/plot/Makefile examples/objects/scatter/Makefile examples/objects/string/Makefile examples/objects/tree/Makefile examples/objects/xmlparser/Makefile examples/zoo/Makefile examples/zoo/binary/Makefile examples/zoo/boolean/Makefile examples/zoo/choice/Makefile examples/zoo/curve/Makefile examples/zoo/drawing/Makefile examples/zoo/enable/Makefile examples/zoo/field/Makefile examples/zoo/group/Makefile examples/zoo/histogram/Makefile examples/zoo/image/Makefile examples/zoo/image/docs/Makefile examples/zoo/image/examples/Makefile examples/zoo/integer/Makefile examples/zoo/integer2/Makefile examples/zoo/loader/Makefile examples/zoo/loader/examples/Makefile examples/zoo/log/Makefile examples/zoo/mesh/Makefile examples/zoo/note/Makefile examples/zoo/note/docs/Makefile examples/zoo/number/Makefile examples/zoo/number2/Makefile examples/zoo/parallelepiped/Makefile examples/zoo/periodicelement/Makefile examples/zoo/phase/Makefile examples/zoo/sequence/Makefile examples/zoo/sequence/examples/Makefile examples/zoo/string/Makefile examples/zoo/structure/Makefile examples/zoo/structure/examples/Makefile examples/zoo/table/Makefile video/Makefile video/pkgIndex.tcl oldtest/Makefile oldtest/src/Makefile"
     10215ac_config_files="$ac_config_files Makefile packages/Makefile src/Makefile src/core/Makefile src/core2/Makefile src/objects/Makefile src/objects/RpHash.h gui/Makefile gui/apps/Makefile gui/apps/about gui/apps/copy_rappture_examples gui/apps/encodedata gui/apps/rappture gui/apps/rappture-csh.env gui/apps/rappture.env gui/apps/rappture.use gui/apps/rerun gui/apps/simsim gui/apps/xmldiff gui/pkgIndex.tcl gui/scripts/Makefile gui/src/Makefile builder/Makefile builder/pkgIndex.tcl builder/scripts/Makefile tester/Makefile tester/pkgIndex.tcl tester/scripts/Makefile lang/Makefile lang/java/Makefile lang/java/rappture/Makefile lang/perl/Makefile lang/perl/Makefile.PL lang/python/Makefile lang/python/setup.py lang/matlab/Makefile lang/octave/Makefile lang/octave/octave2/Makefile lang/octave/octave3/Makefile lang/R/Makefile lang/ruby/Makefile lang/ruby/build.rb lang/tcl/Makefile lang/tcl/pkgIndex.tcl lang/tcl/scripts/Makefile lang/tcl/src/Makefile lang/tcl/tests/Makefile lib/Makefile examples/3D/Makefile examples/Makefile examples/app-fermi/2.0/Makefile examples/app-fermi/Makefile examples/app-fermi/cee/Makefile examples/app-fermi/fortran/Makefile examples/app-fermi/java/Makefile examples/app-fermi/matlab/Makefile examples/app-fermi/matlab/compiled/Makefile examples/app-fermi/matlab/uncompiled/Makefile examples/app-fermi/octave/octave2/Makefile examples/app-fermi/octave/octave3/Makefile examples/app-fermi/octave/Makefile examples/app-fermi/perl/Makefile examples/app-fermi/python/Makefile examples/app-fermi/ruby/Makefile examples/app-fermi/tcl/Makefile examples/app-fermi/wrapper/Makefile examples/app-fermi/wrapper/cee/Makefile examples/app-fermi/wrapper/perl/Makefile examples/app-fermi/wrapper/python/Makefile examples/app-fermi/wrapper/tcl/Makefile examples/app-fermi/R/Makefile examples/c-example/Makefile examples/canvas/Makefile examples/demo.bash examples/flow/Makefile examples/flow/demo1/Makefile examples/flow/demo2/Makefile examples/flow/demo3/Makefile examples/graph/Makefile examples/objects/Makefile examples/objects/axis/Makefile examples/objects/curve/Makefile examples/objects/dxWriter/Makefile examples/objects/floatBuffer/Makefile examples/objects/histogram/Makefile examples/objects/library/Makefile examples/objects/number/Makefile examples/objects/path/Makefile examples/objects/plot/Makefile examples/objects/scatter/Makefile examples/objects/string/Makefile examples/objects/tree/Makefile examples/objects/xmlparser/Makefile examples/zoo/Makefile examples/zoo/binary/Makefile examples/zoo/boolean/Makefile examples/zoo/choice/Makefile examples/zoo/curve/Makefile examples/zoo/drawing/Makefile examples/zoo/enable/Makefile examples/zoo/field/Makefile examples/zoo/group/Makefile examples/zoo/histogram/Makefile examples/zoo/image/Makefile examples/zoo/image/docs/Makefile examples/zoo/image/examples/Makefile examples/zoo/integer/Makefile examples/zoo/integer2/Makefile examples/zoo/loader/Makefile examples/zoo/loader/examples/Makefile examples/zoo/log/Makefile examples/zoo/mesh/Makefile examples/zoo/note/Makefile examples/zoo/note/docs/Makefile examples/zoo/number/Makefile examples/zoo/number2/Makefile examples/zoo/parallelepiped/Makefile examples/zoo/periodicelement/Makefile examples/zoo/phase/Makefile examples/zoo/sequence/Makefile examples/zoo/sequence/examples/Makefile examples/zoo/string/Makefile examples/zoo/structure/Makefile examples/zoo/structure/examples/Makefile examples/zoo/table/Makefile video/Makefile video/pkgIndex.tcl oldtest/Makefile oldtest/src/Makefile puq/Makefile"
    1021610216
    1021710217cat >confcache <<\_ACEOF
    … …  
    1103711037    "oldtest/Makefile") CONFIG_FILES="$CONFIG_FILES oldtest/Makefile" ;;
    1103811038    "oldtest/src/Makefile") CONFIG_FILES="$CONFIG_FILES oldtest/src/Makefile" ;;
     11039    "puq/Makefile") CONFIG_FILES="$CONFIG_FILES puq/Makefile" ;;
    1103911040
    1104011041  *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;;

  • branches/uq/configure.in

    r4798 r5029  
    4343AC_PROG_MAKE_SET
    4444
    45 # Check for C, C++, and FORTRAN 
     45# Check for C, C++, and FORTRAN
    4646AC_PROG_CC
    4747AC_PROG_CXX
    48 # Avoid g95 
     48# Avoid g95
    4949AC_PROG_F77([g77 gfortran f77 fort77 f90 xlf xlf90 fl32])
    5050
    … …  
    146146for dir in \
    147147 ${exec_prefix} \
    148  ${exec_prefix}/lib ; do 
     148 ${exec_prefix}/lib ; do
    149149  tclconfig="${dir}/tclConfig.sh"
    150150  if test -f "$tclconfig" ; then
    … …  
    171171if test "${with_tclsh}" != "no" ; then
    172172  tclsh="tclsh${TCL_VERSION}"
    173   if test "${with_tclsh}" = "yes" ; then 
     173  if test "${with_tclsh}" = "yes" ; then
    174174    AC_PATH_PROG(TCLSH, ${tclsh}, [], [${exec_prefix}/bin:${PATH}])
    175   else 
     175  else
    176176    AC_PATH_PROG(TCLSH, ${tclsh}, [], [${with_tclsh}/bin:${with_tclsh}])
    177177  fi
    … …  
    188188    [AS_HELP_STRING([--with-vtk[=version]],
    189189        [VTK library version @<:@default=6.0@:>@])],
    190     [], 
     190    [],
    191191    [with_vtk=yes])
    192192
    … …  
    230230    [AS_HELP_STRING([--enable-vtkdicom],
    231231        [Use vtkDICOM package @<:@default=no@:>@])],
    232     [], 
     232    [],
    233233    [enable_vtkdicom=no])
    234234
    … …  
    296296#--------------------------------------------------------------------
    297297if test "${with_ffmpeg}" != "no" ; then
    298   if test "${with_ffmpeg}" = "yes" ; then 
     298  if test "${with_ffmpeg}" = "yes" ; then
    299299    AC_PATH_PROG(FFMPEG, ffmpeg, [], $PATH)
    300   else 
     300  else
    301301    AC_PATH_PROG(FFMPEG, ffmpeg, [], [${with_ffmpeg}/bin:${with_ffmpeg}])
    302   fi 
     302  fi
    303303  if test "${FFMPEG}x" != "x" ; then
    304304    AC_DEFINE(HAVE_FFMPEG, 1, [Render servers can use ffmpeg])
    … …  
    342342  AC_CHECK_FUNCS(av_close_input_file)
    343343  AC_CHECK_FUNCS(avformat_close_input)
    344        
     344
    345345  AC_CHECK_FUNC(avcodec_find_decoder,,
    346346    AC_MSG_ERROR(oops! no av_codec_find_decoder ?!?))
    … …  
    598598    oldtest/Makefile
    599599    oldtest/src/Makefile
     600    puq/Makefile
    600601])
    601602AC_OUTPUT
    602        
     603

  • branches/uq/gui/apps/launcher.tcl

    r4513 r5029  
    107107# Note: We're sourcing the driver file "main.tcl" rather than exec-ing
    108108#       wish because we want to see stderr and stdout messages when they
    109 #       are written, rather than when the program completes.  It also 
    110 #       eliminates one process waiting for the other to complete. If 
    111 #       "exec" is needed, then the following could be replaced with 
     109#       are written, rather than when the program completes.  It also
     110#       eliminates one process waiting for the other to complete. If
     111#       "exec" is needed, then the following could be replaced with
    112112#       blt::bgexec.  It doesn't try to redirect stderr into a file.
    113113set argv $alist
    … …  
    116116}
    117117source  $mainscript
     118puts "Done with launcher"

  • branches/uq/gui/scripts/Makefile.in

    r4512 r5029  
    9595                $(srcdir)/periodictable.tcl \
    9696                $(srcdir)/postern.tcl \
     97                $(srcdir)/probdisteditor.tcl \
    9798                $(srcdir)/progress.tcl \
    9899                $(srcdir)/pushbutton.tcl \
    … …  
    158159                --outfile tclIndex
    159160
    160 install: all install_scripts install_images 
     161install: all install_scripts install_images
    161162
    162 install_scripts: 
     163install_scripts:
    163164        $(MKDIR_P) -m 0755 $(destdir)
    164165        @for i in $(FILES); do \
    165166            echo "Installing $$i" ; \
    166167            $(INSTALL) -m 0444 $$i $(destdir) ; \
    167         done 
     168        done
    168169        $(INSTALL) -m 0444 tclIndex $(destdir)
    169170
    … …  
    173174            echo "Installing $$i" ; \
    174175            $(INSTALL) -m 0444 $$i $(destdir)/images ; \
    175         done 
     176        done
    176177
    177178clean:

  • branches/uq/gui/scripts/analyzer.tcl

    r4512 r5029  
    1 # -*- mode: tcl; indent-tabs-mode: nil -*- 
     1# -*- mode: tcl; indent-tabs-mode: nil -*-
    22# ----------------------------------------------------------------------
    33#  COMPONENT: analyzer - output area for Rappture
    … …  
    5050    itk_option define -notebookpage notebookPage NotebookPage ""
    5151
    52     constructor {tool args} { 
    53         # defined below 
    54     }
    55     destructor { 
    56         # defined below 
     52    constructor {tool args} {
     53        # defined below
     54    }
     55    destructor {
     56        # defined below
    5757    }
    5858
    … …  
    103103itcl::body Rappture::Analyzer::constructor {tool args} {
    104104    set _tool $tool
    105 
     105    puts "Analyzer init"
    106106    # use this to store all simulation results
    107107    set _resultset [Rappture::ResultSet ::\#auto]
    … …  
    391391# ----------------------------------------------------------------------
    392392itcl::body Rappture::Analyzer::simulate {args} {
     393    puts "simulate $args"
    393394    if {$args == "-ifneeded"} {
    394395        # check to see if simulation is really needed
    … …  
    401402        }
    402403        set args ""
    403     } 
    404 
     404    }
     405    puts "simulation needed"
    405406    # simulation is needed -- go to simulation page
    406407    $itk_component(notebook) current simulate
    … …  
    423424
    424425    # execute the job
     426    puts "$_tool run $args"
     427
    425428    foreach {status result} [eval $_tool run $args] break
    426429
    … …  
    443446    if {$status != 0} {
    444447        $itk_component(runinfo) configure -state normal
    445         # Don't erase program error messages. 
     448        # Don't erase program error messages.
    446449        # $itk_component(runinfo) delete 1.0 end
    447450        $itk_component(runinfo) insert end "\n\nProblem launching job:\n\n" text
    … …  
    585588                    $popup activate $widget below
    586589                } else {
    587                     download now $widget 
     590                    download now $widget
    588591                }
    589592            } else {
    … …  
    12821285            set frame ${sequence}.element($frameNum)
    12831286            $xmlobj put ${frame}.index $frameNum
    1284            
     1287
    12851288            set molecule ${frame}.structure.components.molecule
    12861289            $xmlobj put ${molecule}.pdb $contents
    … …  
    13251328                set frame ${sequence}.element($frameNum)
    13261329                $xmlobj put ${frame}.index $frameNum
    1327                
     1330
    13281331                set molecule ${frame}.structure.components.molecule
    13291332                $xmlobj put ${molecule}.lammps $frameContents
    13301333                $xmlobj put ${molecule}.lammpstypemap $typemap
    1331                
     1334
    13321335                incr frameNum
    13331336                set frameContents ""
    … …  
    13451348        set frame ${sequence}.element($frameNum)
    13461349        $xmlobj put ${frame}.index $frameNum
    1347        
     1350
    13481351        set molecule ${frame}.structure.components.molecule
    13491352        $xmlobj put ${molecule}.lammps $frameContents
    … …  
    13551358# USAGE: _trajToSequence <xmlobj> ?<path>?
    13561359#
    1357 #       Check for PDB and LAMMPS trajectories in molecule data and rewrite 
    1358 #       the individual models as a sequence of molecules.  Used internally 
     1360#       Check for PDB and LAMMPS trajectories in molecule data and rewrite
     1361#       the individual models as a sequence of molecules.  Used internally
    13591362#       to detect any molecule output elements that contain trajectory data.
    13601363#       Trajectories will be converted into sequences of individual molecules.
    13611364#       All other elements will be unaffected. Scans the entire xml tree if a
    1362 #       starting path is not specified. 
     1365#       starting path is not specified.
    13631366#
    13641367# ----------------------------------------------------------------------

  • branches/uq/gui/scripts/controlOwner.tcl

    r3636 r5029  
    1 # -*- mode: tcl; indent-tabs-mode: nil -*- 
     1# -*- mode: tcl; indent-tabs-mode: nil -*-
    22# ----------------------------------------------------------------------
    33#  COMPONENT: owner - manages Rappture controls

  • branches/uq/gui/scripts/gauge.tcl

    r3739 r5029  
    1 # -*- mode: tcl; indent-tabs-mode: nil -*- 
     1# -*- mode: tcl; indent-tabs-mode: nil -*-
    22# ----------------------------------------------------------------------
    33#  COMPONENT: gauge - compact readout for real values
    … …  
    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
    4547    constructor {args} { # defined below }
    … …  
    5658    protected method _layout {}
    5759    protected method _log {event args}
     60    protected method _change_param_type {choice}
     61    protected method _pop_uq {win}
     62    protected method _pop_uq_deactivate {}
    5863
    5964    private variable _value 0  ;# value for this widget
     65    private variable _mode exact ;# current mode
     66    private variable _pde ""   ;# ProbDistEditor
     67    private variable _val ""   ;# value choice combobox
    6068
    6169    blt::bitmap define GaugeArrow {
    … …  
    6674    }
    6775}
    68                                                                                
     76
    6977itk::usual Gauge {
    7078    keep -cursor -font -foreground -background
    … …  
    7684# ----------------------------------------------------------------------
    7785itcl::body Rappture::Gauge::constructor {args} {
     86
    7887    itk_option remove hull.borderwidth hull.relief
    7988    component hull configure -borderwidth 0
    … …  
    8998    bind $itk_component(icon) <Configure> [itcl::code $this _redraw]
    9099
     100    itk_component add uq {
     101        button $itk_interior.uq -image [Rappture::icon UQ] \
     102            -command [itcl::code $this _pop_uq $itk_interior]
     103    }
     104
     105    pack $itk_component(uq) -side right -padx 10
     106
    91107    itk_component add -protected vframe {
    92108        frame $itk_interior.vframe
    … …  
    96112
    97113    itk_component add value {
    98         label $itk_component(vframe).value -width 7 \
     114        label $itk_component(vframe).value -width 20 \
    99115            -borderwidth 1 -relief flat -textvariable [itcl::scope _value]
    100116    } {
    … …  
    197213# ----------------------------------------------------------------------
    198214itcl::body Rappture::Gauge::value {args} {
    199     set onlycheck 0
     215    # puts "Gauge value: $args"
     216
     217    # Query.  Just return the current value.
     218    if {[llength $args] == 0} {
     219        return $_value
     220    }
     221
    200222    set i [lsearch -exact $args -check]
    201223    if {$i >= 0} {
    202224        set onlycheck 1
    203225        set args [lreplace $args $i $i]
    204     }
    205 
    206     if {[llength $args] == 1} {
    207         #
    208         # If this gauge has -units, try to convert the incoming
    209         # value to that system of units.  Also, make sure that
    210         # the value is bound by any min/max value constraints.
    211         #
    212         # Keep track of the inputted units so we can give a
    213         # response about min and max values in familiar units.
    214         #
    215         set newval [set nv [string trim [lindex $args 0]]]
    216         set units $itk_option(-units)
    217         if {"" != $units} {
    218             set newval [Rappture::Units::convert $newval -context $units]
    219             set nvUnits [Rappture::Units::Search::for $newval]
    220             if { "" == $nvUnits} {
    221                 set msg [Rappture::Units::description $units]
    222                 error "unrecognized units in value \"$newval\": should be value with units of $msg"
    223             }
    224             set nv [Rappture::Units::convert $nv \
    225                 -context $units -to $units -units off]
    226 
    227             # Normalize the units name
    228             set newval [Rappture::Units::convert $newval -units off]$nvUnits
    229         }
    230 
    231         switch -- $itk_option(-type) {
    232             integer {
    233                 if { [scan $nv "%g" value] != 1 || int($nv) != $value } {
    234                     error "bad value \"$nv\": should be an integer value"
    235                 }
    236             }
    237             real {
    238                 # "scan" will reject the number if the string is "NaN" or
    239                 # "Inf" or the empty string.  It also is accepts large numbers
    240                 # (e.g. 111111111111111111111) that "string is double"
    241                 # rejects.  The problem with "scan" is that it doesn't care if
    242                 # there are extra characters trailing the number (eg. "123a").
    243                 # The extra %s substitution is used to detect this case.
    244                 if { [scan $nv "%g%s" dummy1 dummy2] != 1 } {
    245                     error "bad value \"$nv\": should be a real number"
    246                 }
    247             }
    248         }
    249 
    250         if {"" != $itk_option(-minvalue)} {
    251             set convMinVal [set minv $itk_option(-minvalue)]
    252             if {"" != $units} {
    253                 set minv [Rappture::Units::convert $minv \
    254                     -context $units -to $units -units off]
    255                 set convMinVal [Rappture::Units::convert \
    256                     $itk_option(-minvalue) -context $units -to $nvUnits]
    257             } else {
    258                 set newval [format "%g" $newval]
    259             }
    260 
    261             # fix for the case when the user tries to
    262             # compare values like minv=-500 nv=-0600
    263             set nv [format "%g" $nv]
    264             set minv [format "%g" $minv]
    265 
    266             if {$nv < $minv} {
    267                 error "minimum value allowed here is $convMinVal"
    268             }
    269         }
    270 
    271         if {"" != $itk_option(-maxvalue)} {
    272             set convMaxVal [set maxv $itk_option(-maxvalue)]
    273             if {"" != $units} {
    274                 set maxv [Rappture::Units::convert $maxv \
    275                     -context $units -to $units -units off]
    276                 set convMaxVal [Rappture::Units::convert \
    277                     $itk_option(-maxvalue) -context $units -to $nvUnits]
    278             } else {
    279                 set newval [format "%g" $newval]
    280             }
    281 
    282             # fix for the case when the user tries to
    283             # compare values like maxv=500 nv=0600
    284             set nv [format "%g" $nv]
    285             set maxv [format "%g" $maxv]
    286 
    287             if {$nv > $maxv} {
    288                 error "maximum value allowed here is $convMaxVal"
    289             }
    290         }
    291 
    292         if {$onlycheck} {
    293             return
    294         }
    295 
    296         set _value $newval
    297 
    298         _redraw
    299         event generate $itk_component(hull) <<Value>>
    300 
    301     } elseif {[llength $args] != 0} {
     226    } else {
     227        set onlycheck 0
     228    }
     229
     230    if {[llength $args] != 1} {
    302231        error "wrong # args: should be \"value ?-check? ?newval?\""
     232    }
     233
     234    set newval [Rappture::Units::mcheck_range [lindex $args 0] \
     235    $itk_option(-minvalue) $itk_option(-maxvalue) $itk_option(-units)]
     236
     237    set newmode [lindex $newval 0]
     238    switch -- $newmode {
     239        uniform -
     240        gaussian {
     241            set _mode $newmode
     242        }
     243        exact -
     244        default {
     245            set _mode exact
     246        }
     247    }
     248
     249    if {$itk_option(-type) == "integer"} {
     250        if { [scan $newval "%g" value] != 1 || int($newval) != $value } {
     251            error "bad value \"$newval\": should be an integer value"
     252        }
     253    }
     254
     255    if {$onlycheck} {
     256        return
     257    }
     258
     259    set _value $newval
     260    $itk_component(value) configure -width [string length $_value]
     261    _redraw
     262    event generate $itk_component(hull) <<Value>>
     263
     264    if {"" != $_pde} {
     265        set val [$_val translate [$_val value]]
     266        $_val value $_mode
     267        $_pde value $_value
     268
    303269    }
    304270    return $_value
    … …  
    483449# ----------------------------------------------------------------------
    484450itcl::body Rappture::Gauge::_editor {option args} {
     451    # puts "Gauge::editor option=$option args=$args"
    485452    if {$itk_option(-state) == "disabled"} {
    486453        return  ;# disabled? then bail out here!
    … …  
    504471            }
    505472            set val [lindex $args 0]
    506 
    507473            if {[catch {value -check $val} result]} {
    508474                if {[regexp {allowed here is (.+)} $result match newval]} {
    … …  
    586552    }
    587553
     554    if {$itk_option(-type) != "integer"} {
     555        pack $itk_component(uq) -side right -padx 10
     556    }
     557
    588558    array set side2anchor {
    589559        left   e
    … …  
    733703    }
    734704}
     705
     706itcl::body Rappture::Gauge::_pop_uq {win} {
     707    # puts "min=$itk_option(-minvalue) max=$itk_option(-maxvalue) units=$itk_option(-units)"
     708    set varname $itk_option(-varname)
     709    set popup .pop_uq_$varname
     710    if { ![winfo exists $popup] } {
     711        Rappture::Balloon $popup -title $itk_option(-label)
     712        set inner [$popup component inner]
     713        frame $inner.type
     714        pack $inner.type -side top -fill x
     715        label $inner.type.l -text "Parameter Value:"
     716        pack $inner.type.l -side left
     717
     718        set _val [Rappture::Combobox $inner.type.val -width 20 -editable no]
     719        pack $_val -side left -expand yes -fill x
     720        $_val choices insert end exact "Exact Value"
     721        $_val choices insert end uniform "Uniform Distribution"
     722        $_val choices insert end gaussian "Gaussian Distribution"
     723        bind $_val <<Value>> [itcl::code $this _change_param_type $inner]
     724
     725        set _pde [Rappture::ProbDistEditor $inner.entry \
     726        $itk_option(-minvalue) $itk_option(-maxvalue)]
     727        $_val value $_mode
     728        $_pde value $_value
     729        pack $inner.entry -expand yes -fill both -pady {10 0}
     730
     731        $popup configure \
     732        -deactivatecommand [itcl::code $this _pop_uq_deactivate]
     733    }
     734    update
     735    $popup activate $win right
     736}
     737
     738itcl::body Rappture::Gauge::_pop_uq_deactivate {} {
     739    # puts "deactivate [$_pde value]"
     740    value [$_pde value]
     741}
     742
     743itcl::body Rappture::Gauge::_change_param_type {inner} {
     744    set val [$_val translate [$_val value]]
     745    $_pde mode $val
     746}

  • branches/uq/gui/scripts/main.tcl

    r3700 r5029  
    1 # -*- mode: tcl; indent-tabs-mode: nil -*- 
     1# -*- mode: tcl; indent-tabs-mode: nil -*-
    22#!/bin/sh
    33# ----------------------------------------------------------------------
    … …  
    9696}
    9797
     98# mmh
     99puts "main.tcl $argv"
     100parray params
     101
    98102proc ReadToolParameters { numTries } {
    99     incr numTries -1 
     103    incr numTries -1
    100104    if { $numTries < 0 } {
    101105        return
    … …  
    107111        return
    108112    }
    109     catch { 
     113    catch {
    110114        set f [open $paramsFile "r"]
    111115        set contents [read $f]
    112116        close $f
    113         set pattern {^file\((.*)\):(.*)$} 
     117        set pattern {^file\((.*)\):(.*)$}
    114118        foreach line [split $contents "\n"] {
    115119            if { [regexp $pattern $line match path rest] } {
    … …  
    178182set installdir [file normalize [file dirname $params(-tool)]]
    179183$xmlobj put tool.version.application.directory(tool) $installdir
    180 
    181184set tool [Rappture::Tool ::#auto $xmlobj $installdir]
    182185
    … …  
    358361    set arrangement [$win.pager cget -arrangement]
    359362    if { $type == "" } {
    360         if { $arrangement != "side-by-side" } { 
     363        if { $arrangement != "side-by-side" } {
    361364           set type auto
    362365        }
    363366    }
    364     if { $arrangement != "side-by-side" && 
     367    if { $arrangement != "side-by-side" &&
    365368            ($type == "manual" || $type == "manual-resim" ||
    366369             $type == "auto" || $style == "wizard") } {
    … …  
    389392    $win.pager current analyzer
    390393}
    391 
     394puts "DONE main.tcl"
    392395wm deiconify .main

  • branches/uq/gui/scripts/numberentry.tcl

    r3647 r5029  
    1 # -*- mode: tcl; indent-tabs-mode: nil -*- 
     1# -*- mode: tcl; indent-tabs-mode: nil -*-
    22# ----------------------------------------------------------------------
    33#  COMPONENT: NumberEntry - widget for entering numeric values
    … …  
    2525    public method label {}
    2626    public method tooltip {}
    27 
    2827    protected method _newValue {}
    2928
    … …  
    4342# ----------------------------------------------------------------------
    4443itcl::body Rappture::NumberEntry::constructor {owner path args} {
     44    puts "NumberEntry '$path' '$args'"
     45    set varname [lindex [split $path ()] 1]
     46
    4547    if {[catch {$owner isa Rappture::ControlOwner} valid] != 0 || !$valid} {
    4648        error "bad object \"$owner\": should be Rappture::ControlOwner"
    … …  
    4850    set _owner $owner
    4951    set _path $path
    50    
     52
     53    puts "LABEL=[label]"
    5154    #
    5255    # Figure out what sort of control to create
    … …  
    5861        lappend presets $value $label
    5962    }
    60    
     63
    6164    set class Rappture::Gauge
    6265    set units [string trim [$_owner xml get $path.units]]
     66    puts "units=$units"
    6367    if {$units != ""} {
    6468        set desc [Rappture::Units::description $units]
    … …  
    6771        }
    6872    }
    69    
     73
    7074    #
    7175    # Create the widget and configure it properly based on other
    … …  
    7377    #
    7478    itk_component add gauge {
    75         $class $itk_interior.gauge -units $units -presets $presets -log $path
     79        $class $itk_interior.gauge -units $units -presets $presets -log $path -varname $varname -label [label]
    7680    }
    7781    pack $itk_component(gauge) -expand yes -fill both
    7882    bind $itk_component(gauge) <<Value>> [itcl::code $this _newValue]
    79    
     83
    8084    set min [string trim [$_owner xml get $path.min]]
    81     if {$min ne ""} { 
    82         $itk_component(gauge) configure -minvalue $min 
    83     }
    84    
     85    if {$min ne ""} {
     86        $itk_component(gauge) configure -minvalue $min
     87    }
     88
    8589    set max [string trim [$_owner xml get $path.max]]
    86     if {$max ne ""} { 
    87         $itk_component(gauge) configure -maxvalue $max 
     90    if {$max ne ""} {
     91        $itk_component(gauge) configure -maxvalue $max
    8892    }
    8993
    … …  
    119123    #
    120124    set str [string trim [$_owner xml get $path.default]]
    121     if {$str ne ""} {
    122         $itk_component(gauge) value $str
     125    puts "Default=$str"
     126    if {$str ne ""} {
     127        $itk_component(gauge) value $str
    123128    }
    124129}

  • branches/uq/gui/scripts/spectrum.tcl

    r3330 r5029  
    1 # -*- mode: tcl; indent-tabs-mode: nil -*- 
     1# -*- mode: tcl; indent-tabs-mode: nil -*-
    22# ----------------------------------------------------------------------
    33#  COMPONENT: spectrum - maps a range of real values onto a color
    … …  
    4141    private variable _specw0 0      ;# wavelength for minimum
    4242}
    43                                                                                
     43
    4444# ----------------------------------------------------------------------
    4545# CONSTRUCTOR
    … …  
    8080            set val1 [lindex $args 2]
    8181            set color1 [string trimright [lindex $args 3] "nm"]
    82            
     82
    8383            if {"" != $units} {
    8484                set val0 [Rappture::Units::convert $val0 \
    … …  
    176176# ----------------------------------------------------------------------
    177177itcl::body Rappture::Spectrum::get {args} {
     178    puts "Spectrum::get $args"
    178179    if {[llength $args] == 0} {
    179180        set rlist ""
    … …  
    199200
    200201    set value [lindex $args 0]
    201     if {$units != ""} {
    202         set value [Rappture::Units::convert $value \
    203             -context $units -to $units -units off]
    204     }
    205 
     202
     203    puts "SPECTRUN GET value=$value units=$units"
     204
     205    switch -- [lindex $value 0] {
     206        gaussian {
     207            set value [lindex $value 1]
     208            if {$units != ""} {
     209                set value [Rappture::Units::convert $value \
     210                -context $units -to $units -units off]
     211            }
     212        }
     213        uniform {
     214            set min [lindex $value 1]
     215            set max [lindex $value 2]
     216            if {$units != ""} {
     217                set min [Rappture::Units::convert $min \
     218                -context $units -to $units -units off]
     219                set max [Rappture::Units::convert $max \
     220                -context $units -to $units -units off]
     221            }
     222            set value [expr {0.5 * ($min + $max)}]
     223        }
     224        default {
     225            if {$units != ""} {
     226                set value [Rappture::Units::convert $value \
     227                -context $units -to $units -units off]
     228            }
     229        }
     230    }
     231    puts "SPECTRUN GET NEW value=$value what=$what"
    206232    switch -- $what {
    207233        -color {

  • branches/uq/gui/scripts/tempgauge.tcl

    r3642 r5029  
    1 # -*- mode: tcl; indent-tabs-mode: nil -*- 
     1# -*- mode: tcl; indent-tabs-mode: nil -*-
    22# ----------------------------------------------------------------------
    33#  COMPONENT: tempgauge - gauge for temperature values
    … …  
    7373
    7474    if {"" != $itk_option(-spectrum)} {
     75        puts "TemperatureGauge"
    7576        set color [$itk_option(-spectrum) get [value]]
     77        puts "TemperatureGauge: color=$color"
    7678        set frac [$itk_option(-spectrum) get -fraction [value]]
    7779    } else {

  • branches/uq/gui/scripts/tool.tcl

    r4531 r5029  
    1 # -*- mode: tcl; indent-tabs-mode: nil -*- 
     1# -*- mode: tcl; indent-tabs-mode: nil -*-
    22# ----------------------------------------------------------------------
    33#  COMPONENT: tool - represents an entire tool
    … …  
    3131    public method run {args} {
    3232        sync  ;# sync all widget values to XML
     33        puts "Tool $_task run $args"
    3334        eval $_task run $args
    3435    }
    … …  
    5253# ----------------------------------------------------------------------
    5354itcl::body Rappture::Tool::constructor {xmlobj installdir} {
     55    puts "Tool Init"
     56
    5457    if {![Rappture::library isvalid $xmlobj]} {
    5558        error "bad value \"$xmlobj\": should be Rappture::Library"

  • branches/uq/gui/scripts/units.tcl

    r3330 r5029  
    1 # -*- mode: tcl; indent-tabs-mode: nil -*- 
     1# -*- mode: tcl; indent-tabs-mode: nil -*-
    22# ----------------------------------------------------------------------
    33#  COMPONENT: units - mechanism for converting numbers with units
    … …  
    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    # make sure the value has units
     78    if {$units != ""} {
     79        set value [Rappture::Units::convert $value -context $units]
     80        # for comparisons, remove units
     81        set nv [Rappture::Units::convert $value -units off]
     82        # get the units for the value
     83        set newunits [Rappture::Units::Search::for $value]
     84    } else {
     85        set nv $value
     86    }
     87
     88    if {"" != $min} {
     89        if {"" != $units} {
     90            # compute the minimum in the new units
     91            set minv [Rappture::Units::convert $min -to $newunits -units off]
     92            # same, but include units for printing
     93            set convMinVal [Rappture::Units::convert $min -to $newunits]
     94        } else {
     95            set minv $min
     96            set convMinVal $min
     97        }
     98        if {$nv < $minv} {
     99            error "Minimum value allowed here is $convMinVal"
     100        }
     101    }
     102    if {"" != $max} {
     103        if {"" != $units} {
     104            # compute the maximum in the new units
     105            set maxv [Rappture::Units::convert $max -to $newunits -units off]
     106            # same, but include units for printing
     107            set convMaxVal [Rappture::Units::convert $max -to $newunits]
     108        } else {
     109            set maxv $max
     110            set convMaxVal $max
     111        }
     112        if {$nv > $maxv} {
     113            error "Maximum value allowed here is $convMaxVal"
     114        }
     115    }
     116    return $value
     117}
     118
     119proc Rappture::Units::mcheck_range {value {min ""} {max ""} {units ""}} {
     120    puts "mcheck_range $value min=$min max=$max units=$units"
     121
     122    switch -- [lindex $value 0] {
     123        normal -
     124        gaussian {
     125            # get the mean
     126            set mean [_check_range [lindex $value 1] $min $max $units]
     127            if {$units == ""} {
     128                set dev [lindex $value 2]
     129                set ndev $dev
     130            } else {
     131                set dev [Rappture::Units::convert [lindex $value 2] -context $units]
     132                set ndev [Rappture::Units::convert $dev -units off]
     133            }
     134            if {$ndev <= 0} {
     135                error "Deviation must be positive."
     136            }
     137            return [list gaussian $mean $dev]
     138        }
     139        uniform {
     140            set min [_check_range [lindex $value 1] $min $max $units]
     141            set max [_check_range [lindex $value 2] $min $max $units]
     142            return [list uniform $min $max]
     143        }
     144        exact  {
     145            return [_check_range [lindex $value 1] $min $max $units]
     146        }
     147        default {
     148            return [_check_range [lindex $value 0] $min $max $units]
     149        }
     150    }
     151}
     152
     153# ----------------------------------------------------------------------
     154# USAGE: mconvert value ?-context units? ?-to units? ?-units on/off?
     155#
     156# This version of convert() converts multiple values.  Used when the
     157# value could be a range or probability density function (PDF).
     158# Examples:
     159#    gaussian 100k 1k
     160#    uniform 0eV 10eV
     161#    42
     162#    exact 42
     163# ----------------------------------------------------------------------
     164
     165proc Rappture::Units::mconvert {value args} {
     166    puts "mconvert $value : $args"
     167    array set opts {
     168        -context ""
     169        -to ""
     170        -units "on"
     171    }
     172
     173    set value [split $value]
     174
     175    switch [lindex $value 0] {
     176        normal -
     177        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# ----------------------------------------------------------------------

  • branches/uq/lang/tcl/scripts/library.tcl

    r4180 r5029  
    215215    public method remove {{path ""}}
    216216    public method xml {{path ""}}
     217    public method uq_make_template {}
    217218
    218219    public method diff {libobj}
    … …  
    228229    private variable _root 0       ;# non-zero => this obj owns document
    229230    private variable _document ""  ;# XML DOM tree
    230     private variable _node ""      ;# node within 
     231    private variable _node ""      ;# node within
    231232}
    232233
    … …  
    10381039    return $rlist
    10391040}
     1041
     1042
     1043# FIXME: get units convert. change varlist to have no units
     1044itcl::body Rappture::LibraryObj::uq_make_template {} {
     1045    set varlist ""
     1046    set n [$_node selectNodes /run/input//number]
     1047    foreach _n $n {
     1048        set x [$_n selectNodes current/text()]
     1049        set val [$x nodeValue]
     1050        if {[string equal -length 8 $val "uniform "] ||
     1051            [string equal -length 9 $val "gaussian "]} {
     1052            set unode [$_n selectNodes units/text()]
     1053            if {"" != $unode} {
     1054                set units [$unode nodeValue]
     1055                set val [Rappture::Units::mconvert $val \
     1056                -context $units -to $units -units off]
     1057            }
     1058            $x nodeValue @@[$_n getAttribute id]
     1059            lappend varlist [list [$_n getAttribute id] $val]
     1060        }
     1061    }
     1062    return $varlist
     1063}

  • branches/uq/lang/tcl/scripts/task.tcl

    r4514 r5029  
    1 # -*- mode: tcl; indent-tabs-mode: nil -*- 
     1# -*- mode: tcl; indent-tabs-mode: nil -*-
    22# ----------------------------------------------------------------------
    33#  COMPONENT: task - represents the executable part of a tool
    … …  
    5757    # default method for -jobstats control
    5858    public proc MiddlewareTime {args}
     59
     60    public method get_params {varlist csvname uq_type args}
    5961}
    6062
    … …  
    7577# ----------------------------------------------------------------------
    7678itcl::body Rappture::Task::constructor {xmlobj installdir args} {
     79    puts "Task Init"
    7780    if {![Rappture::library isvalid $xmlobj]} {
    7881        error "bad value \"$xmlobj\": should be Rappture::Library"
    … …  
    138141itcl::body Rappture::Task::run {args} {
    139142    global env errorInfo
    140 
     143    puts "task run $args"
    141144    #
    142145    # Make sure that we save the proper application name.
    … …  
    164167    foreach item {control output error} { set job($item) "" }
    165168
    166     # write out the driver.xml file for the tool
    167     set file "driver[pid].xml"
    168     set status [catch {
    169         set fid [open $file w]
    170         puts $fid "<?xml version=\"1.0\"?>"
    171         puts $fid [$_xmlobj xml]
    172         close $fid
    173     } result]
    174 
    175169    # Set limits for cpu time
    176170    set limit [$_xmlobj get tool.limits.cputime]
    … …  
    185179            set limit 10;               # lower bound is 10 seconds.
    186180        }
    187     }
    188     Rappture::rlimit set cputime $limit 
     181    }
     182    Rappture::rlimit set cputime $limit
     183
     184    # write out the driver.xml file for the tool
     185    set file "driver[pid].xml"
     186    set status [catch {
     187        set fid [open $file w]
     188        puts $fid "<?xml version=\"1.0\"?>"
     189        puts $fid [$_xmlobj xml]
     190        close $fid
     191    } result]
     192
     193    # This will turn the driver xml into a template
     194    # and return a list of the UQ variables and their PDFs.
     195    set uq_varlist [$_xmlobj uq_make_template]
     196
     197    if {$uq_varlist != ""} {
     198        # write out the template file for submit
     199        set tfile "template[pid].xml"
     200        set status [catch {
     201            set fid [open $tfile w]
     202            puts $fid "<?xml version=\"1.0\"?>"
     203            puts $fid [$_xmlobj xml]
     204            close $fid
     205        } result]
     206    }
     207
     208
    189209    # execute the tool using the path from the tool description
    190210    if {$status == 0} {
    191211        set cmd [$_xmlobj get tool.command]
     212        puts "1. cmd=$cmd"
    192213        regsub -all @tool $cmd $_installdir cmd
    193         regsub -all @driver $cmd $file cmd
    194         regsub -all {\\} $cmd {\\\\} cmd
     214
     215        if {$uq_varlist == ""} {
     216            regsub -all @driver $cmd $file cmd
     217        } else {
     218            regsub -all @driver $cmd $tfile cmd
     219        }
    195220        set cmd [string trimleft $cmd " "]
    196         if { $cmd == "" } {
    197             puts stderr "cmd is empty"
    198             return [list 1 "Command is empty.\n\nThere is no command specified by\n\n <command>\n </command>\n\nin the tool.xml file."]
    199         }
    200 
    201         switch -glob -- [resources -jobprotocol] {
    202             "submit*" {
    203                 # if job_protocol is "submit", then use use submit command
    204                 set cmd "submit --local $cmd"
    205             }
    206             "mx" {
    207                 # metachory submission
    208                 set cmd "mx $cmd"
    209             }
    210             "exec" {
    211                 # default -- nothing special
    212             }
    213         }
     221        puts "2. cmd=$cmd"
     222        if { $cmd == "" } {
     223            puts stderr "cmd is empty"
     224            return [list 1 "Command is empty.\n\nThere is no command specified by\n\n <command>\n </command>\n\nin the tool.xml file."]
     225        }
     226
     227        if {$uq_varlist == ""} {
     228            switch -glob -- [resources -jobprotocol] {
     229                "submit*" {
     230                    # if job_protocol is "submit", then use use submit command
     231                    set cmd "submit --local $cmd"
     232                }
     233                "mx" {
     234                    # metachory submission
     235                    set cmd "mx $cmd"
     236                }
     237                "exec" {
     238                    # default -- nothing special
     239                }
     240            }
     241        } else {
     242            puts "uq_varlist=$uq_varlist"
     243            # FIXME. Default to Smolyak level 2, but allow more later.
     244            file delete -force puq
     245            set params_file [get_params $file $uq_varlist "smolyak" 2]
     246            set cmd "submit --runName=puq -l -d $params_file python uq.py $cmd @:$tfile"
     247        }
     248
    214249        $_xmlobj put tool.execute $cmd
    215250
    216         # starting job...
    217         _log run started
    218         Rappture::rusage mark
    219 
    220         if {0 == [string compare -nocase -length 5 $cmd "ECHO "] } {
    221             set status 0;
    222             set job(output) [string range $cmd 5 end]
    223         } else {
    224             set status [catch {
    225                 set ::Rappture::Task::job(control) ""
    226                 eval blt::bgexec \
    227                     ::Rappture::Task::job(control) \
    228                     -keepnewline yes \
    229                     -killsignal SIGTERM \
    230                     -onoutput [list [itcl::code $this _output]] \
     251    puts "cmd=$cmd"
     252    # starting job...
     253    _log run started
     254    Rappture::rusage mark
     255
     256    if {0 == [string compare -nocase -length 5 $cmd "ECHO "] } {
     257        set status 0;
     258        set job(output) [string range $cmd 5 end]
     259    } else {
     260        set status [catch {
     261            set ::Rappture::Task::job(control) ""
     262            eval blt::bgexec \
     263            ::Rappture::Task::job(control) \
     264            -keepnewline yes \
     265            -killsignal SIGTERM \
     266            -onoutput [list [itcl::code $this _output]] \
    231267                    -output ::Rappture::Task::job(output) \
    232268                    -error ::Rappture::Task::job(error) \
    233269                    $cmd
    234             } result]
    235 
    236             if { $status != 0 } {
    237                 # We're here because the exec-ed program failed
    238                 set logmesg $result
    239                 if { $::Rappture::Task::job(control) ne "" } {
    240                     foreach { token pid code mesg } \
    241                         $::Rappture::Task::job(control) break
    242                     if { $token == "EXITED" } {
    243                         # This means that the program exited normally but
    244                         # returned a non-zero exitcode.  Consider this an
    245                         # invalid result from the program.  Append the stderr
    246                         # from the program to the message.
    247                         set logmesg "Program finished: exit code is $code"
    248                         set result "$logmesg\n\n$::Rappture::Task::job(error)"
    249                     } elseif { $token == "abort" }  {
    250                         # The user pressed the abort button.
    251                         set logmesg "Program terminated by user."
    252                         set result "$logmesg\n\n$::Rappture::Task::job(output)"
    253                     } else {
    254                         # Abnormal termination
    255                         set logmesg "Abnormal program termination: $mesg"
    256                         set result "$logmesg\n\n$::Rappture::Task::job(output)"
    257                     }
    258                 }
    259                 _log run failed [list $logmesg]
    260                 return [list $status $result]
    261             }
    262         }
    263         # ...job is finished
    264         array set times [Rappture::rusage measure]
    265 
    266         if {[resources -jobprotocol] ne "submit"} {
    267             set id [$_xmlobj get tool.id]
    268             set vers [$_xmlobj get tool.version.application.revision]
    269             set simulation simulation
    270             if { $id ne "" && $vers ne "" } {
    271                 set pid [pid]
    272                 set simulation ${pid}_${id}_r${vers}
    273             }
    274 
    275             # need to save job info? then invoke the callback
    276             if {[string length $jobstats] > 0} {
    277                 uplevel #0 $jobstats [list job [incr jobnum] \
    278                     event $simulation start $times(start) \
    279                     walltime $times(walltime) cputime $times(cputime) \
    280                     status $status]
    281             }
    282 
    283             #
    284             # Scan through stderr channel and look for statements that
    285             # represent grid jobs that were executed.  The statements
    286             # look like this:
    287             #
    288             # MiddlewareTime: job=1 event=simulation start=3.001094 ...
    289             #
    290             set subjobs 0
    291             while {[regexp -indices {(^|\n)MiddlewareTime:( +[a-z]+=[^ \n]+)+(\n|$)} $job(error) match]} {
    292                 foreach {p0 p1} $match break
    293                 if {[string index $job(error) $p0] == "\n"} { incr p0 }
    294 
    295                 catch {unset data}
    296                 array set data {
    297                     job 1
    298                     event simulation
    299                     start 0
    300                     walltime 0
    301                     cputime 0
    302                     status 0
    303                 }
     270        } result]
     271
     272        if { $status != 0 } {
     273            # We're here because the exec-ed program failed
     274            set logmesg $result
     275            if { $::Rappture::Task::job(control) ne "" } {
     276                foreach { token pid code mesg } \
     277                $::Rappture::Task::job(control) break
     278                if { $token == "EXITED" } {
     279                   # This means that the program exited normally but
     280                   # returned a non-zero exitcode.  Consider this an
     281                   # invalid result from the program.  Append the stderr
     282                   # from the program to the message.
     283                   set logmesg "Program finished: exit code is $code"
     284                   set result "$logmesg\n\n$::Rappture::Task::job(error)"
     285                } elseif { $token == "abort" }  {
     286                    # The user pressed the abort button.
     287                    set logmesg "Program terminated by user."
     288                    set result "$logmesg\n\n$::Rappture::Task::job(output)"
     289                } else {
     290                    # Abnormal termination
     291                    set logmesg "Abnormal program termination: $mesg"
     292                    set result "$logmesg\n\n$::Rappture::Task::job(output)"
     293                }
     294            }
     295            _log run failed [list $logmesg]
     296            return [list $status $result]
     297        }
     298    }
     299    # ...job is finished
     300    array set times [Rappture::rusage measure]
     301
     302    if {[resources -jobprotocol] ne "submit"} {
     303        set id [$_xmlobj get tool.id]
     304        set vers [$_xmlobj get tool.version.application.revision]
     305        set simulation simulation
     306        if { $id ne "" && $vers ne "" } {
     307            set pid [pid]
     308            set simulation ${pid}_${id}_r${vers}
     309        }
     310
     311        # need to save job info? then invoke the callback
     312        if {[string length $jobstats] > 0} {
     313            uplevel #0 $jobstats [list job [incr jobnum] \
     314            event $simulation start $times(start) \
     315            walltime $times(walltime) cputime $times(cputime) \
     316            status $status]
     317        }
     318
     319        #
     320        # Scan through stderr channel and look for statements that
     321        # represent grid jobs that were executed.  The statements
     322        # look like this:
     323        #
     324        # MiddlewareTime: job=1 event=simulation start=3.001094 ...
     325        #
     326        set subjobs 0
     327        while {[regexp -indices {(^|\n)MiddlewareTime:( +[a-z]+=[^ \n]+)+(\n|$)} $job(error) match]} {
     328            foreach {p0 p1} $match break
     329            if {[string index $job(error) $p0] == "\n"} { incr p0 }
     330
     331            catch {unset data}
     332            array set data {
     333                job 1
     334                event simulation
     335                start 0
     336                walltime 0
     337                cputime 0
     338                status 0
     339            }
    304340                foreach arg [lrange [string range $job(error) $p0 $p1] 1 end] {
    305341                    foreach {key val} [split $arg =] break
    … …  
    337373    }
    338374    if {$status == 0} {
    339         file delete -force -- $file
     375        # file delete -force -- $file
    340376    }
    341377
    … …  
    350386    # a reference to the run.xml file containing results.
    351387    #
     388
    352389    if {$status == 0} {
    353390        set result [string trim $job(output)]
     391        puts "result=$result"
     392        if {$uq_varlist != ""} {
     393            file delete -force -- new.xml
     394            exec puq_analyze.py puq_[pid].hdf5
     395            append result "\n" "=RAPPTURE-RUN=>new.xml"
     396        }
    354397        if {[regexp {=RAPPTURE-RUN=>([^\n]+)} $result match file]} {
    355398            set status [catch {Rappture::library $file} result]
     399            puts "STATUS=$status"
    356400            if {$status == 0} {
    357401                # add cputime info to run.xml file
    … …  
    381425            if {$status == 0 && $rdir ne ""} {
    382426                catch {
    383                     file delete -force -- $file
     427                    # file delete -force -- $file
    384428                    if {![file exists $rdir]} {
    385429                        _mkdir $rdir
    … …  
    393437            } else {
    394438                # don't keep the file
    395                 file delete -force -- $file
     439                # file delete -force -- $file
    396440            }
    397441        } else {
    … …  
    518562    puts stderr $line
    519563}
     564
     565
     566#
     567# Send the list of parameters to a python program so it can call PUQ
     568# and get a CSV file containing the parameter values to use for the runs.
     569itcl::body Rappture::Task::get_params {dfile varlist uq_type args} {
     570
     571    # convert tcl list of variables to json so python can read it
     572    proc varlist2py {inlist} {
     573        set ovar "\["
     574        set first 1
     575        foreach a $inlist {
     576            foreach {var val} $a break
     577            if {$first == 1} {
     578                append ovar \[\"$var\",
     579                set first 0
     580            } else {
     581                append ovar \],\[\"$var\",
     582            }
     583            switch [lindex $val 0] {
     584                gaussian {
     585                    append ovar "\[\"gaussian\",[lindex $val 1],[lindex $val 2]\]"
     586                }
     587                uniform {
     588                    append ovar "\[\"uniform\",[lindex $val 1],[lindex $val 2]\]"
     589                }
     590                default {
     591                    append ovar $val
     592                }
     593            }
     594        }
     595        append ovar "\]\]"
     596        return $ovar
     597    }
     598
     599    puts "varlist=$varlist"
     600    set varlist [varlist2py $varlist]
     601    set pid [pid]
     602    exec get_params.py $dfile $pid $varlist $uq_type $args
     603    return params[pid].csv
     604}

  • branches/uq/lang/tcl/scripts/units.tcl

    r3362 r5029  
     1# -*- mode: tcl; indent-tabs-mode: nil -*-
    12# ----------------------------------------------------------------------
    23#  COMPONENT: units - mechanism for converting numbers with units
    … …  
    6061}
    6162
     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    # make sure the value has units
     78    if {$units != ""} {
     79        set value [Rappture::Units::convert $value -context $units]
     80        # for comparisons, remove units
     81        set nv [Rappture::Units::convert $value -units off]
     82        # get the units for the value
     83        set newunits [Rappture::Units::Search::for $value]
     84    } else {
     85        set nv $value
     86    }
     87
     88    if {"" != $min} {
     89        if {"" != $units} {
     90            # compute the minimum in the new units
     91            set minv [Rappture::Units::convert $min -to $newunits -units off]
     92            # same, but include units for printing
     93            set convMinVal [Rappture::Units::convert $min -to $newunits]
     94        } else {
     95            set minv $min
     96            set convMinVal $min
     97        }
     98        if {$nv < $minv} {
     99            error "Minimum value allowed here is $convMinVal"
     100        }
     101    }
     102    if {"" != $max} {
     103        if {"" != $units} {
     104            # compute the maximum in the new units
     105            set maxv [Rappture::Units::convert $max -to $newunits -units off]
     106            # same, but include units for printing
     107            set convMaxVal [Rappture::Units::convert $max -to $newunits]
     108        } else {
     109            set maxv $max
     110            set convMaxVal $max
     111        }
     112        if {$nv > $maxv} {
     113            error "Maximum value allowed here is $convMaxVal"
     114        }
     115    }
     116    return $value
     117}
     118
     119proc Rappture::Units::mcheck_range {value {min ""} {max ""} {units ""}} {
     120    puts "mcheck_range $value min=$min max=$max units=$units"
     121
     122    switch -- [lindex $value 0] {
     123        normal -
     124        gaussian {
     125            # get the mean
     126            set mean [_check_range [lindex $value 1] $min $max $units]
     127            if {$units == ""} {
     128                set dev [lindex $value 2]
     129                set ndev $dev
     130            } else {
     131                set dev [Rappture::Units::convert [lindex $value 2] -context $units]
     132                set ndev [Rappture::Units::convert $dev -units off]
     133            }
     134            if {$ndev <= 0} {
     135                error "Deviation must be positive."
     136            }
     137            return [list gaussian $mean $dev]
     138        }
     139        uniform {
     140            set min [_check_range [lindex $value 1] $min $max $units]
     141            set max [_check_range [lindex $value 2] $min $max $units]
     142            return [list uniform $min $max]
     143        }
     144        exact  {
     145            return [_check_range [lindex $value 1] $min $max $units]
     146        }
     147        default {
     148            return [_check_range [lindex $value 0] $min $max $units]
     149        }
     150    }
     151}
     152
     153# ----------------------------------------------------------------------
     154# USAGE: mconvert value ?-context units? ?-to units? ?-units on/off?
     155#
     156# This version of convert() converts multiple values.  Used when the
     157# value could be a range or probability density function (PDF).
     158# Examples:
     159#    gaussian 100k 1k
     160#    uniform 0eV 10eV
     161#    42
     162#    exact 42
     163# ----------------------------------------------------------------------
     164
     165proc Rappture::Units::mconvert {value args} {
     166    puts "mconvert $value : $args"
     167    array set opts {
     168        -context ""
     169        -to ""
     170        -units "on"
     171    }
     172
     173    set value [split $value]
     174
     175    switch [lindex $value 0] {
     176        normal -
     177        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
    62226# ----------------------------------------------------------------------
    63227# USAGE: convert value ?-context units? ?-to units? ?-units on/off?
    … …  
    69233# current system.
    70234# ----------------------------------------------------------------------
    71 proc Rappture::Units::convert {value args} {
    72     array set opts {
    73         -context ""
    74         -to ""
    75         -units "on"
    76     }
    77     foreach {key val} $args {
    78         if {![info exists opts($key)]} {
    79             error "bad option \"$key\": should be [join [lsort [array names opts]] {, }]"
    80         }
    81         set opts($key) $val
    82     }
    83 
    84     #
    85     # Parse the value into the number part and the units part.
    86     #
    87     set value [string trim $value]
    88     if {![regexp {^([-+]?[0-9]+\.?([0-9]+)?([eEdD][-+]?[0-9]+)?) *(/?[a-zA-Z]+[0-9]*)?$} $value match number dummy1 dummy2 units]} {
    89         set mesg "bad value \"$value\": should be real number with units"
    90         if {$opts(-context) != ""} {
    91             append mesg " of [Rappture::Units::description $opts(-context)]"
    92         }
    93         error $mesg
    94     }
    95     if {$units == ""} {
    96         set units $opts(-context)
    97     }
    98 
    99     #
    100     # Try to find the object representing the current system of units.
    101     #
    102     set units [Rappture::Units::System::regularize $units]
    103     set oldsys [Rappture::Units::System::for $units]
    104     if {$oldsys == ""} {
    105         set mesg "value \"$value\" has unrecognized units"
    106         if {$opts(-context) != ""} {
    107             append mesg ".\nShould be units of [Rappture::Units::description $opts(-context)]"
    108         }
    109         error $mesg
    110     }
    111 
    112     #
    113     # Convert the number to the new system of units.
    114     #
    115     if {$opts(-to) == ""} {
    116         # no units -- return the number as is
    117         return "$number$units"
    118     }
    119     return [$oldsys convert "$number$units" $opts(-to) $opts(-units)]
    120 }
     235# proc Rappture::Units::convert {value args} {}
     236# Actual implementation is in rappture/lang/tcl/src/RpUnitsTclInterface.cc.
     237
    121238
    122239# ----------------------------------------------------------------------
    … …  
    127244# along with a list of all compatible systems.
    128245# ----------------------------------------------------------------------
    129 proc Rappture::Units::description {units} {
    130     set sys [Rappture::Units::System::for $units]
    131     if {$sys == ""} {
    132         return ""
    133     }
    134     set mesg [$sys cget -type]
    135     set ulist [Rappture::Units::System::all $units]
    136     if {"" != $ulist} {
    137         append mesg " ([join $ulist {, }])"
    138     }
    139     return $mesg
    140 }
     246# proc Rappture::Units::description {units} {}
     247# Actual implementation is in rappture/lang/tcl/src/RpUnitsTclInterface.cc.
     248
    141249
    142250# ----------------------------------------------------------------------
    … …  
    153261    private variable _system ""  ;# this system of units
    154262
    155     public proc for {units}
    156     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
    157267    public proc regularize {units}
    158268
    … …  
    360470# if there is no system that matches the units string.
    361471# ----------------------------------------------------------------------
    362 itcl::body Rappture::Units::System::for {units} {
    363     #
    364     # See if the units are a recognized system.  If not, then try to
    365     # extract any metric prefix and see if what's left is a recognized
    366     # system.  If all else fails, see if we can find a system without
    367     # the exact capitalization.  The user might say "25c" instead of
    368     # "25C".  Try to allow that.
    369     #
    370     if {[info exists _base($units)]} {
    371         return $_base($units)
    372     } else {
    373         set orig $units
    374         if {[regexp {^(/?)[cCmMuUnNpPfFaAkKgGtT](.+)$} $units match slash tail]} {
    375             set base "$slash$tail"
    376             if {[info exists _base($base)]} {
    377                 set sys $_base($base)
    378                 if {[$sys cget -metric]} {
    379                     return $sys
    380                 }
    381             }
    382 
    383             # check the base part for improper capitalization below...
    384             set units $base
    385         }
    386 
    387         set matching ""
    388         foreach u [array names _base] {
    389             if {[string equal -nocase $u $units]} {
    390                 lappend matching $_base($u)
    391             }
    392         }
    393         if {[llength $matching] == 1} {
    394             set sys [lindex $matching 0]
    395             #
    396             # If we got rid of a metric prefix above, make sure
    397             # that the system is metric.  If not, then we don't
    398             # have a match.
    399             #
    400             if {[string equal $units $orig] || [$sys cget -metric]} {
    401                 return $sys
    402             }
    403         }
    404     }
    405     return ""
    406 }
     472# itcl::body Rappture::Units::System::for {units} {}
     473# Actual implementation is in rappture/lang/tcl/src/RpUnitsTclInterface.cc.
     474
    407475
    408476# ----------------------------------------------------------------------
    … …  
    413481# relationships that lead to the same base system.
    414482# ----------------------------------------------------------------------
    415 itcl::body Rappture::Units::System::all {units} {
    416     set sys [Rappture::Units::System::for $units]
    417     if {$sys == ""} {
    418         return ""
    419     }
    420 
    421     if {"" != [$sys cget -basis]} {
    422         set basis [lindex [$sys cget -basis] 0]
    423     } else {
    424         set basis $units
    425     }
    426 
    427     set ulist $basis
    428     foreach u [array names _base] {
    429         set obj $_base($u)
    430         set b [lindex [$obj cget -basis] 0]
    431         if {$b == $basis} {
    432             lappend ulist $u
    433         }
    434     }
    435     return $ulist
    436 }
     483# itcl::body Rappture::Units::System::all {units} {}
     484# Actual implementation is in rappture/lang/tcl/src/RpUnitsTclInterface.cc.
     485
    437486
    438487# ----------------------------------------------------------------------

  • branches/uq/src/core/RpUnits.cc

    r4224 r5029  
    7070    exponent = 1;
    7171
    72     // check to see if there is an exponent at the end 
     72    // check to see if there is an exponent at the end
    7373    // of the search string
    7474    idx = RpUnits::grabExponent(searchStr, &exponent);
    … …  
    353353            }
    354354
    355             // check to see if they are the same basis, 
     355            // check to see if they are the same basis,
    356356            // no need to list all of the metric conversions.
    357357            if (basis) {
    … …  
    493493
    494494    // this is kinda the wrong way to get the job done...
    495     // how do we only create 1 conversion object and share it between 
    496     // atleast two RpUnits objs so that when the RpUnits objs are 
     495    // how do we only create 1 conversion object and share it between
     496    // atleast two RpUnits objs so that when the RpUnits objs are
    497497    // deleted, we are not trying to delete already deleted memory.
    498498    // so for the sake of safety we get the following few lines of code.
    … …  
    528528    // this is kinda the wrong way to get the job done...
    529529    // how do we only create 1 conversion object and share it between at
    530     // least two RpUnits objs so that when the RpUnits objs are deleted, 
     530    // least two RpUnits objs so that when the RpUnits objs are deleted,
    531531    // we are not trying to delete already deleted memory.
    532532    // so for the sake of safety we get the following few lines of code.
    … …  
    640640/// Retrieve the RpUnits object representing the basis of this object.
    641641/**
    642  * Returns a pointer to a RpUnits object which, on success, points to the 
     642 * Returns a pointer to a RpUnits object which, on success, points to the
    643643 * RpUnits object that is the basis of the calling object.
    644644 */
    … …  
    808808 * across a unit that is unrecognized or can not be interpreted, then it
    809809 * returns error (a non-zero value).
    810  * 
     810 *
    811811 * if &compatList == NULL, no compatible list of units will be generated.
    812  * this function does not do a good job of placing the available units 
     812 * this function does not do a good job of placing the available units
    813813 * back into the original formula. i still need to work on this.
    814814 */
    … …  
    920920
    921921    if ((RPUNITS_ORIG_EXP & flags) == RPUNITS_STRICT_NAME) {
    922         // if the user asks for strict naming, 
     922        // if the user asks for strict naming,
    923923        // always place the exponent on the name
    924924        name << myExp;
    … …  
    11141114
    11151115        /*
    1116         // if the exponent != 1,-1 then do a second search 
     1116        // if the exponent != 1,-1 then do a second search
    11171117        // for the unit+exponent string that might be defined.
    11181118        // this is to cover the case were we have defined conversions
    … …  
    13971397    // these are conditions where no conversion is needed
    13981398    if ( (fromUnitsName.empty()) || (toUnitsName == fromUnitsName) )  {
    1399         // there were no units in the input 
     1399        // there were no units in the input
    14001400        // string or no conversion needed
    14011401        // assume fromUnitsName = toUnitsName
    … …  
    15081508                    toIter = toUnitsList.begin();
    15091509
    1510                     // raise error that there was an 
     1510                    // raise error that there was an
    15111511                    // unrecognized conversion request
    15121512
    … …  
    16511651    }
    16521652
    1653     return (std::string(unitText.str())); 
     1653    return (std::string(unitText.str()));
    16541654
    16551655}
    … …  
    17011701    // trying to avoid the recursive way of converting to the basis.
    17021702    // need to rethink this.
    1703     // 
     1703    //
    17041704    if ( (basis) && (basis->getUnitsName() != toUnit->getUnitsName()) ) {
    17051705        value = convert(basis,value,&my_result);
    … …  
    17111711    // find the toUnit in our dictionary.
    17121712    // if the toUnits has a basis, we need to search for the basis
    1713     // and convert between basis' and then convert again back to the 
     1713    // and convert between basis' and then convert again back to the
    17141714    // original unit.
    17151715    if ( (toBasis) && (toBasis->getUnitsName() != fromUnit->getUnitsName()) ) {
    … …  
    17551755            // conversion for a two arg conv function pointer
    17561756            // need to make this simpler, more logical maybe only allow 2 arg
    1757             if (       (p->conv->convForwFxnPtr) 
     1757            if (       (p->conv->convForwFxnPtr)
    17581758                    && (! p->conv->convForwFxnPtrDD) ) {
    17591759
    17601760                value = p->conv->convForwFxnPtr(value);
    17611761            }
    1762             else if (  (p->conv->convForwFxnPtrDD) 
     1762            else if (  (p->conv->convForwFxnPtrDD)
    17631763                    && (! p->conv->convForwFxnPtr) ) {
    17641764
    1765                 value = 
     1765                value =
    17661766                    p->conv->convForwFxnPtrDD(value, fromUnit->getExponent());
    17671767            }
    … …  
    17701770            // or to the requested unit's basis.
    17711771            // if we converted to the requested unit's basis. we need to
    1772             // do one last conversion from the requested unit's basis back 
     1772            // do one last conversion from the requested unit's basis back
    17731773            // to the requested unit.
    17741774            if ( (toBasis) && (toBasis->getUnitsName() != fromUnit->getUnitsName()) ) {
    … …  
    17831783
    17841784            // change the result code to zero, a conversion was performed
    1785             // (we think)... its ture that it is possible to get to this 
    1786             // point and have skipped the conversion because the 
     1785            // (we think)... its ture that it is possible to get to this
     1786            // point and have skipped the conversion because the
    17871787            // conversion object was not properly created...
    17881788            // ie. both fxn ptrs were null or neither fxn ptr was null
    … …  
    18031803            // conversion for a two arg conv function pointer
    18041804            // need to make this simpler, more logical maybe only allow 2 arg
    1805             if (       (p->conv->convBackFxnPtr) 
     1805            if (       (p->conv->convBackFxnPtr)
    18061806                    && (! p->conv->convBackFxnPtrDD) ) {
    18071807
    18081808                value = p->conv->convBackFxnPtr(value);
    18091809            }
    1810             else if (  (p->conv->convBackFxnPtrDD) 
     1810            else if (  (p->conv->convBackFxnPtrDD)
    18111811                    && (! p->conv->convBackFxnPtr) ) {
    18121812
    1813                 value = 
     1813                value =
    18141814                    p->conv->convBackFxnPtrDD(value, fromUnit->getExponent());
    18151815            }
    … …  
    18181818            // or to the requested unit's basis.
    18191819            // if we converted to the requested unit's basis. we need to
    1820             // do one last conversion from the requested unit's basis back 
     1820            // do one last conversion from the requested unit's basis back
    18211821            // to the requested unit.
    18221822            if ( (toBasis) && (toBasis->getUnitsName() != fromUnit->getUnitsName()) ) {
    … …  
    18311831
    18321832            // change the result code to zero, a conversion was performed
    1833             // (we think)... its ture that it is possible to get to this 
    1834             // point and have skipped the conversion because the 
     1833            // (we think)... its ture that it is possible to get to this
     1834            // point and have skipped the conversion because the
    18351835            // conversion object was not properly created...
    18361836            // ie. both fxn ptrs were null or neither fxn ptr was null
    … …  
    19111911    // find the toUnit in our dictionary.
    19121912    // if the toUnits has a basis, we need to search for the basis
    1913     // and convert between basis' and then convert again back to the 
     1913    // and convert between basis' and then convert again back to the
    19141914    // original unit.
    19151915    if ( (toBasis) && (toBasis->getUnitsName() != fromUnit->getUnitsName()) ) {
    … …  
    19551955            // or to the requested unit's basis.
    19561956            // if we converted to the requested unit's basis. we need to
    1957             // do one last conversion from the requested unit's basis back 
     1957            // do one last conversion from the requested unit's basis back
    19581958            // to the requested unit.
    19591959            if ( (toBasis) && (toBasis->getUnitsName() != fromUnit->getUnitsName()) ) {
    … …  
    19681968
    19691969            // change the result code to zero, a conversion was performed
    1970             // (we think)... its ture that it is possible to get to this 
    1971             // point and have skipped the conversion because the 
     1970            // (we think)... its ture that it is possible to get to this
     1971            // point and have skipped the conversion because the
    19721972            // conversion object was not properly created...
    19731973            // ie. both fxn ptrs were null or neither fxn ptr was null
    … …  
    19881988            // or to the requested unit's basis.
    19891989            // if we converted to the requested unit's basis. we need to
    1990             // do one last conversion from the requested unit's basis back 
     1990            // do one last conversion from the requested unit's basis back
    19911991            // to the requested unit.
    19921992            if ( (toBasis) && (toBasis->getUnitsName() != fromUnit->getUnitsName()) ) {
    … …  
    20012001
    20022002            // change the result code to zero, a conversion was performed
    2003             // (we think)... its ture that it is possible to get to this 
    2004             // point and have skipped the conversion because the 
     2003            // (we think)... its ture that it is possible to get to this
     2004            // point and have skipped the conversion because the
    20052005            // conversion object was not properly created...
    20062006            // ie. both fxn ptrs were null or neither fxn ptr was null
    … …  
    20842084    // find the toUnit in our dictionary.
    20852085    // if the toUnits has a basis, we need to search for the basis
    2086     // and convert between basis' and then convert again back to the 
     2086    // and convert between basis' and then convert again back to the
    20872087    // original unit.
    20882088    if ( (toBasis) && (toBasis->getUnitsName() != fromUnit->getUnitsName()) ) {
    … …  
    21482148            // or to the requested unit's basis.
    21492149            // if we converted to the requested unit's basis. we need to
    2150             // do one last conversion from the requested unit's basis back 
     2150            // do one last conversion from the requested unit's basis back
    21512151            // to the requested unit.
    21522152            if ( (toBasis) && (toBasis->getUnitsName() != fromUnit->getUnitsName()) ) {
    … …  
    21662166            // conversion for a two arg conv function pointer
    21672167            // need to make this simpler, more logical maybe only allow 2 arg
    2168             if (       (p->conv->convBackFxnPtr) 
     2168            if (       (p->conv->convBackFxnPtr)
    21692169                    && (! p->conv->convBackFxnPtrDD) ) {
    21702170
    … …  
    21842184            // or to the requested unit's basis.
    21852185            // if we converted to the requested unit's basis. we need to
    2186             // do one last conversion from the requested unit's basis back 
     2186            // do one last conversion from the requested unit's basis back
    21872187            // to the requested unit.
    21882188            if ( (toBasis) && (toBasis->getUnitsName() != fromUnit->getUnitsName()) ) {
    … …  
    22802280/// Place an RpUnits Object into the Rappture Units Dictionary.
    22812281/**
    2282  * Return whether the inserted key was new with a non-zero 
     2282 * Return whether the inserted key was new with a non-zero
    22832283 * value, or if the key already existed with a value of zero.
    22842284 */
    … …  
    24422442/**********************************************************************/
    24432443// METHOD: addPresetPrefix()
    2444 /// 
     2444///
    24452445/**
    24462446 * Defines the following unit prefixes:
    … …  
    25432543 *   days     (d)
    25442544 *
    2545  *   month and year are not included because simple 
     2545 *   month and year are not included because simple
    25462546 *   day->month conversions may be misleading
    25472547 *   month->year conversions may be included in the future
    2548  * 
     2548 *
    25492549 * Return codes: 0 success, anything else is error
    25502550 */
    … …  
    32293229/// Convert a std::list<std::string> into a comma delimited std::string
    32303230/**
    3231  * Iterates through a std::list<std::string> and returns a comma 
     3231 * Iterates through a std::list<std::string> and returns a comma
    32323232 * delimited std::string containing the elements of the inputted std::list.
    32333233 *
Note: See TracChangeset for help on using the changeset viewer.