Changeset 4992 for branches


Ignore:
Timestamp:
Feb 10, 2015 7:17:06 PM (6 years ago)
Author:
dkearney
Message:

merging trunk changes to uiuc_vtk_viewers

Location:
branches/uiuc_vtk_viewers
Files:
15 edited

Legend:

Unmodified
Added
Removed
  • branches/uiuc_vtk_viewers

  • branches/uiuc_vtk_viewers/gui/apps/execute.tcl

    r4856 r4992  
    6767set toolobj [Rappture::library $toolxml]
    6868set TaskObj [Rappture::Task ::#auto $toolobj $installdir]
     69set LogFid ""
    6970
    70 # tasks in execute mode run quietly and don't try to save results
    71 $TaskObj configure -jobstats "" -resultdir ""
     71# Define some things that we need for logging status...
     72# ----------------------------------------------------------------------
     73proc log_output {message} {
     74    global LogFid
     75
     76    if {$LogFid ne ""} {
     77        #
     78        # Scan through and pick out any =RAPPTURE-PROGRESS=> messages.
     79        #
     80        set percent ""
     81        while {[regexp -indices \
     82                {=RAPPTURE-PROGRESS=> *([-+]?[0-9]+) +([^\n]*)(\n|$)} $message \
     83                 match percent mesg]} {
     84
     85            foreach {i0 i1} $percent break
     86            set percent [string range $message $i0 $i1]
     87
     88            foreach {i0 i1} $mesg break
     89            set mesg [string range $message $i0 $i1]
     90
     91            foreach {i0 i1} $match break
     92            set message [string replace $message $i0 $i1]
     93        }
     94        if {$percent ne ""} {
     95            # report the last percent progress found
     96            log_append progress "$percent% - $mesg"
     97        }
     98    }
     99}
     100
     101# Actually write to the log file
     102proc log_append {level message} {
     103    global LogFid
     104
     105    if {$LogFid ne ""} {
     106        set date [clock format [clock seconds] -format {%Y-%m-%dT%H:%M:%S%z}]
     107        set host [info hostname]
     108        puts $LogFid "$date $host rappture [pid] \[$level\] $message"
     109        flush $LogFid
     110    }
     111}
     112
     113# Actually write to the log file
     114proc log_stats {args} {
     115    set line ""
     116    foreach {key val} $args {
     117        append line "$key=$val "
     118    }
     119    log_append usage $line
     120}
     121
     122# Parse command line options to see
     123# ----------------------------------------------------------------------
     124Rappture::getopts argv params {
     125    value -status ""
     126    value -output ""
     127    value -cleanup no
     128}
     129
     130if {$params(-status) ne ""} {
     131    set LogFid [open $params(-status) w]
     132    $TaskObj configure -logger {log_append status} -jobstats log_stats
     133}
     134
     135if {$params(-output) eq ""} {
     136    # no output? then run quietly and don't try to save results
     137    $TaskObj configure -jobstats "" -resultdir ""
     138}
    72139
    73140# Transfer input values from driver to TaskObj, and then run.
     
    80147        lappend args $path [$driverobj get $path.current]
    81148    }
     149}
     150
     151if {$params(-status) ne ""} {
     152    # recording status? then look through output for progress messages
     153    lappend args -output log_output
    82154}
    83155
     
    95167    $runxml put output.status failed
    96168}
    97 $runxml put output.time [clock format [clock seconds]]
    98169
    99 $runxml put tool.version.rappture.version $::Rappture::version
    100 $runxml put tool.version.rappture.revision $::Rappture::build
    101 
    102 if {[info exists tcl_platform(user)]} {
    103     $runxml put output.user $::tcl_platform(user)
     170# Handle output
     171# ----------------------------------------------------------------------
     172switch -- $params(-output) {
     173    "" {
     174        # no output file -- write to stdout
     175        puts "<?xml version=\"1.0\"?>\n[$runxml xml]"
     176    }
     177    "@default" {
     178        # do the usual Rappture thing -- move to results dir
     179        # but ignore any errors if it fails
     180        catch {$TaskObj save $runxml}
     181    }
     182    default {
     183        # save to the specified file
     184        $TaskObj save $runxml $params(-output)
     185    }
    104186}
    105187
    106 puts "<?xml version=\"1.0\"?>\n[$runxml xml]"
     188if {$params(-cleanup)} {
     189    file delete -force -- $driverxml
     190}
     191
     192log_append status "exit $status"
    107193exit $status
  • branches/uiuc_vtk_viewers/gui/apps/launcher.tcl

    r4834 r4992  
    2727set mainscript ""
    2828set alist ""
     29set loadlist ""
    2930set toolxml ""
     31
     32# ----------------------------------------------------------------------
     33#  Look for parameters passed into the tool session.  If there are
     34#  any "file" parameters, they indicate files that should be loaded
     35#  for browsing or executed to get results:
     36#
     37#    file(load):/path/to/run.xml
     38#    file(execute):/path/to/driver.xml
     39# ----------------------------------------------------------------------
     40set params(opt) ""
     41set params(load) ""
     42set params(execute) ""
     43set params(input) ""
     44
     45if {[info exists env(TOOL_PARAMETERS)]} {
     46    # if we can't find the file, wait a little
     47    set ntries 25
     48    while {$ntries > 0 && ![file exists $env(TOOL_PARAMETERS)]} {
     49        after 200
     50        incr ntries -1
     51    }
     52
     53    if {![file exists $env(TOOL_PARAMETERS)]} {
     54        # still no file after all that? then skip parameters
     55        puts stderr "WARNING: can't read tool parameters in file \"$env(TOOL_PARAMETERS)\"\nFile not found."
     56
     57    } elseif {[catch {
     58        # read the file and parse the contents
     59        set fid [open $env(TOOL_PARAMETERS) r]
     60        set info [read $fid]
     61        close $fid
     62    } result] != 0} {
     63        puts stderr "WARNING: can't read tool parameters in file \"$env(TOOL_PARAMETERS)\"\n$result"
     64
     65    } else {
     66        # parse the contents of the tool parameter file
     67        foreach line [split $info \n] {
     68            set line [string trim $line]
     69            if {$line eq "" || [regexp {^#} $line]} {
     70                continue
     71            }
     72
     73            if {[regexp {^([a-zA-Z]+)(\(into\:)(.+)\)\:(.+)$} $line match type name path value]
     74                || [regexp {^([a-zA-Z]+)(\([^)]+\))?\:(.+)} $line match type name value]} {
     75                if {$type eq "file"} {
     76                    switch -exact -- $name {
     77                        "(load)" - "" {
     78                            lappend params(load) $value
     79                            set params(opt) "-load"
     80                        }
     81                        "(execute)" {
     82                            set params(execute) $value
     83                            set params(opt) "-execute"
     84                        }
     85                        "(input)" {
     86                            set params(input) $value
     87                            set params(opt) "-input"
     88                        }
     89                        "(into:" {
     90                            namespace eval ::Rappture { # forward decl }
     91                            set ::Rappture::parameters($path) $value
     92                        }
     93                        default {
     94                            puts stderr "WARNING: directive $name not recognized for file parameter \"$value\""
     95                        }
     96                    }
     97                }
     98            }
     99        }
     100    }
     101}
    30102
    31103# scan through the arguments and look for the function
     
    81153                lappend alist -tool $toolxml
    82154            }
    83             -tool - -testdir - -nosim {
     155            -testdir - -nosim {
    84156                lappend alist $opt [lindex $argv 0]
    85157                set argv [lrange $argv 1 end]
     
    93165            }
    94166            -load {
    95                 lappend alist $opt
    96167                while { [llength $argv] > 0 } {
    97168                    set val [lindex $argv 0]
     
    99170                        break
    100171                    }
    101                     lappend alist $val
     172                    lappend loadlist $val
    102173                    set argv [lrange $argv 1 end]
    103174                }
     
    115186}
    116187
    117 # If no arguments, assume that it's the -run option
     188# If no arguments, check to see if there are any tool parameters.
     189# If not, then assume that it's the -run option.
    118190if {$mainscript eq ""} {
    119     package require RapptureGUI
    120     set guidir $RapptureGUI::library
    121     set mainscript [file join $guidir scripts main.tcl]
    122     set reqpkgs Tk
     191    switch -- $params(opt) {
     192        -load {
     193            # add tool parameters to the end of any files given on cmd line
     194            set loadlist [concat $loadlist $params(load)]
     195            set alist [concat $alist -load $loadlist]
     196
     197            package require RapptureGUI
     198            set guidir $RapptureGUI::library
     199            set mainscript [file join $guidir scripts main.tcl]
     200            set reqpkgs Tk
     201        }
     202        -execute {
     203            if {[llength $params(execute)] != 1} {
     204                puts stderr "ERROR: wrong number of (execute) files in TOOL_PARAMETERS (should be only 1)"
     205                exit 1
     206            }
     207            set driverxml [lindex $params(execute) 0]
     208            if {![file readable $driverxml]} {
     209                puts stderr "error: driver file \"$driverxml\" not found"
     210                exit 1
     211            }
     212            set dir [file dirname [info script]]
     213            set mainscript [file join $dir execute.tcl]
     214            set reqpkgs ""
     215
     216            # When executing from TOOL_PARAMETERS file directives,
     217            # report status, clean up, and save output to data/results.
     218            # This helps the web services interface do its thing.
     219            set alist [list \
     220                -output @default \
     221                -status rappture.status \
     222                -cleanup yes]
     223        }
     224        "" - "-input" {
     225            package require RapptureGUI
     226            set guidir $RapptureGUI::library
     227            set mainscript [file join $guidir scripts main.tcl]
     228            set reqpkgs Tk
     229
     230            # finalize the -input argument for "rappture -run"
     231            if {$params(input) ne ""} {
     232                if {![file readable $params(input)]} {
     233                    puts stderr "error: driver file \"$params(input)\" not found"
     234                    exit 1
     235                }
     236                set alist [concat $alist -input $params(input)]
     237            }
     238
     239            # finalize any pending -load arguments for "rappture -run"
     240            if {[llength $loadlist] > 0} {
     241                set alist [concat $alist -load $loadlist]
     242            }
     243        }
     244        default {
     245            puts stderr "internal error: funny action \"$params(opt)\" inferred from TOOL_PARAMETERS"
     246            exit 1
     247        }
     248    }
     249} else {
     250    # finalize any pending -load arguments for "rappture -run"
     251    if {[llength $loadlist] > 0} {
     252        set alist [concat $alist -load $loadlist]
     253    }
    123254}
    124255
  • branches/uiuc_vtk_viewers/gui/scripts/field.tcl

    r4940 r4992  
    4141#       mesh        3   points-on-mesh                  isosurface      vtkvis
    4242#       dx          3   DX                              volume          nanovis
    43 #       unirect2d   2   unirect3d + extents > 1 flow    flow            nanovis
    44 #       unirect3d   3   unirect2d + extents > 1 flow    flow            nanovis
    45 #       
     43#       unirect2d   2   unirect2d + extents > 1 flow    flow            nanovis
     44#       unirect3d   3   unirect3d + extents > 1 flow    flow            nanovis
     45#
    4646# With <views>, can specify which viewer for specific datasets.  So it's OK
    4747# for the same dataset to be viewed in more than one way.
  • branches/uiuc_vtk_viewers/gui/scripts/main.tcl

    r3700 r4992  
    9393    value -tool tool.xml
    9494    list  -load ""
     95    value -input ""
    9596    value -nosim 0
    96 }
    97 
    98 proc ReadToolParameters { numTries } {
    99     incr numTries -1
    100     if { $numTries < 0 } {
    101         return
    102     }
    103     global env
    104     set paramsFile $env(TOOL_PARAMETERS)
    105     if { ![file readable $paramsFile] } {
    106         after 500 ReadToolParmeters $numTries
    107         return
    108     }
    109     catch {
    110         set f [open $paramsFile "r"]
    111         set contents [read $f]
    112         close $f
    113         set pattern {^file\((.*)\):(.*)$}
    114         foreach line [split $contents "\n"] {
    115             if { [regexp $pattern $line match path rest] } {
    116                 set ::Rappture::parameters($path) $rest
    117             }
    118         }
    119     }
    120 }
    121 
    122 if { [info exists env(TOOL_PARAMETERS)] } {
    123     ReadToolParameters 10
    12497}
    12598
     
    132105    set status [catch {Rappture::library $runfile} result]
    133106    lappend loadobjs $result
     107}
     108
     109set inputobj {}
     110if {$params(-input) ne ""} {
     111    if {![file exists $params(-input)]} {
     112        puts stderr "can't find input file: \"$params(-input)\""
     113        exit 1
     114    }
     115    if {[catch {Rappture::library $params(-input)} result] == 0} {
     116        set inputobj $result
     117    }
    134118}
    135119
     
    143127    # run.xml files they are loading.
    144128    set pseudotool ""
    145     if {0 == [llength $loadobjs]} {
     129    if {[llength $loadobjs] == 0 && $inputobj eq ""} {
    146130        puts stderr "can't find tool \"$params(-tool)\""
    147131        exit 1
     
    151135    # if there are loaders or notes, they will still need
    152136    # examples/ and docs/ dirs from the install location
    153     foreach runobj $loadobjs {
     137    set check [concat $loadobjs $inputobj]
     138    foreach runobj $check {
    154139        set tdir \
    155140            [string trim [$runobj get tool.version.application.directory(tool)]]
     
    374359
    375360# load previous xml runfiles
    376 if {0 != [llength $params(-load)]} {
     361if {[llength $params(-load)] > 0} {
    377362    foreach runobj $loadobjs {
    378         # this doesn't seem to work with loaders
    379         # loaders seem to get their value after this point
    380         # may need to tell loader elements to update its value
    381         $tool load $runobj
    382363        $f.analyze load $runobj
    383364    }
     365    # load the inputs for the very last run
     366    $tool load $runobj
     367
    384368    # don't need simulate button if we cannot simulate
    385369    if {$params(-nosim)} {
     
    388372    $f.analyze configure -notebookpage analyze
    389373    $win.pager current analyzer
     374} elseif {$params(-input) ne ""} {
     375    $tool load $inputobj
     376}
     377
     378# let components (loaders) settle after the newly loaded runs
     379update
     380
     381foreach path [array names ::Rappture::parameters] {
     382    set fname $::Rappture::parameters($path)
     383    if {[catch {
     384          set fid [open $fname r]
     385          set info [read $fid]
     386          close $fid}] == 0} {
     387
     388        set w [$tool widgetfor $path]
     389        if {$w ne ""} {
     390            if {[catch {$w value [string trim $info]} result]} {
     391                puts stderr "WARNING: bad tool parameter value for \"$path\""
     392                puts stderr "  $result"
     393            }
     394        } else {
     395            puts stderr "WARNING: can't find control for tool parameter: $path"
     396        }
     397    }
    390398}
    391399
  • branches/uiuc_vtk_viewers/gui/scripts/map.tcl

    r4789 r4992  
    129129        }
    130130        # Common settings (for all layer types) with defaults
    131         foreach { key defval } { visible true } {
     131        foreach { key defval } { visible 1 cache 1 } {
    132132            $_tree set $child $key $defval
    133133            set val [$layers get $layer.$key]
  • branches/uiuc_vtk_viewers/gui/scripts/mapviewer.tcl

    r4950 r4992  
    7979    private method BuildDownloadPopup { widget command }
    8080    private method BuildLayerTab {}
     81    private method BuildMapTab {}
    8182    private method BuildTerrainTab {}
    82     private method ChangeLayerVisibility { dataobj layer }
    8383    private method Connect {}
    8484    private method CurrentLayers {args}
     
    104104    private method Rotate {option x y}
    105105    private method Select {option x y}
     106    private method SetLayerOpacity { dataobj layer {value 100}}
    106107    private method SetLayerStyle { dataobj layer }
     108    private method SetLayerVisibility { dataobj layer }
    107109    private method SetTerrainStyle { style }
    108     private method SetOpacity { dataset }
    109110    private method UpdateLayerControls {}
    110111    private method Zoom {option {x 0} {y 0}}
     
    121122    private variable _motion;
    122123    private variable _settings
     124    private variable _opacity
    123125    private variable _visibility
    124126    private variable _style;            # Array of current component styles.
     
    184186    $_parser alias camera   [itcl::code $this camera]
    185187    $_parser alias screen   [itcl::code $this ReceiveScreenInfo]
     188
     189    # Millisecond delay before animated wait dialog appears
     190    set _waitTimeout 500
    186191
    187192    # Settings for mouse motion events: these are required
     
    236241        terrain-vertscale      1.0
    237242        terrain-wireframe      0
     243        time                   12
    238244    }]
     245
     246    set _settings(time) [clock format [clock seconds] -format %k -gmt 1]
     247
    239248    itk_component add view {
    240249        canvas $itk_component(plotarea).view \
     
    301310
    302311    BuildLayerTab
     312    BuildMapTab
    303313    BuildTerrainTab
    304314    BuildCameraTab
     
    940950        set _hardcopy($tag) $bytes
    941951    }
     952    set _waitTimeout 0
    942953}
    943954
     
    10461057            } else {
    10471058                if { $_mapsettings(type) == "geocentric" } {
     1059                    $itk_component(grid) configure -state normal
     1060                    $itk_component(time_l) configure -state normal
     1061                    $itk_component(time) configure -state normal
    10481062                    SendCmd "map reset geocentric"
    10491063                }  else {
     1064                    $itk_component(grid) configure -state disabled
     1065                    $itk_component(time_l) configure -state disabled
     1066                    $itk_component(time) configure -state disabled
    10501067                    set proj $_mapsettings(projection)
    10511068                    if { $proj == "" } {
     
    10841101    set count 0
    10851102
     1103    set haveTerrain 0
    10861104    foreach dataobj [get -objects] {
    10871105        set _obj2datasets($dataobj) ""
     
    11041122                SetLayerStyle $dataobj $layer
    11051123            }
     1124            if {$info(type) == "elevation"} {
     1125                set haveTerrain 1
     1126            }
    11061127            lappend _obj2datasets($dataobj) $layer
    11071128            # FIXME: This is overriding all layers' initial visibility setting
     
    11091130                SendCmd "map layer visible 1 $layer"
    11101131                set _visibility($layer) 1
    1111                 #SetLayerOpacity $layer
    1112             }
    1113         }
     1132                #SetLayerOpacity $dataobj $layer
     1133            }
     1134        }
     1135    }
     1136
     1137    if ($haveTerrain) {
     1138        $itk_component(vscale_l) configure -state normal
     1139        $itk_component(vscale) configure -state normal
     1140    } else {
     1141        $itk_component(vscale_l) configure -state disabled
     1142        $itk_component(vscale) configure -state disabled
    11141143    }
    11151144
     
    15191548            SendCmd "map terrain wireframe $bool"
    15201549        }
     1550        "time" {
     1551            set val $_settings($what)
     1552            SendCmd "map time $val"
     1553        }
    15211554        default {
    15221555            error "don't know how to fix $what"
     
    15451578}
    15461579
    1547 itcl::body Rappture::MapViewer::BuildTerrainTab {} {
     1580itcl::body Rappture::MapViewer::BuildMapTab {} {
    15481581
    15491582    set fg [option get $itk_component(hull) font Font]
     
    15511584
    15521585    set inner [$itk_component(main) insert end \
    1553         -title "Terrain Settings" \
    1554         -icon [Rappture::icon surface]]
     1586        -title "Map Settings" \
     1587        -icon [Rappture::icon wrench]]
    15551588    $inner configure -borderwidth 4
    15561589
     
    15611594        -font "Arial 9" -anchor w
    15621595
    1563     checkbutton $inner.grid \
     1596    itk_component add grid {
     1597        checkbutton $inner.grid \
    15641598        -text "Show Graticule" \
    15651599        -variable [itcl::scope _settings(grid)] \
    15661600        -command [itcl::code $this AdjustSetting grid] \
    15671601        -font "Arial 9" -anchor w
     1602    } {
     1603        ignore -font
     1604    }
    15681605
    15691606    checkbutton $inner.wireframe \
     
    15851622        -font "Arial 9" -anchor w
    15861623
    1587     label $inner.palette_l -text "Palette" -font "Arial 9" -anchor w
     1624    itk_component add time_l {
     1625        label $inner.time_l -text "Time (UTC)" -font "Arial 9"
     1626    } {
     1627        ignore -font
     1628    }
     1629    itk_component add time {
     1630        ::scale $inner.time -from 0 -to 23.9 -orient horizontal \
     1631            -resolution 0.1 \
     1632            -variable [itcl::scope _settings(time)] \
     1633            -showvalue on \
     1634            -command [itcl::code $this AdjustSetting time]
     1635    }
     1636
     1637    blt::table $inner \
     1638        0,0 $inner.posdisp   -cspan 2 -anchor w -pady 2 \
     1639        1,0 $inner.grid      -cspan 2 -anchor w -pady 2 \
     1640        2,0 $inner.wireframe -cspan 2 -anchor w -pady 2 \
     1641        3,0 $inner.lighting  -cspan 2 -anchor w -pady 2 \
     1642        4,0 $inner.time_l    -cspan 2 -anchor w -pady 2 \
     1643        4,1 $inner.time      -cspan 2 -fill x   -pady 2
     1644#        4,0 $inner.edges     -cspan 2  -anchor w -pady 2
     1645
     1646    blt::table configure $inner r* c* -resize none
     1647    blt::table configure $inner r5 c1 -resize expand
     1648}
     1649
     1650itcl::body Rappture::MapViewer::BuildTerrainTab {} {
     1651
     1652    set fg [option get $itk_component(hull) font Font]
     1653    #set bfg [option get $itk_component(hull) boldFont Font]
     1654
     1655    set inner [$itk_component(main) insert end \
     1656        -title "Terrain Settings" \
     1657        -icon [Rappture::icon surface]]
     1658    $inner configure -borderwidth 4
     1659
     1660    label $inner.palette_l -text "Palette" -font "Arial 9" -anchor w
    15881661    itk_component add terrainpalette {
    15891662        Rappture::Combobox $inner.palette -width 10 -editable no
     
    15951668        [itcl::code $this AdjustSetting terrain-palette]
    15961669
    1597     label $inner.vscale_l -text "Vertical Scale" -font "Arial 9" -anchor w
    1598     ::scale $inner.vscale -from 0 -to 10 -orient horizontal \
    1599         -variable [itcl::scope _settings(terrain-vertscale)] \
    1600         -width 10 \
    1601         -resolution 0.1 \
    1602         -showvalue on \
    1603         -command [itcl::code $this AdjustSetting terrain-vertscale]
     1670    itk_component add vscale_l {
     1671        label $inner.vscale_l -text "Vertical Scale" -font "Arial 9" -anchor w
     1672    }
     1673    itk_component add vscale {
     1674        ::scale $inner.vscale -from 0 -to 10 -orient horizontal \
     1675            -variable [itcl::scope _settings(terrain-vertscale)] \
     1676            -width 10 \
     1677            -resolution 0.1 \
     1678            -showvalue on \
     1679            -command [itcl::code $this AdjustSetting terrain-vertscale]
     1680    }
    16041681    $inner.vscale set $_settings(terrain-vertscale)
    16051682
    16061683    blt::table $inner \
    1607         0,0 $inner.posdisp   -cspan 2  -anchor w -pady 2 \
    1608         1,0 $inner.grid      -cspan 2  -anchor w -pady 2 \
    1609         2,0 $inner.wireframe -cspan 2  -anchor w -pady 2 \
    1610         3,0 $inner.lighting  -cspan 2  -anchor w -pady 2 \
    1611         4,0 $inner.edges     -cspan 2  -anchor w -pady 2 \
    1612         5,0 $inner.vscale_l  -anchor w -pady 2 \
    1613         5,1 $inner.vscale    -fill x   -pady 2 \
    1614         6,0 $inner.palette_l -anchor w -pady 2 \
    1615         6,1 $inner.palette   -fill x   -pady 2 
     1684        0,0 $inner.vscale_l  -anchor w -pady 2 \
     1685        0,1 $inner.vscale    -fill x   -pady 2
     1686#        1,0 $inner.palette_l -anchor w -pady 2 \
     1687#        1,1 $inner.palette   -fill x   -pady 2 
    16161688
    16171689    blt::table configure $inner r* c* -resize none
    1618     blt::table configure $inner r8 c1 -resize expand
     1690    blt::table configure $inner r3 c1 -resize expand
    16191691}
    16201692
     
    17261798                set _view($name) $value
    17271799            }
    1728             puts stderr "view: $_view(x), $_view(y), $_view(z), $_view(heading), $_view(pitch), $_view(distance), {$_view(srs)}, {$_view(verticalDatum)}"
     1800#            puts stderr "view: $_view(x), $_view(y), $_view(z), $_view(heading), $_view(pitch), $_view(distance), {$_view(srs)}, {$_view(verticalDatum)}"
    17291801        }
    17301802        "go" {
     
    18701942            if { [info exists info(opacity)] } {
    18711943                set settings(-opacity) $info(opacity)
    1872             }
     1944                set _opacity($layer) $info(opacity)
     1945            }
     1946            set _opacity($layer) [expr $settings(-opacity) * 100]
    18731947            if {!$_sendEarthFile} {
    18741948                switch -- $info(driver)  {
     
    18781952                    "gdal" {
    18791953                        SendCmd [list map layer add image gdal \
    1880                                      $info(gdal.url) $layer]
     1954                                     $info(gdal.url) $info(cache) $layer]
    18811955                    }
    18821956                    "tms" {
    18831957                        SendCmd [list map layer add image tms \
    1884                                      $info(tms.url) $layer]
     1958                                     $info(tms.url) $info(cache) $layer]
    18851959                    }
    18861960                    "wms" {
    18871961                        SendCmd [list map layer add image wms \
    1888                                      $info(wms.url) \
     1962                                     $info(wms.url) $info(cache)\
    18891963                                     $info(wms.layers) \
    18901964                                     $info(wms.format) \
     
    18941968                    "xyz" {
    18951969                        SendCmd [list map layer add image xyz \
    1896                                      $info(xyz.url) \
     1970                                     $info(xyz.url) $info(cache) \
    18971971                                     $layer]
    18981972                    }
     
    19352009                set settings(-opacity) $info(opacity)
    19362010            }
     2011            set _opacity($layer) [expr $settings(-opacity) * 100]
    19372012            SendCmd [list map layer add line $info(ogr.url) $layer]
    19382013            SendCmd "map layer opacity $settings(-opacity) $layer"
     
    19502025                set settings(-opacity) $info(opacity)
    19512026            }
     2027            set _opacity($layer) [expr $settings(-opacity) * 100]
    19522028            SendCmd [list map layer add polygon $info(ogr.url) $layer]
    19532029            SendCmd "map layer opacity $settings(-opacity) $layer"
     
    19732049                set settings(-opacity) $info(opacity)
    19742050            }
     2051            set _opacity($layer) [expr $settings(-opacity) * 100]
    19752052            set contentExpr $info(content)
    19762053            if {[info exists info(priority)]} {
     
    19922069}
    19932070
    1994 itcl::body Rappture::MapViewer::SetOpacity { dataset } {
    1995     foreach {dataobj layer} [split $dataset -] break
    1996     set type [$dataobj type $layer]
    1997     set val $_settings(-opacity)
     2071itcl::body Rappture::MapViewer::SetLayerOpacity { dataobj layer {value 100}} {
     2072    set val $_opacity($layer)
    19982073    set sval [expr { 0.01 * double($val) }]
    1999     if { !$_obj2ovride($dataobj-raise) } {
    2000         # This is wrong.  Need to figure out why raise isn't set with 1
    2001         #set sval [expr $sval * .6]
    2002     }
    2003     SendCmd "$type opacity $sval $dataset"
    2004 }
    2005 
    2006 itcl::body Rappture::MapViewer::ChangeLayerVisibility { dataobj layer } {
     2074    SendCmd "map layer opacity $sval $layer"
     2075}
     2076
     2077itcl::body Rappture::MapViewer::SetLayerVisibility { dataobj layer } {
    20072078    set bool $_visibility($layer)
    20082079    SendCmd "map layer visible $bool $layer"
     
    20222093            array unset info
    20232094            array set info [$dataobj layer $layer]
    2024             checkbutton $f.$layer \
     2095            checkbutton $f.${layer}-visible \
    20252096                -text $info(label) \
     2097                -font "Arial 9" -anchor w \
    20262098                -variable [itcl::scope _visibility($layer)] \
    20272099                -command [itcl::code $this \
    2028                               ChangeLayerVisibility $dataobj $layer] \
    2029                     -font "Arial 9" -anchor w
    2030             blt::table $f $row,0 $f.$layer -anchor w -pady 2
    2031             Rappture::Tooltip::for $f.$layer $info(description)
     2100                              SetLayerVisibility $dataobj $layer]
     2101            blt::table $f $row,0 $f.${layer}-visible -anchor w -pady 2 -cspan 2
     2102            Rappture::Tooltip::for $f.${layer}-visible $info(description)
    20322103            incr row
     2104            if { $info(type) != "elevation" } {
     2105                label $f.${layer}-opacity_l -text "Opacity" -font "Arial 9"
     2106                ::scale $f.${layer}-opacity -from 0 -to 100 \
     2107                    -orient horizontal -showvalue off \
     2108                    -variable [itcl::scope _opacity($layer)] \
     2109                    -command [itcl::code $this \
     2110                                  SetLayerOpacity $dataobj $layer]
     2111                blt::table $f $row,0 $f.${layer}-opacity_l -anchor w -pady 2
     2112                blt::table $f $row,1 $f.${layer}-opacity -anchor w -pady 2
     2113                incr row
     2114            }
    20332115        }
    20342116    }
  • branches/uiuc_vtk_viewers/gui/scripts/nanovisviewer.tcl

    r4776 r4992  
    12691269        "-cutplanesvisible" {
    12701270            set bool $_settings($what)
     1271            # We only set cutplanes on the first dataset.
    12711272            set datasets [CurrentDatasets -cutplanes]
    12721273            set tag [lindex $datasets 0]
     
    13631364            set axis [string range $what 1 1]
    13641365            set bool $_settings($what)
     1366            # We only set cutplanes on the first dataset.
    13651367            set datasets [CurrentDatasets -cutplanes]
    13661368            set tag [lindex $datasets 0]
  • branches/uiuc_vtk_viewers/gui/scripts/textentry.tcl

    r4276 r4992  
    106106    # the string alone.
    107107    set str [string trim [$_owner xml get $path.default]]
    108     if { [info exists ::Rappture::parameters($path.default)] } {
    109         set fileName $::Rappture::parameters($path.default)
    110         catch {
    111             set f [open $fileName "r"]
    112             set contents [read $f]
    113             close $f
    114             set str $contents
    115         }
    116     }
    117108    if {"" != $str} {
    118109        value $str
  • branches/uiuc_vtk_viewers/gui/scripts/tool.tcl

    r4127 r4992  
    3131    public method run {args} {
    3232        sync  ;# sync all widget values to XML
    33         eval $_task run $args
     33
     34        foreach {status result} [eval $_task run $args] break
     35        if {$status == 0} {
     36            # move good results to the data/results directory
     37            $_task save $result
     38        }
     39
     40        return [list $status $result]
    3441    }
    3542    public method abort {} {
  • branches/uiuc_vtk_viewers/gui/scripts/vtkisosurfaceviewer.tcl

    r4991 r4992  
    23542354    SendCmd "cutplane add $tag"
    23552355    SendCmd "cutplane color [Color2RGB $itk_option(-plotforeground)] $tag"
     2356    foreach axis {x y z} {
     2357        set pos [expr $_settings(-${axis}cutplaneposition) * 0.01]
     2358        set visible $_settings(-${axis}cutplanevisible)
     2359        SendCmd "cutplane slice $axis $pos $tag"
     2360        SendCmd "cutplane axis $axis $visible $tag"
     2361    }
    23562362    SendCmd "cutplane visible $style(-cutplanesvisible) $tag"
    23572363
  • branches/uiuc_vtk_viewers/gui/src/RpDicomToVtk.cc

    r4128 r4992  
    2727#include <stdio.h>
    2828#include "tcl.h"
     29
     30// #define RP_DICOM_TRACE
    2931
    3032static int
     
    9597    int series = 0;
    9698
     99#ifdef RP_DICOM_TRACE
    97100    fprintf(stderr, "Num Studies: %d\n", numStudies);
     101#endif
    98102    vtkStringArray *files;
    99103#if 0
    100104    for (int i = 0; i < numStudies; i++) {
    101105        int numSeries = sorter->GetNumberOfSeriesInStudy(i);
     106#ifdef RP_DICOM_TRACE
    102107        fprintf(stderr, "Study %d: %d series\n", i, numSeries);
     108#endif
    103109        int k = sorter->GetFirstSeriesInStudy(i);
    104110        for (int j = 0; j < numSeries; j++) {
     
    144150#ifdef USE_VTK_DICOM_PACKAGE
    145151    vtkStringArray *ids = reader->GetStackIDs();
     152#ifdef RP_DICOM_TRACE
    146153    for (int i = 0; i < ids->GetNumberOfValues(); i++) {
    147154        fprintf(stderr, "Stack: %s\n", ids->GetValue(i).c_str());
    148155    }
     156#endif
    149157    vtkIntArray *fidxArray = reader->GetFileIndexArray();
    150158    vtkDICOMMetaData *md = reader->GetMetaData();
     
    160168    }
    161169#endif
     170#ifdef RP_DICOM_TRACE
    162171    fprintf(stderr, "Number of data elements: %d\n", md->GetNumberOfDataElements());
    163 
     172#endif
    164173    Tcl_ListObjAppendElement(interp, metaDataObj, Tcl_NewStringObj("num_files", -1));
    165174    Tcl_ListObjAppendElement(interp, metaDataObj, Tcl_NewIntObj(md->GetNumberOfInstances()));
     
    234243
    235244    Tcl_ListObjAppendList(interp, objPtr, metaDataObj);
    236 
     245#ifdef RP_DICOM_TRACE
    237246    fprintf(stderr, "writing VTK\n");
    238 
     247#endif
    239248    vtkSmartPointer<vtkDataSetWriter> writer = vtkSmartPointer<vtkDataSetWriter>::New();
    240249    writer->SetInputConnection(reader->GetOutputPort());
     
    242251    writer->WriteToOutputStringOn();
    243252    writer->Update();
    244 
     253#ifdef RP_DICOM_TRACE
    245254    fprintf(stderr, "writing VTK...done\n");
    246 
     255#endif
    247256    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("vtkdata", -1));
    248257
  • branches/uiuc_vtk_viewers/gui/src/RpReadPoints.c

    r3404 r4992  
    8888    return TCL_OK;
    8989}
    90    
     90
    9191/*
    9292 *  ReadPoints string dimVar pointsVar
  • branches/uiuc_vtk_viewers/lang/tcl/scripts/task.tcl

    r4135 r4992  
    3232    public method reset {}
    3333    public method xml {args}
     34    public method save {xmlobj {name ""}}
    3435
    3536    protected method _mkdir {dir}
     
    3940    private variable _xmlobj ""      ;# XML object with inputs/outputs
    4041    private variable _origxml ""     ;# copy of original XML (for reset)
     42    private variable _lastrun ""     ;# name of last run file
    4143    private variable _installdir ""  ;# installation directory for this tool
    4244    private variable _outputcb ""    ;# callback for tool output
     
    215217
    216218        # starting job...
     219        set _lastrun ""
    217220        _log run started
    218221        Rappture::rusage mark
     
    353356        set result [string trim $job(output)]
    354357        if {[regexp {=RAPPTURE-RUN=>([^\n]+)} $result match file]} {
     358            set _lastrun $file
     359
    355360            set status [catch {Rappture::library $file} result]
    356361            if {$status == 0} {
     
    366371            }
    367372
    368             # if there's a results_directory defined in the resources
    369             # file, then move the run.xml file there for storage
    370             set rdir ""
    371             if {$resultdir eq "@default"} {
    372                 if {[info exists _resources(-resultdir)]} {
    373                     set rdir $_resources(-resultdir)
    374                 } else {
    375                     set rdir "."
    376                 }
    377             } elseif {$resultdir ne ""} {
    378                 set rdir $resultdir
    379             }
    380 
    381             if {$status == 0 && $rdir ne ""} {
    382                 catch {
    383                     file delete -force -- $file
    384                     if {![file exists $rdir]} {
    385                         _mkdir $rdir
    386                     }
    387                     set tail [file tail $file]
    388                     set fid [open [file join $rdir $tail] w]
    389                     puts $fid "<?xml version=\"1.0\"?>"
    390                     puts $fid [$result xml]
    391                     close $fid
    392                 }
    393             } else {
    394                 # don't keep the file
    395                 file delete -force -- $file
    396             }
     373            file delete -force -- $file
    397374        } else {
    398375            set status 1
     
    475452
    476453# ----------------------------------------------------------------------
     454# USAGE: save <xmlobj> ?<filename>?
     455#
     456# Used by clients to save the contents of an <xmlobj> representing
     457# a run out to the given file.  If <filename> is not specified, then
     458# it uses the -resultsdir and other settings to do what Rappture
     459# would normally do with the output.
     460# ----------------------------------------------------------------------
     461itcl::body Rappture::Task::save {xmlobj {filename ""}} {
     462    if {$filename eq ""} {
     463        # if there's a results_directory defined in the resources
     464        # file, then move the run.xml file there for storage
     465        set rdir ""
     466        if {$resultdir eq "@default"} {
     467            if {[info exists _resources(-resultdir)]} {
     468                set rdir $_resources(-resultdir)
     469            } else {
     470                set rdir "."
     471            }
     472        } elseif {$resultdir ne ""} {
     473            set rdir $resultdir
     474        }
     475
     476        # use the runfile name generated by the last run
     477        if {$_lastrun ne ""} {
     478            set filename [file join $rdir $_lastrun]
     479        } else {
     480            set filename [file join $rdir run.xml]
     481        }
     482    }
     483
     484    # add any last-minute metadata
     485    $xmlobj put output.time [clock format [clock seconds]]
     486
     487    $xmlobj put tool.version.rappture.version $::Rappture::version
     488    $xmlobj put tool.version.rappture.revision $::Rappture::build
     489
     490    if {[info exists ::tcl_platform(user)]} {
     491        $xmlobj put output.user $::tcl_platform(user)
     492    }
     493
     494    # save the output
     495    set rdir [file dirname $filename]
     496    if {![file exists $rdir]} {
     497        _mkdir $rdir
     498    }
     499
     500    set fid [open $filename w]
     501    puts $fid "<?xml version=\"1.0\"?>"
     502    puts $fid [$xmlobj xml]
     503    close $fid
     504
     505    _log output saved in $filename
     506}
     507
     508# ----------------------------------------------------------------------
    477509# USAGE: _output <data>
    478510#
  • branches/uiuc_vtk_viewers/lang/tcl/scripts/xauth.tcl

    r4660 r4992  
    1111#    set clientSecret [XAuth::credentials get nanoHUB.org -secret]
    1212#
    13 #    XAuth::init $site $clientToken $clientSecret $username $password
     13#    XAuth::init $site $clientToken $clientSecret -user $username $password
    1414#    XAuth::call $site $method $params
    1515#
     
    2020# ======================================================================
    2121#  AUTHOR:  Michael McLennan, Purdue University
    22 #  Copyright (c) 2004-2013  HUBzero Foundation, LLC
     22#  Copyright (c) 2004-2015  HUBzero Foundation, LLC
    2323#
    2424#  See the file "license.terms" for information on usage and
     
    287287
    288288# ----------------------------------------------------------------------
    289 # USAGE: XAuth::init <site> <clientToken> <clientSecret> <username> <password>
    290 #
    291 # Should be called to initialize this library.  Sends the <username>
    292 # and <password> to the <site> for authentication.  The <client> ID
    293 # is registered with the OAuth provider to identify the application.
     289# USAGE: XAuth::init <site> <clientToken> <clientSecret> -user <u> <p>
     290# USAGE: XAuth::init <site> <clientToken> <clientSecret> -session <n> <t>
     291#
     292# Should be called to initialize this library.  Can be initialized
     293# one of two ways:
     294#
     295#   -user <u> <p> ...... sends username <u> and password <p>
     296#   -session <n> <t> ... sends tool session number <n> and token <t>
     297#
     298# Sends the credentials to the <site> for authentication.  The client
     299# token and secret are registered to identify the application.
    294300# If successful, this call stores an authenticated session token in
    295301# the tokens array for the <site> URL.  Subsequent calls to XAuth::call
    296302# use this token to identify the user.
    297303# ----------------------------------------------------------------------
    298 proc XAuth::init {site clientToken clientSecret uname passw} {
     304proc XAuth::init {site clientToken clientSecret args} {
    299305    variable clients
    300306    variable tokens
     307
     308    set option [lindex $args 0]
     309    switch -- $option {
     310        -user {
     311            if {[llength $args] != 3} {
     312                error "wrong # args: should be \"-user name password\""
     313            }
     314            set uname [lindex $args 1]
     315            set passw [lindex $args 2]
     316        }
     317        -session {
     318            if {[llength $args] != 3} {
     319                error "wrong # args: should be \"-session number token\""
     320            }
     321            set snum [lindex $args 1]
     322            set stok [lindex $args 2]
     323
     324            # store session info for later -- no need for oauth stuff
     325            set tokens($site) [list session $snum $stok]
     326            set clients($site) [list $clientToken $clientSecret]
     327            return
     328        }
     329        default {
     330            if {[llength $args] != 2} {
     331                error "wrong # args: should be \"XAuth::init site token secret ?-option? arg arg\""
     332            }
     333            set uname [lindex $args 0]
     334            set passw [lindex $args 1]
     335        }
     336    }
    301337
    302338    if {![regexp {^https://} $site]} {
     
    360396
    361397    # success! store the session token for later
    362     set tokens($site) [list $got(oauth_token) $got(oauth_token_secret)]
     398    set tokens($site) [list oauth $got(oauth_token) $got(oauth_token_secret)]
    363399    set clients($site) [list $clientToken $clientSecret]
    364400}
     
    385421    }
    386422    foreach {clientToken clientSecret} $clients($site) break
    387     foreach {userToken userSecret} $tokens($site) break
     423    foreach {scheme userToken userSecret} $tokens($site) break
    388424
    389425    set url $site/$method
    390     set nonce [XAuth::nonce]
    391     set tstamp [clock seconds]
    392 
    393     # BE CAREFUL -- put all query parameters in alphabetical order
    394     array set qparams [list \
    395         oauth_consumer_key $clientToken \
    396         oauth_nonce $nonce \
    397         oauth_signature_method "HMAC-SHA1" \
    398         oauth_timestamp $tstamp \
    399         oauth_token $userToken \
    400         oauth_version "1.0" \
    401         x_auth_mode "client_auth" \
    402     ]
    403     array set qparams $params
    404 
    405     set query ""
    406     foreach key [lsort [array names qparams]] {
    407         lappend query $key $qparams($key)
    408     }
    409     set query [eval http::formatQuery $query]
    410 
    411     set base "POST&[urlencode $url]&[urlencode $query]"
    412     set key "$clientSecret&$userSecret"
    413     set sig [urlencode [base64::encode [sha1::hmac -bin -key $key $base]]]
    414 
    415     # build the header and send the request
    416     set auth [format "OAuth oauth_consumer_key=\"%s\", oauth_token=\"%s\", oauth_nonce=\"%s\", oauth_signature_method=\"HMAC-SHA1\", oauth_signature=\"%s\", oauth_timestamp=\"%s\", oauth_version=\"1.0\"" $clientToken $userToken $nonce $sig $tstamp]
    417 
    418     return [XAuth::fetch $url -headers [list Authorization $auth] -query $query]
     426
     427    switch -- $scheme {
     428        oauth {
     429            set nonce [XAuth::nonce]
     430            set tstamp [clock seconds]
     431
     432            # BE CAREFUL -- put all query parameters in alphabetical order
     433            array set qparams [list \
     434                oauth_consumer_key $clientToken \
     435                oauth_nonce $nonce \
     436                oauth_signature_method "HMAC-SHA1" \
     437                oauth_timestamp $tstamp \
     438                oauth_token $userToken \
     439                oauth_version "1.0" \
     440                x_auth_mode "client_auth" \
     441            ]
     442            array set qparams $params
     443
     444            set query ""
     445            foreach key [lsort [array names qparams]] {
     446                lappend query $key $qparams($key)
     447            }
     448            set query [eval http::formatQuery $query]
     449
     450            set base "POST&[urlencode $url]&[urlencode $query]"
     451            set key "$clientSecret&$userSecret"
     452            set sig [urlencode [base64::encode [sha1::hmac -bin -key $key $base]]]
     453
     454            # build the header and send the request
     455            set auth [format "OAuth oauth_consumer_key=\"%s\", oauth_token=\"%s\", oauth_nonce=\"%s\", oauth_signature_method=\"HMAC-SHA1\", oauth_signature=\"%s\", oauth_timestamp=\"%s\", oauth_version=\"1.0\"" $clientToken $userToken $nonce $sig $tstamp]
     456            set hdr [list Authorization $auth]
     457        }
     458        session {
     459            set hdr [list sessionnum $userToken sessiontoken $userSecret]
     460            set query ""
     461            foreach {key val} $params {
     462                lappend query $key $val
     463            }
     464            set query [eval http::formatQuery $query]
     465        }
     466        default {
     467            error "internal error -- don't understand call scheme \"$scheme\""
     468        }
     469    }
     470    return [XAuth::fetch $url -headers $hdr -query $query]
    419471}
    420472
     
    596648    switch -- $option {
    597649        load {
    598             set fname "~/.xauth"
    599650            if {[llength $args] == 1} {
    600651                set fname [lindex $args 0]
    601             } elseif {[llength $args] > 1} {
     652            } elseif {[llength $args] == 0} {
     653                if {[file exists ~/.xauth]} {
     654                    set fname "~/.xauth"
     655                } else {
     656                    set fname ""
     657                }
     658            } else {
    602659                error "wrong # args: should be \"credentials load ?file?\""
    603660            }
    604661
    605             if {![file readable $fname]} {
    606                 error "file \"$fname\" not found"
    607             }
    608             set fid [open $fname r]
    609             set info [read $fid]
    610             close $fid
    611 
    612             if {[catch {$parser eval $info} result]} {
    613                 error "error in sites file \"$fname\": $result"
     662            if {$fname ne ""} {
     663                if {![file readable $fname]} {
     664                    error "file \"$fname\" not found"
     665                }
     666                set fid [open $fname r]
     667                set info [read $fid]
     668                close $fid
     669
     670                if {[catch {$parser eval $info} result]} {
     671                    error "error in sites file \"$fname\": $result"
     672                }
    614673            }
    615674        }
Note: See TracChangeset for help on using the changeset viewer.