- Timestamp:
- Mar 11, 2015 10:26:15 AM (6 years ago)
- Location:
- branches/uq
- Files:
-
- 4 deleted
- 56 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
branches/uq
- Property svn:mergeinfo changed
-
branches/uq/configure
r5029 r5121 672 672 OCTAVE_VERSION_MAJOR 673 673 OCTAVE_VERSION 674 SVN_URL 674 675 SVN_VERSION 675 676 MKOCTFILE3 … … 7297 7298 7298 7299 SVN_VERSION=`svnversion $srcdir | sed 's/Unversioned directory/unknown/'` 7300 SVN_URL=`svn info $srcdir | sed -ne 's/^URL: //p'` 7299 7301 7300 7302 make_command="" … … 10135 10137 10136 10138 MAKE=${make_command} 10139 10137 10140 10138 10141 -
branches/uq/configure.in
r5029 r5121 108 108 109 109 SVN_VERSION=`svnversion $srcdir | sed 's/Unversioned directory/unknown/'` 110 SVN_URL=`svn info $srcdir | sed -ne 's/^URL: //p'` 110 111 111 112 make_command="" … … 401 402 AC_SUBST(MKOCTFILE3) 402 403 AC_SUBST(SVN_VERSION) 404 AC_SUBST(SVN_URL) 403 405 AC_SUBST(OCTAVE_VERSION) 404 406 AC_SUBST(OCTAVE_VERSION_MAJOR) -
branches/uq/examples/flow/flowtest.tcl
r4228 r5121 39 39 $f1.component.flow.particles(right).color khaki 40 40 $f1.component.flow.particles(right).position 90% 41 $f1.component.style "-color blue:red -levels 6 -opacity 1"41 $f1.component.style "-color blue:red -levels 6" 42 42 $f1.component.flow.box(one).label "Region 1" 43 43 $f1.component.flow.box(one).color cyan … … 75 75 $f2.component.flow.particles(right).color pink 76 76 $f2.component.flow.particles(right).position 90% 77 $f2.component.style "-color rainbow -levels 6 -opacity 1"77 $f2.component.style "-color rainbow -levels 6" 78 78 $f2.camera.position { 79 79 qw 1 qx 0 qy 0 qz 0 pan-x 0 pan-y 0 zoom 1.0 … … 100 100 $f3.component.flow.particles(right).color khaki 101 101 $f3.component.flow.particles(right).position 90% 102 $f3.component.style "-color blue:red -levels 6 -opacity 1"102 $f3.component.style "-color blue:red -levels 6" 103 103 $f3.component.elemtype vectors 104 104 $f3.component.elemsize 3 -
branches/uq/gui/apps/Makefile.in
r4513 r5121 24 24 copy_rappture_examples \ 25 25 encodedata \ 26 $(srcdir)/execute.tcl \ 26 27 $(srcdir)/launcher.tcl \ 27 $(srcdir)/mapviewer-test \28 28 $(srcdir)/grabdata \ 29 29 $(srcdir)/nanovis-test \ -
branches/uq/gui/apps/launcher.tcl
r5029 r5121 12 12 # rappture -builder ?-tool <toolfile>? 13 13 # rappture -tester ?-tool <toolfile>? ?-testdir <directory>? 14 # rappture -execute driver.xml ?-tool <toolfile>? 14 15 # 15 16 # The default option is "-run", which brings up the GUI used to … … 26 27 set mainscript "" 27 28 set alist "" 29 set loadlist "" 28 30 set 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 # ---------------------------------------------------------------------- 40 set params(opt) "" 41 set params(load) "" 42 set params(execute) "" 43 set params(input) "" 44 45 if {[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 } 29 102 30 103 # scan through the arguments and look for the function … … 53 126 set reqpkgs Tk 54 127 } 128 -execute { 129 # for web services and simulation cache -- don't load Tk 130 set reqpkgs "" 131 if {[llength $argv] < 1} { 132 puts stderr "error: missing driver.xml file for -execute option" 133 exit 1 134 } 135 set driverxml [lindex $argv 0] 136 set argv [lrange $argv 1 end] 137 138 if {![file readable $driverxml]} { 139 puts stderr "error: driver file \"$driverxml\" not found" 140 exit 1 141 } 142 143 set dir [file dirname [info script]] 144 set mainscript [file join $dir execute.tcl] 145 } 55 146 -tool { 56 147 set toolxml [lindex $argv 0] … … 62 153 lappend alist -tool $toolxml 63 154 } 64 -t ool - -testdir - -nosim {155 -testdir - -nosim { 65 156 lappend alist $opt [lindex $argv 0] 66 157 set argv [lrange $argv 1 end] … … 74 165 } 75 166 -load { 76 lappend alist $opt77 167 while { [llength $argv] > 0 } { 78 168 set val [lindex $argv 0] … … 80 170 break 81 171 } 82 lappend alist $val172 lappend loadlist $val 83 173 set argv [lrange $argv 1 end] 84 174 } … … 89 179 puts stderr " rappture -builder ?-tool toolFile?" 90 180 puts stderr " rappture -tester ?-auto? ?-tool toolFile? ?-testdir directory?" 181 puts stderr " rappture -execute driver.xml ?-tool toolFile?" 91 182 exit 1 92 183 } … … 95 186 } 96 187 97 # 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. 98 190 if {$mainscript eq ""} { 99 package require RapptureGUI 100 set guidir $RapptureGUI::library 101 set mainscript [file join $guidir scripts main.tcl] 102 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 } 103 254 } 104 255 -
branches/uq/gui/apps/rpdiff
r3177 r5121 24 24 exec tclsh "$0" ${1+"$@"} 25 25 # tclsh executes the rest... 26 27 26 package require Rappture 28 27 … … 36 35 proc diff {path lib1 lib2} { 37 36 set knowntypes {boolean choice cloud curve field group histogram image integer loader log mesh note number periodicelement phase sequence string structure table unirect2d} 38 39 37 set type1 [$lib1 element -as type $path] 40 38 set type2 [$lib2 element -as type $path] … … 490 488 } 491 489 } 490 loader { 491 } 492 492 default { 493 error "don't know how to compare type \"$type\""493 puts stderr "ignoring \"$type1\" for \"$path\"" 494 494 } 495 495 } … … 557 557 558 558 # ====================================================================== 559 if {$argc != 2} { 559 560 if {$argc < 2} { 560 561 puts stderr "USAGE: rpdiff file1.xml file2.xml" 561 562 exit 9 … … 563 564 set lib1 [Rappture::library [lindex $argv 0]] 564 565 set lib2 [Rappture::library [lindex $argv 1]] 566 set path "output" 567 if { $argc > 2 } { 568 set arg [lindex $argv 2] 569 if { $arg == "-path" && $argc == 4 } { 570 set path [lindex $argv 3] 571 } 572 } 565 573 566 574 # compute the differences 567 set diffs [diff output$lib1 $lib2]575 set diffs [diff $path $lib1 $lib2] 568 576 569 577 if {[llength $diffs] == 0} { -
branches/uq/gui/configure
r4798 r5121 1 1 #! /bin/sh 2 2 # Guess values for system-dependent variables and create Makefiles. 3 # Generated by GNU Autoconf 2.69 for RapptureGUI 1. 4.3 # Generated by GNU Autoconf 2.69 for RapptureGUI 1.3. 4 4 # 5 5 # Report bugs to <rappture@nanohub.org>. … … 580 580 PACKAGE_NAME='RapptureGUI' 581 581 PACKAGE_TARNAME='rappturegui' 582 PACKAGE_VERSION='1. 4'583 PACKAGE_STRING='RapptureGUI 1. 4'582 PACKAGE_VERSION='1.3' 583 PACKAGE_STRING='RapptureGUI 1.3' 584 584 PACKAGE_BUGREPORT='rappture@nanohub.org' 585 585 PACKAGE_URL='' … … 1223 1223 # This message is too long to be a string in the A/UX 3.1 sh. 1224 1224 cat <<_ACEOF 1225 \`configure' configures RapptureGUI 1. 4to adapt to many kinds of systems.1225 \`configure' configures RapptureGUI 1.3 to adapt to many kinds of systems. 1226 1226 1227 1227 Usage: $0 [OPTION]... [VAR=VALUE]... … … 1289 1289 if test -n "$ac_init_help"; then 1290 1290 case $ac_init_help in 1291 short | recursive ) echo "Configuration of RapptureGUI 1. 4:";;1291 short | recursive ) echo "Configuration of RapptureGUI 1.3:";; 1292 1292 esac 1293 1293 cat <<\_ACEOF … … 1380 1380 if $ac_init_version; then 1381 1381 cat <<\_ACEOF 1382 RapptureGUI configure 1. 41382 RapptureGUI configure 1.3 1383 1383 generated by GNU Autoconf 2.69 1384 1384 … … 1435 1435 running configure, to aid debugging if configure makes a mistake. 1436 1436 1437 It was created by RapptureGUI $as_me 1. 4, which was1437 It was created by RapptureGUI $as_me 1.3, which was 1438 1438 generated by GNU Autoconf 2.69. Invocation command line was 1439 1439 … … 3685 3685 # values after options handling. 3686 3686 ac_log=" 3687 This file was extended by RapptureGUI $as_me 1. 4, which was3687 This file was extended by RapptureGUI $as_me 1.3, which was 3688 3688 generated by GNU Autoconf 2.69. Invocation command line was 3689 3689 … … 3738 3738 ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" 3739 3739 ac_cs_version="\\ 3740 RapptureGUI config.status 1. 43740 RapptureGUI config.status 1.3 3741 3741 configured by $0, generated by GNU Autoconf 2.69, 3742 3742 with options \\"\$ac_cs_config\\" -
branches/uq/gui/configure.in
r4798 r5121 1 1 2 AC_INIT([RapptureGUI],[1. 4],[rappture@nanohub.org])2 AC_INIT([RapptureGUI],[1.3],[rappture@nanohub.org]) 3 3 AC_CONFIG_AUX_DIR(cf) 4 4 #------------------------------------------------------------------------ -
branches/uq/gui/pkgIndex.tcl.in
r2117 r5121 1 1 # HACK: The Img library needs to be loaded before RapptureGUI 2 # to avoid conflicts with libjpeg, libtiff, etc. 2 3 package ifneeded RapptureGUI @PACKAGE_VERSION@ [format { 4 package require Img 3 5 set dir [file normalize "%s"] 4 6 set version @PACKAGE_VERSION@ … … 12 14 package provide RapptureGUI $version 13 15 } $dir] 14 -
branches/uq/gui/scripts/Makefile.in
r5102 r5121 77 77 $(srcdir)/main.tcl \ 78 78 $(srcdir)/mainwin.tcl \ 79 $(srcdir)/map.tcl \80 $(srcdir)/mapviewer.tcl \81 79 $(srcdir)/mesh.tcl \ 82 80 $(srcdir)/meshresult.tcl \ -
branches/uq/gui/scripts/analyzer.tcl
r5102 r5121 319 319 320 320 itk_component add results { 321 Rappture::Panes $w.pane -sashwidth 1 -sashrelief solid -sashpadding {4 0} 321 Rappture::Panes $w.pane \ 322 -sashwidth 2 -sashrelief solid -sashpadding {2 0} 323 } { 324 usual 325 ignore -sashwidth -sashrelief -sashpadding 322 326 } 323 327 pack $itk_component(results) -expand yes -fill both … … 829 833 _autoLabel $xmlobj output.$item "String" counters 830 834 } 831 histogram* - curve* - field* - map*{835 histogram* - curve* - field* { 832 836 _autoLabel $xmlobj output.$item "Plot" counters 833 837 } -
branches/uq/gui/scripts/cloud.tcl
r4504 r5121 148 148 # Extract each point and add it to the points list 149 149 foreach {x y z} $line break 150 foreach axis {x y z} units $_units { 151 if { $units == "" } { 152 set value [set $axis] 153 } else { 154 set value [Rappture::Units::convert [set $axis] \ 155 -context $units -to $units -units off] 156 } 157 set $axis $value; # Set the (x/y/z) coordinate to 158 # converted value. 150 foreach axis {x y z} { 151 # Units on point coordinates are NOT supported 152 set value [set $axis] 153 # Update limits 159 154 if { ![info exists _limits($axis)] } { 160 155 set _limits($axis) [list $value $value] -
branches/uq/gui/scripts/curve.tcl
r4008 r5121 112 112 # USAGE: values ?<name>? 113 113 # 114 # Returns the xvec for the specified curve component <name>.114 # Returns the yvec for the specified curve component <name>. 115 115 # If the name is not specified, then it returns the vectors for the 116 116 # overall curve (sum of all components). -
branches/uq/gui/scripts/drawing.tcl
r4494 r5121 129 129 } 130 130 } 131 foreach {key path} { 132 toolid tool.id 133 toolname tool.name 134 toolcommand tool.execute 135 tooltitle tool.title 136 toolrevision tool.version.application.revision 137 } { 138 set str [$_xmlobj get $path] 139 if { "" != $str } { 140 set _hints($key) $str 141 } 142 } 131 143 } 132 144 -
branches/uq/gui/scripts/field.tcl
r4797 r5121 1 # -*- mode: tcl; indent-tabs-mode: nil -*- 1 # -*- mode: tcl; indent-tabs-mode: nil -*- 2 2 # ---------------------------------------------------------------------- 3 3 # COMPONENT: field - extracts data from an XML description of a field … … 25 25 # unirect2d (deprecated) 26 26 # cloud (x,y point coordinates) (deprecated) 27 # mesh 27 # mesh 28 28 # 3D Datasets 29 # vtk 29 # vtk 30 30 # unirect3d (deprecated) 31 31 # cloud (x,y,z coordinates) (deprecated) 32 # mesh 32 # mesh 33 33 # dx (FIXME: make dx-to-vtk converter work) 34 34 # ucd avs … … 41 41 # mesh 3 points-on-mesh isosurface vtkvis 42 42 # dx 3 DX volume nanovis 43 # unirect2d 2 unirect 3d + extents > 1 flow flow nanovis44 # unirect3d 3 unirect 2d + extents > 1 flow flow nanovis45 # 43 # unirect2d 2 unirect2d + extents > 1 flow flow nanovis 44 # unirect3d 3 unirect3d + extents > 1 flow flow nanovis 45 # 46 46 # With <views>, can specify which viewer for specific datasets. So it's OK 47 47 # for the same dataset to be viewed in more than one way. 48 # o Any 2D dataset can be viewed as a contour/heightmap. 48 # o Any 2D dataset can be viewed as a contour/heightmap. 49 49 # o Any 3D dataset can be viewed as a isosurface. 50 # o Any 2D dataset with vector data can be streamlines or flow. 50 # o Any 2D dataset with vector data can be streamlines or flow. 51 51 # o Any 3D uniform rectilinear dataset can be viewed as a volume. 52 52 # o Any 3D dataset with vector data can be streamlines or flow. … … 59 59 package require BLT 60 60 61 namespace eval Rappture { 62 # forward declaration 61 namespace eval Rappture { 62 # forward declaration 63 63 } 64 64 … … 68 68 private variable _limits; # maps axis name => {z0 z1} limits 69 69 private variable _field "" 70 private variable _comp2fldName ; 71 private variable _comp2type ; 72 private variable _comp2size ; 73 private variable _comp2assoc; 70 private variable _comp2fldName ; # cname => field names. 71 private variable _comp2type ; # cname => type (e.g. "vectors") 72 private variable _comp2size ; # cname => # of components in element 73 private variable _comp2assoc; # cname => association (e.g. pointdata) 74 74 private variable _fld2Components; # field name => number of components 75 75 private variable _fld2Label; # field name => label 76 76 private variable _fld2Units; # field name => units 77 private variable _hints 77 private variable _hints 78 78 private variable _viewer ""; # Hints which viewer to use 79 79 private variable _xv ""; # For 1D meshes only. Holds the points … … 83 83 private variable _alwaysConvertDX 0; 84 84 85 constructor {xmlobj path} { 86 # defined below 87 } 88 destructor { 89 # defined below 85 constructor {xmlobj path} { 86 # defined below 87 } 88 destructor { 89 # defined below 90 90 } 91 91 public method blob { cname } … … 127 127 } 128 128 public method viewer {} { 129 return $_viewer 129 return $_viewer 130 130 } 131 131 protected method Build {} 132 132 protected method _getValue {expr} 133 133 134 private variable _path ""; # Path of this object in the XML 134 private variable _path ""; # Path of this object in the XML 135 135 private variable _units "" ; # system of units for this field 136 136 private variable _zmax 0 ;# length of the device … … 144 144 private variable _comp2style ;# maps component name => style settings 145 145 private variable _comp2cntls ;# maps component name => x,y control points 146 private variable _comp2extents 147 private variable _comp2limits; 148 private variable _type "" 149 private variable _comp2flowhints 146 private variable _comp2extents 147 private variable _comp2limits; # Array of limits per component 148 private variable _type "" 149 private variable _comp2flowhints 150 150 private variable _comp2mesh 151 151 private common _counter 0 ;# counter for unique vector names 152 152 153 private method AvsToVtk { cname contents } 154 private method DicomToVtk { cname contents } 155 private method BuildPointsOnMesh { cname } 156 protected method GetAssociation { cname } 157 protected method GetTypeAndSize { cname } 158 protected method ReadVtkDataSet { cname contents } 159 private method InitHints {} 160 161 private method VerifyVtkDataSet { contents } 153 private method AvsToVtk { cname contents } 154 private method DicomToVtk { cname contents } 155 private method BuildPointsOnMesh { cname } 156 protected method GetAssociation { cname } 157 protected method GetTypeAndSize { cname } 158 protected method ReadVtkDataSet { cname contents } 159 private method InitHints {} 160 161 private method VerifyVtkDataSet { contents } 162 162 private method VectorLimits { vector vectorsize {comp -1} } 163 163 private variable _values "" … … 229 229 } 230 230 foreach name [array names _comp2mesh] { 231 232 233 231 # Data is in the form of a mesh and a vector. 232 foreach { mesh vector } $_comp2mesh($name) break 233 # Release the mesh (may be shared) 234 234 set class [$mesh info class] 235 235 ${class}::release $mesh 236 236 # Destroy the vector 237 237 blt::vector destroy $vector 238 238 } … … 285 285 # Now handle the tests. 286 286 switch -- $params(what) { 287 -name { 287 -name { 288 288 set rlist $components 289 289 } 290 -style { 290 -style { 291 291 foreach cname $components { 292 292 if { [info exists _comp2style($cname)] } { 293 lappend rlist $_comp2style($cname) 293 lappend rlist $_comp2style($cname) 294 294 } 295 295 } … … 314 314 } 315 315 if { [info exists _comp2vtk($cname)] } { 316 316 # FIXME: extract mesh from VTK file data. 317 317 if { $_comp2dims($cname) == "1D" } { 318 318 return $_xv … … 353 353 # VTK file data 354 354 if { [info exists _comp2vtk($cname)] } { 355 355 # FIXME: extract the values from the VTK file data 356 356 if { $_comp2dims($cname) == "1D" } { 357 357 return $_values … … 361 361 # Points-on-mesh 362 362 if { [info exists _comp2mesh($cname)] } { 363 363 set vector [lindex $_comp2mesh($cname) 1] 364 364 return [$vector range 0 end] 365 365 } … … 368 368 } 369 369 if {[info exists _comp2unirect2d($cname)]} { 370 return [$_comp2unirect2d($cname) values]370 return $_values 371 371 } 372 372 if {[info exists _comp2unirect3d($cname)]} { … … 389 389 } 390 390 if { [info exists _comp2vtk($cname)] } { 391 391 error "blob not implemented for VTK file data" 392 392 } 393 393 if {[info exists _comp2dx($cname)]} { … … 408 408 # USAGE: valueLimits <cname> 409 409 # 410 # Returns an array for the requested component with a list {min max} 410 # Returns an array for the requested component with a list {min max} 411 411 # representing the limits for each axis. 412 412 # ---------------------------------------------------------------------- … … 432 432 1D { 433 433 switch -- $which { 434 x - xlin { 435 set pos 0; set log 0; set axis x 436 437 xlog { 438 set pos 0; set log 1; set axis x 439 440 y - ylin - v - vlin { 441 set pos 1; set log 0; set axis y 442 443 ylog - vlog { 444 set pos 1; set log 1; set axis y 445 434 x - xlin { 435 set pos 0; set log 0; set axis x 436 } 437 xlog { 438 set pos 0; set log 1; set axis x 439 } 440 y - ylin - v - vlin { 441 set pos 1; set log 0; set axis y 442 } 443 ylog - vlog { 444 set pos 1; set log 1; set axis y 445 } 446 446 default { 447 447 error "bad axis \"$which\": should be x, xlin, xlog, y, ylin, ylog, v, vlin, vlog" … … 480 480 default { 481 481 if {[info exists _comp2limits($cname)]} { 482 array set limits $_comp2limits($cname) 483 482 array set limits $_comp2limits($cname) 483 switch -- $which { 484 484 x - xlin - xlog { 485 485 set axis x 486 486 foreach {axisMin axisMax} $limits(x) break 487 487 } 488 488 y - ylin - ylog { 489 489 set axis y 490 490 foreach {axisMin axisMax} $limits(y) break 491 491 } 492 492 z - zlin - zlog { 493 493 set axis z 494 494 foreach {axisMin axisMax} $limits(z) break 495 495 } 496 496 v - vlin - vlog { 497 497 set axis v 498 499 500 501 502 503 498 foreach {axisMin axisMax} $limits(v) break 499 } 500 default { 501 if { ![info exists limits($which)] } { 502 error "limits: unknown axis \"$which\"" 503 } 504 504 set axis v 505 506 507 505 foreach {axisMin axisMax} $limits($which) break 506 } 507 } 508 508 } else { 509 509 set axisMin 0 ;# HACK ALERT! must be OpenDX data … … 545 545 itcl::body Rappture::Field::fieldlimits {} { 546 546 foreach cname [array names _comp2limits] { 547 array set limits $_comp2limits($cname) 547 array set limits $_comp2limits($cname) 548 548 foreach fname [fieldnames $cname] { 549 549 if { ![info exists limits($fname)] } { … … 571 571 return "" 572 572 } 573 573 574 574 # ---------------------------------------------------------------------- 575 575 # USAGE: controls get ?<name>? … … 779 779 set type "" 780 780 if { ([$_field element $cname.constant] != "" && 781 782 781 [$_field element $cname.domain] != "") || 782 [$_field element $cname.xy] != "" } { 783 783 set type "1D" 784 784 } elseif { [$_field element $cname.mesh] != "" && 785 785 [$_field element $cname.values] != ""} { 786 786 set type "points-on-mesh" 787 787 } elseif { [$_field element $cname.vtk] != ""} { 788 789 790 791 792 788 set type "vtk" 789 set viewer [$_field get "about.view"] 790 if { $viewer != "" } { 791 set _viewer $viewer 792 } 793 793 } elseif {[$_field element $cname.opendx] != ""} { 794 794 global env 795 795 if { [info exists env(VTKVOLUME)] } { 796 796 set _viewer "vtkvolume" 797 } 797 } 798 798 set type "opendx" 799 799 } elseif {[$_field element $cname.dx] != ""} { … … 807 807 } elseif {[$_field element $cname.dicom] != ""} { 808 808 set type "dicom" 809 809 } 810 810 set _comp2style($cname) "" 811 811 if { $type == "" } { … … 817 817 set extents [$_field get $cname.extents] 818 818 } else { 819 set extents 1 819 set extents 1 820 820 } 821 821 set _comp2extents($cname) $extents … … 880 880 } 881 881 } elseif {$type == "points-on-mesh"} { 882 882 if { ![BuildPointsOnMesh $cname] } { 883 883 continue; # Ignore this component 884 884 } … … 981 981 return 0 982 982 } 983 # Sanity check. Verify that all components of the field have the same 983 # Sanity check. Verify that all components of the field have the same 984 984 # dimension. 985 985 set dim "" … … 998 998 # the label and units for each field will be specified there. 999 999 # 1000 # FIXME: Test that every <field><component> has the same field names, 1000 # FIXME: Test that every <field><component> has the same field names, 1001 1001 # units, components. 1002 1002 # … … 1070 1070 # isunirect2d -- 1071 1071 # 1072 # Returns if the field is a unirect2d object. 1072 # Returns if the field is a unirect2d object. 1073 1073 # 1074 1074 itcl::body Rappture::Field::isunirect2d { } { … … 1079 1079 # isunirect3d -- 1080 1080 # 1081 # Returns if the field is a unirect3d object. 1081 # Returns if the field is a unirect3d object. 1082 1082 # 1083 1083 itcl::body Rappture::Field::isunirect3d { } { … … 1088 1088 # flowhints -- 1089 1089 # 1090 # Returns the hints associated with a flow vector field. 1090 # Returns the hints associated with a flow vector field. 1091 1091 # 1092 1092 itcl::body Rappture::Field::flowhints { cname } { … … 1100 1100 # style -- 1101 1101 # 1102 # Returns the style associated with a component of the field. 1102 # Returns the style associated with a component of the field. 1103 1103 # 1104 1104 itcl::body Rappture::Field::style { cname } { … … 1137 1137 # extents -- 1138 1138 # 1139 # Returns if the field is a unirect2d object. 1139 # Returns if the field is a unirect2d object. 1140 1140 # 1141 1141 itcl::body Rappture::Field::extents {{cname -overall}} { … … 1153 1153 } 1154 1154 return $max 1155 } 1155 } 1156 1156 if { $cname == "component0"} { 1157 1157 set cname [lindex [components -name] 0] … … 1170 1170 set f [open "$tmpfile" "w"] 1171 1171 fconfigure $f -translation binary -encoding binary 1172 puts $f $contents 1172 puts $f $contents 1173 1173 close $f 1174 1174 … … 1187 1187 set dataAttrs [$dataset GetPointData] 1188 1188 if { $dataAttrs == ""} { 1189 1189 puts stderr "WARNING: No point data found in \"$_path\"" 1190 1190 rename $reader "" 1191 1191 return 0 … … 1204 1204 set f [open "$tmpfile" "w"] 1205 1205 fconfigure $f -translation binary -encoding binary 1206 puts $f $contents 1206 puts $f $contents 1207 1207 close $f 1208 1208 … … 1224 1224 set _dim 0 1225 1225 if { $xmax > $xmin } { 1226 1226 incr _dim 1227 1227 } 1228 1228 if { $ymax > $ymin } { 1229 1229 incr _dim 1230 1230 } 1231 1231 if { $zmax > $zmin } { 1232 1232 incr _dim 1233 1233 } 1234 1234 if { $_viewer == "" } { 1235 1236 1237 1238 1239 1235 if { $_dim == 2 } { 1236 set _viewer contour 1237 } else { 1238 set _viewer isosurface 1239 } 1240 1240 } 1241 1241 set _comp2dims($cname) ${_dim}D … … 1245 1245 for { set i 0 } { $i < $numPoints } { incr i } { 1246 1246 set point [$dataset GetPoint $i] 1247 $xv append [lindex $point 0] 1247 $xv append [lindex $point 0] 1248 1248 } 1249 1249 set yv [blt::vector create \#auto] … … 1262 1262 set numTuples [$array GetNumberOfTuples] 1263 1263 for { set i 0 } { $i < $numTuples } { incr i } { 1264 $yv append [$array GetComponent $i 0] 1264 $yv append [$array GetComponent $i 0] 1265 1265 } 1266 1266 $xv sort $yv 1267 1267 set _comp2xy($cname) [list $xv $yv] 1268 1268 } 1269 lappend limits x [list $xmin $xmax] 1270 lappend limits y [list $ymin $ymax] 1269 lappend limits x [list $xmin $xmax] 1270 lappend limits y [list $ymin $ymax] 1271 1271 lappend limits z [list $zmin $zmax] 1272 1272 set dataAttrs [$dataset GetPointData] 1273 1273 if { $dataAttrs == ""} { 1274 1274 puts stderr "WARNING: No point data found in \"$_path\"" 1275 1275 rename $reader "" 1276 1276 return 0 … … 1280 1280 set numArrays [$dataAttrs GetNumberOfArrays] 1281 1281 if { $numArrays > 0 } { 1282 1283 1284 1285 1282 for {set i 0} {$i < [$dataAttrs GetNumberOfArrays] } {incr i} { 1283 set array [$dataAttrs GetArray $i] 1284 set fname [$dataAttrs GetArrayName $i] 1285 foreach {min max} [$array GetRange -1] break 1286 1286 if {$i == 0} { 1287 1287 set vmin $min 1288 1288 set vmax $max 1289 1289 } 1290 1290 lappend limits $fname [list $min $max] 1291 1291 set _fld2Units($fname) "" 1292 1292 set _fld2Label($fname) $fname 1293 1293 # Let the VTK file override the <type> designated. 1294 1294 set _fld2Components($fname) [$array GetNumberOfComponents] 1295 1295 lappend _comp2fldName($cname) $fname 1296 1297 } 1298 1296 } 1297 } 1298 1299 1299 lappend limits v [list $vmin $vmax] 1300 1300 set _comp2limits($cname) $limits … … 1306 1306 # vtkdata -- 1307 1307 # 1308 # 1309 # 1308 # Returns a string representing the mesh and field data for a specific 1309 # component in the legacy VTK file format. 1310 1310 # 1311 1311 itcl::body Rappture::Field::vtkdata {cname} { … … 1313 1313 set cname "component" 1314 1314 } 1315 # DX: Convert DX to VTK 1315 # DX: Convert DX to VTK 1316 1316 if {[info exists _comp2dx($cname)]} { 1317 1317 set data $_comp2dx($cname) … … 1319 1319 return [Rappture::DxToVtk $data] 1320 1320 } 1321 # Unirect3d: isosurface 1321 # Unirect3d: isosurface 1322 1322 if {[info exists _comp2unirect3d($cname)]} { 1323 1323 return [$_comp2unirect3d($cname) vtkdata] 1324 1324 } 1325 # VTK file data: 1325 # VTK file data: 1326 1326 if { [info exists _comp2vtk($cname)] } { 1327 1327 return $_comp2vtk($cname) … … 1329 1329 # Points on mesh: Construct VTK file output. 1330 1330 if { [info exists _comp2mesh($cname)] } { 1331 1332 1331 # Data is in the form mesh and vector 1332 foreach {mesh vector} $_comp2mesh($cname) break 1333 1333 set label $cname 1334 1334 regsub -all { } $label {_} label 1335 1336 1337 1338 1335 append out "# vtk DataFile Version 3.0\n" 1336 append out "[hints label]\n" 1337 append out "ASCII\n" 1338 append out [$mesh vtkdata] 1339 1339 1340 1340 if { $_comp2assoc($cname) == "pointdata" } { … … 1377 1377 } 1378 1378 } 1379 append out [$vector range 0 end] 1379 append out [$vector range 0 end] 1380 1380 append out "\n" 1381 1381 if 0 { 1382 1382 VerifyVtkDataSet $out 1383 1383 } 1384 1384 return $out 1385 1385 } 1386 1386 error "can't find vtkdata for $cname. This method should only be called by the vtkheightmap widget" … … 1390 1390 # BuildPointsOnMesh -- 1391 1391 # 1392 # 1393 # 1394 # 1392 # Parses the field XML description to build a mesh and values vector 1393 # representing the field. Right now we handle the deprecated types 1394 # of "cloud", "unirect2d", and "unirect3d" (mostly for flows). 1395 1395 # 1396 1396 itcl::body Rappture::Field::BuildPointsOnMesh {cname} { … … 1401 1401 set path [$_field get $cname.mesh] 1402 1402 if {[$_xmlobj element $path] == ""} { 1403 1404 1403 # Unknown mesh designated. 1404 return 0 1405 1405 } 1406 1406 set viewer [$_field get "about.view"] … … 1422 1422 # Handle bizarre cases that hopefully will be deprecated. 1423 1423 if { $element == "unirect3d" } { 1424 1424 # Special case: unirect3d (should be deprecated) + flow. 1425 1425 if { [$_field element $cname.extents] != "" } { 1426 1426 set vectorsize [$_field get $cname.extents] 1427 1427 } else { 1428 set vectorsize 1 1428 set vectorsize 1 1429 1429 } 1430 1430 set _type unirect3d 1431 1431 set _dim 3 1432 1432 if { $_viewer == "" } { 1433 1433 set _viewer flowvis 1434 1434 } 1435 1436 1437 1438 1435 set _comp2dims($cname) "3D" 1436 set _comp2unirect3d($cname) \ 1437 [Rappture::Unirect3d \#auto $_xmlobj $_field $cname $vectorsize] 1438 set _comp2style($cname) [$_field get $cname.style] 1439 1439 set limits {} 1440 1440 foreach axis { x y z } { 1441 1441 lappend limits $axis [$_comp2unirect3d($cname) limits $axis] 1442 1442 } 1443 # Get the data limits 1443 # Get the data limits 1444 1444 set vector [$_comp2unirect3d($cname) valuesObj] 1445 1445 set minmax [VectorLimits $vector $vectorsize] … … 1447 1447 lappend limits v $minmax 1448 1448 set _comp2limits($cname) $limits 1449 1450 1451 1452 1453 1454 1449 if {[$_field element $cname.flow] != ""} { 1450 set _comp2flowhints($cname) \ 1451 [Rappture::FlowHints ::\#auto $_field $cname $_units] 1452 } 1453 incr _counter 1454 return 1 1455 1455 } 1456 1456 if { $element == "unirect2d" && [$_field element $cname.flow] != "" } { 1457 1457 # Special case: unirect2d (normally deprecated) + flow. 1458 1458 if { [$_field element $cname.extents] != "" } { 1459 1459 set vectorsize [$_field get $cname.extents] 1460 1460 } else { 1461 set vectorsize 1 1461 set vectorsize 1 1462 1462 } 1463 1463 set _type unirect2d 1464 1464 set _dim 2 1465 1465 if { $_viewer == "" } { 1466 1466 set _viewer "flowvis" 1467 1467 } 1468 1469 1470 1471 1472 1473 1474 1468 set _comp2dims($cname) "2D" 1469 set _comp2unirect2d($cname) \ 1470 [Rappture::Unirect2d \#auto $_xmlobj $path] 1471 set _comp2style($cname) [$_field get $cname.style] 1472 set _comp2flowhints($cname) \ 1473 [Rappture::FlowHints ::\#auto $_field $cname $_units] 1474 set _values [$_field get $cname.values] 1475 1475 set limits {} 1476 1476 foreach axis { x y z } { … … 1484 1484 blt::vector destroy $xv 1485 1485 set _comp2limits($cname) $limits 1486 1487 1486 incr _counter 1487 return 1 1488 1488 } 1489 1489 switch -- $element { 1490 1491 1490 "cloud" { 1491 set mesh [Rappture::Cloud::fetch $_xmlobj $path] 1492 1492 set _type cloud 1493 1494 1495 1493 } 1494 "mesh" { 1495 set mesh [Rappture::Mesh::fetch $_xmlobj $path] 1496 1496 set _type mesh 1497 } 1498 1497 } 1498 "unirect2d" { 1499 1499 if { $_viewer == "" } { 1500 1500 set _viewer "heightmap" 1501 1501 } 1502 1502 set mesh [Rappture::Unirect2d::fetch $_xmlobj $path] 1503 1503 set _type unirect2d 1504 1504 } 1505 1505 } 1506 1506 if { ![$mesh isvalid] } { … … 1510 1510 set _dim [$mesh dimensions] 1511 1511 if { $_dim == 3 } { 1512 set dim 0 1512 set dim 0 1513 1513 foreach axis {x y z} { 1514 1514 foreach {min max} [$mesh limits $axis] { … … 1523 1523 } 1524 1524 1525 if {$_dim == 1} { 1526 # 1D data: Create vectors for graph widget. 1527 # Is this used anywhere? 1528 # 1529 # OOPS! This is 1D data 1530 # Forget the cloud/field -- store BLT vectors 1531 # 1532 # Is there a natural growth path in generating output from 1D to 1533 # higher dimensions? If there isn't, let's kill this in favor 1534 # or explicitly using a <curve> instead. Otherwise, the features 1535 # (methods such as xmarkers) or the <curve> need to be added 1536 # to the <field>. 1537 # 1538 set xv [blt::vector create x$_counter] 1539 set yv [blt::vector create y$_counter] 1540 1541 $yv set [$mesh points] 1542 $xv seq 0 1 [$yv length] 1543 # sort x-coords in increasing order 1544 $xv sort $yv 1545 set _comp2dims($cname) "1D" 1546 set _comp2xy($cname) [list $xv $yv] 1547 incr _counter 1548 return 1 1549 } 1525 if {$_dim < 2} { 1526 puts stderr "ERROR: Can't convert 1D cloud/mesh to curve. Please use curve output for 1D meshes." 1527 return 0 1528 1529 # 1D data: Create vectors for graph widget. 1530 # The prophet tool currently outputs 1D clouds with fields 1531 # Band Structure Lab used to (see isosurface1 test in rappture-bat) 1532 # 1533 # Is there a natural growth path in generating output from 1D to 1534 # higher dimensions? If there isn't, let's kill this in favor 1535 # or explicitly using a <curve> instead. Otherwise, the features 1536 # (methods such as xmarkers) or the <curve> need to be added 1537 # to the <field>. 1538 # 1539 #set xv [blt::vector create x$_counter] 1540 #set yv [blt::vector create y$_counter] 1541 1542 # This only works with a Cloud mesh type, since the points method 1543 # is not implemented for the Mesh object 1544 #$xv set [$mesh points] 1545 # TODO: Put field values in yv 1546 #set _comp2dims($cname) "1D" 1547 #set _comp2xy($cname) [list $xv $yv] 1548 #incr _counter 1549 #return 1 1550 } 1550 1551 if {$_dim == 2} { 1551 1552 1553 1552 # 2D data: By default surface or contour plot using heightmap widget. 1553 set v [blt::vector create \#auto] 1554 $v set [$_field get $cname.values] 1554 1555 if { [$v length] == 0 } { 1555 1556 return 0 … … 1578 1579 } 1579 1580 } 1580 1581 1582 1581 set _comp2dims($cname) "[$mesh dimensions]D" 1582 set _comp2mesh($cname) [list $mesh $v] 1583 set _comp2style($cname) [$_field get $cname.style] 1583 1584 if {[$_field element $cname.flow] != ""} { 1584 1585 set _comp2flowhints($cname) \ 1585 1586 [Rappture::FlowHints ::\#auto $_field $cname $_units] 1586 1587 } 1587 1588 1588 incr _counter 1589 array unset _comp2limits $cname 1589 1590 foreach axis { x y z } { 1590 1591 lappend _comp2limits($cname) $axis [$mesh limits $axis] … … 1593 1594 lappend _comp2limits($cname) $cname $minmax 1594 1595 lappend _comp2limits($cname) v $minmax 1595 1596 } 1596 return 1 1597 } 1597 1598 if {$_dim == 3} { 1598 1599 # 3D data: By default isosurfaces plot using isosurface widget. 1599 1600 if { $_viewer == "" } { 1600 1601 set _viewer "isosurface" 1601 1602 } 1602 1603 1603 set v [blt::vector create \#auto] 1604 $v set [$_field get $cname.values] 1604 1605 if { [$v length] == 0 } { 1605 1606 return 0 … … 1639 1640 lappend _comp2limits($cname) $cname $minmax 1640 1641 lappend _comp2limits($cname) v $minmax 1641 1642 return 1 1642 1643 } 1643 1644 error "unhandled case in field dim=$_dim element=$element" … … 1731 1732 "tcoords" 2 1732 1733 "tensors" 9 1733 "vectors" 3 1734 "vectors" 3 1734 1735 } 1735 1736 set type [$_field get $cname.elemtype] 1736 1737 if { $type == "" } { 1737 1738 set type "scalars" 1738 } 1739 } 1739 1740 if { ![info exists type2components($type)] } { 1740 1741 error "unknown <elemtype> \"$type\" in field" … … 1753 1754 set _comp2assoc($cname) "pointdata" 1754 1755 return 1755 } 1756 } 1756 1757 switch -- $assoc { 1757 1758 "pointdata" - "celldata" - "fielddata" { -
branches/uq/gui/scripts/flowvisviewer.tcl
r4797 r5121 44 44 itk_option define -plotoutline plotOutline PlotOutline "" 45 45 46 private variable _volcomponents ; # Array of components found47 private variable _componentsList ; # Array of components found48 private method BuildVolumeComponents {}49 private method GetDatasetsWithComponent { cname }50 51 46 constructor { hostlist args } { 52 47 Rappture::VisViewer::constructor $hostlist … … 68 63 public method get {args} 69 64 public method isconnected {} 70 public method limits { cname}71 public method over Marker { m x }65 public method limits { tf } 66 public method overmarker { m x } 72 67 public method parameters {title args} { 73 68 # do nothing 74 69 } 75 public method r emoveDuplicateMarker { m x }70 public method rmdupmarker { m x } 76 71 public method scale {args} 77 public method update TransferFunctions {}72 public method updatetransferfuncs {} 78 73 79 74 protected method Connect {} … … 90 85 protected method ReceiveLegend { tf vmin vmax size } 91 86 protected method Rotate {option x y} 87 protected method SendDataObjs {} 92 88 protected method SendTransferFuncs {} 93 89 protected method Slice {option args} … … 135 131 private variable _serverObjs ;# maps dataobj-component to volume ID 136 132 # in the server 133 private variable _sendobjs "" ;# list of data objs to send to server 137 134 private variable _recvObjs ;# list of data objs to send to server 138 135 private variable _obj2style ;# maps dataobj-component to transfunc … … 181 178 $_dispatcher dispatch $this !legend "[itcl::code $this ResizeLegend]; list" 182 179 180 # Send dataobjs event 181 $_dispatcher register !send_dataobjs 182 $_dispatcher dispatch $this !send_dataobjs \ 183 "[itcl::code $this SendDataObjs]; list" 184 183 185 # Send transferfunctions event 184 186 $_dispatcher register !send_transfunc … … 230 232 $_arcball quaternion $q 231 233 232 set _limits(v) [list 0.0 1.0] 234 set _limits(vmin) 0.0 235 set _limits(vmax) 1.0 233 236 set _reset 1 234 237 … … 332 335 set _image(legend) [image create photo] 333 336 itk_component add legend { 334 canvas $itk_component(plotarea).legend -height 50 -highlightthickness 0 337 canvas $itk_component(plotarea).legend \ 338 -height 50 -highlightthickness 0 -background black 335 339 } { 336 340 usual … … 556 560 # ---------------------------------------------------------------------- 557 561 itcl::body Rappture::FlowvisViewer::destructor {} { 562 set _sendobjs "" ;# stop any send in progress 558 563 $_dispatcher cancel !rebuild 564 $_dispatcher cancel !send_dataobjs 559 565 $_dispatcher cancel !send_transfunc 560 566 image delete $_image(plot) … … 666 672 # ---------------------------------------------------------------------- 667 673 itcl::body Rappture::FlowvisViewer::delete {args} { 668 flow stop674 flow stop 669 675 if {[llength $args] == 0} { 670 676 set args $_dlist … … 716 722 # ---------------------------------------------------------------------- 717 723 itcl::body Rappture::FlowvisViewer::scale {args} { 718 array set styles { 719 -color BCGYR 720 -levels 6 721 -markers "" 722 -opacity 1.0 723 } 724 array unset _limits 725 array unset _volcomponents 726 foreach dataobj $args { 727 if { ![$dataobj isvalid] } { 728 continue; # Object doesn't contain valid data. 729 } 730 foreach cname [$dataobj components] { 731 if { ![info exists _volcomponents($cname)] } { 732 lappend _componentsList $cname 733 array set styles [lindex [$dataobj components -style $cname] 0] 734 set cmap [ColorsToColormap $styles(-color)] 735 set _cname2defaultcolormap($cname) $cmap 736 set _settings($cname-colormap) $styles(-color) 737 } 738 lappend _volcomponents($cname) $dataobj-$cname 739 array unset limits 740 array set limits [$dataobj valueLimits $cname] 741 set _limits($cname) $limits(v) 742 } 743 foreach axis {x y z v} { 744 foreach { min max } [$dataobj limits $axis] break 724 foreach val {xmin xmax ymin ymax vmin vmax} { 725 set _limits($val) "" 726 } 727 foreach obj $args { 728 foreach axis {x y v} { 729 730 foreach { min max } [$obj limits $axis] break 731 745 732 if {"" != $min && "" != $max} { 746 if { ![info exists _limits($axis)] } { 747 set _limits($axis) [list $min $max] 733 if {"" == $_limits(${axis}min)} { 734 set _limits(${axis}min) $min 735 set _limits(${axis}max) $max 748 736 } else { 749 foreach {amin amax} $_limits($axis) break 750 if {$min < $amin} { 751 set amin $min 737 if {$min < $_limits(${axis}min)} { 738 set _limits(${axis}min) $min 752 739 } 753 if {$max > $ amax} {754 set amax$max740 if {$max > $_limits(${axis}max)} { 741 set _limits(${axis}max) $max 755 742 } 756 set _limits($axis) [list $amin $amax]757 743 } 758 744 } 759 745 } 760 746 } 761 #BuildVolumeComponents762 747 } 763 748 … … 872 857 if { $_reportClientInfo } { 873 858 # Tell the server the viewer, hub, user and session. 874 # Do this immediately on connect before buff ering any commands859 # Do this immediately on connect before buffing any commands 875 860 global env 876 861 … … 929 914 # disconnected -- no more data sitting on server 930 915 array unset _serverObjs 916 set _sendobjs "" 917 } 918 919 # ---------------------------------------------------------------------- 920 # USAGE: SendDataObjs 921 # 922 # Used internally to send a series of volume objects off to the 923 # server. Sends each object, a little at a time, with updates in 924 # between so the interface doesn't lock up. 925 # ---------------------------------------------------------------------- 926 itcl::body Rappture::FlowvisViewer::SendDataObjs {} { 927 blt::busy hold $itk_component(hull) 928 foreach dataobj $_sendobjs { 929 foreach comp [$dataobj components] { 930 # Send the data as one huge base64-encoded mess -- yuck! 931 set data [$dataobj blob $comp] 932 set nbytes [string length $data] 933 set extents [$dataobj extents $comp] 934 935 # I have a field. Is a vector field or a volume field? 936 if { $extents == 1 } { 937 set cmd "volume data follows $nbytes $dataobj-$comp\n" 938 } else { 939 set cmd [FlowCmd $dataobj $comp $nbytes $extents] 940 if { $cmd == "" } { 941 puts stderr "no command" 942 continue 943 } 944 } 945 f { ![SendBytes $cmd] } { 946 puts stderr "can't send" 947 return 948 } 949 if { ![SendBytes $data] } { 950 puts stderr "can't send" 951 return 952 } 953 NameTransferFunc $dataobj $comp 954 set _recvObjs($dataobj-$comp) 1 955 } 956 } 957 set _sendobjs "" 958 blt::busy release $itk_component(hull) 959 960 # Turn on buffering of commands to the server. We don't want to 961 # be preempted by a server disconnect/reconnect (which automatically 962 # generates a new call to Rebuild). 963 StartBufferingCommands 964 965 # activate the proper volume 966 set _first [lindex [get] 0] 967 if { "" != $_first } { 968 set axis [$_first hints updir] 969 if {"" != $axis} { 970 SendCmd "up $axis" 971 } 972 973 if 0 { 974 set location [$_first hints camera] 975 if { $location != "" } { 976 array set _view $location 977 } 978 set _settings($this-qw) $_view(qw) 979 set _settings($this-qx) $_view(qx) 980 set _settings($this-qy) $_view(qy) 981 set _settings($this-qz) $_view(qz) 982 set _settings($this-xpan) $_view(xpan) 983 set _settings($this-ypan) $_view(ypan) 984 set _settings($this-zoom) $_view(zoom) 985 set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)] 986 $_arcball quaternion $q 987 SendCmd "camera orient $q" 988 SendCmd "camera reset" 989 PanCamera 990 SendCmd "camera zoom $_view(zoom)" 991 } 992 # The active transfer function is by default the first component of 993 # the first data object. This assumes that the data is always 994 # successfully transferred. 995 set comp [lindex [$_first components] 0] 996 set _activeTf [lindex $_obj2style($_first-$comp) 0] 997 } 998 999 SendCmd "flow reset" 1000 StopBufferingCommands 931 1001 } 932 1002 … … 1027 1097 set h [winfo height $c] 1028 1098 set lx 10 1099 # FIXME: I don't know what I have to do this for the 2D flow 1100 # example. Otherwise the canvas background is white. 1101 # I'll get to this when we add background changes into 1102 # nanvis. 1103 $c configure -background black 1029 1104 set ly [expr {$h - 1}] 1030 if {"" == [$c find withtag colorbar]} {1105 if {"" == [$c find withtag transfunc]} { 1031 1106 $c create image 10 10 -anchor nw \ 1032 -image $_image(legend) -tags colorbar1107 -image $_image(legend) -tags transfunc 1033 1108 $c create text $lx $ly -anchor sw \ 1034 1109 -fill $itk_option(-plotforeground) -tags "limits vmin" 1035 1110 $c create text [expr {$w-$lx}] $ly -anchor se \ 1036 1111 -fill $itk_option(-plotforeground) -tags "limits vmax" 1037 $c lower colorbar 1038 $c bind colorbar <ButtonRelease-1> [itcl::code $this AddIsoMarker %x %y] 1112 $c lower transfunc 1113 $c bind transfunc <ButtonRelease-1> \ 1114 [itcl::code $this AddIsoMarker %x %y] 1039 1115 } 1040 1116 # Display the markers used by the active transfer function. 1041 1117 set tf $_obj2style($tag) 1042 foreach {vmin vmax} [limits $tf] break1043 $c itemconfigure vmin -text [format % g $vmin]1118 array set limits [limits $tf] 1119 $c itemconfigure vmin -text [format %.2g $limits(vmin)] 1044 1120 $c coords vmin $lx $ly 1045 1121 1046 $c itemconfigure vmax -text [format % g $vmax]1122 $c itemconfigure vmax -text [format %.2g $limits(vmax)] 1047 1123 $c coords vmax [expr {$w-$lx}] $ly 1048 1124 … … 1084 1160 set dataobj [lindex $parts 0] 1085 1161 set _serverObjs($tag) 0 1086 set _limits($tag) [list $values(min) $values(max)] 1162 set _limits($tag-min) $values(min); # Minimum value of the volume. 1163 set _limits($tag-max) $values(max); # Maximum value of the volume. 1087 1164 unset _recvObjs($tag) 1088 1165 if { [array size _recvObjs] == 0 } { 1089 update TransferFunctions1166 updatetransferfuncs 1090 1167 } 1091 1168 } … … 1131 1208 foreach comp [$dataobj components] { 1132 1209 set tag $dataobj-$comp 1133 set isvtk 0 1134 # FIXME: Would like to use the type method of the dataobj 1135 # but the returned value isn't well defined now 1136 if {[catch { 1137 # Send the data as one huge base64-encoded mess -- yuck! 1138 set data [$dataobj blob $comp] 1139 }]} { 1140 set data [$dataobj vtkdata $comp] 1141 set isvtk 1 1142 } 1210 # Send the data as one huge base64-encoded mess -- yuck! 1211 set data [$dataobj blob $comp] 1143 1212 set nbytes [string length $data] 1144 1213 if { $_reportClientInfo } { 1145 1214 set info {} 1146 lappend info "tool_id" [$dataobj hints toolId] 1147 lappend info "tool_name" [$dataobj hints toolName] 1148 lappend info "tool_version" [$dataobj hints toolRevision] 1149 lappend info "tool_title" [$dataobj hints toolTitle] 1215 lappend info "tool_id" [$dataobj hints toolid] 1216 lappend info "tool_name" [$dataobj hints toolname] 1217 lappend info "tool_title" [$dataobj hints tooltitle] 1218 lappend info "tool_command" [$dataobj hints toolcommand] 1219 lappend info "tool_revision" [$dataobj hints toolrevision] 1150 1220 lappend info "dataset_label" [$dataobj hints label] 1151 1221 lappend info "dataset_size" $nbytes … … 1155 1225 set extents [$dataobj extents $comp] 1156 1226 # I have a field. Is a vector field or a volume field? 1157 if { !$isvtk &&$extents == 1 } {1227 if { $extents == 1 } { 1158 1228 set cmd "volume data follows $nbytes $tag\n" 1159 1229 } else { … … 1259 1329 foreach key [array names _serverObjs *-*] { 1260 1330 if {[string match $_first-* $key]} { 1261 array set style s{1331 array set style { 1262 1332 -cutplanes 1 1263 1333 } 1264 1334 foreach {dataobj comp} [split $key -] break 1265 array set style s[lindex [$dataobj components -style $comp] 0]1266 if {$what != "-cutplanes" || $style s(-cutplanes)} {1335 array set style [lindex [$dataobj components -style $comp] 0] 1336 if {$what != "-cutplanes" || $style(-cutplanes)} { 1267 1337 lappend rlist $_serverObjs($key) 1268 1338 } … … 1324 1394 1325 1395 itcl::body Rappture::FlowvisViewer::PanCamera {} { 1396 #set x [expr ($_view(xpan)) / $_limits(xrange)] 1397 #set y [expr ($_view(ypan)) / $_limits(yrange)] 1326 1398 set x $_view(xpan) 1327 1399 set y $_view(ypan) … … 1587 1659 set tf $_activeTf 1588 1660 set _settings($this-$tf-opacity) $opacity 1589 update TransferFunctions1661 updatetransferfuncs 1590 1662 } 1591 1663 } … … 1598 1670 set tf $_activeTf 1599 1671 set _settings($this-$tf-thickness) $sval 1600 update TransferFunctions1672 updatetransferfuncs 1601 1673 } 1602 1674 } … … 1706 1778 # now. 1707 1779 # 1708 itcl::body Rappture::FlowvisViewer::NameTransferFunc { dataobj c name} {1709 array set style s{1780 itcl::body Rappture::FlowvisViewer::NameTransferFunc { dataobj comp } { 1781 array set style { 1710 1782 -color BCGYR 1711 1783 -levels 6 1784 -opacity 1.0 1712 1785 -light 40 1713 -opacity 1.01714 1786 -transp 50 1715 1787 } 1716 array set styles [lindex [$dataobj components -style $cname] 0] 1717 set _settings($this-light) $styles(-light) 1718 set _settings($this-transp) $styles(-transp) 1719 set _settings($this-opacity) [expr $styles(-opacity) * 100] 1720 set _obj2style($dataobj-$cname) $cname 1721 lappend _style2objs($cname) $dataobj $cname 1722 return $cname 1788 array set style [lindex [$dataobj components -style $comp] 0] 1789 set _settings($this-light) $style(-light) 1790 set _settings($this-transp) $style(-transp) 1791 set _settings($this-opacity) [expr $style(-opacity) * 100] 1792 set tf "$style(-color):$style(-levels):$style(-opacity)" 1793 set _obj2style($dataobj-$comp) $tf 1794 lappend _style2objs($tf) $dataobj $comp 1795 return $tf 1723 1796 } 1724 1797 … … 1733 1806 # 1734 1807 itcl::body Rappture::FlowvisViewer::ComputeTransferFunc { tf } { 1735 array set style s{1808 array set style { 1736 1809 -color BCGYR 1737 1810 -levels 6 … … 1745 1818 return 0 1746 1819 } 1747 array set style s[lindex [$dataobj components -style $comp] 0]1820 array set style [lindex [$dataobj components -style $comp] 0] 1748 1821 1749 1822 … … 1763 1836 if { ![info exists _isomarkers($tf)] } { 1764 1837 # Have to defer creation of isomarkers until we have data limits 1765 if { [info exists style s(-markers)] &&1766 [llength $style s(-markers)] > 0 } {1767 ParseMarkersOption $tf $style s(-markers)1838 if { [info exists style(-markers)] && 1839 [llength $style(-markers)] > 0 } { 1840 ParseMarkersOption $tf $style(-markers) 1768 1841 } else { 1769 ParseLevelsOption $tf $style s(-levels)1770 } 1771 } 1772 if { [info exists style s(-nonuniformcolors)] } {1773 foreach { value color } $style s(-nonuniformcolors) {1842 ParseLevelsOption $tf $style(-levels) 1843 } 1844 } 1845 if { [info exists style(-nonuniformcolors)] } { 1846 foreach { value color } $style(-nonuniformcolors) { 1774 1847 append cmap "$value [Color2RGB $color] " 1775 1848 } 1776 1849 } else { 1777 set cmap [ColorsToColormap $style s(-color)]1850 set cmap [ColorsToColormap $style(-color)] 1778 1851 } 1779 1852 set tag $this-$tf 1780 1853 if { ![info exists _settings($tag-opacity)] } { 1781 set _settings($tag-opacity) $style s(-opacity)1854 set _settings($tag-opacity) $style(-opacity) 1782 1855 } 1783 1856 set max 1.0 ;#$_settings($tag-opacity) … … 1844 1917 itcl::configbody Rappture::FlowvisViewer::plotbackground { 1845 1918 if { [isconnected] } { 1846 set color $itk_option(-plotbackground) 1847 set rgb [Color2RGB $color] 1848 SendCmd "screen bgcolor $rgb" 1849 $itk_component(legend) configure -background $color 1919 foreach {r g b} [Color2RGB $itk_option(-plotbackground)] break 1920 #fix this! 1921 #SendCmd "color background $r $g $b" 1850 1922 } 1851 1923 } … … 1856 1928 itcl::configbody Rappture::FlowvisViewer::plotforeground { 1857 1929 if { [isconnected] } { 1858 set color $itk_option(-plotforeground) 1859 set rgb [Color2RGB $color] 1860 SendCmd "volume outline color $rgb" 1861 SendCmd "grid axiscolor $rgb" 1862 SendCmd "grid linecolor $rgb" 1863 $itk_component(legend) itemconfigure labels -fill $color 1864 $itk_component(legend) itemconfigure limits -fill $color 1930 foreach {r g b} [Color2RGB $itk_option(-plotforeground)] break 1931 #fix this! 1932 #SendCmd "color background $r $g $b" 1865 1933 } 1866 1934 } … … 1896 1964 set x [expr {double($i)/($levels+1)}] 1897 1965 set m [Rappture::IsoMarker \#auto $c $this $tf] 1898 $itk_component(legend) itemconfigure labels -fill $itk_option(-plotforeground)1899 1966 $m relval $x 1900 1967 lappend _isomarkers($tf) $m … … 1903 1970 foreach x $levels { 1904 1971 set m [Rappture::IsoMarker \#auto $c $this $tf] 1905 $itk_component(legend) itemconfigure labels -fill $itk_option(-plotforeground)1906 1972 $m relval $x 1907 1973 lappend _isomarkers($tf) $m … … 1931 1997 set value [expr {$value * 0.01}] 1932 1998 set m [Rappture::IsoMarker \#auto $c $this $tf] 1933 $itk_component(legend) itemconfigure labels -fill $itk_option(-plotforeground)1934 1999 $m relval $value 1935 2000 lappend _isomarkers($tf) $m … … 1937 2002 # ${n} : Set absolute value. 1938 2003 set m [Rappture::IsoMarker \#auto $c $this $tf] 1939 $itk_component(legend) itemconfigure labels -fill $itk_option(-plotforeground)1940 2004 $m absval $value 1941 2005 lappend _isomarkers($tf) $m … … 1947 2011 # USAGE: UndateTransferFuncs 1948 2012 # ---------------------------------------------------------------------- 1949 itcl::body Rappture::FlowvisViewer::update TransferFunctions {} {2013 itcl::body Rappture::FlowvisViewer::updatetransferfuncs {} { 1950 2014 $_dispatcher event -after 100 !send_transfunc 1951 2015 } … … 1958 2022 set c $itk_component(legend) 1959 2023 set m [Rappture::IsoMarker \#auto $c $this $tf] 1960 $itk_component(legend) itemconfigure labels -fill $itk_option(-plotforeground)1961 2024 set w [winfo width $c] 1962 2025 $m relval [expr {double($x-10)/($w-20)}] 1963 2026 lappend _isomarkers($tf) $m 1964 update TransferFunctions2027 updatetransferfuncs 1965 2028 return 1 1966 2029 } 1967 2030 1968 itcl::body Rappture::FlowvisViewer::r emoveDuplicateMarker { marker x } {2031 itcl::body Rappture::FlowvisViewer::rmdupmarker { marker x } { 1969 2032 set tf [$marker transferfunc] 1970 2033 set bool 0 … … 1986 2049 } 1987 2050 set _isomarkers($tf) $list 1988 update TransferFunctions2051 updatetransferfuncs 1989 2052 } 1990 2053 return $bool 1991 2054 } 1992 2055 1993 itcl::body Rappture::FlowvisViewer::over Marker { marker x } {2056 itcl::body Rappture::FlowvisViewer::overmarker { marker x } { 1994 2057 set tf [$marker transferfunc] 1995 2058 if { [info exists _isomarkers($tf)] } { … … 2006 2069 } 2007 2070 2008 itcl::body Rappture::FlowvisViewer::limits { cname } { 2009 set _limits(v) [list 0.0 1.0] 2010 if { ![info exists _style2objs($cname)] } { 2011 puts stderr "no style2objs for $cname cname=($cname)" 2071 itcl::body Rappture::FlowvisViewer::limits { tf } { 2072 set _limits(vmin) 0.0 2073 set _limits(vmax) 1.0 2074 if { ![info exists _style2objs($tf)] } { 2075 puts stderr "no style2objs for $tf tf=($tf)" 2012 2076 return [array get _limits] 2013 2077 } 2014 2078 set min ""; set max "" 2015 foreach tag [GetDatasetsWithComponent $cname] { 2079 foreach {dataobj comp} $_style2objs($tf) { 2080 set tag $dataobj-$comp 2016 2081 if { ![info exists _serverObjs($tag)] } { 2017 2082 puts stderr "$tag not in serverObjs?" 2018 2083 continue 2019 2084 } 2020 if { ![info exists _limits($tag )] } {2085 if { ![info exists _limits($tag-min)] } { 2021 2086 puts stderr "$tag no min?" 2022 2087 continue 2023 2088 } 2024 foreach {vmin vmax} $_limits($tag) break 2025 if { $min == "" || $min > $vmin } { 2026 set min $vmin 2027 } 2028 if { $max == "" || $max < $vmax } { 2029 set max $vmax 2030 } 2031 } 2032 if { $min != "" && $max != "" } { 2033 set _limits(v) [list $min $max] 2034 set _limits($cname) [list $min $max] 2035 } 2036 return $_limits($cname) 2089 if { $min == "" || $min > $_limits($tag-min) } { 2090 set min $_limits($tag-min) 2091 } 2092 if { $max == "" || $max < $_limits($tag-max) } { 2093 set max $_limits($tag-max) 2094 } 2095 } 2096 if { $min != "" } { 2097 set _limits(vmin) $min 2098 } 2099 if { $max != "" } { 2100 set _limits(vmax) $max 2101 } 2102 return [array get _limits] 2037 2103 } 2038 2104 … … 2186 2252 } 2187 2253 2188 $inner.colormap choices insert end [GetColormapList -includeNone] 2254 $inner.colormap choices insert end \ 2255 "BCGYR" "BCGYR" \ 2256 "BGYOR" "BGYOR" \ 2257 "blue" "blue" \ 2258 "blue-to-brown" "blue-to-brown" \ 2259 "blue-to-orange" "blue-to-orange" \ 2260 "blue-to-grey" "blue-to-grey" \ 2261 "green-to-magenta" "green-to-magenta" \ 2262 "greyscale" "greyscale" \ 2263 "nanohub" "nanohub" \ 2264 "rainbow" "rainbow" \ 2265 "spectral" "spectral" \ 2266 "ROYGB" "ROYGB" \ 2267 "RYGCB" "RYGCB" \ 2268 "brown-to-blue" "brown-to-blue" \ 2269 "grey-to-blue" "grey-to-blue" \ 2270 "orange-to-blue" "orange-to-blue" \ 2271 "none" "none" 2272 2189 2273 $itk_component(colormap) value "BCGYR" 2190 2274 bind $inner.colormap <<Value>> \ … … 2497 2581 itcl::body Rappture::FlowvisViewer::SlicerTip {axis} { 2498 2582 set val [$itk_component(${axis}CutScale) get] 2583 # set val [expr {0.01*($val-50) 2584 # *($_limits(${axis}max)-$_limits(${axis}min)) 2585 # + 0.5*($_limits(${axis}max)+$_limits(${axis}min))}] 2499 2586 return "Move the [string toupper $axis] cut plane.\nCurrently: $axis = $val%" 2500 2587 } … … 2950 3037 set _settings($this-zoom) $_view(zoom) 2951 3038 } 2952 2953 # Reset global settings from dataset's settings.2954 itcl::body Rappture::FlowvisViewer::BuildVolumeComponents {} {2955 $itk_component(volcomponents) choices delete 0 end2956 foreach name $_componentsList {2957 $itk_component(volcomponents) choices insert end $name $name2958 }2959 set _current [lindex $_componentsList 0]2960 $itk_component(volcomponents) value $_current2961 }2962 2963 # Reset global settings from dataset's settings.2964 itcl::body Rappture::FlowvisViewer::GetDatasetsWithComponent { cname } {2965 if { ![info exists _volcomponents($cname)] } {2966 return ""2967 }2968 set list ""2969 foreach tag $_volcomponents($cname) {2970 if { ![info exists _serverObjs($tag)] } {2971 continue2972 }2973 lappend list $tag2974 }2975 return $list2976 } -
branches/uq/gui/scripts/gauge.tcl
r5029 r5121 44 44 itk_option define -varname varname Varname "" 45 45 itk_option define -label label Label "" 46 itk_option define -validatecommand validateCommand ValidateCommand "" 46 47 47 48 constructor {args} { # defined below } … … 115 116 -borderwidth 1 -relief flat -textvariable [itcl::scope _value] 116 117 } { 118 keep -font 117 119 rename -background -textbackground textBackground Background 118 120 } … … 247 249 } 248 250 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 } 251 switch -- $itk_option(-type) { 252 integer { 253 if { [scan $newval "%g" value] != 1 || int($newval) != $value } { 254 error "bad value \"$newval\": should be an integer value" 255 } 256 } 257 } 258 259 # 260 # If there's a -validatecommand option, then invoke the code 261 # now to check the new value. 262 # 263 if {[string length $itk_option(-validatecommand)] > 0} { 264 set cmd "uplevel #0 [list $itk_option(-validatecommand) [list $newval]]" 265 set result [eval $cmd] 253 266 } 254 267 -
branches/uq/gui/scripts/imageresult.tcl
r3844 r5121 72 72 pack propagate $itk_component(hull) no 73 73 74 Rappture::Panes $itk_interior.panes -sashwidth 1 -sashrelief solid -sashpadding 2 74 Rappture::Panes $itk_interior.panes \ 75 -sashwidth 2 -sashrelief solid -sashpadding 1 76 75 77 pack $itk_interior.panes -expand yes -fill both 76 78 set main [$itk_interior.panes pane 0] -
branches/uq/gui/scripts/images/ask.png
- Property svn:executable deleted
-
branches/uq/gui/scripts/images/folder.gif
- Property svn:executable deleted
-
branches/uq/gui/scripts/images/molvis-3dorth.gif
- Property svn:executable deleted
-
branches/uq/gui/scripts/images/molvis-3dpers.gif
- Property svn:executable deleted
-
branches/uq/gui/scripts/images/popup.png
- Property svn:executable deleted
-
branches/uq/gui/scripts/isomarker.tcl
r4546 r5121 30 30 private common _normalIcon [Rappture::icon nvlegendmark] 31 31 private common _activeIcon [Rappture::icon nvlegendmark2] 32 private method EnterTick {}33 private method LeaveTick {}34 private method StartDrag { x y }35 private method ContinueDrag { x y }36 private method StopDrag { x y }37 32 38 constructor {c obj tf args} {} 39 destructor {} 40 public method transferfunc {} 41 public method activate { bool } 42 public method visible { bool } 43 public method screenpos {} 44 public method absval { {x "-get"} } 45 public method relval { {x "-get"} } 46 } 47 48 itcl::body Rappture::IsoMarker::constructor {c obj tf args} { 49 set _canvas $c 50 set _nvobj $obj 51 set _tf $tf 52 set w [winfo width $_canvas] 53 set h [winfo height $_canvas] 54 set _tick [$c create image 0 $h \ 55 -image $_normalIcon -anchor s \ 56 -tags "tick $this $obj" -state hidden] 57 set _label [$c create text 0 $h \ 58 -anchor n -fill white -font "Helvetica 8" \ 59 -tags "labels $this $obj" -state hidden] 60 $c bind $_tick <Enter> [itcl::code $this EnterTick] 61 $c bind $_tick <Leave> [itcl::code $this LeaveTick] 62 $c bind $_tick <ButtonPress-1> [itcl::code $this StartDrag %x %y] 63 $c bind $_tick <B1-Motion> [itcl::code $this ContinueDrag %x %y] 64 $c bind $_tick <ButtonRelease-1> [itcl::code $this StopDrag %x %y] 65 } 66 67 itcl::body Rappture::IsoMarker::destructor {} { 68 $_canvas delete $this 69 } 70 71 itcl::body Rappture::IsoMarker::transferfunc {} { 72 return $_tf 73 } 74 75 itcl::body Rappture::IsoMarker::activate { bool } { 76 if { $bool || $_activePress || $_activeMotion } { 77 $_canvas itemconfigure $_label -state normal 78 $_canvas itemconfigure $_tick -image $_activeIcon 79 $_canvas itemconfigure title -state hidden 80 } else { 81 $_canvas itemconfigure $_label -state hidden 82 $_canvas itemconfigure $_tick -image $_normalIcon 83 $_canvas itemconfigure title -state normal 33 constructor {c obj tf args} { 34 set _canvas $c 35 set _nvobj $obj 36 set _tf $tf 37 set w [winfo width $_canvas] 38 set h [winfo height $_canvas] 39 set _tick [$c create image 0 $h \ 40 -image $_normalIcon -anchor s \ 41 -tags "$this $obj" -state hidden] 42 set _label [$c create text 0 $h \ 43 -anchor n -fill white -font "Helvetica 8" \ 44 -tags "$this $obj" -state hidden] 45 $c bind $_tick <Enter> [itcl::code $this HandleEvent "enter"] 46 $c bind $_tick <Leave> [itcl::code $this HandleEvent "leave"] 47 $c bind $_tick <ButtonPress-1> \ 48 [itcl::code $this HandleEvent "start" %x %y] 49 $c bind $_tick <B1-Motion> \ 50 [itcl::code $this HandleEvent "update" %x %y] 51 $c bind $_tick <ButtonRelease-1> \ 52 [itcl::code $this HandleEvent "end" %x %y] 53 } 54 destructor { 55 $_canvas delete $this 56 } 57 public method transferfunc {} { 58 return $_tf 59 } 60 public method activate { bool } { 61 if { $bool || $_activePress || $_activeMotion } { 62 $_canvas itemconfigure $_label -state normal 63 $_canvas itemconfigure $_tick -image $_activeIcon 64 } else { 65 $_canvas itemconfigure $_label -state hidden 66 $_canvas itemconfigure $_tick -image $_normalIcon 67 } 68 } 69 public method visible { bool } { 70 if { $bool } { 71 absval $_value 72 $_canvas itemconfigure $_tick -state normal 73 $_canvas raise $_tick 74 } else { 75 $_canvas itemconfigure $_tick -state hidden 76 } 77 } 78 public method screenpos { } { 79 set x [relval] 80 if { $x < 0.0 } { 81 set x 0.0 82 } elseif { $x > 1.0 } { 83 set x 1.0 84 } 85 set low 10 86 set w [winfo width $_canvas] 87 set high [expr {$w - 10}] 88 set x [expr {round($x*($high - $low) + $low)}] 89 return $x 90 } 91 public method absval { {x "-get"} } { 92 if { $x != "-get" } { 93 set _value $x 94 set y 31 95 $_canvas itemconfigure $_label -text [format %.2g $_value] 96 set x [screenpos] 97 $_canvas coords $_tick $x [expr {$y+3}] 98 $_canvas coords $_label $x [expr {$y+5}] 99 } 100 return $_value 101 } 102 public method relval { {x "-get"} } { 103 if { $x == "-get" } { 104 array set limits [$_nvobj limits $_tf] 105 if { $limits(vmax) == $limits(vmin) } { 106 if { $limits(vmax) == 0.0 } { 107 set limits(vmin) 0.0 108 set limits(vmax) 1.0 109 } else { 110 set limits(vmax) [expr $limits(vmin) + 1.0] 111 } 112 } 113 return [expr {($_value-$limits(vmin))/ 114 ($limits(vmax) - $limits(vmin))}] 115 } 116 array set limits [$_nvobj limits $_tf] 117 if { $limits(vmax) == $limits(vmin) } { 118 set limits(vmin) 0.0 119 set limits(vmax) 1.0 120 } 121 if { [catch {expr $limits(vmax) - $limits(vmin)} r] != 0 } { 122 return 0.0 123 } 124 absval [expr {($x * $r) + $limits(vmin)}] 125 } 126 private method HandleEvent { option args } { 127 switch -- $option { 128 enter { 129 set _activeMotion 1 130 activate yes 131 $_canvas raise $_tick 132 } 133 leave { 134 set _activeMotion 0 135 activate no 136 } 137 start { 138 $_canvas raise $_tick 139 set _activePress 1 140 activate yes 141 $_canvas itemconfigure limits -state hidden 142 } 143 update { 144 set w [winfo width $_canvas] 145 set x [lindex $args 0] 146 relval [expr {double($x-10)/($w-20)}] 147 $_nvobj overmarker $this $x 148 $_nvobj updatetransferfuncs 149 } 150 end { 151 set x [lindex $args 0] 152 if { ![$_nvobj rmdupmarker $this $x]} { 153 eval HandleEvent update $args 154 } 155 set _activePress 0 156 activate no 157 $_canvas itemconfigure limits -state normal 158 } 159 default { 160 error "bad option \"$option\": should be start, update, end" 161 } 162 } 84 163 } 85 164 } 86 87 itcl::body Rappture::IsoMarker::visible { bool } {88 if { $bool } {89 absval $_value90 $_canvas itemconfigure $_tick -state normal91 $_canvas raise $_tick92 } else {93 $_canvas itemconfigure $_tick -state hidden94 }95 }96 97 itcl::body Rappture::IsoMarker::screenpos { } {98 set x [relval]99 if { $x < 0.0 } {100 set x 0.0101 } elseif { $x > 1.0 } {102 set x 1.0103 }104 set low 10105 set w [winfo width $_canvas]106 set high [expr {$w - 10}]107 set x [expr {round($x*($high - $low) + $low)}]108 return $x109 }110 111 itcl::body Rappture::IsoMarker::absval { {x "-get"} } {112 if { $x != "-get" } {113 set _value $x114 set y 31115 $_canvas itemconfigure $_label -text [format %g $_value]116 set x [screenpos]117 $_canvas coords $_tick $x [expr {$y+3}]118 $_canvas coords $_label $x [expr {$y+5}]119 }120 return $_value121 }122 123 itcl::body Rappture::IsoMarker::relval { {x "-get"} } {124 foreach {min max} [$_nvobj limits $_tf] break125 if { $x == "-get" } {126 if { $max == $min } {127 if { $max == 0.0 } {128 set min 0.0129 set max 1.0130 } else {131 set max [expr $min + 1.0]132 }133 }134 return [expr {($_value - $min) / ($max - $min)}]135 }136 if { $max == $min } {137 set min 0.0138 set max 1.0139 }140 if { [catch {expr $max - $min} r] != 0 } {141 return 0.0142 }143 absval [expr {($x * $r) + $min}]144 }145 146 itcl::body Rappture::IsoMarker::EnterTick {} {147 set _activeMotion 1148 activate yes149 $_canvas raise $_tick150 }151 152 itcl::body Rappture::IsoMarker::LeaveTick {} {153 set _activeMotion 0154 activate no155 }156 157 itcl::body Rappture::IsoMarker::StartDrag { x y } {158 $_canvas raise $_tick159 set _activePress 1160 activate yes161 $_canvas itemconfigure limits -state hidden162 $_canvas itemconfigure title -state hidden163 }164 165 itcl::body Rappture::IsoMarker::StopDrag { x y } {166 if { ![$_nvobj removeDuplicateMarker $this $x]} {167 ContinueDrag $x $y168 }169 set _activePress 0170 activate no171 $_canvas itemconfigure limits -state normal172 $_canvas itemconfigure title -state normal173 }174 175 itcl::body Rappture::IsoMarker::ContinueDrag { x y } {176 set w [winfo width $_canvas]177 relval [expr {double($x-10)/($w-20)}]178 $_nvobj overMarker $this $x179 $_nvobj updateTransferFunctions180 $_canvas raise $_tick181 set _activePress 1182 activate yes183 $_canvas itemconfigure limits -state hidden184 $_canvas itemconfigure title -state hidden185 }186 -
branches/uq/gui/scripts/main.tcl
r5029 r5121 93 93 value -tool tool.xml 94 94 list -load "" 95 value -input "" 95 96 value -nosim 0 96 97 } … … 103 104 incr numTries -1 104 105 if { $numTries < 0 } { 105 106 return 106 107 } 107 108 global env 108 109 set paramsFile $env(TOOL_PARAMETERS) 109 110 if { ![file readable $paramsFile] } { 110 111 111 after 500 ReadToolParmeters $numTries 112 return 112 113 } 113 114 catch { … … 138 139 } 139 140 141 set inputobj {} 142 if {$params(-input) ne ""} { 143 if {![file exists $params(-input)]} { 144 puts stderr "can't find input file: \"$params(-input)\"" 145 exit 1 146 } 147 if {[catch {Rappture::library $params(-input)} result] == 0} { 148 set inputobj $result 149 } 150 } 151 140 152 # open the XML file containing the tool parameters 141 153 if {![file exists $params(-tool)]} { … … 147 159 # run.xml files they are loading. 148 160 set pseudotool "" 149 if { 0 == [llength $loadobjs]} {161 if {[llength $loadobjs] == 0 && $inputobj eq ""} { 150 162 puts stderr "can't find tool \"$params(-tool)\"" 151 163 exit 1 … … 155 167 # if there are loaders or notes, they will still need 156 168 # examples/ and docs/ dirs from the install location 157 foreach runobj $loadobjs { 169 set check [concat $loadobjs $inputobj] 170 foreach runobj $check { 158 171 set tdir \ 159 172 [string trim [$runobj get tool.version.application.directory(tool)]] … … 367 380 if { $arrangement != "side-by-side" && 368 381 ($type == "manual" || $type == "manual-resim" || 369 382 $type == "auto" || $style == "wizard") } { 370 383 # in "auto" mode, we don't need a simulate button 371 384 $f.analyze configure -simcontrol off … … 377 390 378 391 # load previous xml runfiles 379 if { 0 != [llength $params(-load)]} {392 if {[llength $params(-load)] > 0} { 380 393 foreach runobj $loadobjs { 381 # this doesn't seem to work with loaders382 # loaders seem to get their value after this point383 # may need to tell loader elements to update its value384 $tool load $runobj385 394 $f.analyze load $runobj 386 395 } 396 # load the inputs for the very last run 397 $tool load $runobj 398 387 399 # don't need simulate button if we cannot simulate 388 400 if {$params(-nosim)} { … … 391 403 $f.analyze configure -notebookpage analyze 392 404 $win.pager current analyzer 405 } elseif {$params(-input) ne ""} { 406 $tool load $inputobj 393 407 } 394 408 puts "DONE main.tcl" 409 # let components (loaders) settle after the newly loaded runs 410 update 411 412 foreach path [array names ::Rappture::parameters] { 413 set fname $::Rappture::parameters($path) 414 if {[catch { 415 set fid [open $fname r] 416 set info [read $fid] 417 close $fid}] == 0} { 418 419 set w [$tool widgetfor $path] 420 if {$w ne ""} { 421 if {[catch {$w value [string trim $info]} result]} { 422 puts stderr "WARNING: bad tool parameter value for \"$path\"" 423 puts stderr " $result" 424 } 425 } else { 426 puts stderr "WARNING: can't find control for tool parameter: $path" 427 } 428 } 429 } 430 395 431 wm deiconify .main -
branches/uq/gui/scripts/mesh.tcl
r4798 r5121 1 # -*- mode: tcl; indent-tabs-mode: nil -*- 1 # -*- mode: tcl; indent-tabs-mode: nil -*- 2 2 3 3 # ---------------------------------------------------------------------- … … 18 18 package require Itcl 19 19 20 namespace eval Rappture { 21 # forward declaration 20 namespace eval Rappture { 21 # forward declaration 22 22 } 23 23 24 24 itcl::class Rappture::Mesh { 25 private variable _xmlobj "" ; 26 private variable _mesh "" ; 27 private variable _dim 0;# Dimension of mesh (1, 2, or 3)28 private variable _type ""; 29 private variable _axis2units; 30 private variable _axis2labels; # 31 private variable _hints 32 private variable _limits ; # Array of mesh limits. Keys are33 34 private variable _numPoints 0 ; 35 private variable _numCells 0 ;# # of cells in mesh36 private variable _vtkdata ""; 25 private variable _xmlobj "" ; # Ref to XML obj with device data 26 private variable _mesh "" ; # Lib obj representing this mesh 27 private variable _dim 0; # Dimension of mesh (1, 2, or 3) 28 private variable _type ""; # Indicates the type of mesh. 29 private variable _axis2units; # System of units for x, y, z 30 private variable _axis2labels; # 31 private variable _hints 32 private variable _limits ; # Array of mesh limits. Keys are 33 # xmin, xmax, ymin, ymax, ... 34 private variable _numPoints 0 ; # # of points in mesh 35 private variable _numCells 0 ; # # of cells in mesh 36 private variable _vtkdata ""; # Mesh in vtk file format. 37 37 private variable _isValid 0; # Indicates if the mesh is valid. 38 constructor {xmlobj path} { 39 # defined below 40 } 41 destructor { 42 # defined below 38 constructor {xmlobj path} { 39 # defined below 40 } 41 destructor { 42 # defined below 43 43 } 44 44 public method points {} … … 58 58 public method vtkdata {{what -partial}} 59 59 public method type {} { 60 60 return $_type 61 61 } 62 62 public method numpoints {} { 63 63 return $_numPoints 64 64 } 65 65 public method numcells {} { 66 67 } 68 69 private common _xp2obj ; 70 private common _obj2ref ; 71 private variable _xv 72 private variable _yv 73 private variable _zv 74 private variable _xCoords "";# For the blt contour only75 private variable _yCoords "";# For the blt contour only76 66 return $_numCells 67 } 68 69 private common _xp2obj ; # used for fetch/release ref counting 70 private common _obj2ref ; # used for fetch/release ref counting 71 private variable _xv "" 72 private variable _yv "" 73 private variable _zv "" 74 private variable _xCoords ""; # For the blt contour only 75 private variable _yCoords ""; # For the blt contour only 76 77 77 private method ReadNodesElements {path} 78 private method GetCellCount { xNum yNum zNum } 79 private method GetDimension { path } 80 private method GetDouble { path } 81 private method GetInt { path } 82 private method InitHints {} 78 private method GetDimension { path } 79 private method GetDouble { path } 80 private method GetInt { path } 81 private method InitHints {} 83 82 private method ReadGrid { path } 84 83 private method ReadUnstructuredGrid { path } … … 165 164 foreach u $units axis { x y z } { 166 165 if { $u != "" } { 167 set _axis2units($axis) $u 166 set _axis2units($axis) $u 168 167 } else { 169 set _axis2units($axis) $first 168 set _axis2units($axis) $first 170 169 } 171 170 } … … 180 179 # Meshes comes in a variety of flavors 181 180 # 182 # Dimensionality is determined from the <dimension> tag. 181 # Dimensionality is determined from the <dimension> tag. 183 182 # 184 183 # <vtk> described mesh 185 184 # <element> + <node> definitions 186 # <grid> rectangular mesh 185 # <grid> rectangular mesh 187 186 # <unstructured> homogeneous cell type mesh. 188 187 … … 190 189 set subcount 0 191 190 foreach cname [$_mesh children] { 192 193 194 195 196 } 197 191 foreach type { vtk grid unstructured } { 192 if { $cname == $type } { 193 incr subcount 194 break 195 } 196 } 198 197 } 199 198 if {[$_mesh element "node"] != "" || … … 207 206 } 208 207 if { $subcount > 1 } { 209 208 puts stderr "WARNING: too many mesh types specified for \"$path\"." 210 209 return 211 210 } 212 211 set result 0 213 212 if { [$_mesh element "vtk"] != ""} { 214 213 set result [ReadVtk $path] 215 214 } elseif {[$_mesh element "grid"] != "" } { 216 215 set result [ReadGrid $path] 217 216 } elseif {[$_mesh element "unstructured"] != "" } { 218 217 set result [ReadUnstructuredGrid $path] 219 218 } elseif {[$_mesh element "node"] != "" && [$_mesh element "element"] != ""} { 220 219 set result [ReadNodesElements $path] … … 232 231 233 232 if { $_xCoords != "" } { 234 233 blt::vector destroy $_xCoords 235 234 } 236 235 if { $_yCoords != "" } { 237 238 } 239 } 240 241 # 242 # vtkdata -- 243 # 244 # 245 # 246 # 247 # 248 # 236 blt::vector destroy $_yCoords 237 } 238 } 239 240 # 241 # vtkdata -- 242 # 243 # This is called by the field object to generate a VTK file to send to 244 # the remote render server. Returns the vtkDataSet object containing 245 # (at this point) just the mesh. The field object doesn't know (or 246 # care) what type of mesh is used. The field object will add field 247 # arrays before generating output to send to the remote render server. 249 248 # 250 249 itcl::body Rappture::Mesh::vtkdata {{what -partial}} { 251 250 if {$what == "-full"} { 252 251 append out "# vtk DataFile Version 3.0\n" 253 254 252 append out "[hints label]\n" 253 append out "ASCII\n" 255 254 append out $_vtkdata 256 255 return $out … … 341 340 itcl::body Rappture::Mesh::mesh { {type "vtk"} } { 342 341 switch $type { 343 "vtk" { 344 345 346 default { 347 348 342 "vtk" { 343 return "" 344 } 345 default { 346 error "Requested mesh type \"$type\" is unknown." 347 } 349 348 } 350 349 } … … 427 426 } 428 427 } 428 foreach {key path} { 429 toolid tool.id 430 toolname tool.name 431 toolcommand tool.execute 432 tooltitle tool.title 433 toolrevision tool.version.application.revision 434 } { 435 set str [$_xmlobj get $path] 436 if { "" != $str } { 437 set _hints($key) $str 438 } 439 } 429 440 } 430 441 … … 432 443 set string [$_xmlobj get $path.dim] 433 444 if { $string == "" } { 434 445 puts stderr "WARNING: no tag <dim> found in mesh \"$path\"." 435 446 return 0 436 447 } … … 468 479 return 0 469 480 } 470 # Create a VTK file with the mesh in it. 481 # Create a VTK file with the mesh in it. 471 482 set _vtkdata [$_xmlobj get $path.vtk] 472 483 append out "# vtk DataFile Version 3.0\n" … … 500 511 } 501 512 502 itcl::body Rappture::Mesh::GetCellCount { xNum yNum zNum } {503 set numCells 1504 if { $xNum > 0 } {505 set numCells [expr $numCells * $xNum]506 }507 if { $yNum > 0 } {508 set numCells [expr $numCells * $yNum]509 }510 if { $zNum > 0 } {511 set numCells [expr $numCells * $zNum]512 }513 return $numCells514 }515 516 513 itcl::body Rappture::Mesh::ReadGrid { path } { 517 514 set _type "grid" … … 524 521 set numCurvilinear 0 525 522 foreach axis { x y z } { 526 527 528 529 530 531 532 533 534 523 set min [$_xmlobj get "$path.grid.${axis}axis.min"] 524 set max [$_xmlobj get "$path.grid.${axis}axis.max"] 525 set num [$_xmlobj get "$path.grid.${axis}axis.numpoints"] 526 set coords [$_xmlobj get "$path.grid.${axis}coords"] 527 set dim [$_xmlobj get "$path.grid.${axis}dim"] 528 if { $min != "" && $max != "" && $num != "" && $num > 0 } { 529 set ${axis}Min $min 530 set ${axis}Max $max 531 set ${axis}Num $num 535 532 if {$min > $max} { 536 puts stderr "ERROR: grid $axis min can't be greater than max"533 puts stderr "ERROR: grid $axis axis minimum larger than maximum" 537 534 return 0 538 535 } 539 540 541 542 543 536 incr numUniform 537 } elseif { $coords != "" } { 538 incr numRectilinear 539 set ${axis}Coords $coords 540 } elseif { $dim != "" } { 544 541 set ${axis}Num $dim 545 542 incr numCurvilinear … … 548 545 set _dim [expr $numRectilinear + $numUniform + $numCurvilinear] 549 546 if { $_dim == 0 } { 550 547 # No data found. 551 548 puts stderr "WARNING: bad grid \"$path\": no data found" 552 549 return 0 553 550 } 554 551 if { $numCurvilinear > 0 } { … … 563 560 return 0 564 561 } 565 562 if { ![info exists xNum] } { 566 563 puts stderr "WARNING: bad grid \"$path\": invalid dimensions for curvilinear grid: missing <xdim> from grid description." 567 564 return 0 … … 575 572 if { [info exists zNum] } { 576 573 set _dim 3 577 578 set _numCells [ GetCellCount $xNum $yNum $zNum]579 if { ($_numPoints *3) != $numCoords } {574 set _numPoints [expr $xNum * $yNum * $zNum] 575 set _numCells [expr ($xNum > 1 ? ($xNum - 1) : 1) * ($yNum > 1 ? ($yNum - 1) : 1) * ($zNum > 1 ? ($zNum - 1) : 1)] 576 if { ($_numPoints*3) != $numCoords } { 580 577 puts stderr "WARNING: bad grid \"$path\": invalid grid: \# of points does not match dimensions <xdim> * <ydim> * <zdim>" 581 578 return 0 … … 586 583 } 587 584 $all split $xv $yv $zv 588 585 foreach axis {x y z} { 589 586 set vector [set ${axis}v] 590 587 set _limits($axis) [$vector limits] 591 592 593 594 588 } 589 append out "DATASET STRUCTURED_GRID\n" 590 append out "DIMENSIONS $xNum $yNum $zNum\n" 591 append out "POINTS $_numPoints double\n" 595 592 append out [$all range 0 end] 596 593 append out "\n" 597 594 set _vtkdata $out 598 595 } elseif { [info exists yNum] } { 599 596 set _dim 2 600 601 set _numCells [ GetCellCount $xNum $yNum 0]602 if { ($_numPoints *2) != $numCoords } {597 set _numPoints [expr $xNum * $yNum] 598 set _numCells [expr ($xNum > 1 ? ($xNum - 1) : 1) * ($yNum > 1 ? ($yNum - 1) : 1)] 599 if { ($_numPoints*2) != $numCoords } { 603 600 puts stderr "WARNING: bad grid \"$path\": \# of points does not match dimensions <xdim> * <ydim>" 604 601 return 0 … … 608 605 return 0 609 606 } 610 607 foreach axis {x y} { 611 608 set vector [set ${axis}v] 612 609 set _limits($axis) [$vector limits] 613 610 } 614 611 set _limits(z) [list 0 0] 615 612 $zv seq 0 0 [$xv length] 616 613 $all merge $xv $yv $zv 617 618 619 614 append out "DATASET STRUCTURED_GRID\n" 615 append out "DIMENSIONS $xNum $yNum 1\n" 616 append out "POINTS $_numPoints double\n" 620 617 append out [$all range 0 end] 621 618 append out "\n" 622 619 set _vtkdata $out 623 620 } else { 624 621 set _dim 1 625 622 set _numPoints $xNum 626 set _numCells [ GetCellCount $xNum 0 0]623 set _numCells [expr $xNum - 1] 627 624 if { $_numPoints != $numCoords } { 628 625 puts stderr "WARNING: bad grid \"$path\": \# of points does not match <xdim>" … … 635 632 $zv seq 0 0 [$xv length] 636 633 $all merge $xv $yv $zv 637 638 639 634 append out "DATASET STRUCTURED_GRID\n" 635 append out "DIMENSIONS $xNum 1 1\n" 636 append out "POINTS $_numPoints double\n" 640 637 append out [$all range 0 end] 641 638 append out "\n" 642 643 639 set _vtkdata $out 640 } 644 641 blt::vector destroy $all $xv $yv $zv 645 642 return 1 646 643 } 647 644 if { $numRectilinear == 0 && $numUniform > 0} { 648 # This is the special case where all axes 2D/3D are uniform. 645 # This is the special case where all axes 2D/3D are uniform. 649 646 # This results in a STRUCTURED_POINTS 650 647 if { $_dim == 1 } { 651 set xSpacing 0 652 if { $xNum > 1 } { 653 set xSpacing [expr ($xMax - $xMin) / double($xNum - 1)] 654 } 655 set _numPoints $xNum 656 set _numCells [GetCellCount $xNum 0 0] 657 append out "DATASET STRUCTURED_POINTS\n" 658 append out "DIMENSIONS $xNum 1 1\n" 659 append out "ORIGIN $xMin 0 0\n" 660 append out "SPACING $xSpacing 0 0\n" 661 set _vtkdata $out 648 if {$xNum == 1} { 649 set xSpace 0 650 } else { 651 set xSpace [expr ($xMax - $xMin) / double($xNum - 1)] 652 } 653 set _numPoints $xNum 654 set _numCells [expr $xNum - 1] 655 append out "DATASET STRUCTURED_POINTS\n" 656 append out "DIMENSIONS $xNum 1 1\n" 657 append out "ORIGIN $xMin 0 0\n" 658 append out "SPACING $xSpace 0 0\n" 659 set _vtkdata $out 662 660 set _limits(x) [list $xMin $xMax] 663 661 set _limits(y) [list 0 0] 664 662 set _limits(z) [list 0 0] 665 } elseif { $_dim == 2 } { 666 set xSpacing 0 667 set ySpacing 0 668 if { $xNum > 1 } { 669 set xSpacing [expr ($xMax - $xMin) / double($xNum - 1)] 670 } 671 if { $yNum > 1 } { 672 set ySpacing [expr ($yMax - $yMin) / double($yNum - 1)] 673 } 674 set _numPoints [expr $xNum * $yNum] 675 set _numCells [GetCellCount $xNum $yNum 0] 676 append out "DATASET STRUCTURED_POINTS\n" 677 append out "DIMENSIONS $xNum $yNum 1\n" 678 append out "ORIGIN $xMin $yMin 0\n" 679 append out "SPACING $xSpacing $ySpacing 0\n" 680 set _vtkdata $out 681 foreach axis {x y} { 682 set _limits($axis) [list [set ${axis}Min] [set ${axis}Max]] 683 } 663 } elseif { $_dim == 2 } { 664 if {$xNum == 1} { 665 set xSpace 0 666 } else { 667 set xSpace [expr ($xMax - $xMin) / double($xNum - 1)] 668 } 669 if {$yNum == 1} { 670 set ySpace 0 671 } else { 672 set ySpace [expr ($yMax - $yMin) / double($yNum - 1)] 673 } 674 set _numPoints [expr $xNum * $yNum] 675 set _numCells [expr ($xNum > 1 ? ($xNum - 1) : 1) * ($yNum > 1 ? ($yNum - 1) : 1)] 676 append out "DATASET STRUCTURED_POINTS\n" 677 append out "DIMENSIONS $xNum $yNum 1\n" 678 append out "ORIGIN $xMin $yMin 0\n" 679 append out "SPACING $xSpace $ySpace 0\n" 680 set _vtkdata $out 681 foreach axis {x y} { 682 set _limits($axis) [list [set ${axis}Min] [set ${axis}Max]] 683 } 684 684 set _limits(z) [list 0 0] 685 } elseif { $_dim == 3 } { 686 set xSpacing 0 687 set ySpacing 0 688 set zSpacing 0 689 if {$xNum > 1} { 690 set xSpacing [expr ($xMax - $xMin) / double($xNum - 1)] 691 } 692 if {$yNum > 1} { 693 set ySpacing [expr ($yMax - $yMin) / double($yNum - 1)] 694 } 695 if {$zNum > 1} { 696 set zSpacing [expr ($zMax - $zMin) / double($zNum - 1)] 697 } 698 set _numPoints [expr $xNum * $yNum * $zNum] 699 set _numCells [GetCellCount $xNum $yNum $zNum] 700 append out "DATASET STRUCTURED_POINTS\n" 701 append out "DIMENSIONS $xNum $yNum $zNum\n" 702 append out "ORIGIN $xMin $yMin $zMin\n" 703 append out "SPACING $xSpacing $ySpacing $zSpacing\n" 704 set _vtkdata $out 705 foreach axis {x y z} { 706 set _limits($axis) [list [set ${axis}Min] [set ${axis}Max]] 707 } 708 } else { 709 puts stderr "WARNING: bad grid \"$path\": bad dimension \"$_dim\"" 685 } elseif { $_dim == 3 } { 686 if {$xNum == 1} { 687 set xSpace 0 688 } else { 689 set xSpace [expr ($xMax - $xMin) / double($xNum - 1)] 690 } 691 if {$yNum == 1} { 692 set ySpace 0 693 } else { 694 set ySpace [expr ($yMax - $yMin) / double($yNum - 1)] 695 } 696 if {$zNum == 1} { 697 set zSpace 0 698 } else { 699 set zSpace [expr ($zMax - $zMin) / double($zNum - 1)] 700 } 701 set _numPoints [expr $xNum * $yNum * $zNum] 702 set _numCells [expr ($xNum > 1 ? ($xNum - 1) : 1) * ($yNum > 1 ? ($yNum - 1) : 1) * ($zNum > 1 ? ($zNum - 1) : 1)] 703 append out "DATASET STRUCTURED_POINTS\n" 704 append out "DIMENSIONS $xNum $yNum $zNum\n" 705 append out "ORIGIN $xMin $yMin $zMin\n" 706 append out "SPACING $xSpace $ySpace $zSpace\n" 707 set _vtkdata $out 708 foreach axis {x y z} { 709 set _limits($axis) [list [set ${axis}Min] [set ${axis}Max]] 710 } 711 } else { 712 puts stderr "WARNING: bad grid \"$path\": bad dimension \"$_dim\"" 710 713 return 0 711 712 714 } 715 return 1 713 716 } 714 717 # This is the hybrid case. Some axes are uniform, others are nonuniform. 715 718 set xv [blt::vector create \#auto] 716 719 if { [info exists xMin] } { 717 718 } else { 719 720 721 722 720 $xv seq $xMin $xMax $xNum 721 } else { 722 $xv set [$_xmlobj get $path.grid.xcoords] 723 set xMin [$xv min] 724 set xMax [$xv max] 725 set xNum [$xv length] 723 726 } 724 727 set yv [blt::vector create \#auto] … … 737 740 set zv [blt::vector create \#auto] 738 741 if { $_dim == 3 } { 739 740 741 742 743 744 745 746 747 } else { 748 742 if { [info exists zMin] } { 743 $zv seq $zMin $zMax $zNum 744 } else { 745 $zv set [$_xmlobj get $path.grid.zcoords] 746 set zMin [$zv min] 747 set zMax [$zv max] 748 set zNum [$zv length] 749 } 750 } else { 751 set zNum 1 749 752 } 750 753 if { $_dim == 3 } { 751 752 set _numCells [ GetCellCount $xNum $yNum $zNum]753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 754 set _numPoints [expr $xNum * $yNum * $zNum] 755 set _numCells [expr ($xNum > 1 ? ($xNum - 1) : 1) * ($yNum > 1 ? ($yNum - 1) : 1) * ($zNum > 1 ? ($zNum - 1) : 1)] 756 append out "DATASET RECTILINEAR_GRID\n" 757 append out "DIMENSIONS $xNum $yNum $zNum\n" 758 append out "X_COORDINATES $xNum double\n" 759 append out [$xv range 0 end] 760 append out "\n" 761 append out "Y_COORDINATES $yNum double\n" 762 append out [$yv range 0 end] 763 append out "\n" 764 append out "Z_COORDINATES $zNum double\n" 765 append out [$zv range 0 end] 766 append out "\n" 767 set _vtkdata $out 768 foreach axis {x y z} { 769 if { [info exists ${axis}Min] } { 770 set _limits($axis) [list [set ${axis}Min] [set ${axis}Max]] 771 } 772 } 770 773 } elseif { $_dim == 2 } { 771 772 set _numCells [ GetCellCount $xNum $yNum 0]773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 774 set _numPoints [expr $xNum * $yNum] 775 set _numCells [expr ($xNum > 1 ? ($xNum - 1) : 1) * ($yNum > 1 ? ($yNum - 1) : 1)] 776 append out "DATASET RECTILINEAR_GRID\n" 777 append out "DIMENSIONS $xNum $yNum 1\n" 778 append out "X_COORDINATES $xNum double\n" 779 append out [$xv range 0 end] 780 append out "\n" 781 append out "Y_COORDINATES $yNum double\n" 782 append out [$yv range 0 end] 783 append out "\n" 784 append out "Z_COORDINATES 1 double\n" 785 append out "0\n" 786 foreach axis {x y} { 787 if { [info exists ${axis}Min] } { 788 set _limits($axis) [list [set ${axis}Min] [set ${axis}Max]] 789 } 790 } 788 791 set _limits(z) [list 0 0] 789 792 set _vtkdata $out 790 793 } elseif { $_dim == 1 } { 791 794 set _numPoints $xNum 792 set _numCells [ GetCellCount $xNum 0 0]793 794 795 796 797 798 799 800 801 795 set _numCells [expr $xNum - 1] 796 append out "DATASET RECTILINEAR_GRID\n" 797 append out "DIMENSIONS $xNum 1 1\n" 798 append out "X_COORDINATES $xNum double\n" 799 append out [$xv range 0 end] 800 append out "\n" 801 append out "Y_COORDINATES 1 double\n" 802 append out "0\n" 803 append out "Z_COORDINATES 1 double\n" 804 append out "0\n" 802 805 if { [info exists xMin] } { 803 806 set _limits(x) [list $xMin $xMax] … … 805 808 set _limits(y) [list 0 0] 806 809 set _limits(z) [list 0 0] 807 808 } else { 809 810 set _vtkdata $out 811 } else { 812 puts stderr "WARNING: bad grid \"$path\": invalid dimension \"$_dim\"" 810 813 return 0 811 814 } 812 blt::vector destroy $xv $yv $zv 815 blt::vector destroy $xv $yv $zv 813 816 return 1 814 817 } … … 844 847 set celltypes {} 845 848 foreach { a b c } $triangles { 846 847 848 849 append data " 3 $a $b $c\n" 850 append celltypes "5\n" 851 incr _numCells 849 852 } 850 853 append out "DATASET UNSTRUCTURED_GRID\n" 851 854 append out "POINTS $_numPoints double\n" 852 855 foreach x [$xv range 0 end] y [$yv range 0 end] z [$zv range 0 end] { 853 856 append out " $x $y $z\n" 854 857 } 855 858 set count [expr $_numCells * 4] … … 876 879 set celltypes {} 877 880 foreach { a b c d } $quads { 878 879 880 881 append data " 4 $a $b $c $d\n" 882 append celltypes "9\n" 883 incr _numCells 881 884 } 882 885 append out "DATASET UNSTRUCTURED_GRID\n" 883 886 append out "POINTS $_numPoints double\n" 884 887 foreach x [$xv range 0 end] y [$yv range 0 end] z [$zv range 0 end] { 885 888 append out " $x $y $z\n" 886 889 } 887 890 set count [expr $_numCells * 5] … … 913 916 continue 914 917 } 915 916 918 append data " $numIndices $line\n" 919 incr _numCells 917 920 set count [expr $count + $numIndices + 1] 918 921 } … … 920 923 append out "POINTS $_numPoints double\n" 921 924 foreach x [$xv range 0 end] y [$yv range 0 end] z [$zv range 0 end] { 922 925 append out " $x $y $z\n" 923 926 } 924 927 append out "VERTICES $_numCells $count\n" … … 947 950 continue 948 951 } 949 950 952 append data " $numIndices $line\n" 953 incr _numCells 951 954 set count [expr $count + $numIndices + 1] 952 955 } … … 954 957 append out "POINTS $_numPoints double\n" 955 958 foreach x [$xv range 0 end] y [$yv range 0 end] z [$zv range 0 end] { 956 959 append out " $x $y $z\n" 957 960 } 958 961 append out "LINES $_numCells $count\n" … … 981 984 continue 982 985 } 983 984 986 append data " $numIndices $line\n" 987 incr _numCells 985 988 set count [expr $count + $numIndices + 1] 986 989 } … … 988 991 append out "POINTS $_numPoints double\n" 989 992 foreach x [$xv range 0 end] y [$yv range 0 end] z [$zv range 0 end] { 990 993 append out " $x $y $z\n" 991 994 } 992 995 append out "POLYGONS $_numCells $count\n" … … 1015 1018 continue 1016 1019 } 1017 1018 1020 append data " $numIndices $line\n" 1021 incr _numCells 1019 1022 set count [expr $count + $numIndices + 1] 1020 1023 } … … 1022 1025 append out "POINTS $_numPoints double\n" 1023 1026 foreach x [$xv range 0 end] y [$yv range 0 end] z [$zv range 0 end] { 1024 1027 append out " $x $y $z\n" 1025 1028 } 1026 1029 append out "TRIANGLE_STRIPS $_numCells $count\n" … … 1044 1047 set celltypes {} 1045 1048 foreach { a b c d } $tetras { 1046 1047 1048 1049 append data " 4 $a $b $c $d\n" 1050 append celltypes "10\n" 1051 incr _numCells 1049 1052 } 1050 1053 append out "DATASET UNSTRUCTURED_GRID\n" 1051 1054 append out "POINTS $_numPoints double\n" 1052 1055 foreach x [$xv range 0 end] y [$yv range 0 end] z [$zv range 0 end] { 1053 1056 append out " $x $y $z\n" 1054 1057 } 1055 1058 set count [expr $_numCells * 5] … … 1073 1076 set celltypes {} 1074 1077 foreach { a b c d e f g h } $hexas { 1075 1076 1077 1078 append data " 8 $a $b $c $d $e $f $g $h\n" 1079 append celltypes "12\n" 1080 incr _numCells 1078 1081 } 1079 1082 append out "DATASET UNSTRUCTURED_GRID\n" 1080 1083 append out "POINTS $_numPoints double\n" 1081 1084 foreach x [$xv range 0 end] y [$yv range 0 end] z [$zv range 0 end] { 1082 1085 append out " $x $y $z\n" 1083 1086 } 1084 1087 set count [expr $_numCells * 9] … … 1102 1105 set celltypes {} 1103 1106 foreach { a b c d e f } $wedges { 1104 1105 1106 1107 append data " 6 $a $b $c $d $e $f\n" 1108 append celltypes "13\n" 1109 incr _numCells 1107 1110 } 1108 1111 append out "DATASET UNSTRUCTURED_GRID\n" 1109 1112 append out "POINTS $_numPoints double\n" 1110 1113 foreach x [$xv range 0 end] y [$yv range 0 end] z [$zv range 0 end] { 1111 1114 append out " $x $y $z\n" 1112 1115 } 1113 1116 set count [expr $_numCells * 7] … … 1131 1134 set celltypes {} 1132 1135 foreach { a b c d e } $pyramids { 1133 1134 1135 1136 append data " 5 $a $b $c $d $e\n" 1137 append celltypes "14\n" 1138 incr _numCells 1136 1139 } 1137 1140 append out "DATASET UNSTRUCTURED_GRID\n" 1138 1141 append out "POINTS $_numPoints double\n" 1139 1142 foreach x [$xv range 0 end] y [$yv range 0 end] z [$zv range 0 end] { 1140 1143 append out " $x $y $z\n" 1141 1144 } 1142 1145 set count [expr $_numCells * 6] … … 1150 1153 1151 1154 set _vtkdata $out 1152 return 1 1155 return 1 1153 1156 } 1154 1157 … … 1217 1220 # Step 1: Verify that there's only one cell tag of any kind. 1218 1221 set numCells 0 1219 foreach type { 1222 foreach type { 1220 1223 cells 1221 hexahedrons 1222 lines 1223 polygons 1224 pyramids 1224 hexahedrons 1225 lines 1226 polygons 1227 pyramids 1225 1228 quads 1226 tetrahedrons 1227 triangles 1229 tetrahedrons 1230 triangles 1228 1231 trianglestrips 1229 vertices 1230 wedges 1232 vertices 1233 wedges 1231 1234 } { 1232 1235 set data [$_xmlobj get $path.unstructured.$type] … … 1238 1241 set celltypes [$_xmlobj get $path.unstructured.celltypes] 1239 1242 if { $numCells == 0 && $celltypes != "" } { 1240 1243 puts stderr "WARNING: bad unstuctured grid \"$path\": no <cells> description found." 1241 1244 return 0 1242 1245 } … … 1245 1248 return 0 1246 1249 } 1247 foreach type { cells 1248 vertices lines polygons trianglestrips 1249 triangles quads 1250 tetrahedrons hexahedrons wedges pyramids } { 1250 foreach type { 1251 cells 1252 hexahedrons 1253 lines 1254 polygons 1255 pyramids 1256 quads 1257 tetrahedrons 1258 triangles 1259 trianglestrips 1260 vertices 1261 wedges 1262 } { 1251 1263 set data [$_xmlobj get $path.unstructured.$type] 1252 1264 if { $data != "" } { … … 1254 1266 } 1255 1267 } 1256 # Step 2: Allow points to be specified as <points> or 1268 # Step 2: Allow points to be specified as <points> or 1257 1269 # <xcoords>, <ycoords>, <zcoords>. Split and convert into 1258 1270 # 3 vectors, one for each coordinate. … … 1402 1414 set data {} 1403 1415 foreach cname [$_xmlobj children -type node $path] { 1404 1405 } 1416 append data "[$_xmlobj get $path.$cname]\n" 1417 } 1406 1418 Rappture::ReadPoints $data _dim points 1407 1419 if { $_dim == 2 } { 1408 1409 1410 1411 1412 1413 1414 1420 set all [blt::vector create \#auto] 1421 set xv [blt::vector create \#auto] 1422 set yv [blt::vector create \#auto] 1423 set zv [blt::vector create \#auto] 1424 $all set $points 1425 $all split $xv $yv 1426 set _numPoints [$xv length] 1415 1427 set _limits(x) [$xv limits] 1416 1428 set _limits(y) [$yv limits] 1417 1429 set _limits(z) [list 0 0] 1418 1419 1420 1421 1422 1430 # 2D Dataset. All Z coordinates are 0 1431 $zv seq 0.0 0.0 $_numPoints 1432 $all merge $xv $yv $zv 1433 set points [$all range 0 end] 1434 blt::vector destroy $all $xv $yv $zv 1423 1435 } elseif { $_dim == 3 } { 1424 1425 1426 1427 1428 1429 1430 1436 set all [blt::vector create \#auto] 1437 set xv [blt::vector create \#auto] 1438 set yv [blt::vector create \#auto] 1439 set zv [blt::vector create \#auto] 1440 $all set $points 1441 $all split $xv $yv $zv 1442 set _numPoints [$xv length] 1431 1443 set _limits(x) [$xv limits] 1432 1444 set _limits(y) [$yv limits] 1433 1445 set _limits(z) [$zv limits] 1434 1435 1436 } else { 1437 1446 set points [$all range 0 end] 1447 blt::vector destroy $all $xv $yv $zv 1448 } else { 1449 error "bad dimension \"$_dim\" for nodes mesh" 1438 1450 } 1439 1451 array set node2celltype { 1440 1441 1442 1443 1444 1452 3 5 1453 4 10 1454 8 12 1455 6 13 1456 5 14 1445 1457 } 1446 1458 set count 0 … … 1451 1463 foreach cname [$_xmlobj children -type element $path] { 1452 1464 set nodeList [$_mesh get $cname.nodes] 1453 1454 1455 1456 1457 1458 1459 1465 set numNodes [llength $nodeList] 1466 if { ![info exists node2celltype($numNodes)] } { 1467 puts stderr "WARNING: bad nodes/elements mesh \$path\": unknown number of indices \"$_numNodes\": should be 3, 4, 5, 6, or 8" 1468 return 0 1469 } 1470 set celltype $node2celltype($numNodes) 1471 append celltypes " $celltype\n" 1460 1472 if { $celltype == 12 } { 1461 1473 # Formerly used voxels instead of hexahedrons. We're converting … … 1467 1479 } 1468 1480 set nodeList $newList 1469 } 1470 1471 1472 incr count $numNodes 1473 incr count;# One extra for the VTK celltype id.1481 } 1482 append data " $numNodes $nodeList\n" 1483 incr _numCells 1484 incr count $numNodes 1485 incr count; # One extra for the VTK celltype id. 1474 1486 } 1475 1487 … … 1484 1496 append out "\n" 1485 1497 set _vtkdata $out 1486 set _isValid 1 1498 set _isValid 1 1487 1499 } 1488 1500 -
branches/uq/gui/scripts/moleculeViewer.tcl
r3844 r5121 1 # -*- mode: tcl; indent-tabs-mode: nil -*- 1 # -*- mode: tcl; indent-tabs-mode: nil -*- 2 2 # ---------------------------------------------------------------------- 3 3 # COMPONENT: MoleculeViewer - view a molecule in 3D … … 27 27 itk_option define -device device Device "" 28 28 29 constructor {tool args} { 30 # defined below 31 } 32 destructor { 33 # defined below 29 constructor {tool args} { 30 # defined below 31 } 32 destructor { 33 # defined below 34 34 } 35 35 … … 38 38 public method delete {args} 39 39 public method snap {w h} 40 public method parameters {title args} { 41 # do nothing 40 public method parameters {title args} { 41 # do nothing 42 42 } 43 43 public method emblems {option} … … 63 63 private variable _download "";# snapshot for download 64 64 } 65 65 66 66 itk::usual MoleculeViewer { 67 67 } … … 236 236 } 237 237 array set params $settings 238 238 239 239 set pos [lsearch -exact $_dlist $dataobj] 240 240 … … 243 243 error "bad value \"$dataobj\": should be Rappture::library object" 244 244 } 245 245 246 246 set emblem [$dataobj get components.molecule.about.emblems] 247 247 if {$emblem == "" || ![string is boolean $emblem] || !$emblem} { -
branches/uq/gui/scripts/molvisviewer.tcl
r4797 r5121 1 # -*- mode: tcl; indent-tabs-mode: nil -*- 1 # -*- mode: tcl; indent-tabs-mode: nil -*- 2 2 3 3 # ---------------------------------------------------------------------- … … 52 52 53 53 private variable _active; # array of active models. 54 private variable _obj2models; # array containing list of models 54 private variable _obj2models; # array containing list of models 55 55 # for each data object. 56 56 private variable _view … … 63 63 private variable _imagecache 64 64 private variable _state 65 private variable _labels 65 private variable _labels "default" 66 66 private variable _cacheid "" 67 67 private variable _cacheimage "" 68 private variable _first 69 70 private common _settings ; # Array of settings for all known 68 private variable _first "" 69 70 private common _settings ; # Array of settings for all known 71 71 # widgets 72 72 private variable _initialized … … 81 81 private variable _width 82 82 private variable _height 83 private variable _reset 1; 83 private variable _reset 1; # Restore camera settings 84 84 private variable _cell 0; # Restore camera settings 85 85 … … 96 96 } 97 97 private method BuildSettingsTab {} 98 private method DoResize {} 99 private method DoRotate {} 100 private method DoUpdate {} 101 private method EventuallyResize { w h } 102 private method EventuallyRotate { a b c } 103 private method EventuallyChangeSettings { args } 98 private method DoResize {} 99 private method DoRotate {} 100 private method DoUpdate {} 101 private method EventuallyResize { w h } 102 private method EventuallyRotate { a b c } 103 private method EventuallyChangeSettings { args } 104 104 private method GetImage { widget } 105 105 private method ReceiveImage { size cacheid frame rock } … … 107 107 private method AddImageControls { frame widget } 108 108 private method SetWaitVariable { value } { 109 set _getimage $value 109 set _getimage $value 110 110 } 111 111 private method WaitForResponse {} { … … 125 125 public method Connect {} 126 126 public method Disconnect {} 127 public method ResetView {} 127 public method ResetView {} 128 128 public method add {dataobj {options ""}} 129 129 public method delete {args} … … 132 132 public method isconnected {} 133 133 public method labels {option {model "all"}} 134 public method parameters {title args} { 135 # do nothing 134 public method parameters {title args} { 135 # do nothing 136 136 } 137 137 … … 236 236 $this-showlabels-initialized no 237 237 }] 238 238 239 239 itk_component add 3dview { 240 240 label $itk_component(plotarea).view -image $_image(plot) \ … … 294 294 Rappture::Tooltip::for $itk_component(labels) \ 295 295 "Show/hide the labels on atoms" 296 pack $itk_component(labels) -padx 2 -pady {6 2} 296 pack $itk_component(labels) -padx 2 -pady {6 2} 297 297 298 298 itk_component add rock { … … 303 303 -variable [itcl::scope _settings($this-rock)] 304 304 } 305 pack $itk_component(rock) -padx 2 -pady 2 305 pack $itk_component(rock) -padx 2 -pady 2 306 306 Rappture::Tooltip::for $itk_component(rock) "Rock model back and forth" 307 307 … … 319 319 BuildSettingsTab 320 320 321 # HACK ALERT. Initially force a requested width of the 3dview label. 321 # HACK ALERT. Initially force a requested width of the 3dview label. 322 322 323 323 # It's a chicken-and-the-egg problem. The size of the 3dview label is set … … 463 463 if { $showlabels != "" && [string is boolean $showlabels] } { 464 464 set _settings($this-showlabels) $showlabels 465 } 465 } 466 466 } 467 467 … … 567 567 -variable [itcl::scope _downloadPopup(format)] \ 568 568 -font "Arial 10 " \ 569 -value pdb 569 -value pdb 570 570 Rappture::Tooltip::for $inner.pdb \ 571 571 "Save as PDB Protein Data Bank format file." … … 573 573 -variable [itcl::scope _downloadPopup(format)] \ 574 574 -font "Arial 10 " \ 575 -value image 575 -value image 576 576 Rappture::Tooltip::for $inner.image \ 577 577 "Save as image." … … 589 589 blt::table $f \ 590 590 0,0 $f.ok \ 591 0,1 $f.cancel 591 0,1 $f.cancel 592 592 blt::table $inner \ 593 593 0,0 $inner.summary -anchor w \ … … 628 628 } else { 629 629 set inner [$popup component inner] 630 } 630 } 631 631 update 632 632 # Activate the popup and call for the output. … … 635 635 $popup activate $widget left 636 636 set bool [WaitForResponse] 637 $popup deactivate 637 $popup deactivate 638 638 if { $bool } { 639 639 return [GetImage $widget] … … 674 674 return 0 675 675 } 676 set _reset 1 676 set _reset 1 677 677 set result [VisViewer::Connect $hosts] 678 678 if { $result } { … … 684 684 set info {} 685 685 set user "???" 686 686 if { [info exists env(USER)] } { 687 687 set user $env(USER) 688 688 } 689 689 set session "???" 690 690 if { [info exists env(SESSION)] } { 691 691 set session $env(SESSION) 692 692 } 693 693 lappend info "version" "$Rappture::version" 694 694 lappend info "build" "$Rappture::build" … … 760 760 incr count 761 761 if { $cacheid != $_cacheid } { 762 array unset _imagecache 762 array unset _imagecache 763 763 set _cacheid $cacheid 764 764 } … … 798 798 "sticks" "sticks" \ 799 799 "lines" "lines" \ 800 "cartoon" "cartoon" 800 "cartoon" "cartoon" 801 801 802 802 bind $inner.rep <<Value>> [itcl::code $this Representation] … … 883 883 # Turn on buffering of commands to the server. We don't want to 884 884 # be preempted by a server disconnect/reconnect (that automatically 885 # generates a new call to Rebuild). 885 # generates a new call to Rebuild). 886 886 StartBufferingCommands 887 887 set _cell 0 … … 897 897 set dlist [get] 898 898 foreach dataobj $dlist { 899 900 901 899 if { $_first == "" } { 900 set _first $dataobj 901 } 902 902 set model [$dataobj get components.molecule.model] 903 903 if {"" == $model } { … … 906 906 set model $model$suffix 907 907 } 908 lappend _obj2models($dataobj) $model 908 lappend _obj2models($dataobj) $model 909 909 set state [$dataobj get components.molecule.state] 910 if {"" == $state} { 911 set state $_state(server) 910 if {"" == $state} { 911 set state $_state(server) 912 912 } 913 913 if { ![info exists _mlist($model)] } { # new, turn on 914 914 set _mlist($model) 2 915 915 } elseif { $_mlist($model) == 1 } { # on, leave on 916 set _mlist($model) 3 916 set _mlist($model) 3 917 917 } elseif { $_mlist($model) == 0 } { # off, turn on 918 918 set _mlist($model) 2 … … 1002 1002 set charge "" 1003 1003 if { "" == $lammpstypemap} { 1004 set atom $type 1004 set atom $type 1005 1005 } else { 1006 1006 set atom [lindex $lammpstypemap [expr {$type - 1}]] … … 1012 1012 append data3 $pdbline 1013 1013 } 1014 # only read first model 1014 # only read first model 1015 1015 if {[regexp "^ITEM: ATOMS" $lammpsline]} { 1016 1016 incr modelcount … … 1025 1025 set numBytes [string length $data3] 1026 1026 1027 # We know we're buffered here, so append the "loadpdb" 1027 # We know we're buffered here, so append the "loadpdb" 1028 1028 # command with the data payload immediately afterwards. 1029 1029 ServerCmd "loadpdb -defer follows $model $state $numBytes" … … 1057 1057 } 1058 1058 } 1059 1059 1060 1060 # enable/disable models as required (0=off->off, 1=on->off, 2=off->on, 1061 1061 # 3=on->on) … … 1074 1074 } 1075 1075 if { $_mlist($model) == 1 } { 1076 if { [info exists _model($model-newtransparency)] || 1076 if { [info exists _model($model-newtransparency)] || 1077 1077 [info exists _model($model-newrep)] } { 1078 1078 if { ![info exists _model($model-newrep)] } { … … 1118 1118 # Set or restore viewing parameters. We do this for the first 1119 1119 # model and assume this works for everything else. 1120 set w [winfo width $itk_component(3dview)] 1121 set h [winfo height $itk_component(3dview)] 1122 ServerCmd [subst { 1120 set w [winfo width $itk_component(3dview)] 1121 set h [winfo height $itk_component(3dview)] 1122 ServerCmd [subst { 1123 1123 reset 1124 1124 screen $w $h … … 1134 1134 if { $changed } { 1135 1135 # Default settings for all models. 1136 SphereScale update 1136 SphereScale update 1137 1137 StickRadius update 1138 labels update 1139 Opacity update 1140 CartoonTrace update 1138 labels update 1139 Opacity update 1140 CartoonTrace update 1141 1141 Cell update 1142 OrthoProjection update 1142 OrthoProjection update 1143 1143 Representation update 1144 1144 } … … 1188 1188 $_image(plot) configure -width $_width -height $_height 1189 1189 # Immediately invalidate cache, defer update until mapped 1190 array unset _imagecache 1190 array unset _imagecache 1191 1191 set _resizePending 0 1192 1192 } 1193 1193 1194 1194 itcl::body Rappture::MolvisViewer::EventuallyResize { w h } { 1195 1195 set _width $w … … 1203 1203 itcl::body Rappture::MolvisViewer::DoRotate {} { 1204 1204 ServerCmd "rotate $_view(a) $_view(b) $_view(c)" 1205 array unset _imagecache 1205 array unset _imagecache 1206 1206 set _rotatePending 0 1207 1207 } 1208 1208 1209 1209 itcl::body Rappture::MolvisViewer::EventuallyRotate { a b c } { 1210 set _view(a) $a 1210 set _view(a) $a 1211 1211 set _view(b) $b 1212 set _view(c) $c 1212 set _view(c) $c 1213 1213 if { !$_rotatePending } { 1214 1214 $_dispatcher event -after 100 !rotate … … 1246 1246 set _view(x) [expr $_view(x) + $dx] 1247 1247 set _view(y) [expr $_view(y) + $dy] 1248 array unset _imagecache 1248 array unset _imagecache 1249 1249 ServerCmd "pan $dx $dy" 1250 1250 return … … 1253 1253 set option "click" 1254 1254 } 1255 if { $option == "click" } { 1255 if { $option == "click" } { 1256 1256 $itk_component(3dview) configure -cursor hand1 1257 1257 } … … 1261 1261 set _view(x) [expr $_view(x) + $dx] 1262 1262 set _view(y) [expr $_view(y) + $dy] 1263 array unset _imagecache 1263 array unset _imagecache 1264 1264 ServerCmd "pan $dx $dy" 1265 1265 } … … 1294 1294 } 1295 1295 } 1296 array unset _imagecache 1296 array unset _imagecache 1297 1297 } 1298 1298 … … 1324 1324 return 1325 1325 } 1326 set _rocker(on) $_settings($this-rock) 1326 set _rocker(on) $_settings($this-rock) 1327 1327 if { $option == "step"} { 1328 1328 if { $_rocker(client) >= 10 } { … … 1554 1554 } 1555 1555 if { $option == $_mrep } { 1556 return 1556 return 1557 1557 } 1558 1558 if { $option == "update" } { 1559 1559 set option $_settings($this-model) 1560 1560 } 1561 array unset _imagecache 1561 array unset _imagecache 1562 1562 if { $option == "sticks" } { 1563 1563 set _settings($this-modelimg) [Rappture::icon lines] … … 1659 1659 return 1660 1660 } 1661 array unset _imagecache 1661 array unset _imagecache 1662 1662 if { $cell } { 1663 1663 Rappture::Tooltip::for $itk_component(ortho) \ … … 1723 1723 } 1724 1724 } 1725 1725 1726 1726 itcl::body Rappture::MolvisViewer::GetImage { widget } { 1727 1727 set token "print[incr _nextToken]" … … 1729 1729 set $var "" 1730 1730 1731 set controls $_downloadPopup(image_controls) 1731 set controls $_downloadPopup(image_controls) 1732 1732 set combo $controls.size 1733 1733 set size [$combo translate [$combo value]] … … 1751 1751 # Setup an automatic timeout procedure. 1752 1752 $_dispatcher dispatch $this !pngtimeout "set $var {} ; list" 1753 1753 1754 1754 set popup .molvisviewerimagedownload 1755 1755 if { ![winfo exists $popup] } { … … 1765 1765 1,0 $inner.please -anchor w \ 1766 1766 1,1 $inner.icon -anchor e \ 1767 2,0 $inner.cancel -cspan 2 1768 blt::table configure $inner r0 -pady 4 1769 blt::table configure $inner r2 -pady 4 1767 2,0 $inner.cancel -cspan 2 1768 blt::table configure $inner r0 -pady 4 1769 blt::table configure $inner r2 -pady 4 1770 1770 bind $inner.cancel <Return> [list $inner.cancel invoke] 1771 1771 bind $inner.cancel <KP_Enter> [list $inner.cancel invoke] … … 1775 1775 set combo $controls.bgcolor 1776 1776 set bgcolor [$combo translate [$combo value]] 1777 1777 1778 1778 $_dispatcher event -after 60000 !pngtimeout 1779 1779 WaitIcon start $inner.icon 1780 1780 grab set $inner 1781 1781 focus $inner.cancel 1782 1782 1783 1783 ServerCmd "print $token $width $height $bgcolor" 1784 1784 1785 1785 $popup activate $widget below 1786 # We wait here for either 1787 # 1) the png to be delivered or 1788 # 2) timeout or 1786 # We wait here for either 1787 # 1) the png to be delivered or 1788 # 2) timeout or 1789 1789 # 3) user cancels the operation. 1790 1790 tkwait variable $var … … 1826 1826 # 1827 1827 # Used internally to change the molecular atom scale used to render 1828 # our scene. 1829 # 1830 # Note: Only sets the specified radius for active models. If the model 1828 # our scene. 1829 # 1830 # Note: Only sets the specified radius for active models. If the model 1831 1831 # is inactive, then it overridden with the value "0.1". 1832 1832 # ---------------------------------------------------------------------- … … 1864 1864 # our scene. 1865 1865 # 1866 # Note: Only sets the specified radius for active models. If the model 1866 # Note: Only sets the specified radius for active models. If the model 1867 1867 # is inactive, then it overridden with the value "0.25". 1868 1868 # ---------------------------------------------------------------------- … … 1900 1900 # our scene. 1901 1901 # 1902 # Note: Only sets the specified transparency for active models. If the model 1902 # Note: Only sets the specified transparency for active models. If the model 1903 1903 # is inactive, then it overridden with the value "0.75". 1904 1904 # ---------------------------------------------------------------------- … … 1971 1971 # ---------------------------------------------------------------------- 1972 1972 itcl::body Rappture::MolvisViewer::CartoonTrace {option {models "all"}} { 1973 array unset _imagecache 1973 array unset _imagecache 1974 1974 set trace $_settings($this-cartoontrace) 1975 1975 if { $option == "update" } { … … 1996 1996 1997 1997 itcl::body Rappture::MolvisViewer::AddImageControls { inner widget } { 1998 label $inner.size_l -text "Size:" -font "Arial 9" 1998 label $inner.size_l -text "Size:" -font "Arial 9" 1999 1999 set _downloadPopup(image_controls) $inner 2000 2000 set img $_image(plot) … … 2006 2006 "highquality" "High Quality (2400x2400)" 2007 2007 2008 label $inner.bgcolor_l -text "Background:" -font "Arial 9" 2008 label $inner.bgcolor_l -text "Background:" -font "Arial 9" 2009 2009 Rappture::Combobox $inner.bgcolor -width 30 -editable no 2010 2010 $inner.bgcolor choices insert end \ 2011 2011 "black" "Black" \ 2012 2012 "white" "White" \ 2013 "none" "Transparent (PNG only)" 2014 2015 label $inner.format_l -text "Format:" -font "Arial 9" 2013 "none" "Transparent (PNG only)" 2014 2015 label $inner.format_l -text "Format:" -font "Arial 9" 2016 2016 Rappture::Combobox $inner.format -width 30 -editable no 2017 2017 $inner.format choices insert end \ … … 2034 2034 blt::table $f \ 2035 2035 0,0 $f.ok \ 2036 0,1 $f.cancel 2036 0,1 $f.cancel 2037 2037 2038 2038 blt::table $inner \ … … 2048 2048 $inner.bgcolor value "Black" 2049 2049 $inner.size value "Draft (400x400)" 2050 $inner.format value "PNG (Portable Network Graphics format)" 2050 $inner.format value "PNG (Portable Network Graphics format)" 2051 2051 } 2052 2052 … … 2055 2055 set w [image width $_image(plot)] 2056 2056 set h [image height $_image(plot)] 2057 } 2057 } 2058 2058 set tag "$_state(client),$_rocker(client)" 2059 2059 if { $_image(id) != "$tag" } { … … 2122 2122 } 2123 2123 2124 # Scale and translate points 2124 # Scale and translate points 2125 2125 for { set i 0 } { $i < 8 } { incr i } { 2126 2126 point${i} expr "(point${i} * scale) + origin" -
branches/uq/gui/scripts/nanovisviewer.tcl
r4798 r5121 1 1 # -*- mode: tcl; indent-tabs-mode: nil -*- 2 2 3 # ---------------------------------------------------------------------- 3 4 # COMPONENT: nanovisviewer - 3D volume rendering … … 75 76 public method isconnected {} 76 77 public method limits { tf } 78 public method overmarker { m x } 77 79 public method parameters {title args} { 78 80 # do nothing 79 81 } 82 public method rmdupmarker { m x } 80 83 public method scale {args} 81 public method updateTransferFunctions {} 84 public method updatetransferfuncs {} 85 86 protected method Connect {} 87 protected method CurrentDatasets {{what -all}} 88 protected method Disconnect {} 89 protected method DoResize {} 90 protected method FixLegend {} 91 protected method AdjustSetting {what {value ""}} 92 protected method InitSettings { args } 93 protected method Pan {option x y} 94 protected method Rebuild {} 95 protected method ReceiveData { args } 96 protected method ReceiveImage { args } 97 protected method ReceiveLegend { tf vmin vmax size } 98 protected method Rotate {option x y} 99 protected method SendTransferFuncs {} 100 protected method Slice {option args} 101 protected method SlicerTip {axis} 102 protected method Zoom {option} 82 103 83 104 # The following methods are only used by this class. 84 85 private method AddNewMarker { x y } 86 private method AdjustSetting {what {value ""}} 105 private method AddIsoMarker { x y } 87 106 private method BuildCameraTab {} 88 107 private method BuildCutplanesTab {} 89 108 private method BuildViewTab {} 90 private method BuildVolumeComponents {}91 109 private method BuildVolumeTab {} 92 private method ComputeAlphamap { cname } 93 private method ComputeTransferFunction { cname } 94 private method Connect {} 95 private method CurrentDatasets {{what -all}} 96 private method Disconnect {} 97 private method DoResize {} 98 private method DrawLegend { cname } 99 private method EventuallyRedrawLegend { } 110 private method ResetColormap { color } 111 private method ComputeTransferFunc { tf } 100 112 private method EventuallyResize { w h } 101 private method FixLegend {} 102 private method GetAlphamap { cname color } 103 private method GetColormap { cname color } 104 private method GetDatasetsWithComponent { cname } 113 private method EventuallyResizeLegend { } 114 private method NameTransferFunc { dataobj comp } 115 private method PanCamera {} 116 private method ParseLevelsOption { tf levels } 117 private method ParseMarkersOption { tf markers } 118 private method volume { tag name } 105 119 private method GetVolumeInfo { w } 106 private method HideAllMarkers {}107 private method InitComponentSettings { cname }108 private method InitSettings { args }109 private method NameToAlphamap { name }110 private method NameTransferFunction { dataobj comp }111 private method Pan {option x y}112 private method PanCamera {}113 private method ParseLevelsOption { cname levels }114 private method ParseMarkersOption { cname markers }115 private method Rebuild {}116 private method ReceiveData { args }117 private method ReceiveImage { args }118 private method ReceiveLegend { tf vmin vmax size }119 private method RemoveMarker { x y }120 private method ResetColormap { cname color }121 private method Rotate {option x y}122 private method SendTransferFunctions {}123 private method SetObjectStyle { dataobj cname }124 120 private method SetOrientation { side } 125 private method Slice {option args}126 private method SlicerTip {axis}127 private method SwitchComponent { cname }128 private method ToggleVolume { tag name }129 private method Zoom {option}130 private method ViewToQuaternion {} {131 return [list $_view(-qw) $_view(-qx) $_view(-qy) $_view(-qz)]132 }133 121 134 122 private variable _arcball "" 135 123 136 124 private variable _dlist "" ;# list of data objects 125 private variable _allDataObjs 137 126 private variable _obj2ovride ;# maps dataobj => style override 138 127 private variable _serverDatasets ;# contains all the dataobj-component 139 128 ;# to volumes in the server 140 private variable _recvdDatasets; # list of data objs to send to server 141 private variable _dataset2style; # maps dataobj-component to transfunc 142 private variable _style2datasets; # maps tf back to list of 143 # dataobj-components using the tf. 144 145 private variable _reset 1; # Connection to server has been reset. 146 private variable _click; # Info used for rotate operations. 147 private variable _limits; # Autoscale min/max for all axes 148 private variable _view; # View params for 3D view 149 private variable _parsedFunction 150 private variable _transferFunctionEditors 151 private variable _settings 152 private variable _alphamap 153 private variable _widget 154 155 private variable _first "" ; # This is the topmost volume. 156 private variable _current ""; # Currently selected component 157 private variable _volcomponents ; # Array of components found 158 private variable _componentsList ; # Array of components found 159 private variable _cname2style 160 private variable _cname2transferFunction 161 private variable _cname2defaultcolormap 162 private variable _cname2defaultalphamap 163 129 private variable _serverTfs ;# contains all the transfer functions 130 ;# in the server. 131 private variable _recvdDatasets ;# list of data objs to send to server 132 private variable _dataset2style ;# maps dataobj-component to transfunc 133 private variable _style2datasets ;# maps tf back to list of 134 # dataobj-components using the tf. 135 136 private variable _reset 1; # Connection to server has been reset 137 private variable _click ;# info used for rotate operations 138 private variable _limits ;# autoscale min/max for all axes 139 private variable _view ;# view params for 3D view 140 private variable _isomarkers ;# array of isosurface level values 0..1 141 private variable _settings 142 # Array of transfer functions in server. If 0 the transfer has been 143 # defined but not loaded. If 1 the transfer function has been named 144 # and loaded. 145 private variable _activeTfs 146 private variable _first "" ;# This is the topmost volume. 147 148 # This 149 # indicates which isomarkers and transfer 150 # function to use when changing markers, 151 # opacity, or thickness. 164 152 common _downloadPopup ;# download options from popup 165 153 private common _hardcopy … … 188 176 $_dispatcher register !send_transfunc 189 177 $_dispatcher dispatch $this !send_transfunc \ 190 "[itcl::code $this SendTransferFunc tions]; list"178 "[itcl::code $this SendTransferFuncs]; list" 191 179 192 180 # Rebuild event … … 207 195 # Initialize the view to some default parameters. 208 196 array set _view { 209 -qw 0.853553210 -qx -0.353553211 -qy 0.353553212 -qz 0.146447213 -xpan0214 -ypan 0215 -zoom 1.0197 qw 0.853553 198 qx -0.353553 199 qy 0.353553 200 qz 0.146447 201 zoom 1.0 202 xpan 0 203 ypan 0 216 204 } 217 205 set _arcball [blt::arcball create 100 100] 218 $_arcball quaternion [ViewToQuaternion] 219 220 set _limits(v) [list 0.0 1.0] 206 set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)] 207 $_arcball quaternion $q 208 209 set _limits(vmin) 0.0 210 set _limits(vmax) 1.0 221 211 set _reset 1 222 212 223 array set _settings { 224 -axesvisible 1 225 -background black 226 -colormap "default" 227 -cutplanesvisible 0 228 -gridvisible 0 229 -isosurfaceshading 0 230 -legendvisible 1 231 -light 40 232 -light2side 1 233 -outlinevisible 0 234 -qw 0.853553 235 -qx -0.353553 236 -qy 0.353553 237 -qz 0.146447 238 -thickness 350 239 -volume 1 240 -volumeopacity 0.5 241 -volumevisible 1 242 -xcutplaneposition 50 243 -xcutplanevisible 1 244 -xpan 0 245 -ycutplaneposition 50 246 -ycutplanevisible 1 247 -ypan 0 248 -zcutplaneposition 50 249 -zcutplanevisible 1 250 -zoom 1.0 251 } 252 array set _widget { 253 -volumeopacity 50 254 } 213 array set _settings [subst { 214 $this-qw $_view(qw) 215 $this-qx $_view(qx) 216 $this-qy $_view(qy) 217 $this-qz $_view(qz) 218 $this-zoom $_view(zoom) 219 $this-xpan $_view(xpan) 220 $this-ypan $_view(ypan) 221 $this-volume 1 222 $this-xcutplane 0 223 $this-xcutposition 0 224 $this-ycutplane 0 225 $this-ycutposition 0 226 $this-zcutplane 0 227 $this-zcutposition 0 228 }] 229 255 230 itk_component add 3dview { 256 231 label $itk_component(plotarea).view -image $_image(plot) \ … … 273 248 } 274 249 pack $itk_component(reset) -side top -padx 2 -pady 2 275 Rappture::Tooltip::for $itk_component(reset) \ 276 "Reset the view to the default zoom level" 250 Rappture::Tooltip::for $itk_component(reset) "Reset the view to the default zoom level" 277 251 278 252 itk_component add zoomin { … … 304 278 -onimage [Rappture::icon volume-on] \ 305 279 -offimage [Rappture::icon volume-off] \ 306 -command [itcl::code $this AdjustSetting -volume] \307 -variable [itcl::scope _settings( -volume)]280 -command [itcl::code $this AdjustSetting volume] \ 281 -variable [itcl::scope _settings($this-volume)] 308 282 } 309 283 $itk_component(volume) select … … 311 285 "Toggle the volume cloud on/off" 312 286 pack $itk_component(volume) -padx 2 -pady 2 313 314 itk_component add cutplane {315 Rappture::PushButton $f.cutplane \316 -onimage [Rappture::icon cutbutton] \317 -offimage [Rappture::icon cutbutton] \318 -variable [itcl::scope _settings(-cutplanesvisible)] \319 -command [itcl::code $this AdjustSetting -cutplanesvisible]320 }321 Rappture::Tooltip::for $itk_component(cutplane) \322 "Show/Hide cutplanes"323 pack $itk_component(cutplane) -padx 2 -pady 2324 287 325 288 if { [catch { … … 334 297 335 298 # Legend 299 336 300 set _image(legend) [image create photo] 337 301 itk_component add legend { … … 343 307 } 344 308 bind $itk_component(legend) <Configure> \ 345 [itcl::code $this EventuallyRedrawLegend] 346 bind $itk_component(legend) <KeyPress-Delete> \ 347 [itcl::code $this RemoveMarker %x %y] 348 bind $itk_component(legend) <Enter> \ 349 [list focus $itk_component(legend)] 309 [itcl::code $this EventuallyResizeLegend] 350 310 351 311 # Hack around the Tk panewindow. The problem is that the requested … … 426 386 image delete $_image(legend) 427 387 image delete $_image(download) 428 foreach name [array names _transferFunctionEditors] {429 itcl::delete object $_transferFunctionEditors($cname)430 }431 388 catch { blt::arcball destroy $_arcball } 432 array unset _settings 389 array unset _settings $this-* 433 390 } 434 391 … … 462 419 if {$pos < 0} { 463 420 lappend _dlist $dataobj 421 set _allDataObjs($dataobj) 1 464 422 set _obj2ovride($dataobj-color) $params(-color) 465 423 set _obj2ovride($dataobj-width) $params(-width) … … 538 496 if { $pos >= 0 } { 539 497 set _dlist [lreplace $_dlist $pos $pos] 498 array unset _limits $dataobj* 540 499 array unset _obj2ovride $dataobj-* 541 array unset _dataset2style $dataobj-*542 500 set changed 1 543 501 } … … 559 517 # ---------------------------------------------------------------------- 560 518 itcl::body Rappture::NanovisViewer::scale {args} { 561 array set styles { 562 -color BCGYR 563 -levels 6 564 -markers "" 565 } 566 array unset _limits 567 array unset _volcomponents 519 foreach val {xmin xmax ymin ymax zmin zmax vmin vmax} { 520 set _limits($val) "" 521 } 568 522 foreach dataobj $args { 569 523 if { ![$dataobj isvalid] } { 570 524 continue; # Object doesn't contain valid data. 571 525 } 572 foreach cname [$dataobj components] {573 if { ![info exists _volcomponents($cname)] } {574 lappend _componentsList $cname575 array set styles [lindex [$dataobj components -style $cname] 0]576 set cmap [ColorsToColormap $styles(-color)]577 set _cname2defaultcolormap($cname) $cmap578 set _settings($cname-colormap) $styles(-color)579 }580 lappend _volcomponents($cname) $dataobj-$cname581 array unset limits582 array set limits [$dataobj valueLimits $cname]583 set _limits($cname) $limits(v)584 }585 526 foreach axis {x y z v} { 586 527 foreach { min max } [$dataobj limits $axis] break 587 528 if {"" != $min && "" != $max} { 588 if { ![info exists _limits($axis)] } { 589 set _limits($axis) [list $min $max] 529 if {"" == $_limits(${axis}min)} { 530 set _limits(${axis}min) $min 531 set _limits(${axis}max) $max 590 532 } else { 591 foreach {amin amax} $_limits($axis) break 592 if {$min < $amin} { 593 set amin $min 533 if {$min < $_limits(${axis}min)} { 534 set _limits(${axis}min) $min 594 535 } 595 if {$max > $ amax} {596 set amax$max536 if {$max > $_limits(${axis}max)} { 537 set _limits(${axis}max) $max 597 538 } 598 set _limits($axis) [list $amin $amax]599 539 } 600 540 } 601 541 } 602 542 } 603 BuildVolumeComponents604 543 } 605 544 … … 664 603 if { $_reportClientInfo } { 665 604 # Tell the server the viewer, hub, user and session. 666 # Do this immediately on connect before buff ering any commands605 # Do this immediately on connect before buffing any commands 667 606 global env 668 607 … … 724 663 725 664 # ---------------------------------------------------------------------- 726 # USAGE: SendTransferFunctions 727 # ---------------------------------------------------------------------- 728 itcl::body Rappture::NanovisViewer::SendTransferFunctions {} { 729 foreach cname [array names _volcomponents] { 730 ComputeTransferFunction $cname 665 # USAGE: SendTransferFuncs 666 # ---------------------------------------------------------------------- 667 itcl::body Rappture::NanovisViewer::SendTransferFuncs {} { 668 if { $_first == "" } { 669 puts stderr "first not set" 670 return 671 } 672 # Ensure that the global opacity and thickness settings (in the slider 673 # settings widgets) are used for the active transfer-function. Update 674 # the values in the _settings varible. 675 set opacity [expr { double($_settings($this-opacity)) * 0.01 }] 676 # Scale values between 0.00001 and 0.01000 677 set thickness [expr {double($_settings($this-thickness)) * 0.0001}] 678 679 foreach tag [CurrentDatasets] { 680 if { ![info exists _serverDatasets($tag)] || !$_serverDatasets($tag) } { 681 # The volume hasn't reached the server yet. How did we get 682 # here? 683 puts stderr "Don't have $tag in _serverDatasets" 684 continue 685 } 686 if { ![info exists _dataset2style($tag)] } { 687 puts stderr "don't have style for volume $tag" 688 continue; # How does this happen? 689 } 690 set tf $_dataset2style($tag) 691 set _settings($this-$tf-opacity) $opacity 692 set _settings($this-$tf-thickness) $thickness 693 ComputeTransferFunc $tf 694 # FIXME: Need to the send information as to what transfer functions 695 # to update so that we only update the transfer function 696 # as necessary. Right now, all transfer functions are 697 # updated. This makes moving the isomarker slider chunky. 698 if { ![info exists _activeTfs($tf)] || !$_activeTfs($tf) } { 699 set _activeTfs($tf) 1 700 } 701 SendCmd "volume shading transfunc $tf $tag" 731 702 } 732 703 FixLegend … … 759 730 760 731 # 761 # DrawLegend -- 762 # 763 itcl::body Rappture::NanovisViewer::DrawLegend { cname } { 732 # ReceiveLegend -- 733 # 734 # The procedure is the response from the render server to each "legend" 735 # command. The server sends back a "legend" command invoked our 736 # the slave interpreter. The purpose is to collect data of the image 737 # representing the legend in the canvas. In addition, the isomarkers 738 # of the active transfer function are displayed. 739 # 740 # I don't know is this is the right place to display the isomarkers. 741 # I don't know all the different paths used to draw the plot. There's 742 # "Rebuild", "add", etc. 743 # 744 itcl::body Rappture::NanovisViewer::ReceiveLegend { tf vmin vmax size } { 745 if { ![isconnected] } { 746 return 747 } 748 set bytes [ReceiveBytes $size] 749 $_image(legend) configure -data $bytes 750 ReceiveEcho <<line "<read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>" 751 764 752 set c $itk_component(legend) 765 753 set w [winfo width $c] … … 767 755 set lx 10 768 756 set ly [expr {$h - 1}] 769 if {"" == [$c find withtag colorbar]} {757 if {"" == [$c find withtag transfunc]} { 770 758 $c create image 10 10 -anchor nw \ 771 -image $_image(legend) -tags colorbar759 -image $_image(legend) -tags transfunc 772 760 $c create text $lx $ly -anchor sw \ 773 -fill $itk_option(-plotforeground) -tags "limits textvmin"761 -fill $itk_option(-plotforeground) -tags "limits vmin" 774 762 $c create text [expr {$w-$lx}] $ly -anchor se \ 775 -fill $itk_option(-plotforeground) -tags "limits text vmax" 776 $c create text [expr {$w/2}] $ly -anchor s \ 777 -fill $itk_option(-plotforeground) -tags "limits text title" 778 $c lower colorbar 779 $c bind colorbar <ButtonRelease-1> [itcl::code $this AddNewMarker %x %y] 780 } 781 782 # Display the markers used by the current transfer function. 783 HideAllMarkers 784 $_transferFunctionEditors($cname) showMarkers $_limits($cname) 785 786 foreach {min max} $_limits($cname) break 787 $c itemconfigure vmin -text [format %g $min] 763 -fill $itk_option(-plotforeground) -tags "limits vmax" 764 $c lower transfunc 765 $c bind transfunc <ButtonRelease-1> \ 766 [itcl::code $this AddIsoMarker %x %y] 767 } 768 # Display the markers used by the active transfer function. 769 770 array set limits [limits $tf] 771 $c itemconfigure vmin -text [format %.2g $limits(min)] 788 772 $c coords vmin $lx $ly 789 773 790 $c itemconfigure vmax -text [format % g $max]774 $c itemconfigure vmax -text [format %.2g $limits(max)] 791 775 $c coords vmax [expr {$w-$lx}] $ly 792 776 793 set title [$_first hints label] 794 set units [$_first hints units] 795 if { $units != "" } { 796 set title "$title ($units)" 797 } 798 $c itemconfigure title -text $title 799 $c coords title [expr {$w/2}] $ly 777 if { [info exists _isomarkers($tf)] } { 778 foreach m $_isomarkers($tf) { 779 $m visible yes 780 } 781 } 800 782 801 783 # The colormap may have changed. Resync the slicers with the colormap. 802 InitSettings -cutplanesvisible -xcutplanevisible -ycutplanevisible \ 803 -zcutplanevisible 804 } 805 806 # 807 # 808 # ReceiveLegend -- 809 # 810 # The procedure is the response from the render server to each "legend" 811 # command. The server sends back a "legend" command invoked our 812 # the slave interpreter. The purpose is to collect data of the image 813 # representing the legend in the canvas. In addition, the 814 # active transfer function is displayed. 815 # 816 # 817 itcl::body Rappture::NanovisViewer::ReceiveLegend { cname vmin vmax size } { 818 if { ![isconnected] } { 819 return 820 } 821 set bytes [ReceiveBytes $size] 822 $_image(legend) configure -data $bytes 823 ReceiveEcho <<line "<read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>" 824 825 DrawLegend $_current 784 set datasets [CurrentDatasets -cutplanes] 785 SendCmd "volume data state $_settings($this-volume) $datasets" 786 787 # Adjust the cutplane for only the first component in the topmost volume 788 # (i.e. the first volume designated in the field). 789 set tag [lindex $datasets 0] 790 foreach axis {x y z} { 791 # Turn off cutplanes for all volumes 792 SendCmd "cutplane state 0 $axis" 793 if { $_settings($this-${axis}cutplane) } { 794 # Turn on cutplane for this particular volume and set the position 795 SendCmd "cutplane state 1 $axis $tag" 796 set pos [expr {0.01*$_settings($this-${axis}cutposition)}] 797 SendCmd "cutplane position $pos $axis $tag" 798 } 799 } 826 800 } 827 801 … … 863 837 set dataobj [lindex $parts 0] 864 838 set _serverDatasets($tag) 1 865 if { $_settings( -volumevisible) && $dataobj == $_first } {839 if { $_settings($this-volume) && $dataobj == $_first } { 866 840 SendCmd "volume state 1 $tag" 867 841 } 868 set _limits($tag) [list $info(min) $info(max)] 869 set _limits(v) [list $info(vmin) $info(vmax)] 842 set _limits($tag-min) $info(min); # Minimum value of the volume. 843 set _limits($tag-max) $info(max); # Maximum value of the volume. 844 set _limits(vmin) $info(vmin); # Overall minimum value. 845 set _limits(vmax) $info(vmax); # Overall maximum value. 870 846 871 847 unset _recvdDatasets($tag) 872 848 if { [array size _recvdDatasets] == 0 } { 873 updateTransferFunctions 849 # The active transfer function is by default the first component of 850 # the first data object. This assumes that the data is always 851 # successfully transferred. 852 updatetransferfuncs 874 853 } 875 854 } … … 895 874 StartBufferingCommands 896 875 876 # Hide all the isomarkers. Can't remove them. Have to remember the 877 # settings since the user may have created/deleted/moved markers. 878 879 foreach tf [array names _isomarkers] { 880 foreach m $_isomarkers($tf) { 881 $m visible no 882 } 883 } 884 897 885 if { $_width != $w || $_height != $h || $_reset } { 898 886 set _width $w … … 901 889 DoResize 902 890 } 903 904 891 foreach dataobj [get] { 905 892 foreach cname [$dataobj components] { … … 923 910 if { $_reportClientInfo } { 924 911 set info {} 925 lappend info "tool_id" [$dataobj hints toolId] 926 lappend info "tool_name" [$dataobj hints toolName] 927 lappend info "tool_version" [$dataobj hints toolRevision] 928 lappend info "tool_title" [$dataobj hints toolTitle] 912 lappend info "tool_id" [$dataobj hints toolid] 913 lappend info "tool_name" [$dataobj hints toolname] 914 lappend info "tool_title" [$dataobj hints tooltitle] 915 lappend info "tool_command" [$dataobj hints toolcommand] 916 lappend info "tool_revision" [$dataobj hints toolrevision] 929 917 lappend info "dataset_label" [$dataobj hints label] 930 918 lappend info "dataset_size" $nbytes … … 937 925 set _serverDatasets($tag) 0 938 926 } 939 SetObjectStyle $dataobj $cname 940 } 941 } 942 943 # Outline seems to need to be reset every update. 944 InitSettings -outlinevisible -cutplanesvisible -current 945 927 NameTransferFunc $dataobj $cname 928 } 929 } 946 930 set _first [lindex [get] 0] 947 931 if { $_reset } { … … 949 933 # Reset the camera and other view parameters 950 934 # 951 set _settings( -qw) $_view(-qw)952 set _settings( -qx) $_view(-qx)953 set _settings( -qy) $_view(-qy)954 set _settings( -qz) $_view(-qz)955 set _settings( -xpan) $_view(-xpan)956 set _settings( -ypan) $_view(-ypan)957 set _settings( -zoom) $_view(-zoom)958 959 set q [ ViewToQuaternion]935 set _settings($this-qw) $_view(qw) 936 set _settings($this-qx) $_view(qx) 937 set _settings($this-qy) $_view(qy) 938 set _settings($this-qz) $_view(qz) 939 set _settings($this-xpan) $_view(xpan) 940 set _settings($this-ypan) $_view(ypan) 941 set _settings($this-zoom) $_view(zoom) 942 943 set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)] 960 944 $_arcball quaternion $q 961 945 SendCmd "camera orient $q" 962 946 SendCmd "camera reset" 963 947 PanCamera 964 SendCmd "camera zoom $_view(-zoom)" 948 SendCmd "camera zoom $_view(zoom)" 949 InitSettings light2side light transp isosurface grid axes 965 950 966 #cutplane state 0 all967 951 foreach axis {x y z} { 968 952 # Turn off cutplanes for all volumes 969 953 SendCmd "cutplane state 0 $axis" 970 954 } 971 972 InitSettings -light2side -light -volumeopacity \973 -isosurfaceshading -gridvisible -axesvisible \974 975 955 if {"" != $_first} { 976 956 set axis [$_first hints updir] … … 984 964 } 985 965 } 986 966 # Outline seems to need to be reset every update. 967 InitSettings outline 987 968 # nothing to send -- activate the proper ivol 988 969 SendCmd "volume state 0" … … 996 977 set cname [lindex [$_first components] 0] 997 978 if { [info exists _serverDatasets($_first-$cname)] } { 998 update TransferFunctions979 updatetransferfuncs 999 980 } 1000 981 } … … 1022 1003 set tag $_first-$cname 1023 1004 if { [info exists _serverDatasets($tag)] && $_serverDatasets($tag) } { 1024 array set style s{1005 array set style { 1025 1006 -cutplanes 1 1026 1007 } 1027 array set style s[lindex [$_first components -style $cname] 0]1028 if { $what != "-cutplanes" || $style s(-cutplanes) } {1008 array set style [lindex [$_first components -style $cname] 0] 1009 if { $what != "-cutplanes" || $style(-cutplanes) } { 1029 1010 lappend rlist $tag 1030 1011 } … … 1045 1026 switch -- $option { 1046 1027 "in" { 1047 set _view( -zoom) [expr {$_view(-zoom)*1.25}]1048 set _settings( -zoom) $_view(-zoom)1049 SendCmd "camera zoom $_view( -zoom)"1028 set _view(zoom) [expr {$_view(zoom)*1.25}] 1029 set _settings($this-zoom) $_view(zoom) 1030 SendCmd "camera zoom $_view(zoom)" 1050 1031 } 1051 1032 "out" { 1052 set _view( -zoom) [expr {$_view(-zoom)*0.8}]1053 set _settings( -zoom) $_view(-zoom)1054 SendCmd "camera zoom $_view( -zoom)"1033 set _view(zoom) [expr {$_view(zoom)*0.8}] 1034 set _settings($this-zoom) $_view(zoom) 1035 SendCmd "camera zoom $_view(zoom)" 1055 1036 } 1056 1037 "reset" { 1057 1038 array set _view { 1058 -qw 0.8535531059 -qx -0.3535531060 -qy 0.3535531061 -qz 0.1464471062 -xpan01063 -ypan01064 -zoom 1.01039 qw 0.853553 1040 qx -0.353553 1041 qy 0.353553 1042 qz 0.146447 1043 zoom 1.0 1044 xpan 0 1045 ypan 0 1065 1046 } 1066 1047 if { $_first != "" } { … … 1070 1051 } 1071 1052 } 1072 set q [ ViewToQuaternion]1053 set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)] 1073 1054 $_arcball quaternion $q 1074 1055 SendCmd "camera orient $q" 1075 1056 SendCmd "camera reset" 1076 set _settings( -qw) $_view(-qw)1077 set _settings( -qx) $_view(-qx)1078 set _settings( -qy) $_view(-qy)1079 set _settings( -qz) $_view(-qz)1080 set _settings( -xpan) $_view(-xpan)1081 set _settings( -ypan) $_view(-ypan)1082 set _settings( -zoom) $_view(-zoom)1057 set _settings($this-qw) $_view(qw) 1058 set _settings($this-qx) $_view(qx) 1059 set _settings($this-qy) $_view(qy) 1060 set _settings($this-qz) $_view(qz) 1061 set _settings($this-xpan) $_view(xpan) 1062 set _settings($this-ypan) $_view(ypan) 1063 set _settings($this-zoom) $_view(zoom) 1083 1064 } 1084 1065 } … … 1086 1067 1087 1068 itcl::body Rappture::NanovisViewer::PanCamera {} { 1088 set x $_view(-xpan) 1089 set y $_view(-ypan) 1069 #set x [expr ($_view(xpan)) / $_limits(xrange)] 1070 #set y [expr ($_view(ypan)) / $_limits(yrange)] 1071 set x $_view(xpan) 1072 set y $_view(ypan) 1090 1073 SendCmd "camera pan $x $y" 1091 1074 } … … 1126 1109 1127 1110 set q [$_arcball rotate $x $y $_click(x) $_click(y)] 1128 foreach { _view( -qw) _view(-qx) _view(-qy) _view(-qz) } $q break1129 set _settings( -qw) $_view(-qw)1130 set _settings( -qx) $_view(-qx)1131 set _settings( -qy) $_view(-qy)1132 set _settings( -qz) $_view(-qz)1111 foreach { _view(qw) _view(qx) _view(qy) _view(qz) } $q break 1112 set _settings($this-qw) $_view(qw) 1113 set _settings($this-qx) $_view(qx) 1114 set _settings($this-qy) $_view(qy) 1115 set _settings($this-qz) $_view(qz) 1133 1116 SendCmd "camera orient $q" 1134 1117 … … 1163 1146 set x [expr $x / double($w)] 1164 1147 set y [expr $y / double($h)] 1165 set _view( -xpan) [expr $_view(-xpan) + $x]1166 set _view( -ypan) [expr $_view(-ypan) + $y]1148 set _view(xpan) [expr $_view(xpan) + $x] 1149 set _view(ypan) [expr $_view(ypan) + $y] 1167 1150 PanCamera 1168 set _settings( -xpan) $_view(-xpan)1169 set _settings( -ypan) $_view(-ypan)1151 set _settings($this-xpan) $_view(xpan) 1152 set _settings($this-ypan) $_view(ypan) 1170 1153 return 1171 1154 } … … 1180 1163 set _click(x) $x 1181 1164 set _click(y) $y 1182 set _view( -xpan) [expr $_view(-xpan) - $dx]1183 set _view( -ypan) [expr $_view(-ypan) - $dy]1165 set _view(xpan) [expr $_view(xpan) - $dx] 1166 set _view(ypan) [expr $_view(ypan) - $dy] 1184 1167 PanCamera 1185 set _settings( -xpan) $_view(-xpan)1186 set _settings( -ypan) $_view(-ypan)1168 set _settings($this-xpan) $_view(xpan) 1169 set _settings($this-ypan) $_view(ypan) 1187 1170 } 1188 1171 if { $option == "release" } { … … 1216 1199 } 1217 1200 switch -- $what { 1218 "-axesvisible" { 1219 SendCmd "axis visible $_settings($what)" 1220 } 1221 "-background" { 1222 set bgcolor [$itk_component(background) value] 1223 array set fgcolors { 1224 "black" "white" 1225 "white" "black" 1226 "grey" "black" 1227 } 1228 configure -plotbackground $bgcolor \ 1229 -plotforeground $fgcolors($bgcolor) 1230 DrawLegend $_current 1231 } 1232 "-colormap" { 1201 light { 1202 set val $_settings($this-light) 1203 set diffuse [expr {0.01*$val}] 1204 set ambient [expr {1.0-$diffuse}] 1205 set specularLevel 0.3 1206 set specularExp 90.0 1207 SendCmd "volume shading ambient $ambient" 1208 SendCmd "volume shading diffuse $diffuse" 1209 SendCmd "volume shading specularLevel $specularLevel" 1210 SendCmd "volume shading specularExp $specularExp" 1211 } 1212 light2side { 1213 set val $_settings($this-light2side) 1214 SendCmd "volume shading light2side $val" 1215 } 1216 transp { 1217 set val $_settings($this-transp) 1218 set sval [expr { 0.01 * double($val) }] 1219 SendCmd "volume shading opacity $sval" 1220 } 1221 opacity { 1222 set val $_settings($this-opacity) 1223 set sval [expr { 0.01 * double($val) }] 1224 foreach tf [array names _activeTfs] { 1225 set _settings($this-$tf-opacity) $sval 1226 set _activeTfs($tf) 0 1227 } 1228 updatetransferfuncs 1229 } 1230 thickness { 1231 if { [array names _activeTfs] > 0 } { 1232 set val $_settings($this-thickness) 1233 # Scale values between 0.00001 and 0.01000 1234 set sval [expr {0.0001*double($val)}] 1235 foreach tf [array names _activeTfs] { 1236 set _settings($this-$tf-thickness) $sval 1237 set _activeTfs($tf) 0 1238 } 1239 updatetransferfuncs 1240 } 1241 } 1242 "outline" { 1243 SendCmd "volume outline state $_settings($this-outline)" 1244 } 1245 "isosurface" { 1246 SendCmd "volume shading isosurface $_settings($this-isosurface)" 1247 } 1248 "colormap" { 1233 1249 set color [$itk_component(colormap) value] 1234 set _settings($what) $color 1235 set _settings($_current${what}) $color 1236 ResetColormap $_current $color 1237 } 1238 "-current" { 1239 set cname [$itk_component(volcomponents) value] 1240 SwitchComponent $cname 1241 } 1242 "-cutplanesvisible" { 1243 set bool $_settings($what) 1244 # We only set cutplanes on the first dataset. 1245 set datasets [CurrentDatasets -cutplanes] 1246 &