Changeset 4919 for branches/r9
- Timestamp:
- Jan 4, 2015 6:52:23 PM (9 years ago)
- Location:
- branches/r9
- Files:
-
- 41 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/r9/apps/Makefile.in
r4914 r4919 26 26 $(srcdir)/execute.tcl \ 27 27 $(srcdir)/launcher.tcl \ 28 $(srcdir)/mapviewer-test \29 28 $(srcdir)/grabdata \ 30 29 $(srcdir)/nanovis-test \ -
branches/r9/apps/launcher.tcl
r4127 r4919 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 … … 53 54 set reqpkgs Tk 54 55 } 56 -execute { 57 # for web services and simulation cache -- don't load Tk 58 set reqpkgs "" 59 if {[llength $argv] < 1} { 60 puts stderr "error: missing driver.xml file for -execute option" 61 exit 1 62 } 63 set driverxml [lindex $argv 0] 64 set argv [lrange $argv 1 end] 65 66 if {![file readable $driverxml]} { 67 puts stderr "error: driver file \"$driverxml\" not found" 68 exit 1 69 } 70 71 set dir [file dirname [info script]] 72 set mainscript [file join $dir execute.tcl] 73 } 55 74 -tool { 56 75 set toolxml [lindex $argv 0] … … 89 108 puts stderr " rappture -builder ?-tool toolFile?" 90 109 puts stderr " rappture -tester ?-auto? ?-tool toolFile? ?-testdir directory?" 110 puts stderr " rappture -execute driver.xml ?-tool toolFile?" 91 111 exit 1 92 112 } -
branches/r9/apps/rappture.use.in
r4118 r4919 33 33 prepend TK_LIBRARY ${libdir}/tk${tcl_version} 34 34 35 prepend CLASSPATH ${libdir}/java 36 35 37 prepend R_LIBS ${libdir}/R 36 38 -
branches/r9/apps/rpdiff
r3177 r4919 490 490 } 491 491 } 492 loader { 493 } 492 494 default { 493 error "don't know how to compare type \"$type\""495 puts stderr "ignoring \"$type1\" for \"$path\"" 494 496 } 495 497 } … … 557 559 558 560 # ====================================================================== 559 if {$argc != 2} { 561 562 if {$argc < 2} { 560 563 puts stderr "USAGE: rpdiff file1.xml file2.xml" 561 564 exit 9 … … 563 566 set lib1 [Rappture::library [lindex $argv 0]] 564 567 set lib2 [Rappture::library [lindex $argv 1]] 568 set path "output" 569 if { $argc > 2 } { 570 set arg [lindex $argv 2] 571 if { $arg == "-path" && $argc == 4 } { 572 set path [lindex $argv 3] 573 } 574 } 565 575 566 576 # compute the differences 567 set diffs [diff output$lib1 $lib2]577 set diffs [diff $path $lib1 $lib2] 568 578 569 579 if {[llength $diffs] == 0} { -
branches/r9/gui/scripts/analyzer.tcl
r4261 r4919 800 800 _autoLabel $xmlobj output.$item "Integer" counters 801 801 } 802 mesh* { 803 _autoLabel $xmlobj output.$item "Mesh" counters 804 } 802 805 string* { 803 806 _autoLabel $xmlobj output.$item "String" counters -
branches/r9/gui/scripts/balloon.tcl
r3555 r4919 232 232 # grab the mouse pointer 233 233 update 234 while {[catch {grab set -local$itk_component(hull)}]} {234 while {[catch {grab set $itk_component(hull)}]} { 235 235 after 100 236 236 } … … 249 249 250 250 grab release $itk_component(hull) 251 252 251 wm withdraw $itk_component(hull) 253 252 foreach dir {left right above below} { -
branches/r9/gui/scripts/bugreport.tcl
r4003 r4919 87 87 set h [winfo reqheight .bugreport] 88 88 89 set rootx [winfo rootx .main] 90 set rooty [winfo rooty .main] 91 set mw [winfo reqwidth .main] 92 set mh [winfo reqheight .main] 93 94 set x [expr { $rootx + (($mw-$w)/2) }] 95 if {$x < 0} {set x 0} 96 set y [expr { $rooty + (($mh-$h)/2) }] 97 if {$y < 0} {set y 0} 98 89 set x [winfo rootx .main] 90 set y [winfo rooty .main] 91 92 set mw [winfo width .main] 93 if { $mw == 1 } { 94 set mw [winfo reqwidth .main] 95 } 96 set mh [winfo height .main] 97 if { $mh == 1 } { 98 set mh [winfo reqwidth .main] 99 } 100 if { $mw > $w } { 101 set x [expr { $x + (($mw-$w)/2) }] 102 } 103 if { $mh > $h } { 104 set y [expr { $y + (($mh-$h)/2) }] 105 } 99 106 wm geometry .bugreport +$x+$y 100 107 raise .bugreport … … 151 158 set h [winfo reqheight .bugreport] 152 159 153 set rootx [winfo rootx .main] 154 set rooty [winfo rooty .main] 155 set mw [winfo reqwidth .main] 156 set mh [winfo reqheight .main] 157 158 set x [expr { $rootx + (($mw-$w)/2) }] 159 if {$x < 0} {set x 0} 160 set y [expr { $rooty + (($mh-$h)/2) }] 161 if {$y < 0} {set y 0} 160 set x [winfo rootx .main] 161 set y [winfo rooty .main] 162 163 set mw [winfo width .main] 164 if { $mw == 1 } { 165 set mw [winfo reqwidth .main] 166 } 167 set mh [winfo height .main] 168 if { $mh == 1 } { 169 set mh [winfo reqwidth .main] 170 } 171 172 if { $mw > $w } { 173 set x [expr { $x + (($mw-$w)/2) }] 174 } 175 if { $mh > $h } { 176 set y [expr { $y + (($mh-$h)/2) }] 177 } 162 178 163 179 wm geometry .bugreport +$x+$y … … 165 181 raise .bugreport 166 182 167 catch {grab -localset .bugreport}183 catch {grab set .bugreport} 168 184 update 169 185 } … … 474 490 package require http 475 491 package require tls 476 http::register https 443 ::tls::socket492 http::register https 443 [list ::tls::socket -tls1 1] 477 493 478 494 set report $details(stackTrace) -
branches/r9/gui/scripts/cloud.tcl
r4133 r4919 128 128 foreach label [$_cloud get labels] axis { x y z } { 129 129 if { $label != "" } { 130 set _axis2label s($axis) $label130 set _axis2label($axis) $label 131 131 } else { 132 set _axis2label s($axis) [string toupper $axis]132 set _axis2label($axis) [string toupper $axis] 133 133 } 134 134 } … … 149 149 foreach {x y z} $line break 150 150 foreach axis {x y z} units $_units { 151 set value [Rappture::Units::convert [set $axis] \ 151 if { $units == "" } { 152 set value [set $axis] 153 } else { 154 set value [Rappture::Units::convert [set $axis] \ 152 155 -context $units -to $units -units off] 156 } 153 157 set $axis $value; # Set the (x/y/z) coordinate to 154 158 # converted value. … … 266 270 # 267 271 itcl::body Rappture::Cloud::label { axis } { 268 if { ![info exists axis2label($axis)] } {272 if { ![info exists _axis2label($axis)] } { 269 273 return "" 270 274 } 271 return $ axis2label($axis)275 return $_axis2label($axis) 272 276 } 273 277 -
branches/r9/gui/scripts/curve.tcl
r4042 r4919 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/r9/gui/scripts/drawing.tcl
r4002 r4919 1 1 # -*- mode: tcl; indent-tabs-mode: nil -*- 2 3 # ---------------------------------------------------------------------- 4 # COMPONENT: drawing - 2D drawing of data 2 # ---------------------------------------------------------------------- 3 # COMPONENT: drawing - 3D drawing of data 5 4 # ====================================================================== 6 5 # AUTHOR: Michael McLennan, Purdue University … … 20 19 private variable _drawing 21 20 private variable _xmlobj 22 private variable _actors23 21 private variable _styles 24 22 private variable _shapes … … 28 26 private variable _hints 29 27 private variable _units 30 private variable _limits31 28 32 29 constructor {xmlobj path} { … … 36 33 # defined below 37 34 } 38 public method limits {axis} 35 39 36 public method label { elem } 40 37 public method type { elem } … … 63 60 set xunits "um" 64 61 } 65 array set _limits {66 xMin 067 xMax 068 yMin 069 yMax 070 zMin 071 zMax 072 }73 62 # determine the overall size of the device 74 63 foreach elem [$_xmlobj children $path] { 75 64 switch -glob -- $elem { 76 polygon* { 77 set _data($elem) [$_xmlobj get $path.$elem.vtk] 78 set _data($elem) [string trim $_data($elem)] 79 set _styles($elem) [$_xmlobj get $path.$elem.about.style] 80 set _labels($elem) [$_xmlobj get $path.$elem.about.label] 81 set _types($elem) polydata 82 } 83 polydata* { 65 # polygon is deprecated in favor of polydata 66 polygon* - polydata* { 84 67 set _data($elem) [$_xmlobj get $path.$elem.vtk] 85 68 set _data($elem) [string trim $_data($elem)] … … 87 70 set _labels($elem) [$_xmlobj get $path.$elem.about.label] 88 71 set _types($elem) polydata 89 }90 streamlines* {91 set _data($elem) [$_xmlobj get $path.$elem.vtk]92 set _data($elem) [string trim $_data($elem)]93 set _styles($elem) [$_xmlobj get $path.$elem.about.style]94 set _labels($elem) [$_xmlobj get $path.$elem.about.label]95 set _types($elem) streamlines96 72 } 97 73 glyphs* { … … 250 226 251 227 # ---------------------------------------------------------------------- 252 # method limits <axis>253 # Returns a list {min max} representing the limits for the254 # specified axis.255 # ----------------------------------------------------------------------256 itcl::body Rappture::Drawing::limits {which} {257 set min ""258 set max ""259 foreach key [array names _data] {260 set actor $_actors($key)261 foreach key { xMin xMax yMin yMax zMin zMax} value [$actor GetBounds] {262 set _limits($key) $value263 }264 break265 }266 267 foreach key [array names _actors] {268 set actor $_actors($key)269 foreach { xMin xMax yMin yMax zMin zMax} [$actor GetBounds] break270 if { $xMin < $_limits(xMin) } {271 set _limits(xMin) $xMin272 }273 if { $xMax > $_limits(xMax) } {274 set _limits(xMax) $xMax275 }276 if { $yMin < $_limits(yMin) } {277 set _limits(yMin) $yMin278 }279 if { $yMax > $_limits(yMax) } {280 set _limits(yMax) $yMax281 }282 if { $zMin < $_limits(zMin) } {283 set _limits(zMin) $zMin284 }285 if { $zMax > $_limits(zMax) } {286 set _limits(zMax) $zMax287 }288 }289 switch -- $which {290 x {291 set min $_limits(xMin)292 set max $_limits(xMax)293 set axis "xaxis"294 }295 y {296 set min $_limits(yMin)297 set max $_limits(yMax)298 set axis "yaxis"299 }300 v - z {301 set min $_limits(zMin)302 set max $_limits(zMax)303 set axis "zaxis"304 }305 default {306 error "unknown axis description \"$which\""307 }308 }309 return [list $min $max]310 }311 312 # ----------------------------------------------------------------------313 228 # USAGE: hints ?<keyword>? 314 229 # … … 340 255 return [array get _hints] 341 256 } 342 -
branches/r9/gui/scripts/drawingentry.tcl
r4176 r4919 146 146 } 147 147 if {$name eq ""} { 148 puts stderr "no name defined for substitu ion variable \"$cpath\""148 puts stderr "no name defined for substitution variable \"$cpath\"" 149 149 continue 150 150 } … … 672 672 itcl::body Rappture::DrawingEntry::ParsePolygon { cpath cname } { 673 673 array set attr2option { 674 "outline" "-outline" 675 "color" "-fill" 676 "fill" "-fill" 674 677 "linewidth" "-width" 675 "color" "-fill"676 678 } 677 679 # Set default options first and then let tool.xml override them. -
branches/r9/gui/scripts/field.tcl
r4251 r4919 1 1 # -*- mode: tcl; indent-tabs-mode: nil -*- 2 3 2 # ---------------------------------------------------------------------- 4 3 # COMPONENT: field - extracts data from an XML description of a field … … 82 81 # valid data. 83 82 private variable _isValidComponent; # Array of valid components found 83 private variable _alwaysConvertDX 0; 84 84 85 constructor {xmlobj path} { 85 86 # defined below … … 152 153 private method AvsToVtk { cname contents } 153 154 private method DicomToVtk { cname contents } 154 private method DicomToVtk.old { cname contents }155 155 private method BuildPointsOnMesh { cname } 156 156 protected method GetAssociation { cname } … … 321 321 } 322 322 if {[info exists _comp2dx($cname)]} { 323 return "" ;# no mesh -- it's embedded in the valuedata323 return "" ;# no mesh -- it's embedded in the blob data 324 324 } 325 325 if {[info exists _comp2mesh($cname)]} { … … 365 365 } 366 366 if {[info exists _comp2dx($cname)]} { 367 error "method \"values\" is not implemented for dx data"367 error "method \"values\" is not implemented for dx file data" 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)]} { … … 392 392 } 393 393 if {[info exists _comp2dx($cname)]} { 394 return $_comp2dx($cname) 394 return $_comp2dx($cname) ;# return gzipped, base64-encoded DX data 395 395 } 396 396 if {[info exists _comp2unirect2d($cname)]} { … … 405 405 } 406 406 407 # ---------------------------------------------------------------------- 408 # USAGE: valueLimits <cname> 409 # 410 # Returns an array for the requested component with a list {min max} 411 # representing the limits for each axis. 412 # ---------------------------------------------------------------------- 407 413 itcl::body Rappture::Field::valueLimits { cname } { 408 414 if { [info exists _comp2limits($cname)] } { … … 421 427 set min "" 422 428 set max "" 423 blt::vector tmp zero424 429 425 430 foreach cname [array names _comp2dims] { … … 447 452 448 453 if {$log} { 449 # on a log scale, use abs value and ignore 0's 454 blt::vector tmp zero 455 # on a log scale, use abs value and ignore zeros 450 456 $vname dup tmp 451 457 $vname dup zero 452 zero expr {tmp == 0} ;# find the 0's458 zero expr {tmp == 0} ;# find the zeros 453 459 tmp expr {abs(tmp)} ;# get the abs value 454 tmp expr {tmp + zero*max(tmp)} ;# replace 0 's with abs max460 tmp expr {tmp + zero*max(tmp)} ;# replace 0s with abs max 455 461 set axisMin [blt::vector expr min(tmp)] 456 462 set axisMax [blt::vector expr max(tmp)] 463 blt::vector destroy tmp zero 457 464 } else { 458 465 set axisMin [$vname min] … … 471 478 } 472 479 } 473 2D - 3D{480 default { 474 481 if {[info exists _comp2limits($cname)]} { 475 482 array set limits $_comp2limits($cname) … … 513 520 } 514 521 } 515 blt::vector destroy tmp zero516 522 set val [$_field get "${axis}axis.min"] 517 523 if {"" != $val && "" != $min} { … … 531 537 } 532 538 533 534 539 # ---------------------------------------------------------------------- 535 540 # USAGE: fieldlimits … … 541 546 foreach cname [array names _comp2limits] { 542 547 array set limits $_comp2limits($cname) 543 foreach fname $_comp2fldName($cname){548 foreach fname [fieldnames $cname] { 544 549 if { ![info exists limits($fname)] } { 545 550 puts stderr "ERROR: field \"$fname\" unknown in \"$cname\"" … … 805 810 set _comp2style($cname) "" 806 811 if { $type == "" } { 807 puts stderr "WARNING: ignoring field component \"$_path.$cname\": no data found."812 puts stderr "WARNING: Ignoring field component \"$_path.$cname\": no data found." 808 813 continue 809 814 } … … 881 886 set contents [$_field get $cname.vtk] 882 887 if { $contents == "" } { 883 puts stderr "WARNING: no data fo\"$_path.$cname.vtk\""888 puts stderr "WARNING: No data for \"$_path.$cname.vtk\"" 884 889 continue; # Ignore this component 885 890 } … … 899 904 } 900 905 if { $_viewer == "" } { 901 set _viewer "nanovis" 906 if {[$_field element $cname.flow] != ""} { 907 set _viewer "flowvis" 908 } else { 909 set _viewer "nanovis" 910 } 902 911 } 903 912 set _dim 3 … … 906 915 set contents [Rappture::encoding::decode -as zb64 $data] 907 916 if { $contents == "" } { 908 puts stderr "WARNING: no data for \"$_path.$cname.$type\""917 puts stderr "WARNING: No data for \"$_path.$cname.$type\"" 909 918 continue; # Ignore this component 910 919 } 911 set vector ""912 920 if 0 { 913 921 set f [open /tmp/$_path.$cname.dx "w"] … … 915 923 close $f 916 924 } 917 # This is temporary. I put a check for this in the DxToVtk918 # parser.919 if { [string range $contents 0 3] == "<DX>" } {920 set contents [string range $contents 4 end]921 }922 925 if { [catch { Rappture::DxToVtk $contents } vtkdata] == 0 } { 923 926 ReadVtkDataSet $cname $vtkdata 927 if 0 { 928 set f [open /tmp/$_path.$cname.vtk "w"] 929 puts -nonewline $f $vtkdata 930 close $f 931 } 924 932 } else { 925 933 puts stderr "Can't parse dx data: $vtkdata" 926 934 } 927 if 0 { 928 set f [open /tmp/$_path.$cname.vtk "w"] 929 puts -nonewline $f $vtkdata 930 close $f 931 } 932 if { $_viewer != "nanovis" && $_viewer != "flowvis" } { 935 if { $_alwaysConvertDX || 936 ($_viewer != "nanovis" && $_viewer != "flowvis") } { 933 937 set _type "vtk" 934 938 set _comp2vtk($cname) $vtkdata … … 942 946 [Rappture::FlowHints ::\#auto $_field $cname $_units] 943 947 } 944 set _dim 3945 948 incr _counter 946 949 } elseif { $type == "dicom"} { … … 975 978 } 976 979 if { [array size _isValidComponent] == 0 } { 977 puts stderr " WARNING: no valid components for field \"$_path\""980 puts stderr "ERROR: All components of field \"$_path\" are invalid." 978 981 return 0 979 982 } … … 987 990 } 988 991 if { $dim != $_comp2dims($cname) } { 989 puts stderr "WARNING: field can't have components of different dimensions: [join [array get _comp2dims] ,]"992 puts stderr "WARNING: A field can't have components of different dimensions: [join [array get _comp2dims] ,]" 990 993 return 0 991 994 } … … 1184 1187 set dataAttrs [$dataset GetPointData] 1185 1188 if { $dataAttrs == ""} { 1186 puts stderr "WARNING: no point data found in \"$_path\""1189 puts stderr "WARNING: No point data found in \"$_path\"" 1187 1190 rename $reader "" 1188 1191 return 0 … … 1247 1250 set dataAttrs [$dataset GetPointData] 1248 1251 if { $dataAttrs == ""} { 1249 puts stderr "WARNING: no point data found in \"$_path\""1252 puts stderr "WARNING: No point data found in \"$_path\"" 1250 1253 rename $reader "" 1251 1254 return 0 … … 1253 1256 set array [$dataAttrs GetScalars] 1254 1257 if { $array == ""} { 1255 puts stderr "WARNING: no scalar point data found in \"$_path\""1258 puts stderr "WARNING: No scalar point data found in \"$_path\"" 1256 1259 rename $reader "" 1257 1260 return 0 … … 1269 1272 set dataAttrs [$dataset GetPointData] 1270 1273 if { $dataAttrs == ""} { 1271 puts stderr "WARNING: no point data found in \"$_path\""1274 puts stderr "WARNING: No point data found in \"$_path\"" 1272 1275 rename $reader "" 1273 1276 return 0 … … 1509 1512 set dim 0 1510 1513 foreach axis {x y z} { 1511 foreach {min max} [$mesh limits $axis] { 1514 foreach {min max} [$mesh limits $axis] { 1512 1515 if { $min < $max } { 1513 1516 incr dim … … 1540 1543 # sort x-coords in increasing order 1541 1544 $xv sort $yv 1542 1543 1545 set _comp2dims($cname) "1D" 1544 1546 set _comp2xy($cname) [list $xv $yv] … … 1556 1558 set _viewer "contour" 1557 1559 } 1560 set numFieldValues [$v length] 1561 set numComponentsPerTuple [numComponents $cname] 1562 if { [expr $numFieldValues % $numComponentsPerTuple] != 0 } { 1563 puts stderr "ERROR: Number of field values ($numFieldValues) not divisble by elemsize ($numComponentsPerTuple)" 1564 return 0 1565 } 1566 set numFieldTuples [expr $numFieldValues / $numComponentsPerTuple] 1567 if { $_comp2assoc($cname) == "pointdata" } { 1568 set numPoints [$mesh numpoints] 1569 if { $numPoints != $numFieldTuples } { 1570 puts stderr "ERROR: Number of points in mesh ($numPoints) and number of field tuples ($numFieldTuples) don't agree" 1571 return 0 1572 } 1573 } elseif { $_comp2assoc($cname) == "celldata" } { 1574 set numCells [$mesh numcells] 1575 if { $numCells != $numFieldTuples } { 1576 puts stderr "ERROR: Number of cells in mesh ($numCells) and number of field tuples ($numFieldTuples) don't agree" 1577 return 0 1578 } 1579 } 1558 1580 set _comp2dims($cname) "[$mesh dimensions]D" 1559 1581 set _comp2mesh($cname) [list $mesh $v] … … 1583 1605 return 0 1584 1606 } 1607 set numFieldValues [$v length] 1608 set numComponentsPerTuple [numComponents $cname] 1609 if { [expr $numFieldValues % $numComponentsPerTuple] != 0 } { 1610 puts stderr "ERROR: Number of field values ($numFieldValues) not divisble by elemsize ($numComponentsPerTuple)" 1611 return 0 1612 } 1613 set numFieldTuples [expr $numFieldValues / $numComponentsPerTuple] 1614 if { $_comp2assoc($cname) == "pointdata" } { 1615 set numPoints [$mesh numpoints] 1616 if { $numPoints != $numFieldTuples } { 1617 puts stderr "ERROR: Number of points in mesh ($numPoints) and number of field tuples ($numFieldTuples) don't agree" 1618 return 0 1619 } 1620 } elseif { $_comp2assoc($cname) == "celldata" } { 1621 set numCells [$mesh numcells] 1622 if { $numCells != $numFieldTuples } { 1623 puts stderr "ERROR: Number of cells in mesh ($numCells) and number of field tuples ($numFieldTuples) don't agree" 1624 return 0 1625 } 1626 } 1585 1627 set _comp2dims($cname) "[$mesh dimensions]D" 1586 1628 set _comp2mesh($cname) [list $mesh $v] … … 1659 1701 } 1660 1702 1661 foreach key [array names data] { 1662 if {$key == "vtkdata"} { 1663 if {1} { 1664 set f [open /tmp/$cname.vtk "w"] 1665 fconfigure $f -translation binary -encoding binary 1666 puts -nonewline $f $data(vtkdata) 1667 close $f 1668 } 1669 } else { 1670 puts stderr "$key = \"$data($key)\"" 1703 if 0 { 1704 foreach key [array names data] { 1705 if {$key == "vtkdata"} { 1706 if 0 { 1707 set f [open /tmp/$cname.vtk "w"] 1708 fconfigure $f -translation binary -encoding binary 1709 puts -nonewline $f $data(vtkdata) 1710 close $f 1711 } 1712 } else { 1713 puts stderr "$key = \"$data($key)\"" 1714 } 1671 1715 } 1672 1716 } … … 1678 1722 set _viewer $viewer 1679 1723 return $data(vtkdata) 1680 }1681 1682 itcl::body Rappture::Field::DicomToVtk.old { cname path } {1683 package require vtk1684 1685 if { ![file exists $path] } {1686 puts stderr "path \"$path\" doesn't exist."1687 return 01688 }1689 set reader $this-datasetreader1690 vtkDICOMImageReader $reader1691 if { [file isdir $path] } {1692 set files [glob -nocomplain $path/*.dcm]1693 if { [llength $files] == 0 } {1694 puts stderr "no dicom files found in \"$path\""1695 #return 01696 }1697 $reader SetDirectoryName $path1698 } else {1699 $reader SetFileName $path1700 }1701 $reader Update1702 1703 set dataset [$reader GetOutput]1704 set limits {}1705 foreach {xmin xmax ymin ymax zmin zmax} [$dataset GetBounds] break1706 set _dim 01707 if { $xmax > $xmin } {1708 incr _dim1709 }1710 if { $ymax > $ymin } {1711 incr _dim1712 }1713 if { $zmax > $zmin } {1714 incr _dim1715 }1716 1717 set _comp2dims($cname) "${_dim}D"1718 1719 lappend limits x [list $xmin $xmax]1720 lappend limits y [list $ymin $ymax]1721 lappend limits z [list $zmin $zmax]1722 set dataAttrs [$dataset GetPointData]1723 if { $dataAttrs == ""} {1724 puts stderr "WARNING: no point data found in \"$_path\""1725 rename $reader ""1726 return 01727 }1728 set vmin 01729 set vmax 11730 set numArrays [$dataAttrs GetNumberOfArrays]1731 if { $numArrays > 0 } {1732 for {set i 0} {$i < [$dataAttrs GetNumberOfArrays] } {incr i} {1733 set array [$dataAttrs GetArray $i]1734 set fname [$dataAttrs GetArrayName $i]1735 foreach {min max} [$array GetRange -1] break1736 if {$i == 0} {1737 set vmin $min1738 set vmax $max1739 }1740 lappend limits $fname [list $min $max]1741 set _fld2Units($fname) ""1742 set _fld2Label($fname) $fname1743 # Let the VTK file override the <type> designated.1744 set _fld2Components($fname) [$array GetNumberOfComponents]1745 lappend _comp2fldName($cname) $fname1746 }1747 }1748 lappend limits v [list $vmin $vmax]1749 set _comp2limits($cname) $limits1750 1751 set tmpfile $this-$cname.vtk1752 set writer $this-datasetwriter1753 vtkDataSetWriter $writer1754 $writer SetInputConnection [$reader GetOutputPort]1755 $writer SetFileName $tmpfile1756 $writer SetFileTypeToBinary1757 $writer Write1758 rename $reader ""1759 rename $writer ""1760 1761 set f [open "$tmpfile" "r"]1762 fconfigure $f -translation binary -encoding binary1763 set vtkdata [read $f]1764 close $f1765 file delete $tmpfile1766 return $vtkdata1767 1724 } 1768 1725 -
branches/r9/gui/scripts/fieldresult.tcl
r4344 r4919 156 156 # ---------------------------------------------------------------------- 157 157 itcl::body Rappture::FieldResult::add {dataobj {settings ""}} { 158 if { ![info exists itk_component(renderer)] } { 159 puts stderr "add: no renderer created." 160 return 161 } 158 162 eval $itk_component(renderer) add $dataobj [list $settings] 159 163 } … … 166 170 # ---------------------------------------------------------------------- 167 171 itcl::body Rappture::FieldResult::get {} { 172 if { ![info exists itk_component(renderer)] } { 173 puts stderr "get: no renderer created." 174 return 175 } 168 176 return [$itk_component(renderer) get] 169 177 } … … 191 199 # ---------------------------------------------------------------------- 192 200 itcl::body Rappture::FieldResult::scale {args} { 201 if { ![info exists itk_component(renderer)] } { 202 puts stderr "scale: no renderer created." 203 return 204 } 193 205 eval $itk_component(renderer) scale $args 194 206 } … … 205 217 # ---------------------------------------------------------------------- 206 218 itcl::body Rappture::FieldResult::download {option args} { 219 if { ![info exists itk_component(renderer)] } { 220 puts stderr "download: no renderer created." 221 return 222 } 207 223 eval $itk_component(renderer) download $option $args 208 224 } 209 225 210 226 itcl::body Rappture::FieldResult::snap { w h } { 227 if { ![info exists itk_component(renderer)] } { 228 puts stderr "snap: no renderer created." 229 return 230 } 211 231 return [$itk_component(renderer) snap $w $h] 212 232 } -
branches/r9/gui/scripts/flowvisviewer.tcl
r4336 r4919 250 250 $this-streams 0 251 251 $this-volume 1 252 $this-ambient 60 253 $this-diffuse 40 254 $this-light2side 1 255 $this-opacity 100 256 $this-specularLevel 30 257 $this-specularExponent 90 258 $this-thickness 350 259 $this-transp 50 260 $this-cutplaneVisible 0 261 $this-xcutplane 1 252 $this-xcutplane 0 262 253 $this-xcutposition 0 263 $this-ycutplane 1254 $this-ycutplane 0 264 255 $this-ycutposition 0 265 $this-zcutplane 1256 $this-zcutplane 0 266 257 $this-zcutposition 0 267 258 }] … … 324 315 "Toggle the volume cloud on/off" 325 316 pack $itk_component(volume) -padx 2 -pady 2 326 327 itk_component add cutplane {328 Rappture::PushButton $f.cutplane \329 -onimage [Rappture::icon cutbutton] \330 -offimage [Rappture::icon cutbutton] \331 -variable [itcl::scope _settings($this-cutplaneVisible)] \332 -command [itcl::code $this AdjustSetting cutplaneVisible]333 }334 Rappture::Tooltip::for $itk_component(cutplane) \335 "Show/Hide cutplanes"336 pack $itk_component(cutplane) -padx 2 -pady 2337 317 338 318 if { [catch { … … 736 716 # ---------------------------------------------------------------------- 737 717 itcl::body Rappture::FlowvisViewer::scale {args} { 738 array set style {718 array set styles { 739 719 -color BCGYR 740 720 -levels 6 721 -markers "" 741 722 -opacity 1.0 742 -markers ""743 723 } 744 724 array unset _limits … … 751 731 if { ![info exists _volcomponents($cname)] } { 752 732 lappend _componentsList $cname 753 array set style [lindex [$dataobj components -style $cname] 0]754 set cmap [ColorsToColormap $style (-color)]733 array set styles [lindex [$dataobj components -style $cname] 0] 734 set cmap [ColorsToColormap $styles(-color)] 755 735 set _cname2defaultcolormap($cname) $cmap 756 set _settings($cname-colormap) $style (-color)736 set _settings($cname-colormap) $styles(-color) 757 737 } 758 738 lappend _volcomponents($cname) $dataobj-$cname … … 904 884 set session $env(SESSION) 905 885 } 886 lappend info "version" "$Rappture::version" 887 lappend info "build" "$Rappture::build" 888 lappend info "svnurl" "$Rappture::svnurl" 889 lappend info "installdir" "$Rappture::installdir" 906 890 lappend info "hub" [exec hostname] 907 891 lappend info "client" "flowvisviewer" … … 1057 1041 set tf $_obj2style($tag) 1058 1042 foreach {vmin vmax} [limits $tf] break 1059 $c itemconfigure vmin -text [format % .2g $vmin]1043 $c itemconfigure vmin -text [format %g $vmin] 1060 1044 $c coords vmin $lx $ly 1061 1045 1062 $c itemconfigure vmax -text [format % .2g $vmax]1046 $c itemconfigure vmax -text [format %g $vmax] 1063 1047 $c coords vmax [expr {$w-$lx}] $ly 1064 1048 … … 1189 1173 set _first [lindex [get] 0] 1190 1174 1191 foreach axis {x y z} {1192 # Turn off cutplanes for all volumes1193 SendCmd "cutplane state 0 $axis"1194 }1195 1196 1175 # Reset the camera and other view parameters 1197 InitSettings light2side ambient diffuse specularLevel specularExponent \ 1198 transp isosurface grid axes volume outline \ 1199 cutplaneVisible xcutplane ycutplane zcutplane 1200 1176 InitSettings light2side light transp isosurface grid axes volume outline 1177 1201 1178 # nothing to send -- activate the proper volume 1202 1179 if {"" != $_first} { 1180 AdjustSetting light 1181 AdjustSetting transp 1203 1182 set axis [$_first hints updir] 1204 1183 if {"" != $axis} { … … 1251 1230 set vols [CurrentVolumeIds -cutplanes] 1252 1231 foreach axis {x y z} { 1232 SendCmd "cutplane state $_settings($this-${axis}cutplane) $axis $vols" 1253 1233 set pos [expr {0.01*$_settings($this-${axis}cutposition)}] 1254 1234 SendCmd "cutplane position $pos $axis $vols" … … 1279 1259 foreach key [array names _serverObjs *-*] { 1280 1260 if {[string match $_first-* $key]} { 1281 array set style {1261 array set styles { 1282 1262 -cutplanes 1 1283 1263 } 1284 1264 foreach {dataobj comp} [split $key -] break 1285 array set style [lindex [$dataobj components -style $comp] 0]1286 if {$what != "-cutplanes" || $style (-cutplanes)} {1265 array set styles [lindex [$dataobj components -style $comp] 0] 1266 if {$what != "-cutplanes" || $styles(-cutplanes)} { 1287 1267 lappend rlist $_serverObjs($key) 1288 1268 } … … 1575 1555 #ResetColormap $color 1576 1556 } 1577 ambient {1557 light { 1578 1558 if { $_first != "" } { 1579 1559 set comp [lindex [$_first components] 0] 1580 1560 set tag $_first-$comp 1581 set val $_settings($this-ambient) 1582 set val [expr {0.01*$val}] 1583 SendCmd "$tag configure -ambient $val" 1584 } 1585 } 1586 diffuse { 1587 if { $_first != "" } { 1588 set comp [lindex [$_first components] 0] 1589 set tag $_first-$comp 1590 set val $_settings($this-diffuse) 1591 set val [expr {0.01*$val}] 1592 SendCmd "$tag configure -diffuse $val" 1593 } 1594 } 1595 specularLevel { 1596 if { $_first != "" } { 1597 set comp [lindex [$_first components] 0] 1598 set tag $_first-$comp 1599 set val $_settings($this-specularLevel) 1600 set val [expr {0.01*$val}] 1601 SendCmd "$tag configure -specularLevel $val" 1602 } 1603 } 1604 specularExponent { 1605 if { $_first != "" } { 1606 set comp [lindex [$_first components] 0] 1607 set tag $_first-$comp 1608 set val $_settings($this-specularExponent) 1609 SendCmd "$tag configure -specularExp $val" 1561 set diffuse [expr {0.01*$_settings($this-light)}] 1562 set ambient [expr {1.0 - $diffuse}] 1563 set specularLevel 0.3 1564 set specularExp 90.0 1565 SendCmd "$tag configure -ambient $ambient -diffuse $diffuse -specularLevel $specularLevel -specularExp $specularExp" 1610 1566 } 1611 1567 } … … 1683 1639 SendCmd "$tag configure -volume $_settings($this-volume)" 1684 1640 } 1685 }1686 "cutplaneVisible" {1687 set bool $_settings($this-$what)1688 set datasets [CurrentVolumeIds -cutplanes]1689 set tag [lindex $datasets 0]1690 SendCmd "cutplane visible $bool $tag"1691 1641 } 1692 1642 "xcutplane" - "ycutplane" - "zcutplane" { … … 1757 1707 # 1758 1708 itcl::body Rappture::FlowvisViewer::NameTransferFunc { dataobj cname } { 1759 array set style { 1709 array set styles { 1710 -color BCGYR 1711 -levels 6 1712 -light 40 1713 -opacity 1.0 1714 -transp 50 1715 } 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 1723 } 1724 1725 # 1726 # ComputeTransferFunc -- 1727 # 1728 # Computes and sends the transfer function to the render server. It's 1729 # assumed that the volume data limits are known and that the global 1730 # transfer-functions slider values have be setup. Both parts are 1731 # needed to compute the relative value (location) of the marker, and 1732 # the alpha map of the transfer function. 1733 # 1734 itcl::body Rappture::FlowvisViewer::ComputeTransferFunc { tf } { 1735 array set styles { 1760 1736 -color BCGYR 1761 1737 -levels 6 … … 1764 1740 -transp 50 1765 1741 } 1766 array set style [lindex [$dataobj components -style $cname] 0]1767 set _settings($this-light) $style(-light)1768 set _settings($this-transp) $style(-transp)1769 set _settings($this-opacity) [expr $style(-opacity) * 100]1770 set _obj2style($dataobj-$cname) $cname1771 lappend _style2objs($cname) $dataobj $cname1772 return $cname1773 }1774 1775 #1776 # ComputeTransferFunc --1777 #1778 # Computes and sends the transfer function to the render server. It's1779 # assumed that the volume data limits are known and that the global1780 # transfer-functions slider values have be setup. Both parts are1781 # needed to compute the relative value (location) of the marker, and1782 # the alpha map of the transfer function.1783 #1784 itcl::body Rappture::FlowvisViewer::ComputeTransferFunc { tf } {1785 array set style {1786 -color BCGYR1787 -levels 61788 -opacity 1.01789 -light 401790 -transp 501791 }1792 1742 set dataobj ""; set comp "" 1793 1743 foreach {dataobj comp} $_style2objs($tf) break … … 1795 1745 return 0 1796 1746 } 1797 array set style [lindex [$dataobj components -style $comp] 0]1747 array set styles [lindex [$dataobj components -style $comp] 0] 1798 1748 1799 1749 … … 1813 1763 if { ![info exists _isomarkers($tf)] } { 1814 1764 # Have to defer creation of isomarkers until we have data limits 1815 if { [info exists style (-markers)] &&1816 [llength $style (-markers)] > 0 } {1817 ParseMarkersOption $tf $style (-markers)1765 if { [info exists styles(-markers)] && 1766 [llength $styles(-markers)] > 0 } { 1767 ParseMarkersOption $tf $styles(-markers) 1818 1768 } else { 1819 ParseLevelsOption $tf $style (-levels)1820 } 1821 } 1822 if { [info exists style (-nonuniformcolors)] } {1823 foreach { value color } $style (-nonuniformcolors) {1769 ParseLevelsOption $tf $styles(-levels) 1770 } 1771 } 1772 if { [info exists styles(-nonuniformcolors)] } { 1773 foreach { value color } $styles(-nonuniformcolors) { 1824 1774 append cmap "$value [Color2RGB $color] " 1825 1775 } 1826 1776 } else { 1827 set cmap [ColorsToColormap $style (-color)]1777 set cmap [ColorsToColormap $styles(-color)] 1828 1778 } 1829 1779 set tag $this-$tf 1830 1780 if { ![info exists _settings($tag-opacity)] } { 1831 set _settings($tag-opacity) $style (-opacity)1781 set _settings($tag-opacity) $styles(-opacity) 1832 1782 } 1833 1783 set max 1.0 ;#$_settings($tag-opacity) … … 2173 2123 2174 2124 itcl::body Rappture::FlowvisViewer::BuildVolumeTab {} { 2125 foreach { key value } { 2126 light2side 1 2127 light 40 2128 transp 50 2129 opacity 100 2130 thickness 350 2131 } { 2132 set _settings($this-$key) $value 2133 } 2134 2175 2135 set inner [$itk_component(main) insert end \ 2176 2136 -title "Volume Settings" \ … … 2193 2153 -command [itcl::code $this AdjustSetting light2side] 2194 2154 2195 label $inner. ambient_l -text "Ambient" -font $fg2196 ::scale $inner. ambient -from 0 -to 100 -orient horizontal \2197 -variable [itcl::scope _settings($this- ambient)] \2155 label $inner.dim -text "Glow" -font $fg 2156 ::scale $inner.light -from 0 -to 100 -orient horizontal \ 2157 -variable [itcl::scope _settings($this-light)] \ 2198 2158 -width 10 \ 2199 -showvalue off -command [itcl::code $this AdjustSetting ambient] 2200 2201 label $inner.diffuse_l -text "Diffuse" -font $fg 2202 ::scale $inner.diffuse -from 0 -to 100 -orient horizontal \ 2203 -variable [itcl::scope _settings($this-diffuse)] \ 2204 -width 10 \ 2205 -showvalue off -command [itcl::code $this AdjustSetting diffuse] 2206 2207 label $inner.specularLevel_l -text "Specular" -font $fg 2208 ::scale $inner.specularLevel -from 0 -to 100 -orient horizontal \ 2209 -variable [itcl::scope _settings($this-specularLevel)] \ 2210 -width 10 \ 2211 -showvalue off -command [itcl::code $this AdjustSetting specularLevel] 2212 2213 label $inner.specularExponent_l -text "Shininess" -font $fg 2214 ::scale $inner.specularExponent -from 10 -to 128 -orient horizontal \ 2215 -variable [itcl::scope _settings($this-specularExponent)] \ 2216 -width 10 \ 2217 -showvalue off -command [itcl::code $this AdjustSetting specularExponent] 2218 2219 label $inner.clear -text "Clear" -font $fg 2159 -showvalue off -command [itcl::code $this AdjustSetting light] 2160 label $inner.bright -text "Surface" -font $fg 2161 2162 label $inner.fog -text "Clear" -font $fg 2220 2163 ::scale $inner.transp -from 0 -to 100 -orient horizontal \ 2221 2164 -variable [itcl::scope _settings($this-transp)] \ 2222 2165 -width 10 \ 2223 2166 -showvalue off -command [itcl::code $this AdjustSetting transp] 2167 label $inner.plastic -text "Opaque" -font $fg 2168 2169 label $inner.clear -text "Clear" -font $fg 2170 ::scale $inner.opacity -from 0 -to 100 -orient horizontal \ 2171 -variable [itcl::scope _settings($this-opacity)] \ 2172 -width 10 \ 2173 -showvalue off -command [itcl::code $this AdjustSetting opacity] 2224 2174 label $inner.opaque -text "Opaque" -font $fg 2225 2175 … … 2235 2185 Rappture::Combobox $inner.colormap -width 10 -editable no 2236 2186 } 2187 2237 2188 $inner.colormap choices insert end [GetColormapList -includeNone] 2238 2189 $itk_component(colormap) value "BCGYR" … … 2244 2195 1,0 $inner.shading -cspan 4 -anchor w -pady {10 2} \ 2245 2196 2,0 $inner.light2side -cspan 4 -anchor w -pady 2 \ 2246 3,0 $inner.ambient_l -anchor e -pady 2 \ 2247 3,1 $inner.ambient -cspan 3 -pady 2 -fill x \ 2248 4,0 $inner.diffuse_l -anchor e -pady 2 \ 2249 4,1 $inner.diffuse -cspan 3 -pady 2 -fill x \ 2250 5,0 $inner.specularLevel_l -anchor e -pady 2 \ 2251 5,1 $inner.specularLevel -cspan 3 -pady 2 -fill x \ 2252 6,0 $inner.specularExponent_l -anchor e -pady 2 \ 2253 6,1 $inner.specularExponent -cspan 3 -pady 2 -fill x \ 2254 7,0 $inner.clear -anchor e -pady 2 \ 2255 7,1 $inner.transp -cspan 2 -pady 2 -fill x \ 2256 7,3 $inner.opaque -anchor w -pady 2 \ 2257 8,0 $inner.thin -anchor e -pady 2 \ 2258 8,1 $inner.thickness -cspan 2 -pady 2 -fill x \ 2259 8,3 $inner.thick -anchor w -pady 2 2197 3,0 $inner.dim -anchor e -pady 2 \ 2198 3,1 $inner.light -cspan 2 -pady 2 -fill x \ 2199 3,3 $inner.bright -anchor w -pady 2 \ 2200 4,0 $inner.fog -anchor e -pady 2 \ 2201 4,1 $inner.transp -cspan 2 -pady 2 -fill x \ 2202 4,3 $inner.plastic -anchor w -pady 2 \ 2203 5,0 $inner.thin -anchor e -pady 2 \ 2204 5,1 $inner.thickness -cspan 2 -pady 2 -fill x\ 2205 5,3 $inner.thick -anchor w -pady 2 2260 2206 2261 2207 blt::table configure $inner c0 c1 c3 r* -resize none 2262 blt::table configure $inner r 9-resize expand2208 blt::table configure $inner r6 -resize expand 2263 2209 } 2264 2210 … … 2279 2225 Rappture::Tooltip::for $itk_component(xCutButton) \ 2280 2226 "Toggle the X cut plane on/off" 2281 $itk_component(xCutButton) select2282 2227 2283 2228 itk_component add xCutScale { … … 2307 2252 Rappture::Tooltip::for $itk_component(yCutButton) \ 2308 2253 "Toggle the Y cut plane on/off" 2309 $itk_component(yCutButton) select2310 2254 2311 2255 itk_component add yCutScale { … … 2335 2279 Rappture::Tooltip::for $itk_component(zCutButton) \ 2336 2280 "Toggle the Z cut plane on/off" 2337 $itk_component(zCutButton) select2338 2281 2339 2282 itk_component add zCutScale { -
branches/r9/gui/scripts/grab.tcl
r3330 r4919 39 39 # ---------------------------------------------------------------------- 40 40 rename grab _tk_grab 41 proc grab { args} {41 proc grab { args } { 42 42 set op [lindex $args 0] 43 43 if {[winfo exists $op]} { … … 54 54 set state $::Rappture::grab::state 55 55 set window [lindex $args end] 56 56 57 if {[lsearch -exact $args -global] >= 0} { 57 58 set state "-global" … … 91 92 92 93 # and set the next one 93 if { "" != $window} {94 if {[lindex $window 0] != "-global"} {95 # no more global grabs -- resume local grabs96 set ::Rappture::grab::state ""97 }94 if {[lindex $window 0] != "-global"} { 95 # no more global grabs -- resume local grabs 96 set ::Rappture::grab::state "" 97 } 98 if { $window != "" } { 98 99 eval _grabset $window 99 100 } -
branches/r9/gui/scripts/isomarker.tcl
r4166 r4919 113 113 set _value $x 114 114 set y 31 115 $_canvas itemconfigure $_label -text [format % .2g $_value]115 $_canvas itemconfigure $_label -text [format %g $_value] 116 116 set x [screenpos] 117 117 $_canvas coords $_tick $x [expr {$y+3}] -
branches/r9/gui/scripts/map.tcl
r4303 r4919 119 119 set name "layer[incr _nextLayer]" 120 120 set child [$_tree insert $parent -label $name] 121 $_tree set $child "title" [$layers get $layer.label]122 121 set layerType [$layers get $layer.type] 123 122 if { ![info exists _layerTypes($layerType)] } { … … 126 125 $_tree set $child "name" $layer 127 126 $_tree set $child "type" $layerType 128 foreach key { label description url} {127 foreach key { label description } { 129 128 $_tree set $child $key [$layers get $layer.$key] 130 129 } 131 130 # Common settings (for all layer types) with defaults 132 foreach { key defval} { visible true } {131 foreach { key defval } { visible true } { 133 132 $_tree set $child $key $defval 134 133 set val [$layers get $layer.$key] … … 146 145 } 147 146 } 148 set file [$layers get $layer.file] 149 if { $file != "" } { 150 # FIXME: Add test for valid file path 151 $_tree set $child "url" $file 147 $_tree set $child "driver" "debug" 148 set gdal [$layers element -as type $layer.gdal] 149 if { $gdal != "" } { 150 foreach key { url } { 151 set value [$layers get $layer.gdal.$key] 152 $_tree set $child "gdal.$key" $value 153 } 154 set file [$layers get $layer.gdal.file] 155 if { $file != "" } { 156 # FIXME: Add test for valid file path 157 $_tree set $child "gdal.url" $file 158 } 159 $_tree set $child "driver" "gdal" 160 } 161 set ogr [$layers element -as type $layer.ogr] 162 if { $ogr != "" } { 163 foreach key { url } { 164 set value [$layers get $layer.ogr.$key] 165 $_tree set $child "ogr.$key" $value 166 } 167 set file [$layers get $layer.ogr.file] 168 if { $file != "" } { 169 # FIXME: Add test for valid file path 170 $_tree set $child "ogr.url" $file 171 } 172 $_tree set $child "driver" "ogr" 173 } 174 set tfs [$layers element -as type $layer.tfs] 175 if { $tfs != "" } { 176 foreach key { url format } { 177 set value [$layers get $layer.tfs.$key] 178 $_tree set $child "tfs.$key" $value 179 } 180 $_tree set $child "driver" "tfs" 181 } 182 set tms [$layers element -as type $layer.tms] 183 if { $tms != "" } { 184 foreach key { url tmsType format } { 185 set value [$layers get $layer.tms.$key] 186 $_tree set $child "tms.$key" $value 187 } 188 $_tree set $child "driver" "tms" 189 } 190 set wfs [$layers element -as type $layer.wfs] 191 if { $wfs != "" } { 192 foreach key { url typename outputformat maxfeatures request_buffer } { 193 set value [$layers get $layer.wfs.$key] 194 $_tree set $child "wfs.$key" $value 195 } 196 $_tree set $child "driver" "wfs" 197 } 198 set wms [$layers element -as type $layer.wms] 199 if { $wms != "" } { 200 foreach key { url layers format transparent } { 201 set value [$layers get $layer.wms.$key] 202 $_tree set $child "wms.$key" $value 203 } 204 $_tree set $child "driver" "wms" 205 } 206 set xyz [$layers element -as type $layer.xyz] 207 if { $xyz != "" } { 208 foreach key { url } { 209 set value [$layers get $layer.xyz.$key] 210 $_tree set $child "xyz.$key" $value 211 } 212 $_tree set $child "driver" "xyz" 152 213 } 153 214 } -
branches/r9/gui/scripts/mapviewer.tcl
r4336 r4919 72 72 protected method DoResize {} 73 73 protected method DoRotate {} 74 protected method FixSettings { args }74 protected method InitSettings { args } 75 75 protected method KeyPress { key } 76 76 protected method KeyRelease { key } … … 177 177 # to update the Lat/Long coordinate display 178 178 array set _motion { 179 compress 0 180 delay 100 181 enable 0 182 pending 0 179 183 x 0 180 184 y 0 181 pending 0182 delay 100183 compress 0184 185 } 185 186 # This array holds the Viewpoint parameters that the 186 187 # server sends on "camera get". 187 188 array set _view { 189 distance 1.0 190 heading 0.0 191 pitch -89.9 192 srs "" 193 verticalDatum "" 188 194 x 0.0 189 195 y 0.0 190 196 z 0.0 191 heading 0.0192 pitch -89.9193 distance 1.0194 srs ""195 verticalDatum ""196 197 } 197 198 … … 200 201 array set _settings [subst { 201 202 camera-throw 0 203 coords-precision 5 204 coords-units "latlong_decimal_degrees" 205 coords-visible 1 202 206 grid 0 203 207 grid-type "geodetic" … … 334 338 [itcl::code $this MouseRelease 3 %x %y] 335 339 336 bind $itk_component(view) <Motion> \ 337 [itcl::code $this EventuallyHandleMotionEvent %x %y] 340 # Binding for mouse motion events 341 if {$_motion(enable)} { 342 bind $itk_component(view) <Motion> \ 343 [itcl::code $this EventuallyHandleMotionEvent %x %y] 344 } 338 345 } else { 339 346 # Bindings for panning via mouse … … 344 351 bind $itk_component(view) <ButtonRelease-1> \ 345 352 [itcl::code $this Pan release %x %y] 353 bind $itk_component(view) <Button-1> \ 354 +[itcl::code $this SendCmd "map setpos %x %y"] 346 355 bind $itk_component(view) <Double-1> \ 347 356 [itcl::code $this camera go %x %y 0.4] … … 364 373 bind $itk_component(view) <Double-3> \ 365 374 [itcl::code $this camera go %x %y 2.5] 375 bind $itk_component(view) <Double-3> \ 376 +[itcl::code $this SendCmd "map setpos %x %y"] 366 377 367 378 # Bindings for panning via keyboard … … 375 386 [itcl::code $this Pan set 0 10] 376 387 377 # Send (compressed) motion events to update Lat/Long388 # Binding for mouse motion events 378 389 set _motion(compress) 1 379 bind $itk_component(view) <Motion> \ 380 [itcl::code $this EventuallyHandleMotionEvent %x %y] 390 if {$_motion(enable)} { 391 bind $itk_component(view) <Motion> \ 392 [itcl::code $this EventuallyHandleMotionEvent %x %y] 393 } 381 394 } 382 395 … … 954 967 SetTerrainStyle $_mapsettings(style) 955 968 } else { 956 FixSettings terrain-edges terrain-lighting \969 InitSettings terrain-edges terrain-lighting \ 957 970 terrain-vertscale terrain-wireframe 958 971 } 972 InitSettings coords-visible 959 973 } else { 960 974 error "No map settings on reset" … … 971 985 array set info [$dataobj layer $layer] 972 986 if { ![info exists _layers($layer)] } { 973 if { ![info exists info(url)] } {974 continue975 }976 987 if { $_reportClientInfo } { 977 988 set cinfo {} … … 1294 1305 1295 1306 # ---------------------------------------------------------------------- 1296 # USAGE: FixSettings <what> ?<value>?1307 # USAGE: InitSettings <what> ?<value>? 1297 1308 # 1298 1309 # Used internally to update rendering settings whenever parameters … … 1300 1311 # to the back end. 1301 1312 # ---------------------------------------------------------------------- 1302 itcl::body Rappture::MapViewer:: FixSettings { args } {1313 itcl::body Rappture::MapViewer::InitSettings { args } { 1303 1314 foreach setting $args { 1304 1315 AdjustSetting $setting … … 1318 1329 } 1319 1330 switch -- $what { 1331 "coords-visible" - "coords-precision" - "coords-units" { 1332 set bool $_settings(coords-visible) 1333 set units $_settings(coords-units) 1334 set precision $_settings(coords-precision) 1335 SendCmd "map posdisp $bool $units $precision" 1336 } 1320 1337 "grid" - "grid-type" { 1321 1338 set bool $_settings(grid) … … 1324 1341 } 1325 1342 "camera-throw" { 1326 set bool $_settings( camera-throw)1343 set bool $_settings($what) 1327 1344 SendCmd "camera throw $bool" 1328 1345 } 1329 1346 "terrain-edges" { 1330 set bool $_settings( terrain-edges)1347 set bool $_settings($what) 1331 1348 SendCmd "map terrain edges $bool" 1332 1349 } 1333 1350 "terrain-lighting" { 1334 set bool $_settings( terrain-lighting)1351 set bool $_settings($what) 1335 1352 SendCmd "map terrain lighting $bool" 1336 1353 } … … 1340 1357 } 1341 1358 "terrain-vertscale" { 1342 set val $_settings( terrain-vertscale)1359 set val $_settings($what) 1343 1360 SendCmd "map terrain vertscale $val" 1344 1361 } 1345 1362 "terrain-wireframe" { 1346 set bool $_settings( terrain-wireframe)1363 set bool $_settings($what) 1347 1364 SendCmd "map terrain wireframe $bool" 1348 1365 } … … 1387 1404 -icon [Rappture::icon surface]] 1388 1405 $inner configure -borderwidth 4 1406 1407 checkbutton $inner.posdisp \ 1408 -text "Show Coordinate Readout" \ 1409 -variable [itcl::scope _settings(coords-visible)] \ 1410 -command [itcl::code $this AdjustSetting coords-visible] \ 1411 -font "Arial 9" -anchor w 1389 1412 1390 1413 checkbutton $inner.grid \ … … 1432 1455 1433 1456 blt::table $inner \ 1434 0,0 $inner.grid -cspan 2 -anchor w -pady 2 \ 1435 1,0 $inner.wireframe -cspan 2 -anchor w -pady 2 \ 1436 2,0 $inner.lighting -cspan 2 -anchor w -pady 2 \ 1437 3,0 $inner.edges -cspan 2 -anchor w -pady 2 \ 1438 4,0 $inner.vscale_l -anchor w -pady 2 \ 1439 4,1 $inner.vscale -fill x -pady 2 \ 1440 5,0 $inner.palette_l -anchor w -pady 2 \ 1441 5,1 $inner.palette -fill x -pady 2 1457 0,0 $inner.posdisp -cspan 2 -anchor w -pady 2 \ 1458 1,0 $inner.grid -cspan 2 -anchor w -pady 2 \ 1459 2,0 $inner.wireframe -cspan 2 -anchor w -pady 2 \ 1460 3,0 $inner.lighting -cspan 2 -anchor w -pady 2 \ 1461 4,0 $inner.edges -cspan 2 -anchor w -pady 2 \ 1462 5,0 $inner.vscale_l -anchor w -pady 2 \ 1463 5,1 $inner.vscale -fill x -pady 2 \ 1464 6,0 $inner.palette_l -anchor w -pady 2 \ 1465 6,1 $inner.palette -fill x -pady 2 1442 1466 1443 1467 blt::table configure $inner r* c* -resize none 1444 blt::table configure $inner r 7c1 -resize expand1468 blt::table configure $inner r8 c1 -resize expand 1445 1469 } 1446 1470 … … 1452 1476 set inner [$itk_component(main) insert end \ 1453 1477 -title "Layers" \ 1454 -icon [Rappture::icon wrench]]1478 -icon [Rappture::icon layers]] 1455 1479 $inner configure -borderwidth 4 1456 1480 set f [frame $inner.layers] … … 1698 1722 } 1699 1723 if {!$_sendEarthFile} { 1700 SendCmd [list map layer add image gdal $info(url) $layer] 1724 switch -- $info(driver) { 1725 "debug" { 1726 SendCmd [list map layer add image debug $layer] 1727 } 1728 "gdal" { 1729 SendCmd [list map layer add image gdal \ 1730 $info(gdal.url) $layer] 1731 } 1732 "tms" { 1733 SendCmd [list map layer add image tms \ 1734 $info(tms.url) $layer] 1735 } 1736 "wms" { 1737 SendCmd [list map layer add image wms \ 1738 $info(wms.url) \ 1739 $info(wms.layers) \ 1740 $info(wms.format) \ 1741 $info(wms.transparent) \ 1742 $layer] 1743 } 1744 "xyz" { 1745 SendCmd [list map layer add image xyz \ 1746 $info(xyz.url) \ 1747 $layer] 1748 } 1749 } 1701 1750 } 1702 1751 SendCmd "map layer opacity $settings(-opacity) $layer" … … 1711 1760 } 1712 1761 if {!$_sendEarthFile} { 1713 SendCmd [list map layer add elevation gdal $info(url) $layer] 1762 switch -- $info(driver) { 1763 "gdal" { 1764 SendCmd [list map layer add elevation gdal \ 1765 $info(gdal.url) $layer] 1766 } 1767 "tms" { 1768 SendCmd [list map layer add elevation tms \ 1769 $info(tms.url) $layer] 1770 } 1771 } 1714 1772 } 1715 1773 } … … 1727 1785 set settings(-opacity) $info(opacity) 1728 1786 } 1729 SendCmd [list map layer add line $info( url) $layer]1787 SendCmd [list map layer add line $info(ogr.url) $layer] 1730 1788 SendCmd "map layer opacity $settings(-opacity) $layer" 1731 1789 } … … 1742 1800 set settings(-opacity) $info(opacity) 1743 1801 } 1744 SendCmd [list map layer add polygon $info( url) $layer]1802 SendCmd [list map layer add polygon $info(ogr.url) $layer] 1745 1803 SendCmd "map layer opacity $settings(-opacity) $layer" 1746 1804 } … … 1771 1829 set priorityExpr "" 1772 1830 } 1773 SendCmd [list map layer add text $info( url) $contentExpr $priorityExpr $layer]1831 SendCmd [list map layer add text $info(ogr.url) $contentExpr $priorityExpr $layer] 1774 1832 SendCmd "map layer opacity $settings(-opacity) $layer" 1775 1833 } … … 1815 1873 array set info [$dataobj layer $layer] 1816 1874 checkbutton $f.$layer \ 1817 -text $info( title) \1875 -text $info(label) \ 1818 1876 -variable [itcl::scope _visibility($layer)] \ 1819 1877 -command [itcl::code $this \ -
branches/r9/gui/scripts/mesh.tcl
r4259 r4919 33 33 # xmin, xmax, ymin, ymax, ... 34 34 private variable _numPoints 0 ; # # of points in mesh 35 private variable _numCells 0 35 private variable _numCells 0; # # of cells in mesh 36 36 private variable _vtkdata ""; # Mesh in vtk file format. 37 37 private variable _isValid 0; # Indicates if the mesh is valid. … … 63 63 return $_numPoints 64 64 } 65 65 public method numcells {} { 66 return $_numCells 67 } 66 68 67 69 private common _xp2obj ; # used for fetch/release ref counting … … 74 76 75 77 private method ReadNodesElements {path} 78 private method GetCellCount { xNum yNum zNum } 76 79 private method GetDimension { path } 77 80 private method GetDouble { path } … … 83 86 private method WriteTriangles { path xv yv zv triangles } 84 87 private method WriteQuads { path xv yv zv quads } 88 private method WriteVertices { path xv yv zv vertices } 89 private method WriteLines { path xv yv zv lines } 90 private method WritePolygons { path xv yv zv polygons } 91 private method WriteTriangleStrips { path xv yv zv trianglestrips } 85 92 private method WriteTetrahedrons { path xv yv zv tetrahedrons } 86 93 private method WriteHexahedrons { path xv yv zv hexhedrons } … … 420 427 } 421 428 } 429 foreach {key path} { 430 toolid tool.id 431 toolname tool.name 432 toolcommand tool.execute 433 tooltitle tool.title 434 toolrevision tool.version.application.revision 435 } { 436 set str [$_xmlobj get $path] 437 if { "" != $str } { 438 set _hints($key) $str 439 } 440 } 422 441 } 423 442 … … 454 473 return $value 455 474 } 456 457 475 458 476 itcl::body Rappture::Mesh::ReadVtk { path } { … … 482 500 $reader Update 483 501 set output [$reader GetOutput] 502 set _numPoints [$output GetNumberOfPoints] 503 set _numCells [$output GetNumberOfCells] 484 504 foreach { xmin xmax ymin ymax zmin zmax } [$output GetBounds] break 485 505 set _limits(x) [list $xmin $xmax] … … 490 510 rename $reader "" 491 511 return 1 512 } 513 514 itcl::body Rappture::Mesh::GetCellCount { xNum yNum zNum } { 515 set numCells 1 516 if { $xNum > 1 } { 517 set numCells [expr $numCells * ($xNum - 1)] 518 } 519 if { $yNum > 1 } { 520 set numCells [expr $numCells * ($yNum - 1)] 521 } 522 if { $zNum > 1 } { 523 set numCells [expr $numCells * ($zNum - 1)] 524 } 525 return $numCells 492 526 } 493 527 … … 511 545 set ${axis}Max $max 512 546 set ${axis}Num $num 547 if {$min > $max} { 548 puts stderr "ERROR: grid $axis min can't be greater than max" 549 return 0 550 } 513 551 incr numUniform 514 552 } elseif { $coords != "" } { … … 550 588 set _dim 3 551 589 set _numPoints [expr $xNum * $yNum * $zNum] 552 if { ($_numPoints*3) != $numCoords } { 553 puts stderr "WARNING: bad grid \"$path\": invalid grid: \# of points does not match dimensions <xdim> * <ydim> * <zdim>" 590 set _numCells [GetCellCount $xNum $yNum $zNum] 591 if { ($_numPoints * 3) != $numCoords } { 592 puts stderr "WARNING: bad grid \"$path\": \# of points does not match dimensions $xNum * $yNum * $zNum" 554 593 return 0 555 594 } … … 572 611 set _dim 2 573 612 set _numPoints [expr $xNum * $yNum] 574 if { ($_numPoints*2) != $numCoords } { 575 puts stderr "WARNING: bad grid \"$path\": \# of points does not match dimensions <xdim> * <ydim>" 613 set _numCells [GetCellCount $xNum $yNum 1] 614 if { ($_numPoints * 2) != $numCoords } { 615 puts stderr "WARNING: bad grid \"$path\": \# of points does not match dimensions $xNum * $yNum" 576 616 return 0 577 617 } … … 596 636 set _dim 1 597 637 set _numPoints $xNum 638 set _numCells [GetCellCount $xNum 1 1] 598 639 if { $_numPoints != $numCoords } { 599 puts stderr "WARNING: bad grid \"$path\": \# of points does not match <xdim>"640 puts stderr "WARNING: bad grid \"$path\": \# of points does not match $xNum" 600 641 return 0 601 642 } … … 620 661 # This results in a STRUCTURED_POINTS 621 662 if { $_dim == 1 } { 622 set xSpace [expr ($xMax - $xMin) / double($xNum - 1)] 663 set xSpacing 0 664 if { $xNum > 1 } { 665 set xSpacing [expr ($xMax - $xMin) / double($xNum - 1)] 666 } 623 667 set _numPoints $xNum 668 set _numCells [GetCellCount $xNum 1 1] 624 669 append out "DATASET STRUCTURED_POINTS\n" 625 670 append out "DIMENSIONS $xNum 1 1\n" 626 671 append out "ORIGIN $xMin 0 0\n" 627 append out "SPACING $xSpac e0 0\n"672 append out "SPACING $xSpacing 0 0\n" 628 673 set _vtkdata $out 629 674 set _limits(x) [list $xMin $xMax] … … 631 676 set _limits(z) [list 0 0] 632 677 } elseif { $_dim == 2 } { 633 set xSpace [expr ($xMax - $xMin) / double($xNum - 1)] 634 set ySpace [expr ($yMax - $yMin) / double($yNum - 1)] 678 set xSpacing 0 679 set ySpacing 0 680 if { $xNum > 1 } { 681 set xSpacing [expr ($xMax - $xMin) / double($xNum - 1)] 682 } 683 if { $yNum > 1 } { 684 set ySpacing [expr ($yMax - $yMin) / double($yNum - 1)] 685 } 635 686 set _numPoints [expr $xNum * $yNum] 687 set _numCells [GetCellCount $xNum $yNum 1] 636 688 append out "DATASET STRUCTURED_POINTS\n" 637 689 append out "DIMENSIONS $xNum $yNum 1\n" 638 690 append out "ORIGIN $xMin $yMin 0\n" 639 append out "SPACING $xSpac e $ySpace0\n"691 append out "SPACING $xSpacing $ySpacing 0\n" 640 692 set _vtkdata $out 641 693 foreach axis {x y} { … … 644 696 set _limits(z) [list 0 0] 645 697 } elseif { $_dim == 3 } { 646 set xSpace [expr ($xMax - $xMin) / double($xNum - 1)] 647 set ySpace [expr ($yMax - $yMin) / double($yNum - 1)] 648 set zSpace [expr ($zMax - $zMin) / double($zNum - 1)] 698 set xSpacing 0 699 set ySpacing 0 700 set zSpacing 0 701 if {$xNum > 1} { 702 set xSpacing [expr ($xMax - $xMin) / double($xNum - 1)] 703 } 704 if {$yNum > 1} { 705 set ySpacing [expr ($yMax - $yMin) / double($yNum - 1)] 706 } 707 if {$zNum > 1} { 708 set zSpacing [expr ($zMax - $zMin) / double($zNum - 1)] 709 } 649 710 set _numPoints [expr $xNum * $yNum * $zNum] 711 set _numCells [GetCellCount $xNum $yNum $zNum] 650 712 append out "DATASET STRUCTURED_POINTS\n" 651 713 append out "DIMENSIONS $xNum $yNum $zNum\n" 652 714 append out "ORIGIN $xMin $yMin $zMin\n" 653 append out "SPACING $xSpac e $ySpace $zSpace\n"715 append out "SPACING $xSpacing $ySpacing $zSpacing\n" 654 716 set _vtkdata $out 655 717 foreach axis {x y z} { … … 700 762 if { $_dim == 3 } { 701 763 set _numPoints [expr $xNum * $yNum * $zNum] 764 set _numCells [GetCellCount $xNum $yNum $zNum] 702 765 append out "DATASET RECTILINEAR_GRID\n" 703 766 append out "DIMENSIONS $xNum $yNum $zNum\n" … … 719 782 } elseif { $_dim == 2 } { 720 783 set _numPoints [expr $xNum * $yNum] 784 set _numCells [GetCellCount $xNum $yNum 1] 721 785 append out "DATASET RECTILINEAR_GRID\n" 722 786 append out "DIMENSIONS $xNum $yNum 1\n" … … 738 802 } elseif { $_dim == 1 } { 739 803 set _numPoints $xNum 804 set _numCells [GetCellCount $xNum 1 1] 740 805 append out "DATASET RECTILINEAR_GRID\n" 741 806 append out "DIMENSIONS $xNum 1 1\n" … … 787 852 set _type "triangles" 788 853 set _numPoints [$xv length] 789 set count0854 set _numCells 0 790 855 set data {} 791 856 set celltypes {} … … 793 858 append data " 3 $a $b $c\n" 794 859 append celltypes "5\n" 795 incr count860 incr _numCells 796 861 } 797 862 append out "DATASET UNSTRUCTURED_GRID\n" … … 800 865 append out " $x $y $z\n" 801 866 } 802 append out "CELLS $count [expr $count * 4]\n" 867 set count [expr $_numCells * 4] 868 append out "CELLS $_numCells $count\n" 803 869 append out $data 804 append out "CELL_TYPES $ count\n"870 append out "CELL_TYPES $_numCells\n" 805 871 append out $celltypes 806 872 set _limits(x) [$xv limits] … … 818 884 set _type "quads" 819 885 set _numPoints [$xv length] 820 set count0886 set _numCells 0 821 887 set data {} 822 888 set celltypes {} … … 824 890 append data " 4 $a $b $c $d\n" 825 891 append celltypes "9\n" 826 incr count892 incr _numCells 827 893 } 828 894 append out "DATASET UNSTRUCTURED_GRID\n" … … 831 897 append out " $x $y $z\n" 832 898 } 833 append out "CELLS $count [expr $count * 5]\n" 899 set count [expr $_numCells * 5] 900 append out "CELLS $_numCells $count\n" 834 901 append out $data 835 append out "CELL_TYPES $ count\n"902 append out "CELL_TYPES $_numCells\n" 836 903 append out $celltypes 837 904 set _limits(x) [$xv limits] … … 846 913 } 847 914 915 itcl::body Rappture::Mesh::WriteVertices { path xv yv zv vertices } { 916 set _type "vertices" 917 set _numPoints [$xv length] 918 set _numCells 0 919 set data {} 920 set lines [split $vertices \n] 921 set count 0 922 foreach { line } $lines { 923 set numIndices [llength $line] 924 if { $numIndices == 0 } { 925 continue 926 } 927 append data " $numIndices $line\n" 928 incr _numCells 929 set count [expr $count + $numIndices + 1] 930 } 931 append out "DATASET POLYDATA\n" 932 append out "POINTS $_numPoints double\n" 933 foreach x [$xv range 0 end] y [$yv range 0 end] z [$zv range 0 end] { 934 append out " $x $y $z\n" 935 } 936 append out "VERTICES $_numCells $count\n" 937 append out $data 938 set _limits(x) [$xv limits] 939 set _limits(y) [$yv limits] 940 if { $_dim == 3 } { 941 set _limits(z) [$zv limits] 942 } else { 943 set _limits(z) [list 0 0] 944 } 945 set _vtkdata $out 946 return 1 947 } 948 949 itcl::body Rappture::Mesh::WriteLines { path xv yv zv polylines } { 950 set _type "lines" 951 set _numPoints [$xv length] 952 set _numCells 0 953 set data {} 954 set lines [split $polylines \n] 955 set count 0 956 foreach { line } $lines { 957 set numIndices [llength $line] 958 if { $numIndices == 0 } { 959 continue 960 } 961 append data " $numIndices $line\n" 962 incr _numCells 963 set count [expr $count + $numIndices + 1] 964 } 965 append out "DATASET POLYDATA\n" 966 append out "POINTS $_numPoints double\n" 967 foreach x [$xv range 0 end] y [$yv range 0 end] z [$zv range 0 end] { 968 append out " $x $y $z\n" 969 } 970 append out "LINES $_numCells $count\n" 971 append out $data 972 set _limits(x) [$xv limits] 973 set _limits(y) [$yv limits] 974 if { $_dim == 3 } { 975 set _limits(z) [$zv limits] 976 } else { 977 set _limits(z) [list 0 0] 978 } 979 set _vtkdata $out 980 return 1 981 } 982 983 itcl::body Rappture::Mesh::WritePolygons { path xv yv zv polygons } { 984 set _type "polygons" 985 set _numPoints [$xv length] 986 set _numCells 0 987 set data {} 988 set lines [split $polygons \n] 989 set count 0 990 foreach { line } $lines { 991 set numIndices [llength $line] 992 if { $numIndices == 0 } { 993 continue 994 } 995 append data " $numIndices $line\n" 996 incr _numCells 997 set count [expr $count + $numIndices + 1] 998 } 999 append out "DATASET POLYDATA\n" 1000 append out "POINTS $_numPoints double\n" 1001 foreach x [$xv range 0 end] y [$yv range 0 end] z [$zv range 0 end] { 1002 append out " $x $y $z\n" 1003 } 1004 append out "POLYGONS $_numCells $count\n" 1005 append out $data 1006 set _limits(x) [$xv limits] 1007 set _limits(y) [$yv limits] 1008 if { $_dim == 3 } { 1009 set _limits(z) [$zv limits] 1010 } else { 1011 set _limits(z) [list 0 0] 1012 } 1013 set _vtkdata $out 1014 return 1 1015 } 1016 1017 itcl::body Rappture::Mesh::WriteTriangleStrips { path xv yv zv trianglestrips } { 1018 set _type "trianglestrips" 1019 set _numPoints [$xv length] 1020 set _numCells 0 1021 set data {} 1022 set lines [split $trianglestrips \n] 1023 set count 0 1024 foreach { line } $lines { 1025 set numIndices [llength $line] 1026 if { $numIndices == 0 } { 1027 continue 1028 } 1029 append data " $numIndices $line\n" 1030 incr _numCells 1031 set count [expr $count + $numIndices + 1] 1032 } 1033 append out "DATASET POLYDATA\n" 1034 append out "POINTS $_numPoints double\n" 1035 foreach x [$xv range 0 end] y [$yv range 0 end] z [$zv range 0 end] { 1036 append out " $x $y $z\n" 1037 } 1038 append out "TRIANGLE_STRIPS $_numCells $count\n" 1039 append out $data 1040 set _limits(x) [$xv limits] 1041 set _limits(y) [$yv limits] 1042 if { $_dim == 3 } { 1043 set _limits(z) [$zv limits] 1044 } else { 1045 set _limits(z) [list 0 0] 1046 } 1047 set _vtkdata $out 1048 return 1 1049 } 1050 848 1051 itcl::body Rappture::Mesh::WriteTetrahedrons { path xv yv zv tetras } { 849 1052 set _type "tetrahedrons" 850 1053 set _numPoints [$xv length] 851 set count01054 set _numCells 0 852 1055 set data {} 853 1056 set celltypes {} … … 855 1058 append data " 4 $a $b $c $d\n" 856 1059 append celltypes "10\n" 857 incr count1060 incr _numCells 858 1061 } 859 1062 append out "DATASET UNSTRUCTURED_GRID\n" … … 862 1065 append out " $x $y $z\n" 863 1066 } 864 append out "CELLS $count [expr $count * 5]\n" 1067 set count [expr $_numCells * 5] 1068 append out "CELLS $_numCells $count\n" 865 1069 append out $data 866 append out "CELL_TYPES $ count\n"1070 append out "CELL_TYPES $_numCells\n" 867 1071 append out $celltypes 868 1072 set _limits(x) [$xv limits] … … 877 1081 set _type "hexahedrons" 878 1082 set _numPoints [$xv length] 879 set count01083 set _numCells 0 880 1084 set data {} 881 1085 set celltypes {} … … 883 1087 append data " 8 $a $b $c $d $e $f $g $h\n" 884 1088 append celltypes "12\n" 885 incr count1089 incr _numCells 886 1090 } 887 1091 append out "DATASET UNSTRUCTURED_GRID\n" … … 890 1094 append out " $x $y $z\n" 891 1095 } 892 append out "CELLS $count [expr $count * 9]\n" 1096 set count [expr $_numCells * 9] 1097 append out "CELLS $_numCells $count\n" 893 1098 append out $data 894 append out "CELL_TYPES $ count\n"1099 append out "CELL_TYPES $_numCells\n" 895 1100 append out $celltypes 896 1101 set _limits(x) [$xv limits] … … 905 1110 set _type "wedges" 906 1111 set _numPoints [$xv length] 907 set count01112 set _numCells 0 908 1113 set data {} 909 1114 set celltypes {} … … 911 1116 append data " 6 $a $b $c $d $e $f\n" 912 1117 append celltypes "13\n" 913 incr count1118 incr _numCells 914 1119 } 915 1120 append out "DATASET UNSTRUCTURED_GRID\n" … … 918 1123 append out " $x $y $z\n" 919 1124 } 920 append out "CELLS $count [expr $count * 7]\n" 1125 set count [expr $_numCells * 7] 1126 append out "CELLS $_numCells $count\n" 921 1127 append out $data 922 append out "CELL_TYPES $ count\n"1128 append out "CELL_TYPES $_numCells\n" 923 1129 append out $celltypes 924 1130 set _limits(x) [$xv limits] … … 933 1139 set _type "pyramids" 934 1140 set _numPoints [$xv length] 935 set count01141 set _numCells 0 936 1142 set data {} 937 1143 set celltypes {} … … 939 1145 append data " 5 $a $b $c $d $e\n" 940 1146 append celltypes "14\n" 941 incr count1147 incr _numCells 942 1148 } 943 1149 append out "DATASET UNSTRUCTURED_GRID\n" … … 946 1152 append out " $x $y $z\n" 947 1153 } 948 append out "CELLS $count [expr $count * 6]\n" 1154 set count [expr $_numCells * 6] 1155 append out "CELLS $_numCells $count\n" 949 1156 append out $data 950 append out "CELL_TYPES $ count\n"1157 append out "CELL_TYPES $_numCells\n" 951 1158 append out $celltypes 952 1159 set _limits(x) [$xv limits] … … 983 1190 puts stderr "WARNING: bad unstructured grid \"$path\": wrong \# of indices specified for celltype $celltype on line \"$line\"" 984 1191 return 0 1192 } else { 1193 set numIndices $length 985 1194 } 986 1195 append data " $numIndices $line\n" … … 1020 1229 # Step 1: Verify that there's only one cell tag of any kind. 1021 1230 set numCells 0 1022 foreach type { cells triangles quads tetrahedrons 1023 hexahedrons wedges pyramids } { 1231 foreach type { 1232 cells 1233 hexahedrons 1234 lines 1235 polygons 1236 pyramids 1237 quads 1238 tetrahedrons 1239 triangles 1240 trianglestrips 1241 vertices 1242 wedges 1243 } { 1024 1244 set data [$_xmlobj get $path.unstructured.$type] 1025 1245 if { $data != "" } { … … 1037 1257 return 0 1038 1258 } 1039 foreach type { cells triangles quads tetrahedrons 1040 hexahedrons wedges pyramids } { 1259 foreach type { 1260 cells 1261 hexahedrons 1262 lines 1263 polygons 1264 pyramids 1265 quads 1266 tetrahedrons 1267 triangles 1268 trianglestrips 1269 vertices 1270 wedges 1271 } { 1041 1272 set data [$_xmlobj get $path.unstructured.$type] 1042 1273 if { $data != "" } { … … 1153 1384 } 1154 1385 } 1386 set _numPoints [$xv length] 1387 1155 1388 # Step 3: Write the points and cells as vtk data. 1156 1389 if { $numCells == 0 } { … … 1277 1510 itcl::body Rappture::Mesh::GetCellType { name } { 1278 1511 array set name2type { 1279 "triangle" 5 1280 "quad" 9 1281 "tetrahedron" 10 1282 "hexahedron" 12 1283 "wedge" 13 1284 "pyramid" 14 1512 "vertex" 1 1513 "polyvertex" 2 1514 "line" 3 1515 "polyline" 4 1516 "triangle" 5 1517 "trianglestrip" 6 1518 "polygon" 7 1519 "pixel" 8 1520 "quad" 9 1521 "tetrahedron" 10 1522 "voxel" 11 1523 "hexahedron" 12 1524 "wedge" 13 1525 "pyramid" 14 1526 "pentagonalprism" 15 1527 "hexagonalprism" 16 1285 1528 } 1286 1529 if { [info exists name2type($name)] } { … … 1309 1552 13 6 1310 1553 14 5 1311 15 01312 16 01554 15 10 1555 16 12 1313 1556 } 1314 1557 if { [info exists type2indices($type)] } { -
branches/r9/gui/scripts/molvisviewer.tcl
r4075 r4919 691 691 set session $env(SESSION) 692 692 } 693 lappend info "version" "$Rappture::version" 694 lappend info "build" "$Rappture::build" 695 lappend info "svnurl" "$Rappture::svnurl" 696 lappend info "installdir" "$Rappture::installdir" 693 697 lappend info "hub" [exec hostname] 694 698 lappend info "client" "molvisviewer" -
branches/r9/gui/scripts/nanovisviewer.tcl
r4343 r4919 1 1 # -*- mode: tcl; indent-tabs-mode: nil -*- 2 3 2 # ---------------------------------------------------------------------- 4 3 # COMPONENT: nanovisviewer - 3D volume rendering … … 82 81 public method updateTransferFunctions {} 83 82 84 85 83 # The following methods are only used by this class. 84 85 private method AddNewMarker { x y } 86 86 private method AdjustSetting {what {value ""}} 87 87 private method BuildCameraTab {} … … 105 105 private method GetVolumeInfo { w } 106 106 private method HideAllMarkers {} 107 private method AddNewMarker { x y }108 107 private method InitComponentSettings { cname } 109 108 private method InitSettings { args } … … 118 117 private method ReceiveImage { args } 119 118 private method ReceiveLegend { tf vmin vmax size } 119 private method RemoveMarker { x y } 120 120 private method ResetColormap { cname color } 121 121 private method Rotate {option x y} 122 122 private method SendTransferFunctions {} 123 private method SetObjectStyle { dataobj cname } 123 124 private method SetOrientation { side } 124 125 private method Slice {option args} 125 126 private method SlicerTip {axis} 126 127 private method SwitchComponent { cname } 128 private method ToggleVolume { tag name } 127 129 private method Zoom {option} 128 private method ToggleVolume { tag name }129 private method RemoveMarker { x y }130 130 private method ViewToQuaternion {} { 131 131 return [list $_view(-qw) $_view(-qx) $_view(-qy) $_view(-qz)] … … 148 148 private variable _view; # View params for 3D view 149 149 private variable _parsedFunction 150 private variable _transferFunctionEditors;# Array of isosurface level values 0..1 151 private variable _settings 150 private variable _transferFunctionEditors 151 private variable _settings 152 private variable _alphamap 153 private variable _widget 154 152 155 private variable _first "" ; # This is the topmost volume. 153 156 private variable _current ""; # Currently selected component … … 208 211 -qy 0.353553 209 212 -qz 0.146447 210 -zoom 1.0211 213 -xpan 0 212 214 -ypan 0 215 -zoom 1.0 213 216 } 214 217 set _arcball [blt::arcball create 100 100] … … 219 222 220 223 array set _settings { 221 -background black222 -ambient 60223 224 -axesvisible 1 224 - colormap default225 -c utplanevisible 0226 - diffuse 40225 -background black 226 -colormap "default" 227 -cutplanesvisible 0 227 228 -gridvisible 0 228 229 -isosurfaceshading 0 229 230 -legendvisible 1 231 -light 40 230 232 -light2side 1 231 -opacity 50232 233 -outlinevisible 0 233 234 -qw 0.853553 … … 235 236 -qy 0.353553 236 237 -qz 0.146447 237 -specularexponent 90238 -specularlevel 30239 238 -thickness 350 240 239 -volume 1 240 -volumeopacity 0.5 241 241 -volumevisible 1 242 -xcutplaneposition 50 242 243 -xcutplanevisible 1 243 -xcutplaneposition 50244 244 -xpan 0 245 -ycutplaneposition 50 245 246 -ycutplanevisible 1 246 -ycutplaneposition 50247 247 -ypan 0 248 -zcutplaneposition 50 248 249 -zcutplanevisible 1 249 -zcutplaneposition 50250 250 -zoom 1.0 251 251 } 252 252 array set _widget { 253 -volumeopacity 50 254 } 253 255 itk_component add 3dview { 254 256 label $itk_component(plotarea).view -image $_image(plot) \ … … 557 559 # ---------------------------------------------------------------------- 558 560 itcl::body Rappture::NanovisViewer::scale {args} { 559 array set style {560 -color BCGYR561 -levels 6562 -markers ""561 array set styles { 562 -color BCGYR 563 -levels 6 564 -markers "" 563 565 } 564 566 array unset _limits … … 571 573 if { ![info exists _volcomponents($cname)] } { 572 574 lappend _componentsList $cname 573 array set style [lindex [$dataobj components -style $cname] 0]574 set cmap [ColorsToColormap $style (-color)]575 array set styles [lindex [$dataobj components -style $cname] 0] 576 set cmap [ColorsToColormap $styles(-color)] 575 577 set _cname2defaultcolormap($cname) $cmap 576 set _settings($cname-colormap) $style (-color)578 set _settings($cname-colormap) $styles(-color) 577 579 } 578 580 lappend _volcomponents($cname) $dataobj-$cname … … 674 676 set session $env(SESSION) 675 677 } 678 lappend info "version" "$Rappture::version" 679 lappend info "build" "$Rappture::build" 680 lappend info "svnurl" "$Rappture::svnurl" 681 lappend info "installdir" "$Rappture::installdir" 676 682 lappend info "hub" [exec hostname] 677 683 lappend info "client" "nanovisviewer" … … 721 727 # ---------------------------------------------------------------------- 722 728 itcl::body Rappture::NanovisViewer::SendTransferFunctions {} { 723 if 0 {724 if { $_first == "" } {725 puts stderr "first not set"726 return727 }728 729 foreach tag [CurrentDatasets] {730 if { ![info exists _serverDatasets($tag)] || !$_serverDatasets($tag) } {731 # The volume hasn't reached the server yet. How did we get732 # here?733 puts stderr "Don't have $tag in _serverDatasets"734 continue735 }736 if { ![info exists _dataset2style($tag)] } {737 puts stderr "don't have style for volume $tag"738 continue; # How does this happen?739 }740 foreach {dataobj cname} [split $tag -] break741 set cname $_dataset2style($tag)742 743 ComputeTransferFunction $cname744 SendCmd "volume shading transfunc $cname $tag"745 }746 }747 729 foreach cname [array names _volcomponents] { 748 730 ComputeTransferFunction $cname … … 803 785 804 786 foreach {min max} $_limits($cname) break 805 $c itemconfigure vmin -text [format % .2g $min]787 $c itemconfigure vmin -text [format %g $min] 806 788 $c coords vmin $lx $ly 807 789 808 $c itemconfigure vmax -text [format % .2g $max]790 $c itemconfigure vmax -text [format %g $max] 809 791 $c coords vmax [expr {$w-$lx}] $ly 810 792 … … 818 800 819 801 # The colormap may have changed. Resync the slicers with the colormap. 820 set datasets [CurrentDatasets -cutplanes] 821 822 # Adjust the cutplane for only the first component in the topmost volume 823 # (i.e. the first volume designated in the field). 824 set tag [lindex $datasets 0] 825 foreach axis {x y z} { 826 # Turn off cutplanes for all volumes 827 SendCmd "cutplane state 0 $axis" 828 if { $_settings(-${axis}cutplanevisible) } { 829 # Turn on cutplane for this particular volume and set the position 830 SendCmd "cutplane state 1 $axis $tag" 831 set pos [expr {0.01*$_settings(-${axis}cutplaneposition)}] 832 SendCmd "cutplane position $pos $axis $tag" 833 } 834 } 802 InitSettings -cutplanesvisible -xcutplanevisible -ycutplanevisible \ 803 -zcutplanevisible 835 804 } 836 805 … … 932 901 DoResize 933 902 } 903 934 904 foreach dataobj [get] { 935 905 foreach cname [$dataobj components] { … … 942 912 } 943 913 set data [$dataobj blob $cname] 944 if 0 {945 set f [open "/tmp/values-$cname.txt" "w"]946 puts $f [$dataobj values $cname]947 close $f948 }949 914 } else { 950 915 set data [$dataobj vtkdata $cname] … … 972 937 set _serverDatasets($tag) 0 973 938 } 974 NameTransferFunction $dataobj $cname 975 } 976 } 939 SetObjectStyle $dataobj $cname 940 } 941 } 942 943 # Outline seems to need to be reset every update. 944 InitSettings -outlinevisible -cutplanesvisible -current 945 977 946 set _first [lindex [get] 0] 978 947 if { $_reset } { … … 994 963 PanCamera 995 964 SendCmd "camera zoom $_view(-zoom)" 996 965 966 #cutplane state 0 all 997 967 foreach axis {x y z} { 998 968 # Turn off cutplanes for all volumes … … 1000 970 } 1001 971 1002 InitSettings -light2side -ambient -diffuse -specularlevel \ 1003 -specularexponent -opacity -isosurfaceshading -gridvisible \ 1004 -axesvisible -xcutplanevisible -ycutplanevisible -zcutplanevisible \ 1005 -current 972 InitSettings -light2side -light -volumeopacity \ 973 -isosurfaceshading -gridvisible -axesvisible \ 1006 974 1007 975 if {"" != $_first} { … … 1016 984 } 1017 985 } 1018 # Outline seems to need to be reset every update. 1019 InitSettings -outlinevisible -cutplanesvisible 986 1020 987 # nothing to send -- activate the proper ivol 1021 988 SendCmd "volume state 0" … … 1055 1022 set tag $_first-$cname 1056 1023 if { [info exists _serverDatasets($tag)] && $_serverDatasets($tag) } { 1057 array set style {1024 array set styles { 1058 1025 -cutplanes 1 1059 1026 } 1060 array set style [lindex [$_first components -style $cname] 0]1061 if { $what != "-cutplanes" || $style (-cutplanes) } {1027 array set styles [lindex [$_first components -style $cname] 0] 1028 if { $what != "-cutplanes" || $styles(-cutplanes) } { 1062 1029 lappend rlist $tag 1063 1030 } … … 1093 1060 -qy 0.353553 1094 1061 -qz 0.146447 1062 -xpan 0 1063 -ypan 0 1095 1064 -zoom 1.0 1096 -xpan 01097 -ypan 01098 1065 } 1099 1066 if { $_first != "" } { … … 1249 1216 } 1250 1217 switch -- $what { 1251 "-current" { 1252 set cname [$itk_component(volcomponents) value] 1253 SwitchComponent $cname 1218 "-axesvisible" { 1219 SendCmd "axis visible $_settings($what)" 1254 1220 } 1255 1221 "-background" { … … 1264 1230 DrawLegend $_current 1265 1231 } 1266 "-ambient" {1267 # Other parts of the code use the ambient setting to1268 # tell if the component settings have been initialized1269 if { ![info exists _settings($_current${what})] } {1270 InitComponentSettings $_current1271 }1272 set _settings($_current${what}) $_settings($what)1273 set val $_settings($what)1274 set val [expr {0.01*$val}]1275 foreach tag [GetDatasetsWithComponent $_current] {1276 SendCmd "volume shading ambient $val $tag"1277 }1278 }1279 "-diffuse" {1280 set _settings($_current${what}) $_settings($what)1281 set val $_settings($what)1282 set val [expr {0.01*$val}]1283 foreach tag [GetDatasetsWithComponent $_current] {1284 SendCmd "volume shading diffuse $val $tag"1285 }1286 }1287 "-specularlevel" {1288 set _settings($_current${what}) $_settings($what)1289 set val $_settings($what)1290 set val [expr {0.01*$val}]1291 foreach tag [GetDatasetsWithComponent $_current] {1292 SendCmd "volume shading specularLevel $val $tag"1293 }1294 }1295 "-specularexponent" {1296 set _settings($_current${what}) $_settings($what)1297 set val $_settings($what)1298 foreach tag [GetDatasetsWithComponent $_current] {1299 SendCmd "volume shading specularExp $val $tag"1300 }1301 }1302 "-light2side" {1303 set _settings($_current${what}) $_settings($what)1304 set val $_settings($what)1305 foreach tag [GetDatasetsWithComponent $_current] {1306 SendCmd "volume shading light2side $val $tag"1307 }1308 }1309 "-opacity" {1310 set _settings($_current${what}) $_settings($what)1311 set val $_settings($what)1312 set sval [expr { 0.01 * double($val) }]1313 foreach tag [GetDatasetsWithComponent $_current] {1314 SendCmd "volume shading opacity $sval $tag"1315 }1316 }1317 "-thickness" {1318 set val $_settings($what)1319 set _settings($_current${what}) $val1320 updateTransferFunctions1321 }1322 "-outlinevisible" {1323 SendCmd "volume outline state $_settings($what)"1324 }1325 "-outlinecolor" {1326 set rgb [Color2RGB $_settings($what)]1327 SendCmd "volume outline color $rgb"1328 }1329 "-isosurfaceshading" {1330 SendCmd "volume shading isosurface $_settings($what)"1331 }1332 1232 "-colormap" { 1333 1233 set color [$itk_component(colormap) value] … … 1336 1236 ResetColormap $_current $color 1337 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 set tag [lindex $datasets 0] 1247 if { $bool } { 1248 foreach axis { x y z } { 1249 if { $_settings(-${axis}cutplanevisible) } { 1250 SendCmd "cutplane state 1 $axis $tag" 1251 } 1252 } 1253 } else { 1254 foreach axis { x y z } { 1255 SendCmd "cutplane state 0 $axis $tag" 1256 } 1257 } 1258 } 1338 1259 "-gridvisible" { 1339 1260 SendCmd "grid visible $_settings($what)" 1340 1261 } 1341 "- axesvisible" {1342 SendCmd " axis visible $_settings($what)"1262 "-isosurfaceshading" { 1263 SendCmd "volume shading isosurface $_settings($what)" 1343 1264 } 1344 1265 "-legendvisible" { … … 1351 1272 blt::table forget $itk_component(legend) 1352 1273 } 1274 } 1275 "-light" { 1276 set _settings($_current${what}) $_settings($what) 1277 set val $_settings($what) 1278 set diffuse [expr {0.01*$val}] 1279 set ambient [expr {1.0-$diffuse}] 1280 set specularLevel 0.3 1281 set specularExp 90.0 1282 foreach tag [GetDatasetsWithComponent $_current] { 1283 SendCmd "volume shading ambient $ambient $tag" 1284 SendCmd "volume shading diffuse $diffuse $tag" 1285 SendCmd "volume shading specularLevel $specularLevel $tag" 1286 SendCmd "volume shading specularExp $specularExp $tag" 1287 } 1288 } 1289 "-light2side" { 1290 set _settings($_current${what}) $_settings($what) 1291 set val $_settings($what) 1292 foreach tag [GetDatasetsWithComponent $_current] { 1293 SendCmd "volume shading light2side $val $tag" 1294 } 1295 } 1296 "-outlinevisible" { 1297 SendCmd "volume outline state $_settings($what)" 1298 } 1299 "-thickness" { 1300 set val $_settings($what) 1301 set _settings($_current${what}) $val 1302 updateTransferFunctions 1353 1303 } 1354 1304 "-volume" { … … 1365 1315 set _settings(-volumevisible) $bool 1366 1316 } 1317 "-volumeopacity" { 1318 set _settings($what) [expr $_widget($what) * 0.01] 1319 set _settings($_current${what}) $_settings($what) 1320 1321 foreach {cmap wmap} $_cname2transferFunction($_current) break 1322 set wmap [ComputeAlphamap $_current] 1323 set _cname2transferFunction($_current) [list $cmap $wmap] 1324 SendCmd [list transfunc define $_current $cmap $wmap] 1325 } 1367 1326 "-volumevisible" { 1368 1327 # This is the component specific control. It changes the … … 1373 1332 } 1374 1333 } 1375 "-cutplanesvisible" {1376 set bool $_settings($what)1377 set datasets [CurrentDatasets -cutplanes]1378 set tag [lindex $datasets 0]1379 SendCmd "cutplane visible $bool $tag"1380 }1381 1334 "-xcutplanevisible" - "-ycutplanevisible" - "-zcutplanevisible" { 1382 1335 set axis [string range $what 1 1] 1383 1336 set bool $_settings($what) 1337 # We only set cutplanes on the first dataset. 1384 1338 set datasets [CurrentDatasets -cutplanes] 1385 1339 set tag [lindex $datasets 0] 1386 SendCmd "cutplane state $bool $axis $tag" 1340 if { $_settings(-cutplanesvisible) } { 1341 SendCmd "cutplane state $bool $axis $tag" 1342 } 1387 1343 if { $bool } { 1388 1344 $itk_component(${axis}CutScale) configure -state normal \ … … 1428 1384 # 1429 1385 itcl::body Rappture::NanovisViewer::NameTransferFunction { dataobj cname } { 1430 array set style {1386 array set styles { 1431 1387 -color BCGYR 1432 1388 -levels 6 … … 1434 1390 } 1435 1391 set tag $dataobj-$cname 1436 array set style [lindex [$dataobj components -style $cname] 0]1392 array set styles [lindex [$dataobj components -style $cname] 0] 1437 1393 if { ![info exists _cname2transferFunction($cname)] } { 1438 1394 # Get the colormap right now, since it doesn't change with marker 1439 1395 # changes. 1440 set cmap [ColorsToColormap $style (-color)]1396 set cmap [ColorsToColormap $styles(-color)] 1441 1397 set wmap [list 0.0 0.0 1.0 1.0] 1442 1398 set _cname2transferFunction($cname) [list $cmap $wmap] … … 1474 1430 # reference. 1475 1431 if { ![info exists _parsedFunction($cname)] } { 1476 array set style {1432 array set styles { 1477 1433 -color BCGYR 1478 1434 -levels 6 … … 1482 1438 foreach tag [GetDatasetsWithComponent $cname] { 1483 1439 foreach {dataobj cname} [split [lindex $tag 0] -] break 1484 array set style [lindex [$dataobj components -style $cname] 0]1440 array set styles [lindex [$dataobj components -style $cname] 0] 1485 1441 } 1486 1442 eval $_transferFunctionEditors($cname) limits $_limits($cname) 1487 1443 # Have to defer creation of isomarkers until we have data limits 1488 if { [info exists style (-markers)] &&1489 [llength $style (-markers)] > 0 } {1490 ParseMarkersOption $cname $style (-markers)1444 if { [info exists styles(-markers)] && 1445 [llength $styles(-markers)] > 0 } { 1446 ParseMarkersOption $cname $styles(-markers) 1491 1447 } else { 1492 ParseLevelsOption $cname $style (-levels)1448 ParseLevelsOption $cname $styles(-levels) 1493 1449 } 1494 1450 … … 1734 1690 1735 1691 set font [option get $itk_component(hull) font Font] 1736 #set bfont [option get $itk_component(hull) boldFont Font]1737 1738 label $inner.lighting_l \ 1739 -text "Lighting / Material Properties"\1740 - font "Arial 9 bold"1741 1742 checkbutton $inner.light2side \1743 -text "Two-sided lighting" \ 1744 -font $font\1692 set fg [option get $itk_component(hull) font Font] 1693 #set bfg [option get $itk_component(hull) boldFont Font] 1694 1695 checkbutton $inner.vol -text "Show volume" -font $fg \ 1696 -variable [itcl::scope _settings(-volumevisible)] \ 1697 -command [itcl::code $this AdjustSetting -volumevisible] 1698 label $inner.shading -text "Shading:" -font $fg 1699 1700 checkbutton $inner.light2side -text "Two-sided lighting" -font $fg \ 1745 1701 -variable [itcl::scope _settings(-light2side)] \ 1746 1702 -command [itcl::code $this AdjustSetting -light2side] 1747 1703 1748 checkbutton $inner.visibility \ 1749 -text "Visible" \ 1750 -font $font \ 1751 -variable [itcl::scope _settings(-volumevisible)] \ 1752 -command [itcl::code $this AdjustSetting -volumevisible] \ 1753 1754 label $inner.ambient_l \ 1755 -text "Ambient" \ 1756 -font $font 1757 ::scale $inner.ambient -from 0 -to 100 -orient horizontal \ 1758 -variable [itcl::scope _settings(-ambient)] \ 1759 -showvalue off -command [itcl::code $this AdjustSetting -ambient] \ 1760 -troughcolor grey92 1761 1762 label $inner.diffuse_l -text "Diffuse" -font $font 1763 ::scale $inner.diffuse -from 0 -to 100 -orient horizontal \ 1764 -variable [itcl::scope _settings(-diffuse)] \ 1765 -showvalue off -command [itcl::code $this AdjustSetting -diffuse] \ 1766 -troughcolor grey92 1767 1768 label $inner.specularLevel_l -text "Specular" -font $font 1769 ::scale $inner.specularLevel -from 0 -to 100 -orient horizontal \ 1770 -variable [itcl::scope _settings(-specularlevel)] \ 1771 -showvalue off \ 1772 -command [itcl::code $this AdjustSetting -specularlevel] \ 1773 -troughcolor grey92 1774 1775 label $inner.specularExponent_l -text "Shininess" -font $font 1776 ::scale $inner.specularExponent -from 10 -to 128 -orient horizontal \ 1777 -variable [itcl::scope _settings(-specularexponent)] \ 1778 -showvalue off \ 1779 -command [itcl::code $this AdjustSetting -specularexponent] \ 1780 -troughcolor grey92 1781 1782 label $inner.opacity_l -text "Opacity" -font $font 1783 ::scale $inner.opacity -from 0 -to 100 -orient horizontal \ 1784 -variable [itcl::scope _settings(-opacity)] \ 1785 -showvalue off -command [itcl::code $this AdjustSetting -opacity] \ 1786 -troughcolor grey92 1787 1788 label $inner.transferfunction_l \ 1789 -text "Transfer Function" -font "Arial 9 bold" 1790 1791 label $inner.thin -text "Thin" -font $font 1704 label $inner.dim -text "Glow" -font $fg 1705 ::scale $inner.light -from 0 -to 100 -orient horizontal \ 1706 -variable [itcl::scope _settings(-light)] \ 1707 -width 10 \ 1708 -showvalue off -command [itcl::code $this AdjustSetting -light] 1709 label $inner.bright -text "Surface" -font $fg 1710 1711 # Opacity 1712 label $inner.fog -text "Clear" -font $fg 1713 ::scale $inner.transp -from 0 -to 100 -orient horizontal \ 1714 -variable [itcl::scope _widget(-volumeopacity)] \ 1715 -width 10 \ 1716 -showvalue off -command [itcl::code $this AdjustSetting -volumeopacity] 1717 label $inner.plastic -text "Opaque" -font $fg 1718 1719 # Tooth thickness 1720 label $inner.thin -text "Thin" -font $fg 1792 1721 ::scale $inner.thickness -from 0 -to 1000 -orient horizontal \ 1793 1722 -variable [itcl::scope _settings(-thickness)] \ 1794 - showvalue off -command [itcl::code $this AdjustSetting -thickness]\1795 - troughcolor grey921796 1797 label $inner.thick -text "Thick" -font $font 1798 1799 label $inner.colormap_l -text "Colormap" -font $font1723 -width 10 \ 1724 -showvalue off -command [itcl::code $this AdjustSetting -thickness] 1725 label $inner.thick -text "Thick" -font $fg 1726 1727 # Colormap 1728 label $inner.colormap_l -text "Colormap" -font "Arial 9" 1800 1729 itk_component add colormap { 1801 1730 Rappture::Combobox $inner.colormap -width 10 -editable no … … 1808 1737 set _settings(-colormap) "default" 1809 1738 1739 # Component 1810 1740 label $inner.volcomponents_l -text "Component" -font $font 1811 1741 itk_component add volcomponents { … … 1818 1748 0,0 $inner.volcomponents_l -anchor e -cspan 2 \ 1819 1749 0,2 $inner.volcomponents -cspan 3 -fill x \ 1820 1,1 $inner.lighting_l -anchor w -cspan 4 \ 1821 2,1 $inner.ambient_l -anchor e -pady 2 \ 1822 2,2 $inner.ambient -cspan 3 -fill x \ 1823 3,1 $inner.diffuse_l -anchor e -pady 2 \ 1824 3,2 $inner.diffuse -cspan 3 -fill x \ 1825 4,1 $inner.specularLevel_l -anchor e -pady 2 \ 1826 4,2 $inner.specularLevel -cspan 3 -fill x \ 1827 5,1 $inner.specularExponent_l -anchor e -pady 2 \ 1828 5,2 $inner.specularExponent -cspan 3 -fill x \ 1829 6,1 $inner.light2side -cspan 3 -anchor w \ 1830 7,1 $inner.visibility -cspan 3 -anchor w \ 1831 8,1 $inner.transferfunction_l -anchor w -cspan 4 \ 1832 9,1 $inner.opacity_l -anchor e -pady 2 \ 1833 9,2 $inner.opacity -cspan 3 -fill x \ 1834 10,1 $inner.colormap_l -anchor e \ 1835 10,2 $inner.colormap -padx 2 -cspan 3 -fill x \ 1836 11,1 $inner.thin -anchor e \ 1837 11,2 $inner.thickness -cspan 2 -fill x \ 1838 11,4 $inner.thick -anchor w 1839 1840 blt::table configure $inner c* r* -resize none 1841 blt::table configure $inner r* -pady { 2 0 } 1842 blt::table configure $inner c2 c3 r12 -resize expand 1843 blt::table configure $inner c0 -width .1i 1750 1,0 $inner.shading -cspan 4 -anchor w -pady {10 2} \ 1751 2,0 $inner.light2side -cspan 4 -anchor w -pady 2 \ 1752 3,0 $inner.dim -anchor e -pady 2 \ 1753 3,1 $inner.light -cspan 2 -pady 2 -fill x \ 1754 3,3 $inner.bright -anchor w -pady 2 \ 1755 4,0 $inner.fog -anchor e -pady 2 \ 1756 4,1 $inner.transp -cspan 2 -pady 2 -fill x \ 1757 4,3 $inner.plastic -anchor w -pady 2 \ 1758 5,0 $inner.thin -anchor e -pady 2 \ 1759 5,1 $inner.thickness -cspan 2 -pady 2 -fill x\ 1760 5,3 $inner.thick -anchor w -pady 2 1761 1762 blt::table configure $inner c0 c1 c3 r* -resize none 1763 blt::table configure $inner r6 -resize expand 1844 1764 } 1845 1765 … … 1855 1775 -command [itcl::code $this AdjustSetting -cutplanesvisible] \ 1856 1776 -font "Arial 9" 1857 1777 1858 1778 # X-value slicer... 1859 1779 itk_component add xCutButton { … … 1940 1860 1941 1861 blt::table $inner \ 1942 0,1 $inner.visible -anchor w -pady 2 -cspan 4 \ 1943 1,1 $itk_component(xCutScale) \ 1944 1,2 $itk_component(yCutScale) \ 1945 1,3 $itk_component(zCutScale) \ 1946 2,1 $itk_component(xCutButton) \ 1947 2,2 $itk_component(yCutButton) \ 1948 2,3 $itk_component(zCutButton) 1949 1950 blt::table configure $inner r0 r1 r2 c* -resize none 1951 blt::table configure $inner r3 c4 -resize expand 1862 1,1 $itk_component(xCutButton) \ 1863 1,2 $itk_component(yCutButton) \ 1864 1,3 $itk_component(zCutButton) \ 1865 0,1 $itk_component(xCutScale) \ 1866 0,2 $itk_component(yCutScale) \ 1867 0,3 $itk_component(zCutScale) 1868 1869 blt::table configure $inner r0 r1 c* -resize none 1870 blt::table configure $inner r2 c4 -resize expand 1952 1871 blt::table configure $inner c0 -width 2 1953 1872 blt::table configure $inner c1 c2 c3 -padx 2 … … 2180 2099 # InitComponentSettings -- 2181 2100 # 2182 # Initializes the volume settings for a specific component. This 2183 # should match what's used as global settings above. This 2184 # is called the first time we try to switch to a given component 2185 # in SwitchComponent below. 2101 # Initializes the volume settings for a specific component. This should 2102 # match what's used as global settings above. This is called the first 2103 # time we try to switch to a given component in SwitchComponent below. 2186 2104 # 2187 2105 itcl::body Rappture::NanovisViewer::InitComponentSettings { cname } { 2188 # Expanding component name for key. 2189 array set _settings [subst { 2190 $cname-ambient 60 2191 $cname-colormap default 2192 $cname-diffuse 40 2193 $cname-light2side 1 2194 $cname-opacity 50 2195 $cname-specularexponent 90 2196 $cname-specularlevel 30 2197 $cname-thickness 350 2198 $cname-volumevisible 1 2199 }] 2106 foreach {key value} { 2107 -colormap "default" 2108 -light 40 2109 -light2side 1 2110 -thickness 350 2111 -volumeopacity 1.0 2112 -volumevisible 1 2113 } { 2114 if { ![info exists _settings($cname${key})] } { 2115 # Don't override existing component settings 2116 set _settings($cname${key}) $value 2117 } 2118 } 2200 2119 } 2201 2120 … … 2203 2122 # SwitchComponent -- 2204 2123 # 2205 # This is called when the current component is changed by the2206 # dropdown menu in the volume tab. It synchronizes the global2207 # volume settingswith the settings of the new current component.2124 # This is called when the current component is changed by the dropdown 2125 # menu in the volume tab. It synchronizes the global volume settings 2126 # with the settings of the new current component. 2208 2127 # 2209 2128 itcl::body Rappture::NanovisViewer::SwitchComponent { cname } { 2210 if { ![info exists _settings($cname- ambient)] } {2129 if { ![info exists _settings($cname-light)] } { 2211 2130 InitComponentSettings $cname 2212 2131 } 2132 if { $_settings(-colormap) != $_settings($cname-colormap) } { 2133 set _settings(-colormap) $_settings($cname-colormap) 2134 EventuallyRedrawLegend 2135 } 2213 2136 # _settings variables change widgets, except for colormap 2214 set _settings(-ambient) $_settings($cname-ambient) 2215 set _settings(-colormap) $_settings($cname-colormap) 2216 set _settings(-diffuse) $_settings($cname-diffuse) 2137 set _settings(-light) $_settings($cname-light) 2217 2138 set _settings(-light2side) $_settings($cname-light2side) 2218 set _settings(-opacity) $_settings($cname-opacity) 2219 set _settings(-specularexponent) $_settings($cname-specularexponent) 2220 set _settings(-specularlevel) $_settings($cname-specularlevel) 2139 set _settings(-volumeopacity) $_settings($cname-volumeopacity) 2221 2140 set _settings(-thickness) $_settings($cname-thickness) 2222 2141 set _settings(-volumevisible) $_settings($cname-volumevisible) 2223 2142 $itk_component(colormap) value $_settings($cname-colormap) 2143 2144 set _widget(-volumeopacity) [expr $_settings(-volumeopacity) * 100.0] 2145 2224 2146 set _current $cname; # Reset the current component 2225 2147 } … … 2228 2150 # BuildVolumeComponents -- 2229 2151 # 2230 # This is called from the "scale" method which is called when a2231 # new dataset is added or deleted. It repopulates the dropdown2232 # menu of volume component names. It sets the current component2233 # to the first component in the list (of components found).2234 # Finally, if there is only one component, don't displaythe2235 # label or the combobox in thevolume settings tab.2152 # This is called from the "scale" method which is called when a new 2153 # dataset is added or deleted. It repopulates the dropdown menu of 2154 # volume component names. It sets the current component to the first 2155 # component in the list (of components found). Finally, if there is 2156 # only one component, don't display the label or the combobox in the 2157 # volume settings tab. 2236 2158 # 2237 2159 itcl::body Rappture::NanovisViewer::BuildVolumeComponents {} { … … 2259 2181 # GetDatasetsWithComponents -- 2260 2182 # 2261 # Returns a list of all the datasets (known by the combination of2262 # their data object and component name) that match the given2263 # component name. For example, this is used where we want to change2264 # the settings ofvolumes that have the current component.2183 # Returns a list of all the datasets (known by the combination of their 2184 # data object and component name) that match the given component name. 2185 # For example, this is used where we want to change the settings of 2186 # volumes that have the current component. 2265 2187 # 2266 2188 itcl::body Rappture::NanovisViewer::GetDatasetsWithComponent { cname } { … … 2281 2203 # HideAllMarkers -- 2282 2204 # 2283 # Hide all the markers in all the transfer functions. Can't simply2284 # delete and recreate markers from the <style> since the user may2285 # havecreate, deleted, or moved markers.2205 # Hide all the markers in all the transfer functions. Can't simply 2206 # delete and recreate markers from the <style> since the user may have 2207 # create, deleted, or moved markers. 2286 2208 # 2287 2209 itcl::body Rappture::NanovisViewer::HideAllMarkers {} { … … 2321 2243 return [list 0.0 0.0 1.0 1.0] 2322 2244 } 2323 if { ![info exists _settings($cname- ambient)] } {2245 if { ![info exists _settings($cname-light)] } { 2324 2246 InitComponentSettings $cname 2325 2247 } … … 2328 2250 2329 2251 # Currently using volume shading opacity to scale opacity in 2330 # the volume shader. The transfer function always sets full 2331 # opacity 2332 set max 1.0 2252 # the volume shader. 2253 set max $_settings($cname-volumeopacity) 2333 2254 2334 2255 # Use the component-wise thickness setting from the slider … … 2549 2470 } 2550 2471 2551 2472 itcl::body Rappture::NanovisViewer::SetObjectStyle { dataobj cname } { 2473 array set styles { 2474 -opacity 0.6 2475 } 2476 array set styles [lindex [$dataobj components -style $cname] 0] 2477 set _settings($cname-volumeopacity) $styles(-opacity) 2478 NameTransferFunction $dataobj $cname 2479 } -
branches/r9/gui/scripts/resultselector.tcl
r4214 r4919 1295 1295 foreach col [lrange [$_resultset diff names] 1 end] { 1296 1296 set quantity $_cntlInfo($this-$col-label) 1297 set val [lindex [$_resultset get $col $xmlobj] 0] 1297 1298 # Don't know why this was being treated as a list. 1299 #set val [lindex [$_resultset get $col $xmlobj] 0] 1300 1301 set val [$_resultset get $col $xmlobj] 1298 1302 append desc "$quantity = $val\n" 1299 1303 } -
branches/r9/gui/scripts/transferfunctioneditor.tcl
r4121 r4919 199 199 set absval [GetAbsoluteValue $name] 200 200 set y 31 201 $_canvas itemconfigure $_labels($name) -text [format % .2g $absval]201 $_canvas itemconfigure $_labels($name) -text [format %g $absval] 202 202 $_canvas coords $_ticks($name) $x [expr {$y+3}] 203 203 $_canvas coords $_labels($name) $x [expr {$y+5}] … … 215 215 set _values($name) $relval 216 216 set y 31 217 $_canvas itemconfigure $_label -text [format % .2g $absval]217 $_canvas itemconfigure $_label -text [format %g $absval] 218 218 set x [GetScreenPosition $name] 219 219 $_canvas coords $_ticks($name) $x [expr {$y+3}] … … 231 231 set y 31 232 232 set absval [GetAbsoluteValue $name] 233 $_canvas itemconfigure $_labels($name) -text [format % .2g $absval]233 $_canvas itemconfigure $_labels($name) -text [format %g $absval] 234 234 $_canvas coords $_ticks($name) $x [expr {$y+3}] 235 235 $_canvas coords $_labels($name) $x [expr {$y+5}] -
branches/r9/gui/scripts/unirect2d.tcl
r4030 r4919 176 176 # ---------------------------------------------------------------------- 177 177 # method blob 178 # Returns a base64 encoded, gzipped Tcl list that represents the 179 # Tcl command and data to recreate the uniform rectangular grid 180 # on the nanovis server. 178 # Returns a Tcl list that represents the Tcl command and data to 179 # recreate the uniform rectangular grid on the nanovis server. 181 180 # ---------------------------------------------------------------------- 182 181 itcl::body Rappture::Unirect2d::blob {} { … … 184 183 lappend data "xmin" $_xMin "xmax" $_xMax "xnum" $_xNum 185 184 lappend data "ymin" $_yMin "ymax" $_yMax "ynum" $_yNum 186 lappend data "xmin" $_xMin "ymin" $_yMin "xmax" $_xMax "ymax" $_yMax187 185 return $data 188 186 } … … 190 188 # ---------------------------------------------------------------------- 191 189 # method mesh 192 # Returns a base64 encoded, gzipped Tcl list that represents the 193 # Tcl command and data to recreate the uniform rectangular grid 194 # on the nanovis server. 190 # Returns a Tcl list that represents the mesh limits and dims. 195 191 # ---------------------------------------------------------------------- 196 192 itcl::body Rappture::Unirect2d::mesh {} { -
branches/r9/gui/scripts/unirect3d.tcl
r4030 r4919 41 41 private variable _xMax 0 42 42 private variable _xMin 0 43 private variable _xNum 0; # Number of points along x-axis .43 private variable _xNum 0; # Number of points along x-axis 44 44 private variable _yMax 0 45 45 private variable _yMin 0 46 private variable _yNum 0; # Number of points along y-axis .46 private variable _yNum 0; # Number of points along y-axis 47 47 private variable _zMax 0 48 48 private variable _zMin 0 49 private variable _zNum 0; # Number of points along z-axis .50 private variable _compNum 1; # Number of components in values .51 private variable _values ""; # BLT vector containing the z-values49 private variable _zNum 0; # Number of points along z-axis 50 private variable _compNum 1; # Number of components in values 51 private variable _values ""; # BLT vector containing the values 52 52 private variable _hints 53 53 } … … 124 124 # ---------------------------------------------------------------------- 125 125 # method blob 126 # Returns a base64 encoded, gzipped Tcl list that represents the 127 # Tcl command and data to recreate the uniform rectangular grid 128 # on the nanovis server. 126 # Returns a Tcl list that represents the Tcl command and data to 127 # recreate the uniform rectangular grid on the nanovis server. 129 128 # ---------------------------------------------------------------------- 130 129 itcl::body Rappture::Unirect3d::blob {} { … … 142 141 # ---------------------------------------------------------------------- 143 142 # method mesh 144 # Returns a base64 encoded, gzipped Tcl list that represents the 145 # Tcl command and data to recreate the uniform rectangular grid 146 # on the nanovis server. 143 # Returns a Tcl list that represents the points of the uniform 144 # grid. 147 145 # ---------------------------------------------------------------------- 148 146 itcl::body Rappture::Unirect3d::mesh {} { … … 166 164 # ---------------------------------------------------------------------- 167 165 # method values 168 # Returns a base64 encoded, gzipped Tcl list that represents the 169 # Tcl command and data to recreate the uniform rectangular grid 170 # on the nanovis server. 166 # Returns a Tcl list that represents the field values 171 167 # ---------------------------------------------------------------------- 172 168 itcl::body Rappture::Unirect3d::values {} { … … 179 175 # ---------------------------------------------------------------------- 180 176 # method valuesObj 181 # Returns a base64 encoded, gzipped Tcl list that represents the 182 # Tcl command and data to recreate the uniform rectangular grid 183 # on the nanovis server. 177 # Returns a BLT vector that represents the field values 184 178 # ---------------------------------------------------------------------- 185 179 itcl::body Rappture::Unirect3d::valuesObj {} { -
branches/r9/gui/scripts/visviewer.tcl
r4336 r4919 37 37 private variable _icon 0 38 38 39 # Number of milliseconds to wait before idle timeout. If greater than 40 # 0, automatically disconnect from the visualization server when idle41 # timeoutis reached.39 # Number of milliseconds to wait before idle timeout. If greater than 0, 40 # automatically disconnect from the visualization server when idle timeout 41 # is reached. 42 42 private variable _idleTimeout 43200000; # 12 hours 43 43 #private variable _idleTimeout 5000; # 5 seconds … … 284 284 if { [gets $_sid data] <= 0 } { 285 285 set _sid "" 286 puts stderr "reading from server data=($data)"286 puts stderr "reading from server" 287 287 RemoveServerFromList $_serverType $server 288 288 continue … … 454 454 set _done($this) 1 455 455 set _buffer(out) $bytes 456 if {1} { 457 # Let's try this approach: allow a write to block so we don't 458 # re-enter SendBytes 459 SendHelper 460 } else { 461 # This can cause us to re-enter SendBytes during the tkwait, which 462 # is not safe because the _buffer will be clobbered 463 fileevent $_sid writable [itcl::code $this SendHelper] 464 tkwait variable ::Rappture::VisViewer::_done($this) 465 } 456 457 # There's problem when the user is interacting with the GUI at the 458 # same time we're trying to write to the server. Don't want to 459 # block because, the GUI will look like it's dead. We can start 460 # by putting a busy window over plot so that inadvertent things like 461 # mouse movements aren't received. 462 463 blt::busy hold $itk_component(main) 464 fileevent $_sid writable [itcl::code $this SendHelper] 465 tkwait variable ::Rappture::VisViewer::_done($this) 466 blt::busy release $itk_component(main) 467 466 468 set _buffer(out) "" 467 469 if { [IsConnected] } { 468 # The connection may have closed while we were writing to the 469 # server. This can happen if what we sent the server caused it to 470 # barf. 470 # The connection may have closed while we were writing to the server. 471 # This can happen if what we sent the server caused it to barf. 471 472 fileevent $_sid writable "" 472 473 flush $_sid … … 518 519 # Helper routine called from a file event when the connection is readable 519 520 # (i.e. a command response has been sent by the rendering server. Reads 520 # the incoming command and executes it in a safe interpreter to handle 521 # theaction.521 # the incoming command and executes it in a safe interpreter to handle the 522 # action. 522 523 # 523 524 # Note: This routine currently only handles command responses from … … 601 602 # SendEcho -- 602 603 # 603 # Used internally to echo sent data to clients interested in this 604 # widget. If the -sendcommand opti on is set, then it is invoked in605 # the global scope with the <channel> and <data> values as arguments.606 # Otherwise, this doesnothing.604 # Used internally to echo sent data to clients interested in this widget. 605 # If the -sendcommand option is set, then it is invoked in the global scope 606 # with the <channel> and <data> values as arguments. Otherwise, this does 607 # nothing. 607 608 # 608 609 itcl::body Rappture::VisViewer::SendEcho {channel {data ""}} { 609 610 if { $_logging } { 610 set f [open "/tmp/recording.log" "a"] 611 puts $f $data 612 close $f 611 set f [open "/tmp/recording.log" "a"] 612 fconfigure $f -translation binary -encoding binary 613 puts -nonewline $f $data 614 close $f 613 615 } 614 616 #puts stderr ">>($data)" … … 1135 1137 } 1136 1138 } 1137 #regsub -all "\n" $cmap " " cmap1138 1139 return $cmap 1139 1140 } … … 1152 1153 # 1153 1154 # StopBufferingCommands -- 1155 # 1156 # This gets called when we want to stop buffering the commands for 1157 # the server and actually send then to the server. Note that there's 1158 # a reference count on buffering. This is so that you can can 1159 # Start/Stop multiple times without worrying about the current state. 1154 1160 # 1155 1161 itcl::body Rappture::VisViewer::StopBufferingCommands { } { -
branches/r9/gui/scripts/vtkglyphviewer.tcl
r4344 r4919 118 118 # heightmaps displayed. 119 119 private variable _currentColormap "" 120 private variable _currentOpacity ""121 120 122 121 private variable _dataset2style ;# maps dataobj-component to transfunc … … 183 182 $_dispatcher register !xcutplane 184 183 $_dispatcher dispatch $this !xcutplane \ 185 "[itcl::code $this AdjustSetting cutplaneXPosition]; list"184 "[itcl::code $this AdjustSetting -cutplanexposition]; list" 186 185 187 186 # Y-Cutplane event 188 187 $_dispatcher register !ycutplane 189 188 $_dispatcher dispatch $this !ycutplane \ 190 "[itcl::code $this AdjustSetting cutplaneYPosition]; list"189 "[itcl::code $this AdjustSetting -cutplaneyposition]; list" 191 190 192 191 # Z-Cutplane event 193 192 $_dispatcher register !zcutplane 194 193 $_dispatcher dispatch $this !zcutplane \ 195 "[itcl::code $this AdjustSetting cutplaneZPosition]; list"194 "[itcl::code $this AdjustSetting -cutplanezposition]; list" 196 195 197 196 # … … 218 217 219 218 array set _settings [subst { 220 background black 221 colormap BCGYR 222 colormapVisible 1 223 field "Default" 224 axesVisible 1 225 axisLabelsVisible 1 226 axisXGrid 0 227 axisYGrid 0 228 axisZGrid 0 229 cutplaneEdges 0 230 cutplaneLighting 1 231 cutplanePreinterp 1 232 cutplaneOpacity 100 233 cutplaneVisible 0 234 cutplaneWireframe 0 235 cutplaneXPosition 50 236 cutplaneXVisible 1 237 cutplaneYPosition 50 238 cutplaneYVisible 1 239 cutplaneZPosition 50 240 cutplaneZVisible 1 241 glyphEdges 0 242 glyphLighting 1 243 glyphNormscale 1 244 glyphOpacity 100 245 saveGlyphOpacity 100 246 glyphOrient 1 247 glyphOutline 0 248 glyphScale 1 249 glyphScaleMode "vmag" 250 glyphShape "arrow" 251 glyphVisible 1 252 glyphWireframe 0 253 legendVisible 1 219 -axesvisible 1 220 -axislabels 1 221 -axisminorticks 1 222 -axismode "static" 223 -background black 224 -colormap BCGYR 225 -colormapvisible 1 226 -cutplaneedges 0 227 -cutplanelighting 1 228 -cutplanepreinterp 1 229 -cutplaneopacity 100 230 -cutplanevisible 0 231 -cutplanewireframe 0 232 -cutplanexposition 50 233 -cutplanexvisible 1 234 -cutplaneyposition 50 235 -cutplaneyvisible 1 236 -cutplanezposition 50 237 -cutplanezvisible 1 238 -field "Default" 239 -glyphedges 0 240 -glyphlighting 1 241 -glyphopacity 100 242 -glyphoutline 0 243 -glyphscale 1 244 -glyphvisible 1 245 -glyphwireframe 0 246 -legendvisible 1 247 -saveglyphopacity 100 248 -xgrid 0 249 -ygrid 0 250 -zgrid 0 254 251 }] 255 252 array set _changed { 256 glyphOpacity0257 colormap0253 -colormap 0 254 -glyphopacity 0 258 255 } 259 256 … … 335 332 -onimage [Rappture::icon volume-on] \ 336 333 -offimage [Rappture::icon volume-off] \ 337 -variable [itcl::scope _settings( glyphVisible)] \338 -command [itcl::code $this AdjustSetting glyphVisible]334 -variable [itcl::scope _settings(-glyphvisible)] \ 335 -command [itcl::code $this AdjustSetting -glyphvisible] 339 336 } 340 337 $itk_component(glyphs) select … … 348 345 -onimage [Rappture::icon cutbutton] \ 349 346 -offimage [Rappture::icon cutbutton] \ 350 -variable [itcl::scope _settings( cutplaneVisible)] \351 -command [itcl::code $this AdjustSetting cutplaneVisible]347 -variable [itcl::scope _settings(-cutplanevisible)] \ 348 -command [itcl::code $this AdjustSetting -cutplanevisible] 352 349 } 353 350 Rappture::Tooltip::for $itk_component(cutplane) \ … … 439 436 eval itk_initialize $args 440 437 Connect 441 update442 438 } 443 439 … … 547 543 } 548 544 549 550 545 # ---------------------------------------------------------------------- 551 546 # USAGE: delete ?<dataobj1> <dataobj2> ...? 552 547 # 553 # 554 # 555 # 548 # Clients use this to delete a dataobj from the plot. If no dataobjs 549 # are specified, then all dataobjs are deleted. No data objects are 550 # deleted. They are only removed from the display list. 556 551 # 557 552 # ---------------------------------------------------------------------- … … 782 777 set session $env(SESSION) 783 778 } 779 lappend info "version" "$Rappture::version" 780 lappend info "build" "$Rappture::build" 781 lappend info "svnurl" "$Rappture::svnurl" 782 lappend info "installdir" "$Rappture::installdir" 784 783 lappend info "hub" [exec hostname] 785 784 lappend info "client" "vtkglyphviewer" … … 799 798 # isconnected -- 800 799 # 801 # 800 # Indicates if we are currently connected to the visualization server. 802 801 # 803 802 itcl::body Rappture::VtkGlyphViewer::isconnected {} { … … 816 815 # Disconnect -- 817 816 # 818 # 819 # 817 # Clients use this method to disconnect from the current rendering 818 # server. 820 819 # 821 820 itcl::body Rappture::VtkGlyphViewer::Disconnect {} { … … 955 954 PanCamera 956 955 set _first "" 957 InitSettings axisXGrid axisYGrid axisZGrid axisMode \958 axesVisible axisLabelsVisible956 InitSettings -xgrid -ygrid -zgrid -axismode \ 957 -axesvisible -axislabels -axisminorticks 959 958 foreach axis { x y z } { 960 959 SendCmd "axis lformat $axis %g" … … 975 974 if { ![info exists _datasets($tag)] } { 976 975 set bytes [$dataobj vtkdata $comp] 977 978 979 980 976 if 0 { 977 set f [open "/tmp/glyph.vtk" "w"] 978 puts $f $bytes 979 close $f 981 980 } 982 981 set length [string length $bytes] … … 992 991 SendCmd "clientinfo [list $info]" 993 992 } 994 append _outbuf "dataset add $tag data follows $length\n"993 SendCmd "dataset add $tag data follows $length" 995 994 append _outbuf $bytes 996 995 set _datasets($tag) 1 … … 1001 1000 # Setting dataset visible enables outline 1002 1001 # and glyphs 1003 1002 SendCmd "dataset visible 1 $tag" 1004 1003 } 1005 1004 } … … 1007 1006 1008 1007 if { $_first != "" } { 1009 1010 1011 1008 $itk_component(field) choices delete 0 end 1009 $itk_component(fieldmenu) delete 0 end 1010 array unset _fields 1012 1011 set _curFldName "" 1013 1012 foreach cname [$_first components] { … … 1035 1034 $itk_component(field) value $_curFldLabel 1036 1035 } 1037 InitSettings glyphOutline1038 # cutplaneVisible1036 InitSettings -glyphoutline 1037 #-cutplanevisible 1039 1038 if { $_reset } { 1040 1039 # These are settings that rely on a dataset being loaded. 1041 1040 InitSettings \ 1042 glyphLighting \1043 field \1044 glyphEdges glyphLighting glyphOpacity \1045 glyphWireframe1046 1047 # cutplaneXPosition cutplaneYPosition cutplaneZPosition \1048 cutplaneXVisible cutplaneYVisible cutplaneZVisible \1049 cutplanePreinterp1041 -glyphlighting \ 1042 -field \ 1043 -glyphedges -glyphlighting -glyphopacity \ 1044 -glyphwireframe 1045 1046 #-cutplanexposition -cutplaneyposition -cutplanezposition \ 1047 -cutplanexvisible -cutplaneyvisible -cutplanezvisible \ 1048 -cutplanepreinterp 1050 1049 1051 1050 Zoom reset 1052 1051 foreach axis { x y z } { 1053 1052 # Another problem fixed by a <view>. We looking into a data 1054 1053 # object for the name of the axes. This should be global to 1055 1054 # the viewer itself. 1056 1057 1055 set label [$_first hints ${axis}label] 1056 if { $label == "" } { 1058 1057 set label [string toupper $axis] 1059 1060 1061 1058 } 1059 # May be a space in the axis label. 1060 SendCmd [list axis name $axis $label] 1062 1061 } 1063 1062 if { [array size _fields] < 2 } { 1064 blt::table forget $itk_component(field) $itk_component(field_l)1063 catch {blt::table forget $itk_component(field) $itk_component(field_l)} 1065 1064 } 1066 1065 set _reset 0 … … 1166 1165 SendCmd "camera pan $x $y" 1167 1166 } 1168 1169 1167 1170 1168 # ---------------------------------------------------------------------- … … 1287 1285 itcl::body Rappture::VtkGlyphViewer::InitSettings { args } { 1288 1286 foreach spec $args { 1289 if { [info exists _settings($_first -$spec)] } {1287 if { [info exists _settings($_first${spec})] } { 1290 1288 # Reset global setting with dataobj specific setting 1291 set _settings($spec) $_settings($_first -$spec)1289 set _settings($spec) $_settings($_first${spec}) 1292 1290 } 1293 1291 AdjustSetting $spec … … 1298 1296 # AdjustSetting -- 1299 1297 # 1300 # 1301 # 1302 # 1298 # Changes/updates a specific setting in the widget. There are 1299 # usually user-setable option. Commands are sent to the render 1300 # server. 1303 1301 # 1304 1302 itcl::body Rappture::VtkGlyphViewer::AdjustSetting {what {value ""}} { … … 1307 1305 } 1308 1306 switch -- $what { 1309 " background" {1307 "-background" { 1310 1308 set bgcolor [$itk_component(background) value] 1311 1312 1313 1314 "grey""black"1315 1309 array set fgcolors { 1310 "black" "white" 1311 "white" "black" 1312 "grey" "black" 1313 } 1316 1314 configure -plotbackground $bgcolor \ 1317 1318 1319 1320 } 1321 " axesVisible" {1322 set bool $_settings( axesVisible)1315 -plotforeground $fgcolors($bgcolor) 1316 $itk_component(view) delete "legend" 1317 DrawLegend 1318 } 1319 "-axesvisible" { 1320 set bool $_settings($what) 1323 1321 SendCmd "axis visible all $bool" 1324 1322 } 1325 " axisLabelsVisible" {1326 set bool $_settings( axisLabelsVisible)1323 "-axislabels" { 1324 set bool $_settings($what) 1327 1325 SendCmd "axis labels all $bool" 1328 1326 } 1329 "axisXGrid" - "axisYGrid" - "axisZGrid" { 1330 set axis [string tolower [string range $what 4 4]] 1327 "-axisminorticks" { 1328 set bool $_settings($what) 1329 SendCmd "axis minticks all $bool" 1330 } 1331 "-xgrid" - "-ygrid" - "-zgrid" { 1332 set axis [string tolower [string range $what 1 1]] 1331 1333 set bool $_settings($what) 1332 1334 SendCmd "axis grid $axis $bool" 1333 1335 } 1334 " axisMode" {1336 "-axismode" { 1335 1337 set mode [$itk_component(axisMode) value] 1336 1338 set mode [$itk_component(axisMode) translate $mode] … … 1338 1340 SendCmd "axis flymode $mode" 1339 1341 } 1340 " cutplaneEdges" {1342 "-cutplaneedges" { 1341 1343 set bool $_settings($what) 1342 1344 SendCmd "cutplane edges $bool" 1343 1345 } 1344 " cutplaneVisible" {1346 "-cutplanevisible" { 1345 1347 set bool $_settings($what) 1346 1348 SendCmd "cutplane visible $bool" 1347 1349 } 1348 " cutplaneWireframe" {1350 "-cutplanewireframe" { 1349 1351 set bool $_settings($what) 1350 1352 SendCmd "cutplane wireframe $bool" 1351 1353 } 1352 " cutplaneLighting" {1354 "-cutplanelighting" { 1353 1355 set bool $_settings($what) 1354 1356 SendCmd "cutplane lighting $bool" 1355 1357 } 1356 " cutplaneOpacity" {1358 "-cutplaneopacity" { 1357 1359 set val $_settings($what) 1358 1360 set sval [expr { 0.01 * double($val) }] 1359 1361 SendCmd "cutplane opacity $sval" 1360 1362 } 1361 " cutplanePreinterp" {1363 "-cutplanepreinterp" { 1362 1364 set bool $_settings($what) 1363 1365 SendCmd "cutplane preinterp $bool" 1364 1366 } 1365 " cutplaneXVisible" - "cutplaneYVisible" - "cutplaneZVisible" {1366 set axis [string tolower [string range $what 8 8]]1367 "-cutplanexvisible" - "-cutplaneyvisible" - "-cutplanezvisible" { 1368 set axis [string tolower [string range $what 9 9]] 1367 1369 set bool $_settings($what) 1368 1370 if { $bool } { … … 1373 1375 -troughcolor grey82 1374 1376 } 1375 1376 } 1377 " cutplaneXPosition" - "cutplaneYPosition" - "cutplaneZPosition" {1378 set axis [string tolower [string range $what 8 8]]1377 SendCmd "cutplane axis $axis $bool" 1378 } 1379 "-cutplanexposition" - "-cutplaneyposition" - "-cutplanezposition" { 1380 set axis [string tolower [string range $what 9 9]] 1379 1381 set pos [expr $_settings($what) * 0.01] 1380 1382 SendCmd "cutplane slice ${axis} ${pos}" 1381 1383 set _cutplanePending 0 1382 1384 } 1383 " colormap" {1384 set _changed( colormap) 11385 "-colormap" { 1386 set _changed($what) 1 1385 1387 StartBufferingCommands 1386 1388 set color [$itk_component(colormap) value] 1387 set _settings( colormap) $color1388 1389 if { $_settings(colormapVisible) } {1390 1391 set _settings(colormapVisible) 01392 1393 1394 if { !$_settings(colormapVisible) } {1395 1396 set _settings(colormapVisible) 11397 1398 1399 1389 set _settings($what) $color 1390 if { $color == "none" } { 1391 if { $_settings(-colormapvisible) } { 1392 SendCmd "glyphs colormode constant {}" 1393 set _settings(-colormapvisible) 0 1394 } 1395 } else { 1396 if { !$_settings(-colormapvisible) } { 1397 SendCmd "glyphs colormode $_colorMode $_curFldName" 1398 set _settings(-colormapvisible) 1 1399 } 1400 SetCurrentColormap $color 1401 } 1400 1402 StopBufferingCommands 1401 1402 } 1403 " glyphWireframe" {1403 EventuallyRequestLegend 1404 } 1405 "-glyphwireframe" { 1404 1406 set bool $_settings($what) 1405 1406 } 1407 " glyphVisible" {1407 SendCmd "glyphs wireframe $bool" 1408 } 1409 "-glyphvisible" { 1408 1410 set bool $_settings($what) 1409 1411 SendCmd "glyphs visible $bool" 1410 1412 if { $bool } { 1411 1413 Rappture::Tooltip::for $itk_component(glyphs) \ … … 1415 1417 "Show the glyph" 1416 1418 } 1417 1418 } 1419 " glyphLighting" {1419 DrawLegend 1420 } 1421 "-glyphlighting" { 1420 1422 set bool $_settings($what) 1421 1422 } 1423 " glyphEdges" {1423 SendCmd "glyphs lighting $bool" 1424 } 1425 "-glyphedges" { 1424 1426 set bool $_settings($what) 1425 1426 } 1427 " glyphOutline" {1427 SendCmd "glyphs edges $bool" 1428 } 1429 "-glyphoutline" { 1428 1430 set bool $_settings($what) 1429 1430 } 1431 " glyphOpacity" {1431 SendCmd "outline visible $bool" 1432 } 1433 "-glyphopacity" { 1432 1434 set val $_settings($what) 1433 1435 set sval [expr { 0.01 * double($val) }] 1434 SendCmd "glyphs opacity $sval" 1435 } 1436 "glyphNormscale" { 1437 set bool $_settings($what) 1438 SendCmd "glyphs normscale $bool" 1439 } 1440 "glyphOrient" { 1441 set bool $_settings($what) 1442 SendCmd "glyphs gorient $bool {}" 1443 } 1444 "glyphScale" { 1436 SendCmd "glyphs opacity $sval" 1437 } 1438 "-glyphscale" { 1445 1439 set val $_settings($what) 1446 SendCmd "glyphs gscale $val" 1447 } 1448 "glyphScaleMode" { 1449 set label [$itk_component(scaleMode) value] 1450 set mode [$itk_component(scaleMode) translate $label] 1451 set _settings($what) $mode 1452 SendCmd "glyphs smode $mode {}" 1453 } 1454 "glyphShape" { 1455 set label [$itk_component(gshape) value] 1456 set shape [$itk_component(gshape) translate $label] 1457 set _settings($what) $shape 1458 SendCmd "glyphs shape $shape" 1459 } 1460 "field" { 1440 if { [string is double $val] } { 1441 SendCmd "glyphs gscale $val" 1442 } 1443 } 1444 "-field" { 1461 1445 set label [$itk_component(field) value] 1462 1446 set fname [$itk_component(field) translate $label] 1463 set _settings( field) $fname1447 set _settings($what) $fname 1464 1448 if { [info exists _fields($fname)] } { 1465 1449 foreach { label units components } $_fields($fname) break … … 1475 1459 return 1476 1460 } 1477 #if { ![info exists _limits($_curFldName)] } {1478 # SendCmd "dataset maprange all"1479 #} else {1480 # SendCmd "dataset maprange explicit $_limits($_curFldName) $_curFldName"1481 #}1482 #SendCmd "cutplane colormode $_colorMode $_curFldName"1483 1461 SendCmd "glyphs colormode $_colorMode $_curFldName" 1484 1462 DrawLegend 1485 1463 } 1486 " legendVisible" {1464 "-legendvisible" { 1487 1465 if { !$_settings($what) } { 1488 1466 $itk_component(view) delete legend 1489 1490 1467 } 1468 DrawLegend 1491 1469 } 1492 1470 default { … … 1496 1474 } 1497 1475 1498 1499 1476 # 1500 1477 # RequestLegend -- 1501 1478 # 1502 # 1503 # 1479 # Request a new legend from the server. The size of the legend 1480 # is determined from the height of the canvas. 1504 1481 # 1505 1482 # This should be called when 1506 # 1507 # 1508 # 1509 # 1510 # 1483 # 1. A new current colormap is set. 1484 # 2. Window is resized. 1485 # 3. The limits of the data have changed. (Just need a redraw). 1486 # 4. Number of glyph have changed. (Just need a redraw). 1487 # 5. Legend becomes visible (Just need a redraw). 1511 1488 # 1512 1489 itcl::body Rappture::VtkGlyphViewer::RequestLegend {} { … … 1520 1497 set fname $_curFldName 1521 1498 if { [string match "component*" $fname] } { 1522 1499 set title "" 1523 1500 } else { 1524 1525 1526 1527 1528 1529 1530 1531 1501 if { [info exists _fields($fname)] } { 1502 foreach { title units } $_fields($fname) break 1503 if { $units != "" } { 1504 set title [format "%s (%s)" $title $units] 1505 } 1506 } else { 1507 set title $fname 1508 } 1532 1509 } 1533 1510 # If there's a title too, substract one more line … … 1540 1517 # Set the legend on the first heightmap dataset. 1541 1518 if { $_currentColormap != "" } { 1542 1543 1519 set cmap $_currentColormap 1520 SendCmdNoWait "legend $cmap $_colorMode $_curFldName {} $w $h 0" 1544 1521 } 1545 1522 } … … 1561 1538 if { [isconnected] } { 1562 1539 set rgb [Color2RGB $itk_option(-plotforeground)] 1563 1540 SendCmd "axis color all $rgb" 1564 1541 SendCmd "outline color $rgb" 1565 1542 #SendCmd "cutplane color $rgb" … … 1587 1564 checkbutton $inner.glyphs \ 1588 1565 -text "Glyphs" \ 1589 -variable [itcl::scope _settings( glyphVisible)] \1590 -command [itcl::code $this AdjustSetting glyphVisible] \1566 -variable [itcl::scope _settings(-glyphvisible)] \ 1567 -command [itcl::code $this AdjustSetting -glyphvisible] \ 1591 1568 -font "Arial 9" 1592 1593 label $inner.gshape_l -text "Glyph shape" -font "Arial 9"1594 itk_component add gshape {1595 Rappture::Combobox $inner.gshape -width 10 -editable no1596 }1597 $inner.gshape choices insert end \1598 "arrow" "arrow" \1599 "cone" "cone" \1600 "cube" "cube" \1601 "cylinder" "cylinder" \1602 "dodecahedron" "dodecahedron" \1603 "icosahedron" "icosahedron" \1604 "line" "line" \1605 "octahedron" "octahedron" \1606 "point" "point" \1607 "sphere" "sphere" \1608 "tetrahedron" "tetrahedron"1609 1610 $itk_component(gshape) value $_settings(glyphShape)1611 bind $inner.gshape <<Value>> [itcl::code $this AdjustSetting glyphShape]1612 1613 label $inner.scaleMode_l -text "Scale by" -font "Arial 9"1614 itk_component add scaleMode {1615 Rappture::Combobox $inner.scaleMode -width 10 -editable no1616 }1617 $inner.scaleMode choices insert end \1618 "scalar" "Scalar" \1619 "vmag" "Vector magnitude" \1620 "vcomp" "Vector components" \1621 "off" "Constant size"1622 1623 $itk_component(scaleMode) value "[$itk_component(scaleMode) label $_settings(glyphScaleMode)]"1624 bind $inner.scaleMode <<Value>> [itcl::code $this AdjustSetting glyphScaleMode]1625 1626 checkbutton $inner.normscale \1627 -text "Normalize scaling" \1628 -variable [itcl::scope _settings(glyphNormscale)] \1629 -command [itcl::code $this AdjustSetting glyphNormscale] \1630 -font "Arial 9"1631 Rappture::Tooltip::for $inner.normscale "If enabled, field values are normalized to \[0,1\] before scaling and scale factor is relative to a default size"1632 1633 checkbutton $inner.gorient \1634 -text "Orient" \1635 -variable [itcl::scope _settings(glyphOrient)] \1636 -command [itcl::code $this AdjustSetting glyphOrient] \1637 -font "Arial 9"1638 Rappture::Tooltip::for $inner.gorient "Orient glyphs by vector field directions"1639 1569 1640 1570 checkbutton $inner.wireframe \ 1641 1571 -text "Wireframe" \ 1642 -variable [itcl::scope _settings( glyphWireframe)] \1643 -command [itcl::code $this AdjustSetting glyphWireframe] \1572 -variable [itcl::scope _settings(-glyphwireframe)] \ 1573 -command [itcl::code $this AdjustSetting -glyphwireframe] \ 1644 1574 -font "Arial 9" 1645 1575 1646 1576 checkbutton $inner.lighting \ 1647 1577 -text "Enable Lighting" \ 1648 -variable [itcl::scope _settings( glyphLighting)] \1649 -command [itcl::code $this AdjustSetting glyphLighting] \1578 -variable [itcl::scope _settings(-glyphlighting)] \ 1579 -command [itcl::code $this AdjustSetting -glyphlighting] \ 1650 1580 -font "Arial 9" 1651 1581 1652 1582 checkbutton $inner.edges \ 1653 1583 -text "Edges" \ 1654 -variable [itcl::scope _settings( glyphEdges)] \1655 -command [itcl::code $this AdjustSetting glyphEdges] \1584 -variable [itcl::scope _settings(-glyphedges)] \ 1585 -command [itcl::code $this AdjustSetting -glyphedges] \ 1656 1586 -font "Arial 9" 1657 1587 1658 1588 checkbutton $inner.outline \ 1659 1589 -text "Outline" \ 1660 -variable [itcl::scope _settings( glyphOutline)] \1661 -command [itcl::code $this AdjustSetting glyphOutline] \1590 -variable [itcl::scope _settings(-glyphoutline)] \ 1591 -command [itcl::code $this AdjustSetting -glyphoutline] \ 1662 1592 -font "Arial 9" 1663 1593 1664 1594 checkbutton $inner.legend \ 1665 1595 -text "Legend" \ 1666 -variable [itcl::scope _settings( legendVisible)] \1667 -command [itcl::code $this AdjustSetting legendVisible] \1596 -variable [itcl::scope _settings(-legendvisible)] \ 1597 -command [itcl::code $this AdjustSetting -legendvisible] \ 1668 1598 -font "Arial 9" 1669 1599 … … 1677 1607 "grey" "grey" 1678 1608 1679 $itk_component(background) value $_settings( background)1680 bind $inner.background <<Value>> [itcl::code $this AdjustSetting background]1609 $itk_component(background) value $_settings(-background) 1610 bind $inner.background <<Value>> [itcl::code $this AdjustSetting -background] 1681 1611 1682 1612 label $inner.opacity_l -text "Opacity" -font "Arial 9" 1683 1613 ::scale $inner.opacity -from 0 -to 100 -orient horizontal \ 1684 -variable [itcl::scope _settings( glyphOpacity)] \1614 -variable [itcl::scope _settings(-glyphopacity)] \ 1685 1615 -width 10 \ 1686 1616 -showvalue off \ 1687 -command [itcl::code $this AdjustSetting glyphOpacity]1617 -command [itcl::code $this AdjustSetting -glyphopacity] 1688 1618 1689 1619 label $inner.gscale_l -text "Scale factor" -font "Arial 9" 1690 if {0} {1691 1620 ::scale $inner.gscale -from 1 -to 100 -orient horizontal \ 1692 -variable [itcl::scope _settings( glyphScale)] \1621 -variable [itcl::scope _settings(-glyphscale)] \ 1693 1622 -width 10 \ 1694 1623 -showvalue off \ 1695 -command [itcl::code $this AdjustSetting glyphScale] 1696 } else { 1697 itk_component add gscale { 1698 entry $inner.gscale -font "Arial 9" -bg white \ 1699 -textvariable [itcl::scope _settings(glyphScale)] 1700 } { 1701 ignore -font -background 1702 } 1703 bind $inner.gscale <Return> \ 1704 [itcl::code $this AdjustSetting glyphScale] 1705 bind $inner.gscale <KP_Enter> \ 1706 [itcl::code $this AdjustSetting glyphScale] 1707 } 1624 -command [itcl::code $this AdjustSetting -glyphscale] 1708 1625 Rappture::Tooltip::for $inner.gscale "Set scaling multiplier (or constant size)" 1709 1626 … … 1717 1634 } 1718 1635 bind $inner.field <<Value>> \ 1719 [itcl::code $this AdjustSetting field]1636 [itcl::code $this AdjustSetting -field] 1720 1637 1721 1638 label $inner.colormap_l -text "Colormap" -font "Arial 9" … … 1723 1640 Rappture::Combobox $inner.colormap -width 10 -editable no 1724 1641 } 1725 $inner.colormap choices insert end [GetColormapList -includeNone] 1642 1643 $inner.colormap choices insert end [GetColormapList] 1726 1644 $itk_component(colormap) value "BCGYR" 1727 1645 bind $inner.colormap <<Value>> \ 1728 [itcl::code $this AdjustSetting colormap]1646 [itcl::code $this AdjustSetting -colormap] 1729 1647 1730 1648 blt::table $inner \ … … 1733 1651 1,0 $inner.colormap_l -anchor w -pady 2 \ 1734 1652 1,1 $inner.colormap -anchor w -pady 2 -fill x \ 1735 2,0 $inner.gshape_l -anchor w -pady 2 \ 1736 2,1 $inner.gshape -anchor w -pady 2 -fill x \ 1737 3,0 $inner.background_l -anchor w -pady 2 \ 1738 3,1 $inner.background -anchor w -pady 2 -fill x \ 1739 4,0 $inner.scaleMode_l -anchor w -pady 2 \ 1740 4,1 $inner.scaleMode -anchor w -pady 2 -fill x \ 1741 5,0 $inner.gscale_l -anchor w -pady 2 \ 1742 5,1 $inner.gscale -anchor w -pady 2 -fill x \ 1743 6,0 $inner.normscale -anchor w -pady 2 -cspan 2 \ 1744 7,0 $inner.gorient -anchor w -pady 2 -cspan 2 \ 1745 8,0 $inner.wireframe -anchor w -pady 2 -cspan 2 \ 1746 9,0 $inner.lighting -anchor w -pady 2 -cspan 2 \ 1747 10,0 $inner.edges -anchor w -pady 2 -cspan 2 \ 1748 11,0 $inner.outline -anchor w -pady 2 -cspan 2 \ 1749 12,0 $inner.legend -anchor w -pady 2 \ 1750 13,0 $inner.opacity_l -anchor w -pady 2 \ 1751 13,1 $inner.opacity -fill x -pady 2 -fill x \ 1653 3,0 $inner.background_l -anchor w -pady 2 \ 1654 3,1 $inner.background -anchor w -pady 2 -fill x \ 1655 5,0 $inner.wireframe -anchor w -pady 2 -cspan 2 \ 1656 6,0 $inner.lighting -anchor w -pady 2 -cspan 2 \ 1657 7,0 $inner.edges -anchor w -pady 2 -cspan 2 \ 1658 8,0 $inner.outline -anchor w -pady 2 -cspan 2 \ 1659 9,0 $inner.legend -anchor w -pady 2 \ 1660 10,0 $inner.opacity_l -anchor w -pady 2 \ 1661 10,1 $inner.opacity -fill x -pady 2 -fill x \ 1752 1662 1753 1663 blt::table configure $inner r* c* -resize none 1754 blt::table configure $inner r1 4c1 -resize expand1664 blt::table configure $inner r11 c1 -resize expand 1755 1665 } 1756 1666 … … 1766 1676 1767 1677 checkbutton $inner.visible \ 1768 -text " ShowAxes" \1769 -variable [itcl::scope _settings( axesVisible)] \1770 -command [itcl::code $this AdjustSetting axesVisible] \1678 -text "Axes" \ 1679 -variable [itcl::scope _settings(-axesvisible)] \ 1680 -command [itcl::code $this AdjustSetting -axesvisible] \ 1771 1681 -font "Arial 9" 1772 1682 1773 1683 checkbutton $inner.labels \ 1774 -text " ShowAxis Labels" \1775 -variable [itcl::scope _settings( axisLabelsVisible)] \1776 -command [itcl::code $this AdjustSetting axisLabelsVisible] \1684 -text "Axis Labels" \ 1685 -variable [itcl::scope _settings(-axislabels)] \ 1686 -command [itcl::code $this AdjustSetting -axislabels] \ 1777 1687 -font "Arial 9" 1778 1779 checkbutton $inner. gridx\1780 -text " Show X Grid" \1781 -variable [itcl::scope _settings( axisXGrid)] \1782 -command [itcl::code $this AdjustSetting axisXGrid] \1688 label $inner.grid_l -text "Grid" -font "Arial 9" 1689 checkbutton $inner.xgrid \ 1690 -text "X" \ 1691 -variable [itcl::scope _settings(-xgrid)] \ 1692 -command [itcl::code $this AdjustSetting -xgrid] \ 1783 1693 -font "Arial 9" 1784 checkbutton $inner. gridy\1785 -text " Show Y Grid" \1786 -variable [itcl::scope _settings( axisYGrid)] \1787 -command [itcl::code $this AdjustSetting axisYGrid] \1694 checkbutton $inner.ygrid \ 1695 -text "Y" \ 1696 -variable [itcl::scope _settings(-ygrid)] \ 1697 -command [itcl::code $this AdjustSetting -ygrid] \ 1788 1698 -font "Arial 9" 1789 checkbutton $inner.gridz \ 1790 -text "Show Z Grid" \ 1791 -variable [itcl::scope _settings(axisZGrid)] \ 1792 -command [itcl::code $this AdjustSetting axisZGrid] \ 1699 checkbutton $inner.zgrid \ 1700 -text "Z" \ 1701 -variable [itcl::scope _settings(-zgrid)] \ 1702 -command [itcl::code $this AdjustSetting -zgrid] \ 1703 -font "Arial 9" 1704 checkbutton $inner.minorticks \ 1705 -text "Minor Ticks" \ 1706 -variable [itcl::scope _settings(-axisminorticks)] \ 1707 -command [itcl::code $this AdjustSetting -axisminorticks] \ 1793 1708 -font "Arial 9" 1794 1709 … … 1803 1718 "furthest_triad" "farthest" \ 1804 1719 "outer_edges" "outer" 1805 $itk_component(axisMode) value "static"1806 bind $inner.mode <<Value>> [itcl::code $this AdjustSetting axisMode]1720 $itk_component(axisMode) value $_settings(-axismode) 1721 bind $inner.mode <<Value>> [itcl::code $this AdjustSetting -axismode] 1807 1722 1808 1723 blt::table $inner \ 1809 0,0 $inner.visible -anchor w -cspan 2 \ 1810 1,0 $inner.labels -anchor w -cspan 2 \ 1811 2,0 $inner.gridx -anchor w -cspan 2 \ 1812 3,0 $inner.gridy -anchor w -cspan 2 \ 1813 4,0 $inner.gridz -anchor w -cspan 2 \ 1814 5,0 $inner.mode_l -anchor w -cspan 2 -padx { 2 0 } \ 1815 6,0 $inner.mode -fill x -cspan 2 1724 0,0 $inner.visible -anchor w -cspan 4 \ 1725 1,0 $inner.labels -anchor w -cspan 4 \ 1726 2,0 $inner.minorticks -anchor w -cspan 4 \ 1727 4,0 $inner.grid_l -anchor w \ 1728 4,1 $inner.xgrid -anchor w \ 1729 4,2 $inner.ygrid -anchor w \ 1730 4,3 $inner.zgrid -anchor w \ 1731 5,0 $inner.mode_l -anchor w -padx { 2 0 } \ 1732 5,1 $inner.mode -fill x -cspan 3 1816 1733 1817 1734 blt::table configure $inner r* c* -resize none 1818 blt::table configure $inner r7 c 1-resize expand1819 } 1820 1735 blt::table configure $inner r7 c6 -resize expand 1736 blt::table configure $inner r3 -height 0.125i 1737 } 1821 1738 1822 1739 itcl::body Rappture::VtkGlyphViewer::BuildCameraTab {} { … … 1880 1797 checkbutton $inner.visible \ 1881 1798 -text "Cutplanes" \ 1882 -variable [itcl::scope _settings( cutplaneVisible)] \1883 -command [itcl::code $this AdjustSetting cutplaneVisible] \1799 -variable [itcl::scope _settings(-cutplanevisible)] \ 1800 -command [itcl::code $this AdjustSetting -cutplanevisible] \ 1884 1801 -font "Arial 9" 1885 1802 1886 1803 checkbutton $inner.wireframe \ 1887 1804 -text "Wireframe" \ 1888 -variable [itcl::scope _settings( cutplaneWireframe)] \1889 -command [itcl::code $this AdjustSetting cutplaneWireframe] \1805 -variable [itcl::scope _settings(-cutplanewireframe)] \ 1806 -command [itcl::code $this AdjustSetting -cutplanewireframe] \ 1890 1807 -font "Arial 9" 1891 1808 1892 1809 checkbutton $inner.lighting \ 1893 1810 -text "Enable Lighting" \ 1894 -variable [itcl::scope _settings( cutplaneLighting)] \1895 -command [itcl::code $this AdjustSetting cutplaneLighting] \1811 -variable [itcl::scope _settings(-cutplanelighting)] \ 1812 -command [itcl::code $this AdjustSetting -cutplanelighting] \ 1896 1813 -font "Arial 9" 1897 1814 1898 1815 checkbutton $inner.edges \ 1899 1816 -text "Edges" \ 1900 -variable [itcl::scope _settings( cutplaneEdges)] \1901 -command [itcl::code $this AdjustSetting cutplaneEdges] \1817 -variable [itcl::scope _settings(-cutplaneedges)] \ 1818 -command [itcl::code $this AdjustSetting -cutplaneedges] \ 1902 1819 -font "Arial 9" 1903 1820 1904 1821 checkbutton $inner.preinterp \ 1905 1822 -text "Interpolate Scalars" \ 1906 -variable [itcl::scope _settings( cutplanePreinterp)] \1907 -command [itcl::code $this AdjustSetting cutplanePreinterp] \1823 -variable [itcl::scope _settings(-cutplanepreinterp)] \ 1824 -command [itcl::code $this AdjustSetting -cutplanepreinterp] \ 1908 1825 -font "Arial 9" 1909 1826 1910 1827 label $inner.opacity_l -text "Opacity" -font "Arial 9" 1911 1828 ::scale $inner.opacity -from 0 -to 100 -orient horizontal \ 1912 -variable [itcl::scope _settings( cutplaneOpacity)] \1829 -variable [itcl::scope _settings(-cutplaneopacity)] \ 1913 1830 -width 10 \ 1914 1831 -showvalue off \ 1915 -command [itcl::code $this AdjustSetting cutplaneOpacity]1916 $inner.opacity set $_settings( cutplaneOpacity)1832 -command [itcl::code $this AdjustSetting -cutplaneopacity] 1833 $inner.opacity set $_settings(-cutplaneopacity) 1917 1834 1918 1835 # X-value slicer... … … 1921 1838 -onimage [Rappture::icon x-cutplane-red] \ 1922 1839 -offimage [Rappture::icon x-cutplane-red] \ 1923 -command [itcl::code $this AdjustSetting cutplaneXVisible] \1924 -variable [itcl::scope _settings( cutplaneXVisible)] \1840 -command [itcl::code $this AdjustSetting -cutplanexvisible] \ 1841 -variable [itcl::scope _settings(-cutplanexvisible)] \ 1925 1842 } 1926 1843 Rappture::Tooltip::for $itk_component(xbutton) \ … … 1932 1849 -borderwidth 1 -highlightthickness 0 \ 1933 1850 -command [itcl::code $this EventuallySetCutplane x] \ 1934 -variable [itcl::scope _settings( cutplaneXPosition)] \1935 1851 -variable [itcl::scope _settings(-cutplanexposition)] \ 1852 -foreground red2 -font "Arial 9 bold" 1936 1853 } { 1937 1854 usual … … 1949 1866 -onimage [Rappture::icon y-cutplane-green] \ 1950 1867 -offimage [Rappture::icon y-cutplane-green] \ 1951 -command [itcl::code $this AdjustSetting cutplaneYVisible] \1952 -variable [itcl::scope _settings( cutplaneYVisible)] \1868 -command [itcl::code $this AdjustSetting -cutplaneyvisible] \ 1869 -variable [itcl::scope _settings(-cutplaneyvisible)] \ 1953 1870 } 1954 1871 Rappture::Tooltip::for $itk_component(ybutton) \ … … 1961 1878 -borderwidth 1 -highlightthickness 0 \ 1962 1879 -command [itcl::code $this EventuallySetCutplane y] \ 1963 -variable [itcl::scope _settings( cutplaneYPosition)] \1964 1880 -variable [itcl::scope _settings(-cutplaneyposition)] \ 1881 -foreground green3 -font "Arial 9 bold" 1965 1882 } { 1966 1883 usual … … 1978 1895 -onimage [Rappture::icon z-cutplane-blue] \ 1979 1896 -offimage [Rappture::icon z-cutplane-blue] \ 1980 -command [itcl::code $this AdjustSetting cutplaneZVisible] \1981 -variable [itcl::scope _settings( cutplaneZVisible)] \1897 -command [itcl::code $this AdjustSetting -cutplanezvisible] \ 1898 -variable [itcl::scope _settings(-cutplanezvisible)] \ 1982 1899 } { 1983 1984 1900 usual 1901 ignore -foreground 1985 1902 } 1986 1903 Rappture::Tooltip::for $itk_component(zbutton) \ … … 1993 1910 -borderwidth 1 -highlightthickness 0 \ 1994 1911 -command [itcl::code $this EventuallySetCutplane z] \ 1995 -variable [itcl::scope _settings( cutplaneZPosition)] \1996 1912 -variable [itcl::scope _settings(-cutplanezposition)] \ 1913 -foreground blue3 -font "Arial 9 bold" 1997 1914 } { 1998 1915 usual … … 2005 1922 2006 1923 blt::table $inner \ 2007 0,0 $inner.visible -anchor w -pady 2 -cspan 3 \ 2008 1,0 $inner.lighting -anchor w -pady 2 -cspan 3 \ 2009 2,0 $inner.wireframe -anchor w -pady 2 -cspan 3 \ 2010 3,0 $inner.edges -anchor w -pady 2 -cspan 3 \ 2011 4,0 $inner.preinterp -anchor w -pady 2 -cspan 3 \ 2012 5,0 $inner.opacity_l -anchor w -pady 2 -cspan 1 \ 2013 5,1 $inner.opacity -fill x -pady 2 -cspan 3 \ 2014 6,0 $inner.xbutton -anchor w -padx 2 -pady 2 \ 2015 7,0 $inner.ybutton -anchor w -padx 2 -pady 2 \ 2016 8,0 $inner.zbutton -anchor w -padx 2 -pady 2 \ 2017 6,1 $inner.xval -fill y -rspan 4 \ 2018 6,2 $inner.yval -fill y -rspan 4 \ 2019 6,3 $inner.zval -fill y -rspan 4 \ 2020 1924 0,0 $inner.visible -anchor w -pady 2 -cspan 3 \ 1925 1,0 $inner.lighting -anchor w -pady 2 -cspan 3 \ 1926 2,0 $inner.wireframe -anchor w -pady 2 -cspan 3 \ 1927 3,0 $inner.edges -anchor w -pady 2 -cspan 3 \ 1928 4,0 $inner.preinterp -anchor w -pady 2 -cspan 3 \ 1929 5,0 $inner.opacity_l -anchor w -pady 2 -cspan 1 \ 1930 5,1 $inner.opacity -fill x -pady 2 -cspan 3 \ 1931 6,0 $inner.xbutton -anchor w -padx 2 -pady 2 \ 1932 7,0 $inner.ybutton -anchor w -padx 2 -pady 2 \ 1933 8,0 $inner.zbutton -anchor w -padx 2 -pady 2 \ 1934 6,1 $inner.xval -fill y -rspan 4 \ 1935 6,2 $inner.yval -fill y -rspan 4 \ 1936 6,3 $inner.zval -fill y -rspan 4 \ 2021 1937 2022 1938 blt::table configure $inner r* c* -resize none 2023 1939 blt::table configure $inner r9 c4 -resize expand 2024 1940 } 2025 2026 2027 1941 2028 1942 # … … 2133 2047 set tag $dataobj-$comp 2134 2048 array set style { 2135 -color \#FFFFFF 2136 -colormap BCGYR 2137 -colorMode vmag 2049 -color BCGYR 2138 2050 -edgecolor black 2139 2051 -edges 0 … … 2147 2059 -ptsize 1.0 2148 2060 -quality 1 2149 -scaleMode vmag2150 -shape arrow2061 -scaleMode "vmag" 2062 -shape "arrow" 2151 2063 -wireframe 0 2152 2064 } 2153 set $style(-color) $itk_option(-plotforeground)2154 2065 set numComponents [$dataobj numComponents $comp] 2155 2066 if {$numComponents == 3} { … … 2157 2068 set style(-orientGlyphs) 1 2158 2069 set style(-scaleMode) "vmag" 2159 set style(-colorMode) "vmag"2160 2070 } else { 2161 2071 set style(-shape) "sphere" 2162 2072 set style(-orientGlyphs) 0 2163 2073 set style(-scaleMode) "scalar" 2164 set style(-colorMode) "scalar"2165 2074 } 2166 2075 array set style [$dataobj style $comp] … … 2181 2090 # the code to handle aberrant cases. 2182 2091 2183 if { $_changed( glyphOpacity) } {2184 set style(-opacity) $_settings(glyphOpacity)2185 } 2186 if { $_changed( colormap) } {2187 set style(-color map) $_settings(colormap)2092 if { $_changed(-glyphopacity) } { 2093 set style(-opacity) [expr $_settings(-glyphopacity) * 0.01] 2094 } 2095 if { $_changed(-colormap) } { 2096 set style(-color) $_settings(-colormap) 2188 2097 } 2189 2098 if { $_currentColormap == "" } { 2190 $itk_component(colormap) value $style(-colormap) 2191 } 2192 set _currentOpacity $style(-opacity) 2099 $itk_component(colormap) value $style(-color) 2100 } 2101 2102 SendCmd "outline add $tag" 2103 SendCmd "outline color [Color2RGB $itk_option(-plotforeground)] $tag" 2104 SendCmd "outline visible $style(-outline) $tag" 2105 set _settings(-glyphoutline) $style(-outline) 2106 2193 2107 SendCmd "glyphs add $style(-shape) $tag" 2194 set _settings(glyphShape) $style(-shape)2195 $itk_component(gshape) value $style(-shape)2196 2108 SendCmd "glyphs edges $style(-edges) $tag" 2109 set _settings(-glyphedges) $style(-edges) 2110 2197 2111 # normscale=1 and gscale=1 are defaults 2198 2112 if {$style(-normscale) != 1} { … … 2202 2116 SendCmd "glyphs gscale $style(-gscale) $tag" 2203 2117 } 2204 set _settings(glyphNormscale) $style(-normscale) 2205 set _settings(glyphScale) $style(-gscale) 2206 SendCmd "outline add $tag" 2207 SendCmd "outline color [Color2RGB $style(-color)] $tag" 2208 SendCmd "outline visible $style(-outline) $tag" 2209 set _settings(glyphOutline) $style(-outline) 2210 set _settings(glyphEdges) $style(-edges) 2211 if {$style(-colorMode) == "constant" || $style(-colormap) == "none"} { 2212 SendCmd "glyphs colormode constant {} $tag" 2213 set _settings(colormapVisible) 0 2214 set _settings(colormap) "none" 2215 } else { 2216 SendCmd "glyphs colormode $style(-colorMode) $_curFldName $tag" 2217 set _settings(colormapVisible) 1 2218 set _settings(colormap) $style(-colormap) 2219 SetCurrentColormap $style(-colormap) 2220 } 2221 $itk_component(colormap) value $_settings(colormap) 2222 set _colorMode $style(-colorMode) 2118 2223 2119 # constant color only used if colormode set to constant 2224 SendCmd "glyphs color [Color2RGB $ style(-color)] $tag"2120 SendCmd "glyphs color [Color2RGB $itk_option(-plotforeground)] $tag" 2225 2121 # Omitting field name for gorient and smode commands 2226 2122 # defaults to active scalars or vectors depending on mode 2227 2123 SendCmd "glyphs gorient $style(-orientGlyphs) {} $tag" 2228 2124 SendCmd "glyphs smode $style(-scaleMode) {} $tag" 2229 set _settings(glyphScaleMode) $style(-scaleMode)2230 $itk_component(scaleMode) value "[$itk_component(scaleMode) label $style(-scaleMode)]"2231 2125 SendCmd "glyphs quality $style(-quality) $tag" 2232 2126 SendCmd "glyphs lighting $style(-lighting) $tag" 2233 set _settings( glyphLighting) $style(-lighting)2127 set _settings(-glyphlighting) $style(-lighting) 2234 2128 SendCmd "glyphs linecolor [Color2RGB $style(-edgecolor)] $tag" 2235 2129 SendCmd "glyphs linewidth $style(-linewidth) $tag" 2236 2130 SendCmd "glyphs ptsize $style(-ptsize) $tag" 2237 SendCmd "glyphs opacity $_currentOpacity $tag" 2238 set _settings(glyphOpacity) $style(-opacity) 2131 SendCmd "glyphs opacity $style(-opacity) $tag" 2132 set _settings(-glyphopacity) [expr $style(-opacity) * 100.0] 2133 SetCurrentColormap $style(-color) 2239 2134 SendCmd "glyphs wireframe $style(-wireframe) $tag" 2240 set _settings(glyphWireframe) $style(-wireframe) 2241 set _settings(glyphOpacity) [expr $style(-opacity) * 100.0] 2135 set _settings(-glyphwireframe) $style(-wireframe) 2242 2136 } 2243 2137 … … 2293 2187 2294 2188 if { [string match "component*" $fname] } { 2295 2189 set title "" 2296 2190 } else { 2297 2298 2299 2300 2301 2302 2303 2304 2191 if { [info exists _fields($fname)] } { 2192 foreach { title units } $_fields($fname) break 2193 if { $units != "" } { 2194 set title [format "%s (%s)" $title $units] 2195 } 2196 } else { 2197 set title $fname 2198 } 2305 2199 } 2306 2200 # If there's a legend title, increase the offset by the line height. … … 2334 2228 } 2335 2229 2336 2337 2230 # ---------------------------------------------------------------------- 2338 2231 # USAGE: Slice move x|y|z <newval> … … 2368 2261 # ReceiveLegend -- 2369 2262 # 2370 # 2371 # 2372 # 2263 # Invoked automatically whenever the "legend" command comes in from 2264 # the rendering server. Indicates that binary image data with the 2265 # specified <size> will follow. 2373 2266 # 2374 2267 itcl::body Rappture::VtkGlyphViewer::ReceiveLegend { colormap title min max size } { … … 2384 2277 #puts stderr "read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>" 2385 2278 if { [catch {DrawLegend} errs] != 0 } { 2386 2387 2279 global errorInfo 2280 puts stderr "errs=$errs errorInfo=$errorInfo" 2388 2281 } 2389 2282 } … … 2393 2286 # DrawLegend -- 2394 2287 # 2395 # 2288 # Draws the legend in the own canvas on the right side of the plot area. 2396 2289 # 2397 2290 itcl::body Rappture::VtkGlyphViewer::DrawLegend {} { … … 2404 2297 2405 2298 if { [string match "component*" $fname] } { 2406 2299 set title "" 2407 2300 } else { 2408 2409 2410 2411 2412 2413 2414 2415 2301 if { [info exists _fields($fname)] } { 2302 foreach { title units } $_fields($fname) break 2303 if { $units != "" } { 2304 set title [format "%s (%s)" $title $units] 2305 } 2306 } else { 2307 set title $fname 2308 } 2416 2309 } 2417 2310 set x [expr $w - 2] 2418 if { !$_settings( legendVisible) } {2419 2420 2311 if { !$_settings(-legendvisible) } { 2312 $c delete legend 2313 return 2421 2314 } 2422 2315 if { [$c find withtag "legend"] == "" } { 2423 2424 2316 set y 2 2317 # If there's a legend title, create a text item for the title. 2425 2318 $c create text $x $y \ 2426 2427 2428 2319 -anchor ne \ 2320 -fill $itk_option(-plotforeground) -tags "title legend" \ 2321 -font $font 2429 2322 if { $title != "" } { 2430 2323 incr y $lineht 2431 2324 } 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2325 $c create text $x $y \ 2326 -anchor ne \ 2327 -fill $itk_option(-plotforeground) -tags "vmax legend" \ 2328 -font $font 2329 incr y $lineht 2330 $c create image $x $y \ 2331 -anchor ne \ 2332 -image $_image(legend) -tags "colormap legend" 2333 $c create rectangle $x $y 1 1 \ 2334 -fill "" -outline "" -tags "sensor legend" 2335 $c create text $x [expr {$h-2}] \ 2336 -anchor se \ 2337 -fill $itk_option(-plotforeground) -tags "vmin legend" \ 2338 -font $font 2339 $c bind sensor <Enter> [itcl::code $this EnterLegend %x %y] 2340 $c bind sensor <Leave> [itcl::code $this LeaveLegend] 2341 $c bind sensor <Motion> [itcl::code $this MotionLegend %x %y] 2449 2342 } 2450 2343 set x2 $x … … 2460 2353 if { [info exists _limits($_curFldName)] } { 2461 2354 foreach { vmin vmax } $_limits($_curFldName) break 2462 2463 2355 $c itemconfigure vmin -text [format %g $vmin] 2356 $c itemconfigure vmax -text [format %g $vmax] 2464 2357 } 2465 2358 set y 2 … … 2467 2360 if { $title != "" } { 2468 2361 $c itemconfigure title -text $title 2469 2470 2362 $c coords title $x $y 2363 incr y $lineht 2471 2364 $c raise title 2472 2365 } … … 2510 2403 invoke { 2511 2404 $itk_component(field) value $_curFldLabel 2512 AdjustSetting field2405 AdjustSetting -field 2513 2406 } 2514 2407 default { … … 2534 2427 # BuildColormap -- 2535 2428 # 2536 # 2429 # Build the designated colormap on the server. 2537 2430 # 2538 2431 itcl::body Rappture::VtkGlyphViewer::BuildColormap { name } { … … 2565 2458 set _view(zoom) 1.0 2566 2459 } 2567 -
branches/r9/gui/scripts/vtkheightmapviewer.tcl
r4344 r4919 123 123 private variable _currentColormap "" 124 124 private variable _currentNumIsolines -1 125 private variable _currentOpacity ""126 125 127 126 private variable _maxScale 100; # This is the # of times the x-axis … … 217 216 218 217 array set _settings { 219 axisFlymode "static" 220 axisMinorTicks 1 221 stretchToFit 0 222 axisLabels 1 223 axisVisible 1 224 axisXGrid 0 225 axisYGrid 0 226 axisZGrid 0 227 colormapVisible 1 228 colormapDiscrete 0 229 edges 0 230 field "Default" 231 heightmapScale 50 232 isHeightmap 0 233 isolineColor black 234 isolinesVisible 1 235 legendVisible 1 236 lighting 1 237 saveLighting 1 238 numIsolines 10 239 opacity 100 240 outline 0 241 wireframe 0 242 saveOpacity 100 243 saveOutline 0 218 -axisflymode "static" 219 -axislabels 1 220 -axisminorticks 1 221 -axisvisible 1 222 -colormap BCGYR 223 -colormapdiscrete 0 224 -colormapvisible 1 225 -edges 0 226 -field "Default" 227 -heightmapscale 50 228 -isheightmap 0 229 -isolinecolor black 230 -isolinesvisible 1 231 -legendvisible 1 232 -lighting 1 233 -numisolines 10 234 -opacity 100 235 -outline 0 236 -savelighting 1 237 -saveopacity 100 238 -saveoutline 0 239 -stretchtofit 0 240 -wireframe 0 241 -xgrid 0 242 -ygrid 0 243 -zgrid 0 244 244 } 245 245 array set _changed { 246 opacity0247 colormap0248 numIsolines0246 -colormap 0 247 -numisolines 0 248 -opacity 0 249 249 } 250 250 itk_component add view { … … 325 325 -onimage [Rappture::icon surface] \ 326 326 -offimage [Rappture::icon surface] \ 327 -variable [itcl::scope _settings( isHeightmap)] \328 -command [itcl::code $this AdjustSetting isHeightmap] \327 -variable [itcl::scope _settings(-isheightmap)] \ 328 -command [itcl::code $this AdjustSetting -isheightmap] \ 329 329 } 330 330 Rappture::Tooltip::for $itk_component(mode) \ … … 336 336 -onimage [Rappture::icon stretchtofit] \ 337 337 -offimage [Rappture::icon stretchtofit] \ 338 -variable [itcl::scope _settings( stretchToFit)] \339 -command [itcl::code $this AdjustSetting stretchToFit] \338 -variable [itcl::scope _settings(-stretchtofit)] \ 339 -command [itcl::code $this AdjustSetting -stretchtofit] \ 340 340 } 341 341 Rappture::Tooltip::for $itk_component(stretchtofit) \ … … 666 666 } 667 667 if { [array size found] > 1 } { 668 set _settings( stretchToFit) 1668 set _settings(-stretchtofit) 1 669 669 } else { 670 670 # Check if the range of the x and y axes requires that we stretch … … 675 675 if { (($xmax - $xmin) > (($ymax -$ymin) * $_maxScale)) || 676 676 ((($xmax - $xmin) * $_maxScale) < ($ymax -$ymin)) } { 677 set _settings( stretchToFit) 1677 set _settings(-stretchtofit) 1 678 678 } 679 679 } … … 767 767 set session $env(SESSION) 768 768 } 769 lappend info "version" "$Rappture::version" 770 lappend info "build" "$Rappture::build" 771 lappend info "svnurl" "$Rappture::svnurl" 772 lappend info "installdir" "$Rappture::installdir" 769 773 lappend info "hub" [exec hostname] 770 774 lappend info "client" "vtkheightmapviewer" … … 924 928 $_arcball resize $w $h 925 929 DoResize 926 if { $_settings( stretchToFit) } {927 AdjustSetting stretchToFit930 if { $_settings(-stretchtofit) } { 931 AdjustSetting -stretchtofit 928 932 } 929 933 } … … 932 936 # Reset the camera and other view parameters 933 937 # 934 InitSettings isHeightmap background 935 936 # Let's see how this goes. I think it's preferable to overloading the 937 # axis title with the exponent. 938 SendCmd "axis exp 0 0 0 1" 938 InitSettings -isheightmap -background 939 940 # Setting a custom exponent and label format for axes is causing 941 # a problem with rounding. Near zero ticks aren't rounded by 942 # the %g format. The VTK CubeAxes seem to currently work best 943 # when allowed to automatically set the exponent and precision 944 # based on the axis ranges. This does tend to result in less 945 # visual clutter, so I think it is best to use the automatic 946 # settings by default. We can test more fine-grained 947 # controls on the axis settings tab if necessary. 948 # -Leif 949 #SendCmd "axis exp 0 0 0 1" 939 950 940 951 SendCmd "axis lrot z 90" 941 952 set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)] 942 953 $_arcball quaternion $q 943 if {$_settings( isHeightmap) } {954 if {$_settings(-isheightmap) } { 944 955 if { $_view(ortho)} { 945 956 SendCmd "camera mode ortho" … … 1033 1044 $itk_component(field) value $_curFldLabel 1034 1045 } 1035 InitSettings stretchToFitoutline1046 InitSettings -stretchtofit -outline 1036 1047 1037 1048 if { $_reset } { … … 1077 1088 set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)] 1078 1089 $_arcball quaternion $q 1079 if {$_settings( isHeightmap) } {1090 if {$_settings(-isheightmap) } { 1080 1091 if { $_view(ortho)} { 1081 1092 SendCmd "camera mode ortho" … … 1087 1098 } 1088 1099 PanCamera 1089 InitSettings axisXGrid axisYGrid axisZGrid \1090 axisVisible axisLabels heightmapScale field isHeightmap \1091 numIsolines1100 InitSettings -xgrid -ygrid -zgrid \ 1101 -axisvisible -axislabels -heightmapscale -field -isheightmap \ 1102 -numisolines 1092 1103 if { [array size _fields] < 2 } { 1093 blt::table forget $itk_component(field) $itk_component(field_l) 1104 catch { 1105 blt::table forget $itk_component(field) $itk_component(field_l) 1106 } 1094 1107 } 1095 1108 RequestLegend … … 1169 1182 set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)] 1170 1183 $_arcball quaternion $q 1171 if {$_settings( isHeightmap) } {1184 if {$_settings(-isheightmap) } { 1172 1185 DoRotate 1173 1186 } … … 1330 1343 itcl::body Rappture::VtkHeightmapViewer::InitSettings { args } { 1331 1344 foreach spec $args { 1332 if { [info exists _settings($_first -$spec)] } {1345 if { [info exists _settings($_first${spec})] } { 1333 1346 # Reset global setting with dataobj specific setting 1334 set _settings($spec) $_settings($_first -$spec)1347 set _settings($spec) $_settings($_first${spec}) 1335 1348 } 1336 1349 AdjustSetting $spec … … 1350 1363 } 1351 1364 switch -- $what { 1352 " axisFlymode" {1365 "-axisflymode" { 1353 1366 set mode [$itk_component(axisflymode) value] 1354 1367 set mode [$itk_component(axisflymode) translate $mode] … … 1356 1369 SendCmd "axis flymode $mode" 1357 1370 } 1358 " axisLabels" {1371 "-axislabels" { 1359 1372 set bool $_settings($what) 1360 1373 SendCmd "axis labels all $bool" 1361 1374 } 1362 " axisMinorTicks" {1375 "-axisminorticks" { 1363 1376 set bool $_settings($what) 1364 foreach axis { x y z } { 1365 SendCmd "axis minticks ${axis} $bool" 1366 } 1367 } 1368 "axisVisible" { 1377 SendCmd "axis minticks all $bool" 1378 } 1379 "-axisvisible" { 1369 1380 set bool $_settings($what) 1370 1381 SendCmd "axis visible all $bool" 1371 1382 } 1372 " axisXGrid" - "axisYGrid" - "axisZGrid" {1373 set axis [string tolower [string range $what 4 4]]1383 "-xgrid" - "-ygrid" - "-zgrid" { 1384 set axis [string tolower [string range $what 1 1]] 1374 1385 set bool $_settings($what) 1375 1386 SendCmd "axis grid $axis $bool" 1376 1387 } 1377 " background" {1388 "-background" { 1378 1389 set bg [$itk_component(background) value] 1379 1390 array set fgcolors { … … 1390 1401 DrawLegend 1391 1402 } 1392 " colormap" {1403 "-colormap" { 1393 1404 set _changed($what) 1 1394 1405 StartBufferingCommands … … 1396 1407 set _settings($what) $color 1397 1408 if { $color == "none" } { 1398 if { $_settings( colormapVisible) } {1409 if { $_settings(-colormapvisible) } { 1399 1410 SendCmd "heightmap surface 0" 1400 set _settings( colormapVisible) 01411 set _settings(-colormapvisible) 0 1401 1412 } 1402 1413 } else { 1403 if { !$_settings( colormapVisible) } {1414 if { !$_settings(-colormapvisible) } { 1404 1415 SendCmd "heightmap surface 1" 1405 set _settings( colormapVisible) 11416 set _settings(-colormapvisible) 1 1406 1417 } 1407 1418 SetCurrentColormap $color 1408 if {$_settings( colormapDiscrete)} {1409 set numColors [expr $_settings( numIsolines) + 1]1419 if {$_settings(-colormapdiscrete)} { 1420 set numColors [expr $_settings(-numisolines) + 1] 1410 1421 SendCmd "colormap res $numColors $color" 1411 1422 } … … 1414 1425 EventuallyRequestLegend 1415 1426 } 1416 " colormapVisible" {1427 "-colormapvisible" { 1417 1428 set bool $_settings($what) 1418 1429 SendCmd "heightmap surface $bool" 1419 1430 } 1420 " colormapDiscrete" {1431 "-colormapdiscrete" { 1421 1432 set bool $_settings($what) 1422 set numColors [expr $_settings( numIsolines) + 1]1433 set numColors [expr $_settings(-numisolines) + 1] 1423 1434 StartBufferingCommands 1424 1435 if {$bool} { … … 1434 1445 EventuallyRequestLegend 1435 1446 } 1436 " edges" {1447 "-edges" { 1437 1448 set bool $_settings($what) 1438 1449 SendCmd "heightmap edges $bool" 1439 1450 } 1440 " field" {1451 "-field" { 1441 1452 set label [$itk_component(field) value] 1442 1453 set fname [$itk_component(field) translate $label] … … 1483 1494 DrawLegend 1484 1495 } 1485 " heightmapScale" {1486 if { $_settings( isHeightmap) } {1496 "-heightmapscale" { 1497 if { $_settings(-isheightmap) } { 1487 1498 set scale [GetHeightmapScale] 1488 1499 # Have to set the datasets individually because we are … … 1495 1506 } 1496 1507 } 1497 " isHeightmap" {1508 "-isheightmap" { 1498 1509 set bool $_settings($what) 1499 1510 set c $itk_component(view) … … 1501 1512 # Fix heightmap scale: 0 for contours, 1 for heightmaps. 1502 1513 if { $bool } { 1503 set _settings( heightmapScale) 501504 set _settings( opacity) $_settings(saveOpacity)1505 set _settings( lighting) $_settings(saveLighting)1506 set _settings( outline) 01514 set _settings(-heightmapscale) 50 1515 set _settings(-opacity) $_settings(-saveopacity) 1516 set _settings(-lighting) $_settings(-savelighting) 1517 set _settings(-outline) 0 1507 1518 } else { 1508 set _settings(heightmapScale) 0 1509 set _settings(lighting) 0 1510 set _settings(opacity) 100 1511 set _settings(outline) $_settings(saveOutline) 1512 } 1513 AdjustSetting lighting 1514 AdjustSetting opacity 1515 AdjustSetting outline 1519 set _settings(-heightmapscale) 0 1520 set _settings(-lighting) 0 1521 set _settings(-opacity) 100 1522 set _settings(-outline) $_settings(-saveoutline) 1523 } 1524 InitSettings -lighting -opacity -outline 1516 1525 set scale [GetHeightmapScale] 1517 1526 # Have to set the datasets individually because we are … … 1542 1551 SendCmd "camera mode image" 1543 1552 } 1544 if {$_settings( stretchToFit)} {1553 if {$_settings(-stretchtofit)} { 1545 1554 if {$scale == 0} { 1546 1555 SendCmd "camera aspect window" … … 1573 1582 StopBufferingCommands 1574 1583 } 1575 " isolineColor" {1584 "-isolinecolor" { 1576 1585 set color [$itk_component(isolinecolor) value] 1577 1586 if { $color == "none" } { 1578 if { $_settings( isolinesVisible) } {1587 if { $_settings(-isolinesvisible) } { 1579 1588 SendCmd "heightmap isolines 0" 1580 set _settings( isolinesVisible) 01589 set _settings(-isolinesvisible) 0 1581 1590 } 1582 1591 } else { 1583 if { !$_settings( isolinesVisible) } {1592 if { !$_settings(-isolinesvisible) } { 1584 1593 SendCmd "heightmap isolines 1" 1585 set _settings( isolinesVisible) 11594 set _settings(-isolinesvisible) 1 1586 1595 } 1587 1596 SendCmd "heightmap isolinecolor [Color2RGB $color]" … … 1589 1598 DrawLegend 1590 1599 } 1591 " isolinesVisible" {1600 "-isolinesvisible" { 1592 1601 set bool $_settings($what) 1593 1602 SendCmd "heightmap isolines $bool" 1594 1603 DrawLegend 1595 1604 } 1596 " legendVisible" {1605 "-legendvisible" { 1597 1606 if { !$_settings($what) } { 1598 1607 $itk_component(view) delete legend … … 1600 1609 DrawLegend 1601 1610 } 1602 " lighting" {1603 if { $_settings( isHeightmap) } {1604 set _settings( saveLighting) $_settings($what)1611 "-lighting" { 1612 if { $_settings(-isheightmap) } { 1613 set _settings(-savelighting) $_settings($what) 1605 1614 set bool $_settings($what) 1606 1615 SendCmd "heightmap lighting $bool" … … 1609 1618 } 1610 1619 } 1611 " numIsolines" {1620 "-numisolines" { 1612 1621 set _settings($what) [$itk_component(numisolines) value] 1613 1622 set _currentNumIsolines $_settings($what) … … 1615 1624 set _changed($what) 1 1616 1625 SendCmd "heightmap contourlist [list $_contourList]" 1617 if {$_settings( colormapDiscrete)} {1626 if {$_settings(-colormapdiscrete)} { 1618 1627 set numColors [expr $_settings($what) + 1] 1619 1628 SendCmd "colormap res $numColors" … … 1623 1632 } 1624 1633 } 1625 " opacity" {1634 "-opacity" { 1626 1635 set _changed($what) 1 1627 if { $_settings(isHeightmap) } { 1628 set _settings(saveOpacity) $_settings($what) 1629 set val $_settings($what) 1630 set sval [expr { 0.01 * double($val) }] 1631 SendCmd "heightmap opacity $sval" 1636 set val [expr $_settings($what) * 0.01] 1637 if { $_settings(-isheightmap) } { 1638 set _settings(-saveopacity) $_settings($what) 1639 SendCmd "heightmap opacity $val" 1632 1640 } else { 1633 SendCmd "heightmap opacity 1 "1634 } 1635 } 1636 " outline" {1637 if { $_settings( isHeightmap) } {1641 SendCmd "heightmap opacity 1.0" 1642 } 1643 } 1644 "-outline" { 1645 if { $_settings(-isheightmap) } { 1638 1646 SendCmd "outline visible 0" 1639 1647 } else { 1640 set _settings( saveOutline) $_settings($what)1648 set _settings(-saveoutline) $_settings($what) 1641 1649 set bool $_settings($what) 1642 1650 SendCmd "outline visible $bool" 1643 1651 } 1644 1652 } 1645 " stretchToFit" {1653 "-stretchtofit" { 1646 1654 set bool $_settings($what) 1647 1655 if { $bool } { … … 1657 1665 Zoom reset 1658 1666 } 1659 " wireframe" {1667 "-wireframe" { 1660 1668 set bool $_settings($what) 1661 1669 SendCmd "heightmap wireframe $bool" … … 1793 1801 switch -- $itk_option(-mode) { 1794 1802 "heightmap" { 1795 set _settings( isHeightmap) 11803 set _settings(-isheightmap) 1 1796 1804 } 1797 1805 "contour" { 1798 set _settings( isHeightmap) 01806 set _settings(-isheightmap) 0 1799 1807 } 1800 1808 default { … … 1803 1811 } 1804 1812 if { !$_reset } { 1805 AdjustSetting isHeightmap1813 AdjustSetting -isheightmap 1806 1814 } 1807 1815 } … … 1855 1863 checkbutton $inner.legend \ 1856 1864 -text "Legend" \ 1857 -variable [itcl::scope _settings( legendVisible)] \1858 -command [itcl::code $this AdjustSetting legendVisible] \1865 -variable [itcl::scope _settings(-legendvisible)] \ 1866 -command [itcl::code $this AdjustSetting -legendvisible] \ 1859 1867 -font "Arial 9" 1860 1868 1861 1869 checkbutton $inner.wireframe \ 1862 1870 -text "Wireframe" \ 1863 -variable [itcl::scope _settings( wireframe)] \1864 -command [itcl::code $this AdjustSetting wireframe] \1871 -variable [itcl::scope _settings(-wireframe)] \ 1872 -command [itcl::code $this AdjustSetting -wireframe] \ 1865 1873 -font "Arial 9" 1866 1874 … … 1868 1876 checkbutton $inner.lighting \ 1869 1877 -text "Enable Lighting" \ 1870 -variable [itcl::scope _settings( lighting)] \1871 -command [itcl::code $this AdjustSetting lighting] \1878 -variable [itcl::scope _settings(-lighting)] \ 1879 -command [itcl::code $this AdjustSetting -lighting] \ 1872 1880 -font "Arial 9" 1873 1881 } { … … 1876 1884 checkbutton $inner.edges \ 1877 1885 -text "Edges" \ 1878 -variable [itcl::scope _settings( edges)] \1879 -command [itcl::code $this AdjustSetting edges] \1886 -variable [itcl::scope _settings(-edges)] \ 1887 -command [itcl::code $this AdjustSetting -edges] \ 1880 1888 -font "Arial 9" 1881 1889 … … 1883 1891 checkbutton $inner.outline \ 1884 1892 -text "Outline" \ 1885 -variable [itcl::scope _settings( outline)] \1886 -command [itcl::code $this AdjustSetting outline] \1893 -variable [itcl::scope _settings(-outline)] \ 1894 -command [itcl::code $this AdjustSetting -outline] \ 1887 1895 -font "Arial 9" 1888 1896 } { … … 1891 1899 checkbutton $inner.stretch \ 1892 1900 -text "Stretch to fit" \ 1893 -variable [itcl::scope _settings( stretchToFit)] \1894 -command [itcl::code $this AdjustSetting stretchToFit] \1901 -variable [itcl::scope _settings(-stretchtofit)] \ 1902 -command [itcl::code $this AdjustSetting -stretchtofit] \ 1895 1903 -font "Arial 9" 1896 1904 1897 1905 checkbutton $inner.isolines \ 1898 1906 -text "Isolines" \ 1899 -variable [itcl::scope _settings( isolinesVisible)] \1900 -command [itcl::code $this AdjustSetting isolinesVisible] \1907 -variable [itcl::scope _settings(-isolinesvisible)] \ 1908 -command [itcl::code $this AdjustSetting -isolinesvisible] \ 1901 1909 -font "Arial 9" 1902 1910 1903 1911 checkbutton $inner.colormapDiscrete \ 1904 1912 -text "Discrete Colormap" \ 1905 -variable [itcl::scope _settings( colormapDiscrete)] \1906 -command [itcl::code $this AdjustSetting colormapDiscrete] \1913 -variable [itcl::scope _settings(-colormapdiscrete)] \ 1914 -command [itcl::code $this AdjustSetting -colormapdiscrete] \ 1907 1915 -font "Arial 9" 1908 1916 … … 1916 1924 } 1917 1925 bind $inner.field <<Value>> \ 1918 [itcl::code $this AdjustSetting field]1926 [itcl::code $this AdjustSetting -field] 1919 1927 1920 1928 label $inner.colormap_l -text "Colormap" -font "Arial 9" … … 1923 1931 } 1924 1932 $inner.colormap choices insert end [GetColormapList -includeNone] 1925 $itk_component(colormap) value "BCGYR"1933 $itk_component(colormap) value $_settings(-colormap) 1926 1934 bind $inner.colormap <<Value>> \ 1927 [itcl::code $this AdjustSetting colormap]1935 [itcl::code $this AdjustSetting -colormap] 1928 1936 1929 1937 label $inner.isolinecolor_l -text "Isolines Color" -font "Arial 9" … … 1943 1951 "none" "none" 1944 1952 1945 $itk_component(isolinecolor) value "black"1953 $itk_component(isolinecolor) value $_settings(-isolinecolor) 1946 1954 bind $inner.isolinecolor <<Value>> \ 1947 [itcl::code $this AdjustSetting isolineColor]1955 [itcl::code $this AdjustSetting -isolinecolor] 1948 1956 1949 1957 label $inner.background_l -text "Background Color" -font "Arial 9" … … 1957 1965 1958 1966 $itk_component(background) value "white" 1959 bind $inner.background <<Value>> [itcl::code $this AdjustSetting background] 1967 bind $inner.background <<Value>> \ 1968 [itcl::code $this AdjustSetting -background] 1960 1969 1961 1970 itk_component add opacity_l { … … 1966 1975 itk_component add opacity { 1967 1976 ::scale $inner.opacity -from 0 -to 100 -orient horizontal \ 1968 -variable [itcl::scope _settings( opacity)] \1977 -variable [itcl::scope _settings(-opacity)] \ 1969 1978 -showvalue off \ 1970 -command [itcl::code $this AdjustSetting opacity]1979 -command [itcl::code $this AdjustSetting -opacity] 1971 1980 } 1972 1981 itk_component add scale_l { … … 1977 1986 itk_component add scale { 1978 1987 ::scale $inner.scale -from 0 -to 100 -orient horizontal \ 1979 -variable [itcl::scope _settings( heightmapScale)] \1988 -variable [itcl::scope _settings(-heightmapscale)] \ 1980 1989 -showvalue off \ 1981 -command [itcl::code $this AdjustSetting heightmapScale]1990 -command [itcl::code $this AdjustSetting -heightmapscale] 1982 1991 } 1983 1992 label $inner.numisolines_l -text "Number of Isolines" -font "Arial 9" … … 1986 1995 -min 0 -max 50 -font "arial 9" 1987 1996 } 1988 $itk_component(numisolines) value $_settings( numIsolines)1997 $itk_component(numisolines) value $_settings(-numisolines) 1989 1998 bind $itk_component(numisolines) <<Value>> \ 1990 [itcl::code $this AdjustSetting numIsolines]1999 [itcl::code $this AdjustSetting -numisolines] 1991 2000 1992 2001 frame $inner.separator1 -height 2 -relief sunken -bd 1 … … 2035 2044 checkbutton $inner.visible \ 2036 2045 -text "Axes" \ 2037 -variable [itcl::scope _settings( axisVisible)] \2038 -command [itcl::code $this AdjustSetting axisVisible] \2046 -variable [itcl::scope _settings(-axisvisible)] \ 2047 -command [itcl::code $this AdjustSetting -axisvisible] \ 2039 2048 -font "Arial 9" 2040 2049 checkbutton $inner.labels \ 2041 2050 -text "Axis Labels" \ 2042 -variable [itcl::scope _settings( axisLabels)] \2043 -command [itcl::code $this AdjustSetting axisLabels] \2051 -variable [itcl::scope _settings(-axislabels)] \ 2052 -command [itcl::code $this AdjustSetting -axislabels] \ 2044 2053 -font "Arial 9" 2045 2054 label $inner.grid_l -text "Grid" -font "Arial 9" 2046 2055 checkbutton $inner.xgrid \ 2047 2056 -text "X" \ 2048 -variable [itcl::scope _settings( axisXGrid)] \2049 -command [itcl::code $this AdjustSetting axisXGrid] \2057 -variable [itcl::scope _settings(-xgrid)] \ 2058 -command [itcl::code $this AdjustSetting -xgrid] \ 2050 2059 -font "Arial 9" 2051 2060 checkbutton $inner.ygrid \ 2052 2061 -text "Y" \ 2053 -variable [itcl::scope _settings( axisYGrid)] \2054 -command [itcl::code $this AdjustSetting axisYGrid] \2062 -variable [itcl::scope _settings(-ygrid)] \ 2063 -command [itcl::code $this AdjustSetting -ygrid] \ 2055 2064 -font "Arial 9" 2056 2065 checkbutton $inner.zgrid \ 2057 2066 -text "Z" \ 2058 -variable [itcl::scope _settings( axisZGrid)] \2059 -command [itcl::code $this AdjustSetting axisZGrid] \2067 -variable [itcl::scope _settings(-zgrid)] \ 2068 -command [itcl::code $this AdjustSetting -zgrid] \ 2060 2069 -font "Arial 9" 2061 2070 checkbutton $inner.minorticks \ 2062 2071 -text "Minor Ticks" \ 2063 -variable [itcl::scope _settings( axisMinorTicks)] \2064 -command [itcl::code $this AdjustSetting axisMinorTicks] \2072 -variable [itcl::scope _settings(-axisminorticks)] \ 2073 -command [itcl::code $this AdjustSetting -axisminorticks] \ 2065 2074 -font "Arial 9" 2066 2067 2075 2068 2076 label $inner.mode_l -text "Mode" -font "Arial 9" … … 2076 2084 "furthest_triad" "farthest" \ 2077 2085 "outer_edges" "outer" 2078 $itk_component(axisflymode) value "static"2079 bind $inner.mode <<Value>> [itcl::code $this AdjustSetting axisFlymode]2086 $itk_component(axisflymode) value $_settings(-axisflymode) 2087 bind $inner.mode <<Value>> [itcl::code $this AdjustSetting -axisflymode] 2080 2088 2081 2089 blt::table $inner \ … … 2263 2271 -color BCGYR 2264 2272 -levels 10 2265 -opacity 1 002273 -opacity 1.0 2266 2274 } 2267 2275 set stylelist [$dataobj style $comp] … … 2278 2286 # the code to handle aberrant cases. 2279 2287 2280 if { $_changed( opacity) } {2281 set style(-opacity) $_settings(opacity)2282 } 2283 if { $_changed( numIsolines) } {2284 set style(-levels) $_settings( numIsolines)2285 } 2286 if { $_changed( colormap) } {2287 set style(-color) $_settings( colormap)2288 if { $_changed(-opacity) } { 2289 set style(-opacity) [expr $_settings(-opacity) * 0.01] 2290 } 2291 if { $_changed(-numisolines) } { 2292 set style(-levels) $_settings(-numisolines) 2293 } 2294 if { $_changed(-colormap) } { 2295 set style(-color) $_settings(-colormap) 2288 2296 } 2289 2297 if { $_currentColormap == "" } { … … 2291 2299 } 2292 2300 if { [info exists style(-stretchtofit)] } { 2293 set _settings(stretchToFit) $style(-stretchtofit) 2294 AdjustSetting stretchToFit 2295 } 2296 set _currentOpacity $style(-opacity) 2301 set _settings(-stretchtofit) $style(-stretchtofit) 2302 AdjustSetting -stretchtofit 2303 } 2297 2304 if { $_currentNumIsolines != $style(-levels) } { 2298 2305 set _currentNumIsolines $style(-levels) 2299 set _settings( numIsolines) $_currentNumIsolines2306 set _settings(-numisolines) $_currentNumIsolines 2300 2307 $itk_component(numisolines) value $_currentNumIsolines 2301 2308 UpdateContourList … … 2304 2311 SendCmd "outline add $tag" 2305 2312 SendCmd "outline color [Color2RGB $itk_option(-plotforeground)] $tag" 2306 SendCmd "outline visible $_settings( outline) $tag"2313 SendCmd "outline visible $_settings(-outline) $tag" 2307 2314 set scale [GetHeightmapScale] 2308 2315 SendCmd "[list heightmap add contourlist $_contourList $scale $tag]" 2309 set _comp2scale($tag) $_settings( heightmapScale)2310 SendCmd "heightmap edges $_settings( edges) $tag"2311 SendCmd "heightmap wireframe $_settings( wireframe) $tag"2312 SetCurrentColormap $style(-color) 2316 set _comp2scale($tag) $_settings(-heightmapscale) 2317 SendCmd "heightmap edges $_settings(-edges) $tag" 2318 SendCmd "heightmap wireframe $_settings(-wireframe) $tag" 2319 SetCurrentColormap $style(-color) 2313 2320 set color [$itk_component(isolinecolor) value] 2314 2321 SendCmd "heightmap isolinecolor [Color2RGB $color] $tag" 2315 SendCmd "heightmap lighting $_settings(isHeightmap) $tag" 2316 SendCmd "heightmap isolines $_settings(isolinesVisible) $tag" 2317 SendCmd "heightmap surface $_settings(colormapVisible) $tag" 2322 SendCmd "heightmap lighting $_settings(-isheightmap) $tag" 2323 SendCmd "heightmap isolines $_settings(-isolinesvisible) $tag" 2324 SendCmd "heightmap surface $_settings(-colormapvisible) $tag" 2325 SendCmd "heightmap opacity $style(-opacity) $tag" 2326 set _settings(-opacity) [expr $style(-opacity) * 100.0] 2318 2327 } 2319 2328 … … 2374 2383 } 2375 2384 set x [expr $w - 2] 2376 if { !$_settings( legendVisible) } {2385 if { !$_settings(-legendvisible) } { 2377 2386 $c delete legend 2378 2387 return … … 2382 2391 # If there's a legend title, create a text item for the title. 2383 2392 $c create text $x $y \ 2384 2385 2386 2393 -anchor ne \ 2394 -fill $itk_option(-plotforeground) -tags "title legend" \ 2395 -font $font 2387 2396 if { $title != "" } { 2388 2397 incr y $lineht 2389 2398 } 2390 2399 $c create text $x $y \ 2391 2392 2393 2394 2400 -anchor ne \ 2401 -fill $itk_option(-plotforeground) -tags "vmax legend" \ 2402 -font $font 2403 incr y $lineht 2395 2404 $c create image $x $y \ 2396 2405 -anchor ne \ … … 2416 2425 array unset _isolines 2417 2426 if { $color != "none" && [info exists _limits($_curFldName)] && 2418 $_settings( isolinesVisible) && $_currentNumIsolines > 0 } {2427 $_settings(-isolinesvisible) && $_currentNumIsolines > 0 } { 2419 2428 2420 2429 foreach { vmin vmax } $_limits($_curFldName) break … … 2583 2592 invoke { 2584 2593 $itk_component(field) value $_curFldLabel 2585 AdjustSetting field2594 AdjustSetting -field 2586 2595 } 2587 2596 default { … … 2592 2601 2593 2602 itcl::body Rappture::VtkHeightmapViewer::GetHeightmapScale {} { 2594 if { $_settings( isHeightmap) } {2595 set val $_settings( heightmapScale)2603 if { $_settings(-isheightmap) } { 2604 set val $_settings(-heightmapscale) 2596 2605 set sval [expr { $val >= 50 ? double($val)/50.0 : 1.0/(2.0-(double($val)/50.0)) }] 2597 2606 return $sval -
branches/r9/gui/scripts/vtkimageviewer.tcl
r4344 r4919 118 118 private variable _currentColormap "" 119 119 private variable _currentNumIsolines -1 120 private variable _currentOpacity ""121 120 122 121 private variable _maxScale 100; # This is the # of times the x-axis … … 756 755 set session $env(SESSION) 757 756 } 757 lappend info "version" "$Rappture::version" 758 lappend info "build" "$Rappture::build" 759 lappend info "svnurl" "$Rappture::svnurl" 760 lappend info "installdir" "$Rappture::installdir" 758 761 lappend info "hub" [exec hostname] 759 762 lappend info "client" "vtkimageviewer" … … 1020 1023 if { $_reset } { 1021 1024 SendCmd "axis tickpos outside" 1022 foreach axis { x y z } { 1023 SendCmd "axis lformat $axis %g" 1024 } 1025 #SendCmd "axis lformat all %g" 1025 1026 1026 1027 foreach axis { x y z } { … … 1060 1061 axisVisible axisLabels field view3D 1061 1062 if { [array size _fields] < 2 } { 1062 blt::table forget $itk_component(field) $itk_component(field_l) 1063 catch { 1064 blt::table forget $itk_component(field) $itk_component(field_l) 1065 } 1063 1066 } 1064 1067 RequestLegend … … 1317 1320 } 1318 1321 "axisLabels" { 1319 set bool $_settings( axisLabels)1322 set bool $_settings($what) 1320 1323 SendCmd "axis labels all $bool" 1321 1324 } 1322 1325 "axisMinorTicks" { 1323 set bool $_settings(axisMinorTicks) 1324 foreach axis { x y z } { 1325 SendCmd "axis minticks ${axis} $bool" 1326 } 1326 set bool $_settings($what) 1327 SendCmd "axis minticks all $bool" 1327 1328 } 1328 1329 "axisVisible" { 1329 set bool $_settings( axisVisible)1330 set bool $_settings($what) 1330 1331 SendCmd "axis visible all $bool" 1331 1332 } … … 1370 1371 } 1371 1372 "colormap" { 1372 set _changed( colormap) 11373 set _changed($what) 1 1373 1374 StartBufferingCommands 1374 1375 set color [$itk_component(colormap) value] 1375 set _settings( colormap) $color1376 set _settings($what) $color 1376 1377 SetCurrentColormap $color 1377 1378 if {$_settings(colormapDiscrete)} { … … 1395 1396 set label [$itk_component(field) value] 1396 1397 set fname [$itk_component(field) translate $label] 1397 set _settings( field) $fname1398 set _settings($what) $fname 1398 1399 if { [info exists _fields($fname)] } { 1399 1400 foreach { label units components } $_fields($fname) break … … 1417 1418 } 1418 1419 "view3D" { 1419 set bool $_settings( view3D)1420 set bool $_settings($what) 1420 1421 set c $itk_component(view) 1421 1422 StartBufferingCommands … … 1468 1469 } 1469 1470 "window" { 1470 set val $_settings( window)1471 set val $_settings($what) 1471 1472 SendCmd "image window $val" 1472 1473 } 1473 1474 "level" { 1474 set val $_settings( level)1475 set val $_settings($what) 1475 1476 SendCmd "image level $val" 1476 1477 } … … 1482 1483 } 1483 1484 "opacity" { 1484 set _changed( opacity) 11485 set _changed($what) 1 1485 1486 if { $_settings(view3D) } { 1486 set _settings(saveOpacity) $_settings(opacity) 1487 set val $_settings(opacity) 1488 set sval [expr { 0.01 * double($val) }] 1489 SendCmd "image opacity $sval" 1487 set _settings(saveOpacity) $_settings($what) 1488 set val [expr $_settings($what) * 0.01] 1489 SendCmd "image opacity $val" 1490 1490 } else { 1491 SendCmd "image opacity 1 "1491 SendCmd "image opacity 1.0" 1492 1492 } 1493 1493 } 1494 1494 "outline" { 1495 set bool $_settings( outline)1495 set bool $_settings($what) 1496 1496 SendCmd "outline visible $bool" 1497 1497 } … … 1846 1846 -font "Arial 9" 1847 1847 1848 1849 1848 label $inner.mode_l -text "Mode" -font "Arial 9" 1850 1849 … … 2043 2042 array set style { 2044 2043 -color none 2045 -opacity 1 002044 -opacity 1.0 2046 2045 } 2047 2046 set stylelist [$dataobj style $comp] … … 2059 2058 2060 2059 if { $_changed(opacity) } { 2061 set style(-opacity) $_settings(opacity)2060 set style(-opacity) [expr $_settings(opacity) * 0.01] 2062 2061 } 2063 2062 if { $_changed(colormap) } { … … 2071 2070 AdjustSetting stretchToFit 2072 2071 } 2073 set _currentOpacity $style(-opacity)2074 2072 SendCmd "outline add $tag" 2075 2073 SendCmd "outline color [Color2RGB $itk_option(-plotforeground)] $tag" … … 2079 2077 set color [$itk_component(backingcolor) value] 2080 2078 SendCmd "image color [Color2RGB $color] $tag" 2079 SendCmd "image opacity $style(-opacity) $tag" 2080 set _settings(opacity) [expr $style(-opacity) * 100.0] 2081 2081 } 2082 2082 -
branches/r9/gui/scripts/vtkisosurfaceviewer.tcl
r4344 r4919 63 63 public method scale {args} 64 64 65 protected method Connect {}66 protected method CurrentDatasets {args}67 protected method Disconnect {}68 protected method DoResize {}69 protected method DoRotate {}70 protected method AdjustSetting {what {value ""}}71 protected method InitSettings { args }72 protected method Pan {option x y}73 protected method Pick {x y}74 protected method Rebuild {}75 protected method ReceiveDataset { args }76 protected method ReceiveImage { args }77 protected method ReceiveLegend { colormap title vmin vmax size }78 protected method Rotate {option x y}79 protected method Zoom {option}80 81 65 # The following methods are only used by this class. 66 67 private method AdjustSetting {what {value ""}} 82 68 private method BuildAxisTab {} 83 69 private method BuildCameraTab {} … … 87 73 private method BuildIsosurfaceTab {} 88 74 private method Combo { option } 75 private method Connect {} 76 private method CurrentDatasets {args} 77 private method Disconnect {} 78 private method DoChangeContourLevels {} 79 private method DoResize {} 80 private method DoRotate {} 89 81 private method DrawLegend {} 90 82 private method EnterLegend { x y } 83 private method EventuallyChangeContourLevels {} 84 private method EventuallyRequestLegend {} 91 85 private method EventuallyResize { w h } 92 86 private method EventuallyRotate { q } 93 private method EventuallyRequestLegend {}94 87 private method EventuallySetCutplane { axis args } 88 private method GenerateContourList {} 95 89 private method GetImage { args } 96 90 private method GetVtkData { args } 91 private method InitSettings { args } 97 92 private method IsValidObject { dataobj } 98 93 private method LeaveLegend {} 99 94 private method MotionLegend { x y } 95 private method Pan {option x y} 100 96 private method PanCamera {} 97 private method Pick {x y} 98 private method Rebuild {} 99 private method ReceiveDataset { args } 100 private method ReceiveImage { args } 101 private method ReceiveLegend { colormap title vmin vmax size } 101 102 private method RequestLegend {} 103 private method Rotate {option x y} 104 private method SetCurrentColormap { color } 102 105 private method SetLegendTip { x y } 103 106 private method SetObjectStyle { dataobj comp } 107 private method SetCurrentFieldName { dataobj } 108 private method SetOrientation { side } 104 109 private method Slice {option args} 105 private method SetCurrentColormap { color } 106 private method SetOrientation { side } 107 private method UpdateContourList {} 110 private method Zoom {option} 111 private method ViewToQuaternion {} { 112 return [list $_view(-qw) $_view(-qx) $_view(-qy) $_view(-qz)] 113 } 108 114 109 115 private variable _arcball "" … … 120 126 private variable _currentColormap "" 121 127 private variable _currentNumContours -1 122 private variable _currentOpacity ""123 128 124 129 private variable _dataset2style ;# maps dataobj-component to transfunc … … 138 143 private variable _title "" 139 144 private variable _isolines 140 private variable _contourList "" 145 private variable _contourList 146 private variable _currentLimits "" 147 private variable _widget 141 148 142 149 common _downloadPopup; # download options from popup … … 184 191 $_dispatcher dispatch $this !legend "[itcl::code $this RequestLegend]; list" 185 192 193 # Contour levels event 194 $_dispatcher register !contours 195 $_dispatcher dispatch $this !contours \ 196 "[itcl::code $this DoChangeContourLevels]; list" 197 186 198 # X-Cutplane event 187 199 $_dispatcher register !xcutplane … … 208 220 # Initialize the view to some default parameters. 209 221 array set _view { 210 qw 0.853553211 qx -0.353553212 qy0.353553213 qz 0.146447214 zoom 1.0215 xpan 0216 ypan 0217 ortho 0222 -ortho 0 223 -qw 0.853553 224 -qx -0.353553 225 -qy 0.353553 226 -qz 0.146447 227 -xpan 0 228 -ypan 0 229 -zoom 1.0 218 230 } 219 231 set _arcball [blt::arcball create 100 100] 220 set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)] 221 $_arcball quaternion $q 222 232 $_arcball quaternion [ViewToQuaternion] 233 234 array set _contourList { 235 numLevels 10 236 reqValues "" 237 updatePending 0 238 values "" 239 } 223 240 array set _settings { 224 241 -axesvisible 1 225 242 -axislabelsvisible 1 226 -background black 227 -colormap BCGYR 228 -colormapvisible 1 243 -axismode "static" 244 -background black 245 -colormap BCGYR 246 -colormapvisible 1 229 247 -cutplaneedges 0 230 248 -cutplanelighting 1 231 -cutplaneopacity 1 00249 -cutplaneopacity 1.0 232 250 -cutplanepreinterp 1 233 251 -cutplanesvisible 0 234 252 -cutplanewireframe 0 235 236 253 -field "Default" 254 -isolinecolor white 237 255 -isosurfaceedges 0 238 256 -isosurfacelighting 1 239 -isosurfaceopacity 60 240 -isosurfaceoutline 0 257 -isosurfaceopacity 0.6 241 258 -isosurfacevisible 1 242 259 -isosurfacewireframe 0 243 260 -legendvisible 1 244 261 -numcontours 10 245 - xaxisgrid0262 -outline 0 246 263 -xcutplaneposition 50 247 264 -xcutplanevisible 1 248 - yaxisgrid0265 -xgrid 0 249 266 -ycutplaneposition 50 250 267 -ycutplanevisible 1 251 - zaxisgrid0268 -ygrid 0 252 269 -zcutplaneposition 50 253 270 -zcutplanevisible 1 271 -zgrid 0 254 272 } 255 273 array set _changed { 274 -colormap 0 256 275 -isosurfaceopacity 0 257 -c olormap0276 -cutplaneopacity 0 258 277 -numcontours 0 278 } 279 array set _widget { 280 -isosurfaceopacity 60 281 -cutplaneopacity 100 259 282 } 260 283 … … 341 364 $itk_component(contour) select 342 365 Rappture::Tooltip::for $itk_component(contour) \ 343 " Don't displaythe isosurface"366 "Hide the isosurface" 344 367 pack $itk_component(contour) -padx 2 -pady 2 345 368 … … 352 375 } 353 376 Rappture::Tooltip::for $itk_component(cutplane) \ 354 "Show /Hide cutplanes"377 "Show the cutplanes" 355 378 pack $itk_component(cutplane) -padx 2 -pady 2 356 379 … … 441 464 EnableWaitDialog 500 442 465 Connect 443 update444 466 } 445 467 … … 468 490 } 469 491 492 itcl::body Rappture::VtkIsosurfaceViewer::DoChangeContourLevels {} { 493 GenerateContourList 494 SendCmd [list contour3d contourlist $_contourList(values)] 495 SendCmd [list camera reset] 496 DrawLegend 497 set _contourList(updatePending) 0 498 } 499 470 500 itcl::body Rappture::VtkIsosurfaceViewer::DoRotate {} { 471 set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)] 472 SendCmd "camera orient $q" 501 SendCmd "camera orient [ViewToQuaternion]" 473 502 set _rotatePending 0 474 503 } … … 494 523 495 524 itcl::body Rappture::VtkIsosurfaceViewer::EventuallyRotate { q } { 496 foreach { _view( qw) _view(qx) _view(qy) _view(qz) } $q break525 foreach { _view(-qw) _view(-qx) _view(-qy) _view(-qz) } $q break 497 526 if { !$_rotatePending } { 498 527 set _rotatePending 1 … … 506 535 set _cutplanePending 1 507 536 $_dispatcher event -after 100 !${axis}cutplane 537 } 538 } 539 540 itcl::body Rappture::VtkIsosurfaceViewer::EventuallyChangeContourLevels {} { 541 set n $_contourList(numLevels) 542 set _contourList(values) "" 543 if { !$_contourList(updatePending) } { 544 set _contourList(updatePending) 1 545 global rotate_delay 546 $_dispatcher event -after $rotate_delay !contours 508 547 } 509 548 } … … 784 823 set session $env(SESSION) 785 824 } 825 lappend info "version" "$Rappture::version" 826 lappend info "build" "$Rappture::build" 827 lappend info "svnurl" "$Rappture::svnurl" 828 lappend info "installdir" "$Rappture::installdir" 786 829 lappend info "hub" [exec hostname] 787 830 lappend info "client" "vtkisosurfaceviewer" … … 833 876 # disconnected -- no more data sitting on server 834 877 set _outbuf "" 835 array unset _datasets 836 array unset _data 837 array unset _colormaps 838 array unset _seeds 839 array unset _dataset2style 840 array unset _obj2datasets 878 array unset _datasets 879 array unset _data 880 array unset _colormaps 881 array unset _dataset2style 882 array unset _obj2datasets 841 883 } 842 884 … … 940 982 # generates a new call to Rebuild). 941 983 StartBufferingCommands 942 943 984 if { $_reset } { 944 985 set _width $w … … 946 987 $_arcball resize $w $h 947 988 DoResize 948 # 989 949 990 # Reset the camera and other view parameters 950 # 951 set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)] 952 $_arcball quaternion $q 953 if {$_view(ortho)} { 954 SendCmd "camera mode ortho" 955 } else { 956 SendCmd "camera mode persp" 957 } 991 $_arcball quaternion [ViewToQuaternion] 958 992 DoRotate 959 993 PanCamera 960 994 set _first "" 961 InitSettings -x axisgrid -yaxisgrid -zaxisgrid -axismode \962 -axesvisible -axislabelsvisible 963 foreach axis { x y z } {964 SendCmd "axis lformat $axis %g" 965 } 995 InitSettings -xgrid -ygrid -zgrid -axismode \ 996 -axesvisible -axislabelsvisible -ortho 997 SendCmd "axis lformat all %g" 998 # Too many major ticks, so turn off minor ticks 999 SendCmd "axis minticks all 0" 966 1000 StopBufferingCommands 967 1001 SendCmd "imgflush" … … 970 1004 set _first "" 971 1005 SendCmd "dataset visible 0" 1006 eval scale $_dlist 972 1007 foreach dataobj [get -objects] { 973 1008 if { [info exists _obj2ovride($dataobj-raise)] && $_first == "" } { 974 1009 set _first $dataobj 1010 SetCurrentFieldName $dataobj 975 1011 } 976 1012 set _obj2datasets($dataobj) "" … … 996 1032 SendCmd "clientinfo [list $info]" 997 1033 } 998 append _outbuf "dataset add $tag data follows $length\n"1034 SendCmd "dataset add $tag data follows $length" 999 1035 append _outbuf $bytes 1000 1036 set _datasets($tag) 1 … … 1003 1039 lappend _obj2datasets($dataobj) $tag 1004 1040 if { [info exists _obj2ovride($dataobj-raise)] } { 1005 # Setting dataset visible enables outline 1006 # and contour3d 1007 SendCmd "dataset visible 1 $tag" 1008 } 1009 } 1010 } 1011 1012 if { $_first != "" } { 1013 $itk_component(field) choices delete 0 end 1014 $itk_component(fieldmenu) delete 0 end 1015 array unset _fields 1016 set _curFldName "" 1017 foreach cname [$_first components] { 1018 foreach fname [$_first fieldnames $cname] { 1019 if { [info exists _fields($fname)] } { 1020 continue 1021 } 1022 foreach { label units components } \ 1023 [$_first fieldinfo $fname] break 1024 $itk_component(field) choices insert end "$fname" "$label" 1025 $itk_component(fieldmenu) add radiobutton -label "$label" \ 1026 -value $label -variable [itcl::scope _curFldLabel] \ 1027 -selectcolor red \ 1028 -activebackground $itk_option(-plotbackground) \ 1029 -activeforeground $itk_option(-plotforeground) \ 1030 -font "Arial 8" \ 1031 -command [itcl::code $this Combo invoke] 1032 set _fields($fname) [list $label $units $components] 1033 if { $_curFldName == "" } { 1034 set _curFldName $fname 1035 set _curFldLabel $label 1036 } 1037 } 1038 } 1039 $itk_component(field) value $_curFldLabel 1040 } 1041 InitSettings -cutplanesvisible -isosurfacevisible -isosurfaceoutline 1041 SendCmd "contour3d visible 1 $tag" 1042 } 1043 } 1044 } 1045 1046 InitSettings -cutplanesvisible -isosurfacevisible -outline 1042 1047 if { $_reset } { 1043 1048 # These are settings that rely on a dataset being loaded. … … 1062 1067 set label [string toupper $axis] 1063 1068 } 1064 # May be a space in the axis label.1065 1069 SendCmd [list axis name $axis $label] 1066 1070 } 1067 1071 if { [array size _fields] < 2 } { 1068 blt::table forget $itk_component(field) $itk_component(field_l) 1072 catch { 1073 blt::table forget $itk_component(field) $itk_component(field_l) 1074 } 1069 1075 } 1070 1076 set _reset 0 1071 1077 } 1078 # Redraw the legend even if we're using the same colormap. The position 1079 # of the isolines may have changed because the range of data changed. 1080 DrawLegend 1072 1081 1073 1082 # Actually write the commands to the server socket. If it fails, we don't … … 1134 1143 switch -- $option { 1135 1144 "in" { 1136 set _view( zoom) [expr {$_view(zoom)*1.25}]1137 SendCmd "camera zoom $_view( zoom)"1145 set _view(-zoom) [expr {$_view(-zoom)*1.25}] 1146 SendCmd "camera zoom $_view(-zoom)" 1138 1147 } 1139 1148 "out" { 1140 set _view( zoom) [expr {$_view(zoom)*0.8}]1141 SendCmd "camera zoom $_view( zoom)"1149 set _view(-zoom) [expr {$_view(-zoom)*0.8}] 1150 SendCmd "camera zoom $_view(-zoom)" 1142 1151 } 1143 1152 "reset" { 1144 1153 array set _view { 1145 qw 0.8535531146 qx -0.3535531147 qy 0.3535531148 qz 0.1464471149 zoom 1.01150 xpan 01151 ypan01154 -qw 0.853553 1155 -qx -0.353553 1156 -qy 0.353553 1157 -qz 0.146447 1158 -xpan 0 1159 -ypan 0 1160 -zoom 1.0 1152 1161 } 1153 1162 if { $_first != "" } { … … 1157 1166 } 1158 1167 } 1159 set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)] 1160 $_arcball quaternion $q 1168 $_arcball quaternion [ViewToQuaternion] 1161 1169 DoRotate 1162 1170 SendCmd "camera reset" … … 1166 1174 1167 1175 itcl::body Rappture::VtkIsosurfaceViewer::PanCamera {} { 1168 set x $_view( xpan)1169 set y $_view( ypan)1176 set x $_view(-xpan) 1177 set y $_view(-ypan) 1170 1178 SendCmd "camera pan $x $y" 1171 1179 } … … 1245 1253 set x [expr $x / double($w)] 1246 1254 set y [expr $y / double($h)] 1247 set _view( xpan) [expr $_view(xpan) + $x]1248 set _view( ypan) [expr $_view(ypan) + $y]1255 set _view(-xpan) [expr $_view(-xpan) + $x] 1256 set _view(-ypan) [expr $_view(-ypan) + $y] 1249 1257 PanCamera 1250 1258 return … … 1268 1276 set _click(x) $x 1269 1277 set _click(y) $y 1270 set _view( xpan) [expr $_view(xpan) - $dx]1271 set _view( ypan) [expr $_view(ypan) - $dy]1278 set _view(-xpan) [expr $_view(-xpan) - $dx] 1279 set _view(-ypan) [expr $_view(-ypan) - $dy] 1272 1280 PanCamera 1273 1281 } … … 1311 1319 } 1312 1320 switch -- $what { 1321 "-axesvisible" { 1322 set bool $_settings($what) 1323 SendCmd "axis visible all $bool" 1324 } 1325 "-axislabelsvisible" { 1326 set bool $_settings($what) 1327 SendCmd "axis labels all $bool" 1328 } 1329 "-axismode" { 1330 set mode [$itk_component(axisMode) value] 1331 set mode [$itk_component(axisMode) translate $mode] 1332 set _settings($what) $mode 1333 SendCmd "axis flymode $mode" 1334 } 1313 1335 "-background" { 1314 1336 set bgcolor [$itk_component(background) value] … … 1323 1345 DrawLegend 1324 1346 } 1325 "-axesvisible" {1326 set bool $_settings(-axesvisible)1327 SendCmd "axis visible all $bool"1328 }1329 "-axislabelsvisible" {1330 set bool $_settings(-axislabelsvisible)1331 SendCmd "axis labels all $bool"1332 }1333 "-xaxisgrid" - "-yaxisgrid" - "-zaxisgrid" {1334 set axis [string tolower [string range $what 1 1]]1335 set bool $_settings($what)1336 SendCmd "axis grid $axis $bool"1337 }1338 "-axismode" {1339 set mode [$itk_component(axisMode) value]1340 set mode [$itk_component(axisMode) translate $mode]1341 set _settings($what) $mode1342 SendCmd "axis flymode $mode"1343 }1344 1347 "-cutplaneedges" { 1345 1348 set bool $_settings($what) 1346 1349 SendCmd "cutplane edges $bool" 1347 1350 } 1351 "-cutplanelighting" { 1352 set bool $_settings($what) 1353 SendCmd "cutplane lighting $bool" 1354 } 1355 "-cutplaneopacity" { 1356 set _settings($what) [expr $_widget($what) * 0.01] 1357 SendCmd "cutplane opacity $_settings($what)" 1358 } 1359 "-cutplanepreinterp" { 1360 set bool $_settings($what) 1361 SendCmd "cutplane preinterp $bool" 1362 } 1348 1363 "-cutplanesvisible" { 1349 1364 set bool $_settings($what) 1350 SendCmd "cutplane visible $bool" 1365 SendCmd "cutplane visible 0" 1366 if { $bool } { 1367 foreach tag [CurrentDatasets -visible] { 1368 SendCmd "cutplane visible $bool $tag" 1369 } 1370 } 1371 if { $bool } { 1372 Rappture::Tooltip::for $itk_component(cutplane) \ 1373 "Hide the cutplanes" 1374 } else { 1375 Rappture::Tooltip::for $itk_component(cutplane) \ 1376 "Show the cutplanes" 1377 } 1351 1378 } 1352 1379 "-cutplanewireframe" { … … 1354 1381 SendCmd "cutplane wireframe $bool" 1355 1382 } 1356 "-cutplanelighting" {1357 set bool $_settings($what)1358 SendCmd "cutplane lighting $bool"1359 }1360 "-cutplaneopacity" {1361 set val $_settings($what)1362 set sval [expr { 0.01 * double($val) }]1363 SendCmd "cutplane opacity $sval"1364 }1365 "-cutplanepreinterp" {1366 set bool $_settings($what)1367 SendCmd "cutplane preinterp $bool"1368 }1369 "-xcutplanevisible" - "-ycutplanevisible" - "-zcutplanevisible" {1370 set axis [string tolower [string range $what 1 1]]1371 set bool $_settings($what)1372 if { $bool } {1373 $itk_component(${axis}position) configure -state normal \1374 -troughcolor white1375 } else {1376 $itk_component(${axis}position) configure -state disabled \1377 -troughcolor grey821378 }1379 SendCmd "cutplane axis $axis $bool"1380 }1381 "-xcutplaneposition" - "-ycutplaneposition" - "-zcutplaneposition" {1382 set axis [string tolower [string range $what 1 1]]1383 set pos [expr $_settings($what) * 0.01]1384 SendCmd "cutplane slice ${axis} ${pos}"1385 set _cutplanePending 01386 }1387 1383 "-colormap" { 1388 set _changed( -colormap) 11384 set _changed($what) 1 1389 1385 StartBufferingCommands 1390 1386 set color [$itk_component(colormap) value] 1391 set _settings( -colormap) $color1387 set _settings($what) $color 1392 1388 if { $color == "none" } { 1393 1389 if { $_settings(-colormapvisible) } { … … 1405 1401 EventuallyRequestLegend 1406 1402 } 1407 "-numcontours" {1408 set _settings($what) [$itk_component(numcontours) value]1409 set _currentNumContours $_settings($what)1410 UpdateContourList1411 set _changed($what) 11412 SendCmd "contour3d contourlist [list $_contourList]"1413 DrawLegend1414 }1415 "-isosurfacewireframe" {1416 set bool $_settings($what)1417 SendCmd "contour3d wireframe $bool"1418 }1419 "-isosurfacevisible" {1420 set bool $_settings($what)1421 SendCmd "contour3d visible $bool"1422 if { $bool } {1423 Rappture::Tooltip::for $itk_component(contour) \1424 "Hide the isosurface"1425 } else {1426 Rappture::Tooltip::for $itk_component(contour) \1427 "Show the isosurface"1428 }1429 DrawLegend1430 }1431 "-isosurfacelighting" {1432 set bool $_settings($what)1433 SendCmd "contour3d lighting $bool"1434 }1435 "-isosurfaceedges" {1436 set bool $_settings($what)1437 SendCmd "contour3d edges $bool"1438 }1439 "-isosurfaceoutline" {1440 set bool $_settings($what)1441 SendCmd "outline visible $bool"1442 }1443 "-isolinecolor" {1444 set color [$itk_component(isolineColor) value]1445 set _settings($what) $color1446 DrawLegend1447 }1448 "-isosurfaceopacity" {1449 set val $_settings($what)1450 set sval [expr { 0.01 * double($val) }]1451 SendCmd "contour3d opacity $sval"1452 }1453 1403 "-field" { 1454 1404 set label [$itk_component(field) value] … … 1477 1427 SendCmd "contour3d colormode $_colorMode $_curFldName" 1478 1428 SendCmd "camera reset" 1479 UpdateContourList1429 GenerateContourList 1480 1430 DrawLegend 1431 } 1432 "-isolinecolor" { 1433 set color [$itk_component(isolineColor) value] 1434 set _settings($what) $color 1435 DrawLegend 1436 } 1437 "-isosurfaceedges" { 1438 set bool $_settings($what) 1439 SendCmd "contour3d edges $bool" 1440 } 1441 "-isosurfacelighting" { 1442 set bool $_settings($what) 1443 SendCmd "contour3d lighting $bool" 1444 } 1445 "-isosurfaceopacity" { 1446 set _settings($what) [expr $_widget($what) * 0.01] 1447 SendCmd "contour3d opacity $_settings($what)" 1448 } 1449 "-isosurfacevisible" { 1450 set bool $_settings($what) 1451 SendCmd "contour3d visible 0" 1452 if { $bool } { 1453 foreach tag [CurrentDatasets -visible] { 1454 SendCmd "contour3d visible $bool $tag" 1455 } 1456 } 1457 if { $bool } { 1458 Rappture::Tooltip::for $itk_component(contour) \ 1459 "Hide the isosurface" 1460 } else { 1461 Rappture::Tooltip::for $itk_component(contour) \ 1462 "Show the isosurface" 1463 } 1464 } 1465 "-isosurfacewireframe" { 1466 set bool $_settings($what) 1467 SendCmd "contour3d wireframe $bool" 1481 1468 } 1482 1469 "-legendvisible" { … … 1485 1472 } 1486 1473 DrawLegend 1474 } 1475 "-numcontours" { 1476 set _settings($what) [$itk_component(numcontours) value] 1477 if { $_contourList(numLevels) != $_settings($what) } { 1478 set _contourList(numLevels) $_settings($what) 1479 EventuallyChangeContourLevels 1480 } 1481 } 1482 "-ortho" { 1483 set bool $_view($what) 1484 if { $bool } { 1485 SendCmd "camera mode ortho" 1486 } else { 1487 SendCmd "camera mode persp" 1488 } 1489 } 1490 "-outline" { 1491 set bool $_settings($what) 1492 SendCmd "outline visible 0" 1493 if { $bool } { 1494 foreach tag [CurrentDatasets -visible] { 1495 SendCmd "outline visible $bool $tag" 1496 } 1497 } 1498 } 1499 "-xcutplanevisible" - "-ycutplanevisible" - "-zcutplanevisible" { 1500 set axis [string tolower [string range $what 1 1]] 1501 set bool $_settings($what) 1502 if { $bool } { 1503 $itk_component(${axis}position) configure -state normal \ 1504 -troughcolor white 1505 } else { 1506 $itk_component(${axis}position) configure -state disabled \ 1507 -troughcolor grey82 1508 } 1509 SendCmd "cutplane axis $axis $bool" 1510 } 1511 "-xcutplaneposition" - "-ycutplaneposition" - "-zcutplaneposition" { 1512 set axis [string tolower [string range $what 1 1]] 1513 set pos [expr $_settings($what) * 0.01] 1514 SendCmd "cutplane slice ${axis} ${pos}" 1515 set _cutplanePending 0 1516 } 1517 "-xgrid" - "-ygrid" - "-zgrid" { 1518 set axis [string tolower [string range $what 1 1]] 1519 set bool $_settings($what) 1520 SendCmd "axis grid $axis $bool" 1487 1521 } 1488 1522 default { … … 1608 1642 checkbutton $inner.outline \ 1609 1643 -text "Outline" \ 1610 -variable [itcl::scope _settings(- isosurfaceoutline)] \1611 -command [itcl::code $this AdjustSetting - isosurfaceoutline] \1644 -variable [itcl::scope _settings(-outline)] \ 1645 -command [itcl::code $this AdjustSetting -outline] \ 1612 1646 -font "Arial 9" 1613 1647 … … 1653 1687 label $inner.opacity_l -text "Opacity" -font "Arial 9" 1654 1688 ::scale $inner.opacity -from 0 -to 100 -orient horizontal \ 1655 -variable [itcl::scope _ settings(-isosurfaceopacity)] \1689 -variable [itcl::scope _widget(-isosurfaceopacity)] \ 1656 1690 -width 10 \ 1657 1691 -showvalue off \ 1658 1692 -command [itcl::code $this AdjustSetting -isosurfaceopacity] 1693 set _widget(-isosurfaceopacity) \ 1694 [expr $_settings(-isosurfaceopacity) * 100.0] 1659 1695 1660 1696 itk_component add field_l { … … 1735 1771 checkbutton $inner.gridx \ 1736 1772 -text "Show X Grid" \ 1737 -variable [itcl::scope _settings(-x axisgrid)] \1738 -command [itcl::code $this AdjustSetting -x axisgrid] \1773 -variable [itcl::scope _settings(-xgrid)] \ 1774 -command [itcl::code $this AdjustSetting -xgrid] \ 1739 1775 -font "Arial 9" 1740 1776 checkbutton $inner.gridy \ 1741 1777 -text "Show Y Grid" \ 1742 -variable [itcl::scope _settings(-y axisgrid)] \1743 -command [itcl::code $this AdjustSetting -y axisgrid] \1778 -variable [itcl::scope _settings(-ygrid)] \ 1779 -command [itcl::code $this AdjustSetting -ygrid] \ 1744 1780 -font "Arial 9" 1745 1781 checkbutton $inner.gridz \ 1746 1782 -text "Show Z Grid" \ 1747 -variable [itcl::scope _settings(-z axisgrid)] \1748 -command [itcl::code $this AdjustSetting -z axisgrid] \1783 -variable [itcl::scope _settings(-zgrid)] \ 1784 -command [itcl::code $this AdjustSetting -zgrid] \ 1749 1785 -font "Arial 9" 1750 1786 … … 1759 1795 "furthest_triad" "farthest" \ 1760 1796 "outer_edges" "outer" 1761 $itk_component(axisMode) value "static"1797 $itk_component(axisMode) value $_settings(-axismode) 1762 1798 bind $inner.mode <<Value>> [itcl::code $this AdjustSetting -axismode] 1763 1799 … … 1800 1836 label $inner.${tag}label -text $tag -font "Arial 9" 1801 1837 entry $inner.${tag} -font "Arial 9" -bg white \ 1802 -textvariable [itcl::scope _view( $tag)]1838 -textvariable [itcl::scope _view(-$tag)] 1803 1839 bind $inner.${tag} <KeyPress-Return> \ 1804 1840 [itcl::code $this camera set ${tag}] … … 1811 1847 checkbutton $inner.ortho \ 1812 1848 -text "Orthographic Projection" \ 1813 -variable [itcl::scope _view( ortho)] \1814 -command [itcl::code $this camera setortho] \1849 -variable [itcl::scope _view(-ortho)] \ 1850 -command [itcl::code $this AdjustSetting -ortho] \ 1815 1851 -font "Arial 9" 1816 1852 blt::table $inner \ … … 1866 1902 label $inner.opacity_l -text "Opacity" -font "Arial 9" 1867 1903 ::scale $inner.opacity -from 0 -to 100 -orient horizontal \ 1868 -variable [itcl::scope _ settings(-cutplaneopacity)] \1904 -variable [itcl::scope _widget(-cutplaneopacity)] \ 1869 1905 -width 10 \ 1870 1906 -showvalue off \ 1871 1907 -command [itcl::code $this AdjustSetting -cutplaneopacity] 1872 $inner.opacity set $_settings(-cutplaneopacity)1908 set _widget(-cutplaneopacity) [expr $_settings(-cutplaneopacity) * 100.0] 1873 1909 1874 1910 # X-value slicer... … … 1991 2027 } 1992 2028 "set" { 1993 set wh o[lindex $args 0]1994 set x $_view($wh o)2029 set what [lindex $args 0] 2030 set x $_view($what) 1995 2031 set code [catch { string is double $x } result] 1996 2032 if { $code != 0 || !$result } { 1997 2033 return 1998 2034 } 1999 switch -- $wh o{2000 " ortho" {2001 if {$_view( ortho)} {2035 switch -- $what { 2036 "-ortho" { 2037 if {$_view($what)} { 2002 2038 SendCmd "camera mode ortho" 2003 2039 } else { … … 2005 2041 } 2006 2042 } 2007 " xpan" - "ypan" {2043 "-xpan" - "-ypan" { 2008 2044 PanCamera 2009 2045 } 2010 " qx" - "qy" - "qz" - "qw" {2011 set q [ list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]2046 "-qx" - "-qy" - "-qz" - "-qw" { 2047 set q [ViewToQuaternion] 2012 2048 $_arcball quaternion $q 2013 2049 EventuallyRotate $q 2014 2050 } 2015 " zoom" {2016 SendCmd "camera zoom $_view( zoom)"2051 "-zoom" { 2052 SendCmd "camera zoom $_view(-zoom)" 2017 2053 } 2018 2054 } … … 2089 2125 set tag $dataobj-$comp 2090 2126 array set style { 2091 -color BCGYR2092 -cutplanesvisible 02093 -edgecolor black2094 -edges 02095 -isosurface visible 12096 - levels 102097 -l ighting 12098 -li newidth 1.02099 - opacity 0.62100 -outline 02101 - xcutplanevisible 12102 -xcutplaneposition 502103 - ycutplanevisible12104 -ycutplaneposition 502105 - zcutplanevisible12106 -zcutplaneposition 502107 - wireframe 02127 -color BCGYR 2128 -cutplanesvisible 0 2129 -edgecolor black 2130 -edges 0 2131 -isosurfaceopacity 0.6 2132 -isosurfacevisible 1 2133 -levels 10 2134 -lighting 1 2135 -linewidth 1.0 2136 -outline 0 2137 -wireframe 0 2138 -xcutplaneposition 50 2139 -xcutplanevisible 1 2140 -ycutplaneposition 50 2141 -ycutplanevisible 1 2142 -zcutplaneposition 50 2143 -zcutplanevisible 1 2108 2144 } 2109 2145 array set style [$dataobj style $comp] 2110 2146 if { $dataobj != $_first || $style(-levels) == 1 } { 2111 set style(-opacity) 1 2112 } 2113 SendCmd "cutplane add $tag" 2114 SendCmd "cutplane visible 0 $tag" 2147 set style(-isosurfaceopacity) 1.0 2148 } 2115 2149 2116 2150 # This is too complicated. We want to set the colormap, number of … … 2124 2158 2125 2159 if { $_changed(-isosurfaceopacity) } { 2126 set style(- opacity) $_settings(-isosurfaceopacity)2160 set style(-isosurfaceopacity) $_settings(-isosurfaceopacity) 2127 2161 } 2128 2162 if { $_changed(-numcontours) } { … … 2136 2170 $itk_component(colormap) value $style(-color) 2137 2171 } 2138 set _currentOpacity $style(-opacity) 2139 if { $_currentNumContours != $style(-levels) } { 2140 set _currentNumContours $style(-levels) 2141 set _settings(-numcontours) $_currentNumContours 2142 $itk_component(numcontours) value $_currentNumContours 2143 UpdateContourList 2144 DrawLegend 2172 if { $_contourList(numLevels) != $style(-levels) } { 2173 if { [llength $style(-levels)] > 1 } { 2174 set _contourList(reqValues) [lsort -real $style(-levels)] 2175 } else { 2176 set _settings(-numcontours) $style(-levels) 2177 $itk_component(numcontours) value $style(-levels) 2178 set _contourList(numLevels) $style(-levels) 2179 } 2180 EventuallyChangeContourLevels 2145 2181 } 2146 2182 set _settings(-isosurfacevisible) $style(-isosurfacevisible) … … 2153 2189 set _settings(-zcutplaneposition) $style(-zcutplaneposition) 2154 2190 2155 SendCmd [list contour3d add contourlist $_contourList $tag] 2156 SendCmd "contour3d edges $style(-edges) $tag" 2191 SendCmd "cutplane add $tag" 2192 SendCmd "cutplane visible $style(-cutplanesvisible) $tag" 2193 2157 2194 SendCmd "outline add $tag" 2158 2195 SendCmd "outline color [Color2RGB $itk_option(-plotforeground)] $tag" 2159 2196 SendCmd "outline visible $style(-outline) $tag" 2160 set _settings(-isosurfaceoutline) $style(-outline) 2197 set _settings(-outline) $style(-outline) 2198 2199 GenerateContourList 2200 SendCmd [list contour3d add contourlist $_contourList(values) $tag] 2201 SendCmd "contour3d visible $style(-isosurfacevisible) $tag" 2202 SendCmd "contour3d edges $style(-edges) $tag" 2161 2203 set _settings(-isosurfaceedges) $style(-edges) 2162 2204 #SendCmd "contour3d color [Color2RGB $settings(-color)] $tag" … … 2165 2207 SendCmd "contour3d linecolor [Color2RGB $style(-edgecolor)] $tag" 2166 2208 SendCmd "contour3d linewidth $style(-linewidth) $tag" 2167 SendCmd "contour3d opacity $ _currentOpacity$tag"2168 set _settings(-isosurfaceopacity) $style(- opacity)2209 SendCmd "contour3d opacity $style(-isosurfaceopacity) $tag" 2210 set _settings(-isosurfaceopacity) $style(-isosurfaceopacity) 2169 2211 SetCurrentColormap $style(-color) 2170 2212 SendCmd "contour3d wireframe $style(-wireframe) $tag" 2171 2213 set _settings(-isosurfacewireframe) $style(-wireframe) 2172 set _settings(-isosurfaceopacity) [expr $style(-opacity) * 100.0]2173 2214 } 2174 2215 … … 2404 2445 incr offset $lineht 2405 2446 } 2406 foreach value $_contourList {2447 foreach value $_contourList(values) { 2407 2448 set norm [expr 1.0 - (($value - $vmin) / $range)] 2408 2449 set y1 [expr int(round(($norm * $ih) + $offset))] … … 2517 2558 bottom "0.707107 0.707107 0 0" 2518 2559 } 2519 foreach name { qw qx qyqz } value $positions($side) {2560 foreach name { -qw -qx -qy -qz } value $positions($side) { 2520 2561 set _view($name) $value 2521 2562 } 2522 set q [ list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]2563 set q [ViewToQuaternion] 2523 2564 $_arcball quaternion $q 2524 2565 SendCmd "camera orient $q" 2525 2566 SendCmd "camera reset" 2526 set _view( xpan) 02527 set _view( ypan) 02528 set _view( zoom) 1.02529 } 2530 2531 itcl::body Rappture::VtkIsosurfaceViewer:: UpdateContourList {} {2567 set _view(-xpan) 0 2568 set _view(-ypan) 0 2569 set _view(-zoom) 1.0 2570 } 2571 2572 itcl::body Rappture::VtkIsosurfaceViewer::GenerateContourList {} { 2532 2573 if { ![info exists _limits($_curFldName)] } { 2533 return 2534 } 2535 if { $_currentNumContours < 1 } { 2536 set _contourList "" 2537 return 2538 } 2539 foreach { vmin vmax } $_limits($_curFldName) break 2540 set v [blt::vector create \#auto] 2541 $v seq $vmin $vmax [expr $_currentNumContours+2] 2542 $v delete end 0 2543 set _contourList [$v range 0 end] 2544 blt::vector destroy $v 2545 } 2546 2574 puts stderr "no _curFldName" 2575 return "" 2576 } 2577 if { $_contourList(numLevels) < 1 } { 2578 return "" 2579 } 2580 if { [llength $_contourList(reqValues)] > 1 } { 2581 set values $_contourList(reqValues) 2582 } else { 2583 foreach { vmin vmax } $_limits($_curFldName) break 2584 set v [blt::vector create \#auto] 2585 $v seq $vmin $vmax [expr $_contourList(numLevels)+2] 2586 $v delete end 0 2587 set values [$v range 0 end] 2588 blt::vector destroy $v 2589 } 2590 set _contourList(values) $values 2591 } 2592 2593 itcl::body Rappture::VtkIsosurfaceViewer::SetCurrentFieldName { dataobj } { 2594 set _first $dataobj 2595 $itk_component(field) choices delete 0 end 2596 $itk_component(fieldmenu) delete 0 end 2597 array unset _fields 2598 set _curFldName "" 2599 foreach cname [$_first components] { 2600 foreach fname [$_first fieldnames $cname] { 2601 if { [info exists _fields($fname)] } { 2602 continue 2603 } 2604 foreach { label units components } \ 2605 [$_first fieldinfo $fname] break 2606 $itk_component(field) choices insert end "$fname" "$label" 2607 $itk_component(fieldmenu) add radiobutton -label "$label" \ 2608 -value $label -variable [itcl::scope _curFldLabel] \ 2609 -selectcolor red \ 2610 -activebackground $itk_option(-plotbackground) \ 2611 -activeforeground $itk_option(-plotforeground) \ 2612 -font "Arial 8" \ 2613 -command [itcl::code $this Combo invoke] 2614 set _fields($fname) [list $label $units $components] 2615 if { $_curFldName == "" } { 2616 set _curFldName $fname 2617 set _curFldLabel $label 2618 } 2619 } 2620 } 2621 $itk_component(field) value $_curFldLabel 2622 if { ![info exists _limits($_curFldName)] } { 2623 SendCmd "dataset maprange all" 2624 } else { 2625 set limits $_limits($_curFldName) 2626 SendCmd "dataset maprange explicit $limits $_curFldName" 2627 if { $limits != $_currentLimits } { 2628 set _currentLimits $limits 2629 EventuallyChangeContourLevels 2630 } 2631 } 2632 } -
branches/r9/gui/scripts/vtkmeshviewer.tcl
r4344 r4919 57 57 public method get {args} 58 58 public method isconnected {} 59 public method limits { colormap}59 public method limits { dataobj } 60 60 public method parameters {title args} { 61 61 # do nothing … … 63 63 public method scale {args} 64 64 65 protected method Connect {}66 protected method CurrentDatasets {args}67 protected method Disconnect {}68 protected method DoResize {}69 protected method DoRotate {}70 protected method AdjustSetting {what {value ""}}71 protected method FixSettings { args }72 protected method Pan {option x y}73 protected method Pick {x y}74 protected method Rebuild {}75 protected method ReceiveDataset { args }76 protected method ReceiveImage { args }77 protected method Rotate {option x y}78 protected method Zoom {option}79 80 65 # The following methods are only used by this class. 66 private method AdjustSetting {what {value ""}} 81 67 private method BuildAxisTab {} 82 68 private method BuildCameraTab {} 83 private method BuildCutawayTab {}84 69 private method BuildDownloadPopup { widget command } 85 70 private method BuildPolydataTab {} 71 private method Connect {} 72 private method CurrentDatasets {args} 73 private method Disconnect {} 74 private method DoResize {} 75 private method DoRotate {} 86 76 private method EventuallyResize { w h } 87 77 private method EventuallyRotate { q } 88 private method EventuallySetPolydataOpacity { args}78 private method EventuallySetPolydataOpacity {} 89 79 private method GetImage { args } 90 80 private method GetVtkData { args } 81 private method InitSettings { args } 91 82 private method IsValidObject { dataobj } 83 private method Pan {option x y} 92 84 private method PanCamera {} 85 private method Pick {x y} 86 private method QuaternionToView { q } { 87 foreach { _view(-qw) _view(-qx) _view(-qy) _view(-qz) } $q break 88 } 89 private method Rebuild {} 90 private method ReceiveDataset { args } 91 private method ReceiveImage { args } 92 private method Rotate {option x y} 93 93 private method SetObjectStyle { dataobj } 94 private method SetOpacity { dataset }95 94 private method SetOrientation { side } 96 95 private method SetPolydataOpacity {} 97 private method Slice {option args} 96 private method ViewToQuaternion {} { 97 return [list $_view(-qw) $_view(-qx) $_view(-qy) $_view(-qz)] 98 } 99 private method Zoom {option} 98 100 99 101 private variable _arcball "" … … 103 105 private variable _datasets; # contains all the dataobj-component 104 106 # datasets in the server 105 private variable _colormaps; # contains all the colormaps106 # in the server.107 107 private variable _dataset2style; # maps dataobj-component to transfunc 108 108 private variable _style2datasets; # maps tf back to list of … … 112 112 private variable _view; # view params for 3D view 113 113 private variable _settings 114 private variable _widget 114 115 private variable _style; # Array of current component styles. 115 116 private variable _initialStyle; # Array of initial component styles. 116 private variable _axis117 117 private variable _reset 1; # Indicates that server was reset and 118 118 # needs to be reinitialized. 119 119 120 private variable _first "" ;# This is the topmost dataset.120 private variable _first ""; # This is the topmost dataset. 121 121 private variable _start 0 122 122 private variable _title "" 123 123 124 common _downloadPopup ;# download options from popup124 common _downloadPopup; # download options from popup 125 125 private common _hardcopy 126 126 private variable _width 0 … … 130 130 private variable _polydataOpacityPending 0 131 131 private variable _rotateDelay 150 132 private variable _opacityDelay 150 132 133 } 133 134 … … 163 164 # Populate parser with commands handle incoming requests 164 165 # 165 $_parser alias image 166 $_parser alias dataset 166 $_parser alias image [itcl::code $this ReceiveImage] 167 $_parser alias dataset [itcl::code $this ReceiveDataset] 167 168 168 169 # Initialize the view to some default parameters. 169 170 array set _view { 170 qw 0.853553171 qx -0.353553172 qy0.353553173 qz 0.146447174 zoom 1.0175 xpan 0176 ypan 0177 ortho0171 -ortho 0 172 -qw 0.853553 173 -qx -0.353553 174 -qy 0.353553 175 -qz 0.146447 176 -xpan 0 177 -ypan 0 178 -zoom 1.0 178 179 } 179 180 set _arcball [blt::arcball create 100 100] 180 set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)] 181 $_arcball quaternion $q 181 $_arcball quaternion [ViewToQuaternion] 182 182 183 183 set _limits(zmin) 0.0 184 184 set _limits(zmax) 1.0 185 185 186 array set _axis [subst { 187 xgrid 0 188 ygrid 0 189 zgrid 0 190 xcutaway 0 191 ycutaway 0 192 zcutaway 0 193 xposition 0 194 yposition 0 195 zposition 0 196 xdirection -1 197 ydirection -1 198 zdirection -1 199 visible 1 200 labels 1 201 }] 202 array set _settings [subst { 203 polydata-edges 0 204 polydata-lighting 1 205 polydata-opacity 100 206 polydata-visible 1 207 polydata-wireframe 0 208 }] 186 array set _settings { 187 -axesvisible 1 188 -axislabels 1 189 -axisminorticks 1 190 -outline 0 191 -polydataedges 0 192 -polydatalighting 1 193 -polydataopacity 1.0 194 -polydatavisible 1 195 -polydatawireframe 0 196 -xgrid 0 197 -ygrid 0 198 -zgrid 0 199 } 200 array set _widget { 201 -polydataopacity 100 202 } 209 203 itk_component add view { 210 204 canvas $itk_component(plotarea).view \ … … 283 277 BuildPolydataTab 284 278 BuildAxisTab 285 #BuildCutawayTab286 279 BuildCameraTab 287 280 … … 302 295 bind $itk_component(view) <ButtonRelease-1> \ 303 296 [itcl::code $this Rotate release %x %y] 304 bind $itk_component(view) <Configure> \305 [itcl::code $this EventuallyResize %w %h]306 297 307 298 # Bindings for panning via mouse … … 381 372 382 373 itcl::body Rappture::VtkMeshViewer::DoRotate {} { 383 set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)] 384 SendCmd "camera orient $q" 374 SendCmd "camera orient [ViewToQuaternion]" 385 375 set _rotatePending 0 386 376 } … … 397 387 398 388 itcl::body Rappture::VtkMeshViewer::EventuallyRotate { q } { 399 foreach { _view(qw) _view(qx) _view(qy) _view(qz) } $q break389 QuaternionToView $q 400 390 if { !$_rotatePending } { 401 391 set _rotatePending 1 … … 406 396 itcl::body Rappture::VtkMeshViewer::SetPolydataOpacity {} { 407 397 set _polydataOpacityPending 0 408 foreach dataset [CurrentDatasets -visible $_first] { 409 SetOpacity $dataset 410 } 411 } 412 413 itcl::body Rappture::VtkMeshViewer::EventuallySetPolydataOpacity { args } { 398 set val $_settings(-polydataopacity) 399 SendCmd "polydata opacity $val" 400 } 401 402 itcl::body Rappture::VtkMeshViewer::EventuallySetPolydataOpacity {} { 414 403 if { !$_polydataOpacityPending } { 415 404 set _polydataOpacityPending 1 416 $_dispatcher event -after $_ scaleDelay !polydataOpacity405 $_dispatcher event -after $_opacityDelay !polydataOpacity 417 406 } 418 407 } … … 477 466 set _dlist [lreplace $_dlist $pos $pos] 478 467 array unset _obj2ovride $dataobj-* 479 array unset _settings $dataobj-*480 468 set changed 1 481 469 } … … 678 666 set session $env(SESSION) 679 667 } 668 lappend info "version" "$Rappture::version" 669 lappend info "build" "$Rappture::build" 670 lappend info "svnurl" "$Rappture::svnurl" 671 lappend info "installdir" "$Rappture::installdir" 680 672 lappend info "hub" [exec hostname] 681 673 lappend info "client" "vtkmeshviewer" … … 719 711 720 712 # disconnected -- no more data sitting on server 721 array unset _datasets 722 array unset _data 723 array unset _colormaps 713 array unset _datasets 714 array unset _data 724 715 global readyForNextFrame 725 716 set readyForNextFrame 1 … … 745 736 if { $info(-type) == "image" } { 746 737 if 0 { 747 set f [open "last.ppm" "w"] 738 set f [open "last.ppm" "w"] 748 739 fconfigure $f -encoding binary 749 740 puts -nonewline $f $bytes … … 831 822 $_arcball resize $w $h 832 823 DoResize 833 FixSettings axis-xgrid axis-ygrid axis-zgrid axis-mode \ 834 axis-visible axis-labels polydata-edges polydata-lighting polydata-opacity \ 835 polydata-visible polydata-wireframe 836 824 InitSettings -xgrid -ygrid -zgrid -axismode \ 825 -axesvisible -axislabels -axisminorticks 837 826 StopBufferingCommands 838 827 SendCmd "imgflush" … … 856 845 continue 857 846 } 847 if 0 { 848 set f [open /tmp/vtkmesh.vtk "w"] 849 fconfigure $f -translation binary -encoding binary 850 puts -nonewline $f $bytes 851 close $f 852 } 858 853 set length [string length $bytes] 859 854 if { $_reportClientInfo } { 860 855 set info {} 861 lappend info "tool_id" [$dataobj hints toolId] 862 lappend info "tool_name" [$dataobj hints toolName] 863 lappend info "tool_version" [$dataobj hints toolRevision] 864 lappend info "tool_title" [$dataobj hints toolTitle] 856 lappend info "tool_id" [$dataobj hints toolid] 857 lappend info "tool_name" [$dataobj hints toolname] 858 lappend info "tool_title" [$dataobj hints tooltitle] 859 lappend info "tool_command" [$dataobj hints toolcommand] 860 lappend info "tool_revision" [$dataobj hints toolrevision] 865 861 lappend info "dataset_label" [$dataobj hints label] 866 862 lappend info "dataset_size" $length 867 863 lappend info "dataset_tag" $tag 868 SendCmd [list "clientinfo" $info]864 SendCmd "clientinfo [list $info]" 869 865 } 870 866 SendCmd "dataset add $tag data follows $length" … … 876 872 if { [info exists _obj2ovride($dataobj-raise)] } { 877 873 SendCmd "dataset visible 1 $tag" 878 SetOpacity $tag874 EventuallySetPolydataOpacity 879 875 } 880 876 } … … 896 892 } 897 893 } 894 InitSettings -outline 898 895 if { $_reset } { 899 set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)] 900 $_arcball quaternion $q 896 # These are settings that rely on a dataset being loaded. 897 InitSettings -polydataedges -polydatalighting -polydataopacity \ 898 -polydatavisible -polydatawireframe 899 900 #SendCmd "axis lformat all %g" 901 902 $_arcball quaternion [ViewToQuaternion] 901 903 SendCmd "camera reset" 902 if { $_view( ortho)} {904 if { $_view(-ortho)} { 903 905 SendCmd "camera mode ortho" 904 906 } else { … … 975 977 switch -- $option { 976 978 "in" { 977 set _view( zoom) [expr {$_view(zoom)*1.25}]978 SendCmd "camera zoom $_view( zoom)"979 set _view(-zoom) [expr {$_view(-zoom)*1.25}] 980 SendCmd "camera zoom $_view(-zoom)" 979 981 } 980 982 "out" { 981 set _view( zoom) [expr {$_view(zoom)*0.8}]982 SendCmd "camera zoom $_view( zoom)"983 set _view(-zoom) [expr {$_view(-zoom)*0.8}] 984 SendCmd "camera zoom $_view(-zoom)" 983 985 } 984 986 "reset" { 985 987 array set _view { 986 qw 0.853553987 qx -0.353553988 qy 0.353553989 qz 0.146447990 zoom 1.0991 xpan 0992 ypan0988 -qw 0.853553 989 -qx -0.353553 990 -qy 0.353553 991 -qz 0.146447 992 -xpan 0 993 -ypan 0 994 -zoom 1.0 993 995 } 994 996 if { $_first != "" } { … … 998 1000 } 999 1001 } 1000 set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)] 1001 $_arcball quaternion $q 1002 $_arcball quaternion [ViewToQuaternion] 1002 1003 DoRotate 1003 1004 SendCmd "camera reset" … … 1007 1008 1008 1009 itcl::body Rappture::VtkMeshViewer::PanCamera {} { 1009 set x $_view( xpan)1010 set y $_view( ypan)1010 set x $_view(-xpan) 1011 set y $_view(-ypan) 1011 1012 SendCmd "camera pan $x $y" 1012 1013 } … … 1085 1086 set x [expr $x / double($w)] 1086 1087 set y [expr $y / double($h)] 1087 set _view( xpan) [expr $_view(xpan) + $x]1088 set _view( ypan) [expr $_view(ypan) + $y]1088 set _view(-xpan) [expr $_view(-xpan) + $x] 1089 set _view(-ypan) [expr $_view(-ypan) + $y] 1089 1090 PanCamera 1090 1091 return … … 1108 1109 set _click(x) $x 1109 1110 set _click(y) $y 1110 set _view( xpan) [expr $_view(xpan) - $dx]1111 set _view( ypan) [expr $_view(ypan) - $dy]1111 set _view(-xpan) [expr $_view(-xpan) - $dx] 1112 set _view(-ypan) [expr $_view(-ypan) - $dy] 1112 1113 PanCamera 1113 1114 } … … 1123 1124 1124 1125 # ---------------------------------------------------------------------- 1125 # USAGE: FixSettings <what> ?<value>?1126 # USAGE: InitSettings <what> ?<value>? 1126 1127 # 1127 1128 # Used internally to update rendering settings whenever parameters … … 1129 1130 # to the back end. 1130 1131 # ---------------------------------------------------------------------- 1131 itcl::body Rappture::VtkMeshViewer:: FixSettings { args } {1132 itcl::body Rappture::VtkMeshViewer::InitSettings { args } { 1132 1133 foreach setting $args { 1133 1134 AdjustSetting $setting … … 1147 1148 } 1148 1149 switch -- $what { 1149 "polydata-opacity" { 1150 foreach dataset [CurrentDatasets -visible $_first] { 1151 SetOpacity $dataset 1152 } 1153 } 1154 "polydata-wireframe" { 1155 set bool $_settings(polydata-wireframe) 1156 foreach dataset [CurrentDatasets -visible $_first] { 1157 SendCmd "polydata wireframe $bool $dataset" 1158 } 1159 } 1160 "polydata-visible" { 1161 set bool $_settings(polydata-visible) 1162 foreach dataset [CurrentDatasets -visible $_first] { 1150 "-outline" { 1151 set bool $_settings($what) 1152 # Only display a outline for the currently visible sets. 1153 SendCmd "outline visible 0" 1154 foreach dataset [CurrentDatasets -visible] { 1155 SendCmd "outline visible $bool $dataset" 1156 } 1157 } 1158 "-polydataopacity" { 1159 set _settings($what) [expr $_widget($what) * 0.01] 1160 EventuallySetPolydataOpacity 1161 } 1162 "-polydatawireframe" { 1163 set bool $_settings($what) 1164 SendCmd "polydata wireframe $bool" 1165 } 1166 "-polydatavisible" { 1167 set bool $_settings($what) 1168 # Only change visibility of data sets marked "visible". 1169 foreach dataset [CurrentDatasets -visible] { 1163 1170 SendCmd "polydata visible $bool $dataset" 1164 1171 } 1165 1172 } 1166 "polydata-lighting" { 1167 set bool $_settings(polydata-lighting) 1168 foreach dataset [CurrentDatasets -visible $_first] { 1169 SendCmd "polydata lighting $bool $dataset" 1170 } 1171 } 1172 "polydata-edges" { 1173 set bool $_settings(polydata-edges) 1174 foreach dataset [CurrentDatasets -visible $_first] { 1175 SendCmd "polydata edges $bool $dataset" 1176 } 1177 } 1178 "axis-visible" { 1179 set bool $_axis(visible) 1173 "-polydatalighting" { 1174 set bool $_settings($what) 1175 SendCmd "polydata lighting $bool" 1176 } 1177 "-polydataedges" { 1178 set bool $_settings($what) 1179 SendCmd "polydata edges $bool" 1180 } 1181 "-axesvisible" { 1182 set bool $_settings($what) 1180 1183 SendCmd "axis visible all $bool" 1181 1184 } 1182 " axis-labels" {1183 set bool $_ axis(labels)1185 "-axislabels" { 1186 set bool $_settings($what) 1184 1187 SendCmd "axis labels all $bool" 1185 1188 } 1186 "axis-xgrid" { 1187 set bool $_axis(xgrid) 1189 "-axisminorticks" { 1190 set bool $_settings($what) 1191 SendCmd "axis minticks all $bool" 1192 } 1193 "-xgrid" { 1194 set bool $_settings($what) 1188 1195 SendCmd "axis grid x $bool" 1189 1196 } 1190 " axis-ygrid" {1191 set bool $_ axis(ygrid)1197 "-ygrid" { 1198 set bool $_settings($what) 1192 1199 SendCmd "axis grid y $bool" 1193 1200 } 1194 " axis-zgrid" {1195 set bool $_ axis(zgrid)1201 "-zgrid" { 1202 set bool $_settings($what) 1196 1203 SendCmd "axis grid z $bool" 1197 1204 } 1198 " axis-mode" {1205 "-axismode" { 1199 1206 set mode [$itk_component(axismode) value] 1200 1207 set mode [$itk_component(axismode) translate $mode] 1201 1208 SendCmd "axis flymode $mode" 1202 1209 } 1203 "axis-xcutaway" - "axis-ycutaway" - "axis-zcutaway" {1204 set axis [string range $what 5 5]1205 set bool $_axis(${axis}cutaway)1206 if { $bool } {1207 set pos [expr $_axis(${axis}position) * 0.01]1208 set dir $_axis(${axis}direction)1209 $itk_component(${axis}CutScale) configure -state normal \1210 -troughcolor white1211 SendCmd "renderer clipplane $axis $pos $dir"1212 } else {1213 $itk_component(${axis}CutScale) configure -state disabled \1214 -troughcolor grey821215 SendCmd "renderer clipplane $axis 1 -1"1216 }1217 }1218 "axis-xposition" - "axis-yposition" - "axis-zposition" -1219 "axis-xdirection" - "axis-ydirection" - "axis-zdirection" {1220 set axis [string range $what 5 5]1221 #set dir $_axis(${axis}direction)1222 set pos [expr $_axis(${axis}position) * 0.01]1223 SendCmd "renderer clipplane ${axis} $pos -1"1224 }1225 1210 default { 1226 1211 error "don't know how to fix $what" … … 1234 1219 itcl::configbody Rappture::VtkMeshViewer::plotbackground { 1235 1220 if { [isconnected] } { 1236 foreach {r g b} [Color2RGB $itk_option(-plotbackground)] break1237 SendCmd "screen bgcolor $r $g $b"1221 set rgb [Color2RGB $itk_option(-plotbackground)] 1222 SendCmd "screen bgcolor $rgb" 1238 1223 } 1239 1224 } … … 1244 1229 itcl::configbody Rappture::VtkMeshViewer::plotforeground { 1245 1230 if { [isconnected] } { 1246 foreach {r g b} [Color2RGB $itk_option(-plotforeground)] break1247 #fix this!1248 #SendCmd "color background $r $g $b"1231 set rgb [Color2RGB $itk_option(-plotforeground)] 1232 SendCmd "axis color all $rgb" 1233 SendCmd "outline color $rgb" 1249 1234 } 1250 1235 } … … 1306 1291 checkbutton $inner.mesh \ 1307 1292 -text "Show Mesh" \ 1308 -variable [itcl::scope _settings(polydata-visible)] \ 1309 -command [itcl::code $this AdjustSetting polydata-visible] \ 1293 -variable [itcl::scope _settings(-polydatavisible)] \ 1294 -command [itcl::code $this AdjustSetting -polydatavisible] \ 1295 -font "Arial 9" -anchor w 1296 1297 checkbutton $inner.outline \ 1298 -text "Show Outline" \ 1299 -variable [itcl::scope _settings(-outline)] \ 1300 -command [itcl::code $this AdjustSetting -outline] \ 1310 1301 -font "Arial 9" -anchor w 1311 1302 1312 1303 checkbutton $inner.wireframe \ 1313 1304 -text "Show Wireframe" \ 1314 -variable [itcl::scope _settings( polydata-wireframe)] \1315 -command [itcl::code $this AdjustSetting polydata-wireframe] \1305 -variable [itcl::scope _settings(-polydatawireframe)] \ 1306 -command [itcl::code $this AdjustSetting -polydatawireframe] \ 1316 1307 -font "Arial 9" -anchor w 1317 1308 1318 1309 checkbutton $inner.lighting \ 1319 1310 -text "Enable Lighting" \ 1320 -variable [itcl::scope _settings( polydata-lighting)] \1321 -command [itcl::code $this AdjustSetting polydata-lighting] \1311 -variable [itcl::scope _settings(-polydatalighting)] \ 1312 -command [itcl::code $this AdjustSetting -polydatalighting] \ 1322 1313 -font "Arial 9" -anchor w 1323 1314 1324 1315 checkbutton $inner.edges \ 1325 1316 -text "Show Edges" \ 1326 -variable [itcl::scope _settings( polydata-edges)] \1327 -command [itcl::code $this AdjustSetting polydata-edges] \1317 -variable [itcl::scope _settings(-polydataedges)] \ 1318 -command [itcl::code $this AdjustSetting -polydataedges] \ 1328 1319 -font "Arial 9" -anchor w 1329 1320 … … 1337 1328 } 1338 1329 bind $inner.field <<Value>> \ 1339 [itcl::code $this AdjustSetting field]1330 [itcl::code $this AdjustSetting -field] 1340 1331 1341 1332 label $inner.opacity_l -text "Opacity" -font "Arial 9" -anchor w 1342 1333 ::scale $inner.opacity -from 0 -to 100 -orient horizontal \ 1343 -variable [itcl::scope _ settings(polydata-opacity)] \1334 -variable [itcl::scope _widget(-polydataopacity)] \ 1344 1335 -width 10 \ 1345 1336 -showvalue off \ 1346 -command [itcl::code $this AdjustSetting polydata-opacity]1347 $inner.opacity set $_settings(polydata-opacity)1337 -command [itcl::code $this AdjustSetting -polydataopacity] 1338 $inner.opacity set [expr $_settings(-polydataopacity) * 100.0] 1348 1339 1349 1340 blt::table $inner \ 1350 1341 0,0 $inner.mesh -cspan 2 -anchor w -pady 2 \ 1351 1,0 $inner.wireframe -cspan 2 -anchor w -pady 2 \ 1352 2,0 $inner.lighting -cspan 2 -anchor w -pady 2 \ 1353 3,0 $inner.edges -cspan 2 -anchor w -pady 2 \ 1354 4,0 $inner.opacity_l -anchor w -pady 2 \ 1355 4,1 $inner.opacity -fill x -pady 2 1342 1,0 $inner.outline -cspan 2 -anchor w -pady 2 \ 1343 2,0 $inner.wireframe -cspan 2 -anchor w -pady 2 \ 1344 3,0 $inner.lighting -cspan 2 -anchor w -pady 2 \ 1345 4,0 $inner.edges -cspan 2 -anchor w -pady 2 \ 1346 5,0 $inner.opacity_l -anchor w -pady 2 \ 1347 5,1 $inner.opacity -fill x -pady 2 1356 1348 1357 1349 blt::table configure $inner r* c* -resize none 1358 blt::table configure $inner r 6c1 -resize expand1350 blt::table configure $inner r7 c1 -resize expand 1359 1351 } 1360 1352 … … 1366 1358 set inner [$itk_component(main) insert end \ 1367 1359 -title "Axis Settings" \ 1368 -icon [Rappture::icon axis 1]]1360 -icon [Rappture::icon axis2]] 1369 1361 $inner configure -borderwidth 4 1370 1362 1371 1363 checkbutton $inner.visible \ 1372 -text " ShowAxes" \1373 -variable [itcl::scope _ axis(visible)] \1374 -command [itcl::code $this AdjustSetting axis-visible] \1364 -text "Axes" \ 1365 -variable [itcl::scope _settings(-axesvisible)] \ 1366 -command [itcl::code $this AdjustSetting -axesvisible] \ 1375 1367 -font "Arial 9" 1376 1368 1377 1369 checkbutton $inner.labels \ 1378 -text " ShowAxis Labels" \1379 -variable [itcl::scope _ axis(labels)] \1380 -command [itcl::code $this AdjustSetting axis-labels] \1370 -text "Axis Labels" \ 1371 -variable [itcl::scope _settings(-axislabels)] \ 1372 -command [itcl::code $this AdjustSetting -axislabels] \ 1381 1373 -font "Arial 9" 1382 1383 checkbutton $inner. gridx\1384 -text " Show X Grid" \1385 -variable [itcl::scope _ axis(xgrid)] \1386 -command [itcl::code $this AdjustSetting axis-xgrid] \1374 label $inner.grid_l -text "Grid" -font "Arial 9" 1375 checkbutton $inner.xgrid \ 1376 -text "X" \ 1377 -variable [itcl::scope _settings(-xgrid)] \ 1378 -command [itcl::code $this AdjustSetting -xgrid] \ 1387 1379 -font "Arial 9" 1388 checkbutton $inner. gridy\1389 -text " Show Y Grid" \1390 -variable [itcl::scope _ axis(ygrid)] \1391 -command [itcl::code $this AdjustSetting axis-ygrid] \1380 checkbutton $inner.ygrid \ 1381 -text "Y" \ 1382 -variable [itcl::scope _settings(-ygrid)] \ 1383 -command [itcl::code $this AdjustSetting -ygrid] \ 1392 1384 -font "Arial 9" 1393 checkbutton $inner.gridz \ 1394 -text "Show Z Grid" \ 1395 -variable [itcl::scope _axis(zgrid)] \ 1396 -command [itcl::code $this AdjustSetting axis-zgrid] \ 1385 checkbutton $inner.zgrid \ 1386 -text "Z" \ 1387 -variable [itcl::scope _settings(-zgrid)] \ 1388 -command [itcl::code $this AdjustSetting -zgrid] \ 1389 -font "Arial 9" 1390 checkbutton $inner.minorticks \ 1391 -text "Minor Ticks" \ 1392 -variable [itcl::scope _settings(-axisminorticks)] \ 1393 -command [itcl::code $this AdjustSetting -axisminorticks] \ 1397 1394 -font "Arial 9" 1398 1395 … … 1408 1405 "outer_edges" "outer" 1409 1406 $itk_component(axismode) value "static" 1410 bind $inner.mode <<Value>> [itcl::code $this AdjustSetting axis-mode]1407 bind $inner.mode <<Value>> [itcl::code $this AdjustSetting -axismode] 1411 1408 1412 1409 blt::table $inner \ 1413 0,0 $inner.visible -anchor w -cspan 2 \ 1414 1,0 $inner.labels -anchor w -cspan 2 \ 1415 2,0 $inner.gridx -anchor w -cspan 2 \ 1416 3,0 $inner.gridy -anchor w -cspan 2 \ 1417 4,0 $inner.gridz -anchor w -cspan 2 \ 1418 5,0 $inner.mode_l -anchor w -cspan 2 -padx { 2 0 } \ 1419 6,0 $inner.mode -fill x -cspan 2 1410 0,0 $inner.visible -anchor w -cspan 4 \ 1411 1,0 $inner.labels -anchor w -cspan 4 \ 1412 2,0 $inner.minorticks -anchor w -cspan 4 \ 1413 4,0 $inner.grid_l -anchor w \ 1414 4,1 $inner.xgrid -anchor w \ 1415 4,2 $inner.ygrid -anchor w \ 1416 4,3 $inner.zgrid -anchor w \ 1417 5,0 $inner.mode_l -anchor w -padx { 2 0 } \ 1418 5,1 $inner.mode -fill x -cspan 3 1420 1419 1421 1420 blt::table configure $inner r* c* -resize none 1422 blt::table configure $inner r7 c1 -resize expand 1421 blt::table configure $inner r7 c6 -resize expand 1422 blt::table configure $inner r3 -height 0.125i 1423 1423 } 1424 1424 … … 1441 1441 0,0 $inner.view_l -anchor e -pady 2 \ 1442 1442 0,1 $inner.view -anchor w -pady 2 1443 blt::table configure $inner r0 -resize none 1443 1444 1444 1445 set labels { qx qy qz qw xpan ypan zoom } … … 1447 1448 label $inner.${tag}label -text $tag -font "Arial 9" 1448 1449 entry $inner.${tag} -font "Arial 9" -bg white \ 1449 -textvariable [itcl::scope _view($tag)] 1450 bind $inner.${tag} <KeyPress-Return> \ 1451 [itcl::code $this camera set ${tag}] 1450 -textvariable [itcl::scope _view(-$tag)] 1451 bind $inner.${tag} <Return> \ 1452 [itcl::code $this camera set -${tag}] 1453 bind $inner.${tag} <KP_Enter> \ 1454 [itcl::code $this camera set -${tag}] 1452 1455 blt::table $inner \ 1453 1456 $row,0 $inner.${tag}label -anchor e -pady 2 \ … … 1458 1461 checkbutton $inner.ortho \ 1459 1462 -text "Orthographic Projection" \ 1460 -variable [itcl::scope _view( ortho)] \1461 -command [itcl::code $this camera set ortho] \1463 -variable [itcl::scope _view(-ortho)] \ 1464 -command [itcl::code $this camera set -ortho] \ 1462 1465 -font "Arial 9" 1463 1466 blt::table $inner \ … … 1466 1469 incr row 1467 1470 1468 blt::table configure $inner c* r*-resize none1471 blt::table configure $inner c* -resize none 1469 1472 blt::table configure $inner c2 -resize expand 1470 1473 blt::table configure $inner r$row -resize expand 1471 }1472 1473 itcl::body Rappture::VtkMeshViewer::BuildCutawayTab {} {1474 1475 set fg [option get $itk_component(hull) font Font]1476 1477 set inner [$itk_component(main) insert end \1478 -title "Cutaway Along Axis" \1479 -icon [Rappture::icon cutbutton]]1480 1481 $inner configure -borderwidth 41482 1483 # X-value slicer...1484 itk_component add xCutButton {1485 Rappture::PushButton $inner.xbutton \1486 -onimage [Rappture::icon x-cutplane] \1487 -offimage [Rappture::icon x-cutplane] \1488 -command [itcl::code $this AdjustSetting axis-xcutaway] \1489 -variable [itcl::scope _axis(xcutaway)]1490 }1491 Rappture::Tooltip::for $itk_component(xCutButton) \1492 "Toggle the X-axis cutaway on/off"1493 1494 itk_component add xCutScale {1495 ::scale $inner.xval -from 100 -to 0 \1496 -width 10 -orient vertical -showvalue yes \1497 -borderwidth 1 -highlightthickness 0 \1498 -command [itcl::code $this Slice move x] \1499 -variable [itcl::scope _axis(xposition)]1500 } {1501 usual1502 ignore -borderwidth -highlightthickness1503 }1504 # Set the default cutaway value before disabling the scale.1505 $itk_component(xCutScale) set 1001506 $itk_component(xCutScale) configure -state disabled1507 Rappture::Tooltip::for $itk_component(xCutScale) \1508 "@[itcl::code $this Slice tooltip x]"1509 1510 itk_component add xDirButton {1511 Rappture::PushButton $inner.xdir \1512 -onimage [Rappture::icon arrow-down] \1513 -onvalue -1 \1514 -offimage [Rappture::icon arrow-up] \1515 -offvalue 1 \1516 -command [itcl::code $this AdjustSetting axis-xdirection] \1517 -variable [itcl::scope _axis(xdirection)]1518 }1519 set _axis(xdirection) -11520 Rappture::Tooltip::for $itk_component(xDirButton) \1521 "Toggle the direction of the X-axis cutaway"1522 1523 # Y-value slicer...1524 itk_component add yCutButton {1525 Rappture::PushButton $inner.ybutton \1526 -onimage [Rappture::icon y-cutplane] \1527 -offimage [Rappture::icon y-cutplane] \1528 -command [itcl::code $this AdjustSetting axis-ycutaway] \1529 -variable [itcl::scope _axis(ycutaway)]1530 }1531 Rappture::Tooltip::for $itk_component(yCutButton) \1532 "Toggle the Y-axis cutaway on/off"1533 1534 itk_component add yCutScale {1535 ::scale $inner.yval -from 100 -to 0 \1536 -width 10 -orient vertical -showvalue yes \1537 -borderwidth 1 -highlightthickness 0 \1538 -command [itcl::code $this Slice move y] \1539 -variable [itcl::scope _axis(yposition)]1540 } {1541 usual1542 ignore -borderwidth -highlightthickness1543 }1544 Rappture::Tooltip::for $itk_component(yCutScale) \1545 "@[itcl::code $this Slice tooltip y]"1546 # Set the default cutaway value before disabling the scale.1547 $itk_component(yCutScale) set 1001548 $itk_component(yCutScale) configure -state disabled1549 1550 itk_component add yDirButton {1551 Rappture::PushButton $inner.ydir \1552 -onimage [Rappture::icon arrow-down] \1553 -onvalue -1 \1554 -offimage [Rappture::icon arrow-up] \1555 -offvalue 1 \1556 -command [itcl::code $this AdjustSetting axis-ydirection] \1557 -variable [itcl::scope _axis(ydirection)]1558 }1559 Rappture::Tooltip::for $itk_component(yDirButton) \1560 "Toggle the direction of the Y-axis cutaway"1561 set _axis(ydirection) -11562 1563 # Z-value slicer...1564 itk_component add zCutButton {1565 Rappture::PushButton $inner.zbutton \1566 -onimage [Rappture::icon z-cutplane] \1567 -offimage [Rappture::icon z-cutplane] \1568 -command [itcl::code $this AdjustSetting axis-zcutaway] \1569 -variable [itcl::scope _axis(zcutaway)]1570 }1571 Rappture::Tooltip::for $itk_component(zCutButton) \1572 "Toggle the Z-axis cutaway on/off"1573 1574 itk_component add zCutScale {1575 ::scale $inner.zval -from 100 -to 0 \1576 -width 10 -orient vertical -showvalue yes \1577 -borderwidth 1 -highlightthickness 0 \1578 -command [itcl::code $this Slice move z] \1579 -variable [itcl::scope _axis(zposition)]1580 } {1581 usual1582 ignore -borderwidth -highlightthickness1583 }1584 $itk_component(zCutScale) set 1001585 $itk_component(zCutScale) configure -state disabled1586 Rappture::Tooltip::for $itk_component(zCutScale) \1587 "@[itcl::code $this Slice tooltip z]"1588 1589 itk_component add zDirButton {1590 Rappture::PushButton $inner.zdir \1591 -onimage [Rappture::icon arrow-down] \1592 -onvalue -1 \1593 -offimage [Rappture::icon arrow-up] \1594 -offvalue 1 \1595 -command [itcl::code $this AdjustSetting axis-zdirection] \1596 -variable [itcl::scope _axis(zdirection)]1597 }1598 set _axis(zdirection) -11599 Rappture::Tooltip::for $itk_component(zDirButton) \1600 "Toggle the direction of the Z-axis cutaway"1601 1602 blt::table $inner \1603 0,0 $itk_component(xCutButton) -anchor e -padx 2 -pady 2 \1604 1,0 $itk_component(xCutScale) -fill y \1605 0,1 $itk_component(yCutButton) -anchor e -padx 2 -pady 2 \1606 1,1 $itk_component(yCutScale) -fill y \1607 0,2 $itk_component(zCutButton) -anchor e -padx 2 -pady 2 \1608 1,2 $itk_component(zCutScale) -fill y \1609 1610 blt::table configure $inner r* c* -resize none1611 blt::table configure $inner r1 c3 -resize expand1612 1474 } 1613 1475 … … 1621 1483 } 1622 1484 "set" { 1623 set wh o[lindex $args 0]1624 set x $_view($wh o)1485 set what [lindex $args 0] 1486 set x $_view($what) 1625 1487 set code [catch { string is double $x } result] 1626 1488 if { $code != 0 || !$result } { 1627 1489 return 1628 1490 } 1629 switch -- $wh o{1630 " ortho" {1631 if {$_view( ortho)} {1491 switch -- $what { 1492 "-ortho" { 1493 if {$_view($what)} { 1632 1494 SendCmd "camera mode ortho" 1633 1495 } else { … … 1635 1497 } 1636 1498 } 1637 " xpan" - "ypan" {1499 "-xpan" - "-ypan" { 1638 1500 PanCamera 1639 1501 } 1640 " qx" - "qy" - "qz" - "qw" {1641 set q [ list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]1502 "-qx" - "-qy" - "-qz" - "-qw" { 1503 set q [ViewToQuaternion] 1642 1504 $_arcball quaternion $q 1643 1505 EventuallyRotate $q 1644 1506 } 1645 " zoom" {1646 SendCmd "camera zoom $_view( zoom)"1507 "-zoom" { 1508 SendCmd "camera zoom $_view($what)" 1647 1509 } 1648 1510 } … … 1715 1577 set tag $dataobj 1716 1578 set type [$dataobj type] 1717 set color [$dataobj hints color] 1718 set style [$dataobj hints style] 1719 if { $dataobj != $_first } { 1720 set settings(-wireframe) 1 1721 } 1722 1723 array set settings { 1579 1580 array set style { 1724 1581 -cloudstyle mesh 1725 -color \#FFFFFF1582 -color white 1726 1583 -edgecolor black 1727 1584 -edges 1 … … 1729 1586 -linewidth 1.0 1730 1587 -opacity 1.0 1588 -outline 0 1731 1589 -visible 1 1732 1590 -wireframe 0 1733 1591 } 1592 if { $dataobj != $_first } { 1593 set style(-wireframe) 1 1594 } 1734 1595 if {$type == "cloud"} { 1735 set settings(-cloudstyle) points 1736 set settings(-edges) 0 1737 set settings(-edgecolor) white 1738 } 1739 array set settings $style 1740 if {$color != ""} { 1741 set settings(-color) $color 1742 } 1596 set style(-cloudstyle) points 1597 set style(-edges) 0 1598 set style(-edgecolor) white 1599 } 1600 array set style [$dataobj hints style] 1601 1602 if {[$dataobj hints color] != ""} { 1603 set style(-color) [$dataobj hints color] 1604 } 1605 SendCmd "outline add $tag" 1606 SendCmd "outline color [Color2RGB $style(-color)] $tag" 1607 SendCmd "outline visible $style(-outline) $tag" 1608 set _settings(-outline) $style(-outline) 1609 1743 1610 SendCmd "polydata add $tag" 1744 SendCmd "polydata visible $s ettings(-visible) $tag"1745 SendCmd "polydata cloudstyle $settings(-cloudstyle) $tag"1746 set _settings(polydata-visible) $settings(-visible)1747 SendCmd "polydata edges $s ettings(-edges) $tag"1748 set _settings( polydata-edges) $settings(-edges)1749 SendCmd "polydata color [Color2RGB $s ettings(-color)] $tag"1750 #SendCmd "polydata colormode constant {}$tag"1751 SendCmd "polydata lighting $settings(-lighting) $tag"1752 set _settings(polydata-lighting) $settings(-lighting)1753 SendCmd "polydata line color [Color2RGB $settings(-edgecolor)]$tag"1754 SendCmd "polydata linewidth $settings(-linewidth) $tag"1755 SendCmd "polydata opacity $settings(-opacity) $tag"1756 set _ settings(polydata-opacity) [expr 100.0 * $settings(-opacity)]1757 SendCmd "polydata wireframe $s ettings(-wireframe) $tag"1758 set _settings( polydata-wireframe) $settings(-wireframe)1611 SendCmd "polydata visible $style(-visible) $tag" 1612 set _settings(-polydatavisible) $style(-visible) 1613 SendCmd "polydata cloudstyle $style(-cloudstyle) $tag" 1614 SendCmd "polydata edges $style(-edges) $tag" 1615 set _settings(-polydataedges) $style(-edges) 1616 SendCmd "polydata color [Color2RGB $style(-color)] $tag" 1617 SendCmd "polydata lighting $style(-lighting) $tag" 1618 set _settings(-polydatalighting) $style(-lighting) 1619 SendCmd "polydata linecolor [Color2RGB $style(-edgecolor)] $tag" 1620 SendCmd "polydata linewidth $style(-linewidth) $tag" 1621 SendCmd "polydata opacity $style(-opacity) $tag" 1622 set _settings(-polydataopacity) $style(-opacity) 1623 set _widget(-polydataopacity) [expr 100.0 * $style(-opacity)] 1624 SendCmd "polydata wireframe $style(-wireframe) $tag" 1625 set _settings(-polydatawireframe) $style(-wireframe) 1759 1626 set havePolyData 1 1760 1627 } … … 1765 1632 } 1766 1633 return 1 1767 }1768 1769 # ----------------------------------------------------------------------1770 # USAGE: Slice move x|y|z <newval>1771 #1772 # Called automatically when the user drags the slider to move the1773 # cut plane that slices 3D data. Gets the current value from the1774 # slider and moves the cut plane to the appropriate point in the1775 # data set.1776 # ----------------------------------------------------------------------1777 itcl::body Rappture::VtkMeshViewer::Slice {option args} {1778 switch -- $option {1779 "move" {1780 set axis [lindex $args 0]1781 set newval [lindex $args 1]1782 if {[llength $args] != 2} {1783 error "wrong # args: should be \"Slice move x|y|z newval\""1784 }1785 set newpos [expr {0.01*$newval}]1786 SendCmd "renderer clipplane $axis $newpos -1"1787 }1788 "tooltip" {1789 set axis [lindex $args 0]1790 set val [$itk_component(${axis}CutScale) get]1791 return "Move the [string toupper $axis] cut plane.\nCurrently: $axis = $val%"1792 }1793 default {1794 error "bad option \"$option\": should be axis, move, or tooltip"1795 }1796 }1797 1634 } 1798 1635 … … 1806 1643 bottom "0.707107 0.707107 0 0" 1807 1644 } 1808 foreach name { qw qx qyqz } value $positions($side) {1645 foreach name { -qw -qx -qy -qz } value $positions($side) { 1809 1646 set _view($name) $value 1810 1647 } 1811 set q [ list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]1648 set q [ViewToQuaternion] 1812 1649 $_arcball quaternion $q 1813 1650 SendCmd "camera orient $q" 1814 1651 SendCmd "camera reset" 1815 set _view(xpan) 0 1816 set _view(ypan) 0 1817 set _view(zoom) 1.0 1818 } 1819 1820 itcl::body Rappture::VtkMeshViewer::SetOpacity { dataset } { 1821 set val $_settings(polydata-opacity) 1822 set sval [expr { 0.01 * double($val) }] 1823 if { !$_obj2ovride($dataset-raise) } { 1824 # This is wrong. Need to figure out why raise isn't set with 1 1825 #set sval [expr $sval * .6] 1826 } 1827 SendCmd "polydata opacity $sval $dataset" 1828 } 1652 set _view(-xpan) 0 1653 set _view(-ypan) 0 1654 set _view(-zoom) 1.0 1655 } -
branches/r9/gui/scripts/vtkstreamlinesviewer.tcl
r4344 r4919 1 1 # -*- mode: tcl; indent-tabs-mode: nil -*- 2 2 # ---------------------------------------------------------------------- 3 # COMPONENT: vtk viewer - Vtk drawingobject viewer3 # COMPONENT: vtkstreamlinesviewer - Vtk streamlines object viewer 4 4 # 5 5 # It connects to the Vtk server running on a rendering farm, … … 226 226 axesVisible 1 227 227 axisLabelsVisible 1 228 axisMinorTicks 1 228 229 axisXGrid 0 229 230 axisYGrid 0 … … 453 454 eval itk_initialize $args 454 455 Connect 455 update456 456 } 457 457 … … 800 800 set session $env(SESSION) 801 801 } 802 lappend info "version" "$Rappture::version" 803 lappend info "build" "$Rappture::build" 804 lappend info "svnurl" "$Rappture::svnurl" 805 lappend info "installdir" "$Rappture::installdir" 802 806 lappend info "hub" [exec hostname] 803 807 lappend info "client" "vtkstreamlinesviewer" … … 967 971 DoResize 968 972 InitSettings axisXGrid axisYGrid axisZGrid axis-mode \ 969 axesVisible axisLabelsVisible 973 axesVisible axisLabelsVisible axisMinorTicks 970 974 # This "imgflush" is to force an image returned before vtkvis starts 971 975 # reading a (big) dataset. This will display an empty plot with axes … … 1324 1328 switch -- $what { 1325 1329 "volumeOpacity" { 1326 set val $_settings( volumeOpacity)1330 set val $_settings($what) 1327 1331 set sval [expr { 0.01 * double($val) }] 1328 1332 SendCmd "polydata opacity $sval" 1329 1333 } 1330 1334 "volumeWireframe" { 1331 set bool $_settings( volumeWireframe)1335 set bool $_settings($what) 1332 1336 SendCmd "polydata wireframe $bool" 1333 1337 } 1334 1338 "volumeVisible" { 1335 set bool $_settings( volumeVisible)1339 set bool $_settings($what) 1336 1340 SendCmd "polydata visible $bool" 1337 1341 if { $bool } { … … 1344 1348 } 1345 1349 "volumeLighting" { 1346 set bool $_settings( volumeLighting)1350 set bool $_settings($what) 1347 1351 SendCmd "polydata lighting $bool" 1348 1352 } 1349 1353 "volumeEdges" { 1350 set bool $_settings( volumeEdges)1354 set bool $_settings($what) 1351 1355 SendCmd "polydata edges $bool" 1352 1356 } 1353 1357 "axesVisible" { 1354 set bool $_settings( axesVisible)1358 set bool $_settings($what) 1355 1359 SendCmd "axis visible all $bool" 1356 1360 } 1357 1361 "axisLabelsVisible" { 1358 set bool $_settings( axisLabelsVisible)1362 set bool $_settings($what) 1359 1363 SendCmd "axis labels all $bool" 1364 } 1365 "axisMinorTicks" { 1366 set bool $_settings($what) 1367 SendCmd "axis minticks all $bool" 1360 1368 } 1361 1369 "axisXGrid" - "axisYGrid" - "axisZGrid" { … … 1453 1461 } 1454 1462 "streamlinesOpacity" { 1455 set val $_settings( streamlinesOpacity)1463 set val $_settings($what) 1456 1464 set sval [expr { 0.01 * double($val) }] 1457 1465 SendCmd "streamlines opacity $sval" 1458 1466 } 1459 1467 "streamlinesScale" { 1460 set val $_settings( streamlinesScale)1468 set val $_settings($what) 1461 1469 set sval [expr { 0.01 * double($val) }] 1462 1470 SendCmd "streamlines scale $sval $sval $sval" 1463 1471 } 1464 1472 "streamlinesLighting" { 1465 set bool $_settings( streamlinesLighting)1473 set bool $_settings($what) 1466 1474 SendCmd "streamlines lighting $bool" 1467 1475 } … … 1771 1779 set inner [$itk_component(main) insert end \ 1772 1780 -title "Axis Settings" \ 1773 -icon [Rappture::icon axis 1]]1781 -icon [Rappture::icon axis2]] 1774 1782 $inner configure -borderwidth 4 1775 1783 … … 1801 1809 -command [itcl::code $this AdjustSetting axisZGrid] \ 1802 1810 -font "Arial 9" 1811 checkbutton $inner.minorticks \ 1812 -text "Minor Ticks" \ 1813 -variable [itcl::scope _settings(axisMinorTicks)] \ 1814 -command [itcl::code $this AdjustSetting axisMinorTicks] \ 1815 -font "Arial 9" 1803 1816 1804 1817 label $inner.mode_l -text "Mode" -font "Arial 9" … … 1816 1829 1817 1830 blt::table $inner \ 1818 0,0 $inner.visible -anchor w -cspan 2 \ 1819 1,0 $inner.labels -anchor w -cspan 2 \ 1820 2,0 $inner.xgrid -anchor w -cspan 2 \ 1821 3,0 $inner.ygrid -anchor w -cspan 2 \ 1822 4,0 $inner.zgrid -anchor w -cspan 2 \ 1823 5,0 $inner.mode_l -anchor w -cspan 2 -padx { 2 0 } \ 1824 6,0 $inner.mode -fill x -cspan 2 1831 0,0 $inner.visible -anchor w -cspan 4 \ 1832 1,0 $inner.labels -anchor w -cspan 4 \ 1833 2,0 $inner.minorticks -anchor w -cspan 4 \ 1834 4,0 $inner.grid_l -anchor w \ 1835 4,1 $inner.xgrid -anchor w \ 1836 4,2 $inner.ygrid -anchor w \ 1837 4,3 $inner.zgrid -anchor w \ 1838 5,0 $inner.mode_l -anchor w -padx { 2 0 } \ 1839 5,1 $inner.mode -fill x -cspan 3 1825 1840 1826 1841 blt::table configure $inner r* c* -resize none 1827 blt::table configure $inner r7 c 1-resize expand1828 } 1829 1842 blt::table configure $inner r7 c6 -resize expand 1843 blt::table configure $inner r3 -height 0.125i 1844 } 1830 1845 1831 1846 itcl::body Rappture::VtkStreamlinesViewer::BuildCameraTab {} { … … 2144 2159 } 2145 2160 array set settings $style 2161 StartBufferingCommands 2146 2162 SendCmd "streamlines add $tag" 2147 2163 SendCmd "streamlines seed visible off $tag" … … 2150 2166 set length [string length $seeds] 2151 2167 SendCmd "streamlines seed fmesh 200 data follows $length $tag" 2152 SendCmd "$seeds"2168 append _outbuf $seeds 2153 2169 set _seeds($dataobj) 1 2154 2170 } … … 2161 2177 set _settings(volumeWireframe) $settings(-wireframe) 2162 2178 set _settings(volumeOpacity) [expr $settings(-opacity) * 100.0] 2179 StopBufferingCommands 2163 2180 SetColormap $dataobj $comp 2164 2181 } -
branches/r9/gui/scripts/vtksurfaceviewer.tcl
r4344 r4919 117 117 private variable _currentColormap "" 118 118 private variable _currentNumContours -1 119 private variable _currentOpacity ""120 119 121 120 private variable _dataset2style ;# maps dataobj-component to transfunc … … 216 215 -surfacelighting 1 217 216 -surfaceopacity 100 218 - surfaceoutline0217 -outline 0 219 218 -surfacevisible 1 220 219 -surfacewireframe 0 … … 398 397 EnableWaitDialog 500 399 398 Connect 400 update401 399 } 402 400 … … 734 732 set session $env(SESSION) 735 733 } 734 lappend info "version" "$Rappture::version" 735 lappend info "build" "$Rappture::build" 736 lappend info "svnurl" "$Rappture::svnurl" 737 lappend info "installdir" "$Rappture::installdir" 736 738 lappend info "hub" [exec hostname] 737 739 lappend info "client" "vtksurfaceviewer" … … 986 988 $itk_component(field) value $_curFldLabel 987 989 } 988 InitSettings -isolinesvisible -surfacevisible - surfaceoutline990 InitSettings -isolinesvisible -surfacevisible -outline 989 991 if { $_reset } { 990 992 # These are settings that rely on a dataset being loaded. … … 1009 1011 } 1010 1012 if { [array size _fields] < 2 } { 1011 blt::table forget $itk_component(field) $itk_component(field_l)1013 catch {blt::table forget $itk_component(field) $itk_component(field_l)} 1012 1014 } 1013 1015 set _reset 0 … … 1267 1269 } 1268 1270 "-axesvisible" { 1269 set bool $_settings( -axesvisible)1271 set bool $_settings($what) 1270 1272 SendCmd "axis visible all $bool" 1271 1273 } 1272 "-axislabels visible" {1273 set bool $_settings( -axislabelsvisible)1274 "-axislabels" { 1275 set bool $_settings($what) 1274 1276 SendCmd "axis labels all $bool" 1277 } 1278 "-axisminorticks" { 1279 set bool $_settings($what) 1280 SendCmd "axis minticks all $bool" 1275 1281 } 1276 1282 "-xaxisgrid" - "-yaxisgrid" - "-zaxisgrid" { … … 1370 1376 SendCmd "polydata edges $bool" 1371 1377 } 1372 "- surfaceoutline" {1378 "-outline" { 1373 1379 set bool $_settings($what) 1374 1380 SendCmd "outline visible $bool" … … 1553 1559 checkbutton $inner.outline \ 1554 1560 -text "Outline" \ 1555 -variable [itcl::scope _settings(- surfaceoutline)] \1556 -command [itcl::code $this AdjustSetting - surfaceoutline] \1561 -variable [itcl::scope _settings(-outline)] \ 1562 -command [itcl::code $this AdjustSetting -outline] \ 1557 1563 -font "Arial 9" 1558 1564 … … 1906 1912 1907 1913 if { $_changed(-surfaceopacity) } { 1908 set style(-opacity) $_settings(-surfaceopacity)1914 set style(-opacity) [expr $_settings(-surfaceopacity) * 0.01] 1909 1915 } 1910 1916 if { $_changed(-numcontours) } { … … 1918 1924 $itk_component(colormap) value $style(-color) 1919 1925 } 1920 set _currentOpacity $style(-opacity)1921 1926 if { $_currentNumContours != $style(-levels) } { 1922 1927 set _currentNumContours $style(-levels) … … 1929 1934 set _settings(-surfacevisible) $style(-surfacevisible) 1930 1935 1931 SendCmd "polydata add $tag"1932 SendCmd "polydata edges $style(-edges) $tag"1933 SendCmd [list contour2d add contourlist $_contourList $tag]1934 SendCmd "contour2d colormode constant {} $tag"1935 SendCmd "contour2d color [Color2RGB $style(-isolinecolor)] $tag"1936 1936 SendCmd "outline add $tag" 1937 1937 SendCmd "outline color [Color2RGB $itk_option(-plotforeground)] $tag" 1938 1938 SendCmd "outline visible $style(-outline) $tag" 1939 set _settings(-surfaceoutline) $style(-outline) 1939 set _settings(-outline) $style(-outline) 1940 1941 SendCmd "polydata add $tag" 1942 SendCmd "polydata edges $style(-edges) $tag" 1940 1943 set _settings(-surfaceedges) $style(-edges) 1941 1944 #SendCmd "polydata color [Color2RGB $settings(-color)] $tag" … … 1944 1947 SendCmd "polydata linecolor [Color2RGB $style(-edgecolor)] $tag" 1945 1948 SendCmd "polydata linewidth $style(-linewidth) $tag" 1946 SendCmd "polydata opacity $ _currentOpacity$tag"1947 set _settings(-surfaceopacity) $style(-opacity)1949 SendCmd "polydata opacity $style(-opacity) $tag" 1950 set _settings(-surfaceopacity) [expr $style(-opacity) * 100.0] 1948 1951 SetCurrentColormap $style(-color) 1949 1952 SendCmd "polydata wireframe $style(-wireframe) $tag" 1950 1953 set _settings(-surfacewireframe) $style(-wireframe) 1951 set _settings(-surfaceopacity) [expr $style(-opacity) * 100.0] 1954 1955 SendCmd [list contour2d add contourlist $_contourList $tag] 1956 SendCmd "contour2d colormode constant {} $tag" 1957 SendCmd "contour2d color [Color2RGB $style(-isolinecolor)] $tag" 1952 1958 } 1953 1959 -
branches/r9/gui/scripts/vtkviewer.tcl
r4344 r4919 57 57 public method get {args} 58 58 public method isconnected {} 59 public method limits { colormap}59 public method limits { dataobj } 60 60 public method parameters {title args} { 61 61 # do nothing … … 69 69 protected method DoRotate {} 70 70 protected method AdjustSetting {what {value ""}} 71 protected method FixSettings { args }71 protected method InitSettings { args } 72 72 protected method Pan {option x y} 73 73 protected method Pick {x y} … … 85 85 private method BuildCutawayTab {} 86 86 private method BuildDownloadPopup { widget command } 87 private method BuildGlyphsTab {} 87 88 private method BuildMoleculeTab {} 88 89 private method BuildPolydataTab {} … … 94 95 private method EventuallySetAtomScale { args } 95 96 private method EventuallySetBondScale { args } 97 private method EventuallySetGlyphsOpacity { args } 96 98 private method EventuallySetMoleculeOpacity { args } 97 99 private method EventuallySetMoleculeQuality { args } … … 107 109 private method SetBondScale {} 108 110 private method SetColormap { dataobj comp } 111 private method SetGlyphsOpacity {} 109 112 private method SetLegendTip { x y } 110 113 private method SetMoleculeOpacity {} … … 208 211 $_dispatcher dispatch $this !polydataOpacity \ 209 212 "[itcl::code $this SetPolydataOpacity]; list" 213 214 # Glyphs opacity event 215 $_dispatcher register !glyphsOpacity 216 $_dispatcher dispatch $this !glyphsOpacity \ 217 "[itcl::code $this SetGlyphsOpacity]; list" 218 210 219 # 211 220 # Populate parser with commands handle incoming requests … … 248 257 visible 1 249 258 labels 1 259 minorticks 1 250 260 }] 251 261 array set _settings [subst { 252 262 legend 1 263 glyphs-edges 0 264 glyphs-lighting 1 253 265 glyphs-opacity 100 266 glyphs-outline 0 267 glyphs-palette BCGYR 268 glyphs-visible 1 254 269 glyphs-wireframe 0 255 270 polydata-edges 0 256 271 polydata-lighting 1 257 272 polydata-opacity 100 258 polydata-palette rainbow 273 polydata-outline 0 274 polydata-palette BCGYR 259 275 polydata-visible 1 260 276 polydata-wireframe 0 … … 268 284 molecule-lighting 1 269 285 molecule-opacity 100 286 molecule-outline 0 270 287 molecule-palette elementDefault 271 288 molecule-quality 1.0 … … 500 517 } 501 518 519 itcl::body Rappture::VtkViewer::SetGlyphsOpacity {} { 520 set _glyphsOpacityPending 0 521 foreach dataset [CurrentDatasets -visible $_first] { 522 foreach { dataobj comp } [split $dataset -] break 523 if { [$dataobj type $comp] == "glyphs" } { 524 SetOpacity $dataset 525 } 526 } 527 } 528 502 529 itcl::body Rappture::VtkViewer::SetPolydataOpacity {} { 503 530 set _polydataOpacityPending 0 … … 542 569 set _polydataOpacityPending 1 543 570 $_dispatcher event -after $_scaleDelay !polydataOpacity 571 } 572 } 573 574 itcl::body Rappture::VtkViewer::EventuallySetGlyphsOpacity { args } { 575 if { !$_glyphsOpacityPending } { 576 set _glyphsOpacityPending 1 577 $_dispatcher event -after $_scaleDelay !glyphsOpacity 544 578 } 545 579 } … … 710 744 } 711 745 array set bounds [limits $dataobj] 712 if { ![info exists _limits(xmin)] || $_limits(xmin) > $bounds(xmin)} {746 if {[info exists bounds(xmin)] && (![info exists _limits(xmin)] || $_limits(xmin) > $bounds(xmin))} { 713 747 set _limits(xmin) $bounds(xmin) 714 748 } 715 if { ![info exists _limits(xmax)] || $_limits(xmax) < $bounds(xmax)} {749 if {[info exists bounds(xmax)] && (![info exists _limits(xmax)] || $_limits(xmax) < $bounds(xmax))} { 716 750 set _limits(xmax) $bounds(xmax) 717 751 } 718 752 719 if { ![info exists _limits(ymin)] || $_limits(ymin) > $bounds(ymin)} {753 if {[info exists bounds(ymin)] && (![info exists _limits(ymin)] || $_limits(ymin) > $bounds(ymin))} { 720 754 set _limits(ymin) $bounds(ymin) 721 755 } 722 if { ![info exists _limits(ymax)] || $_limits(ymax) < $bounds(ymax)} {756 if {[info exists bounds(ymax)] && (![info exists _limits(ymax)] || $_limits(ymax) < $bounds(ymax))} { 723 757 set _limits(ymax) $bounds(ymax) 724 758 } 725 759 726 if { ![info exists _limits(zmin)] || $_limits(zmin) > $bounds(zmin)} {760 if {[info exists bounds(zmin)] && (![info exists _limits(zmin)] || $_limits(zmin) > $bounds(zmin))} { 727 761 set _limits(zmin) $bounds(zmin) 728 762 } 729 if { ![info exists _limits(zmax)] || $_limits(zmax) < $bounds(zmax)} {763 if {[info exists bounds(zmax)] && (![info exists _limits(zmax)] || $_limits(zmax) < $bounds(zmax))} { 730 764 set _limits(zmax) $bounds(zmax) 765 } 766 } 767 if { $_haveGlyphs } { 768 if { ![$itk_component(main) exists "Glyphs Settings"] } { 769 if { [catch { BuildGlyphsTab } errs ] != 0 } { 770 puts stderr "errs=$errs" 771 } 731 772 } 732 773 } … … 834 875 set session $env(SESSION) 835 876 } 877 lappend info "version" "$Rappture::version" 878 lappend info "build" "$Rappture::build" 879 lappend info "svnurl" "$Rappture::svnurl" 880 lappend info "installdir" "$Rappture::installdir" 836 881 lappend info "hub" [exec hostname] 837 882 lappend info "client" "vtkviewer" … … 987 1032 $_arcball resize $w $h 988 1033 DoResize 989 FixSettings axis-xgrid axis-ygrid axis-zgrid axis-mode \ 990 axis-visible axis-labels 991 992 if { $_havePolydata } { 993 FixSettings polydata-edges polydata-lighting polydata-opacity \ 994 polydata-visible polydata-wireframe 995 } 1034 InitSettings axis-xgrid axis-ygrid axis-zgrid axis-mode \ 1035 axis-visible axis-labels axis-minorticks 1036 996 1037 StopBufferingCommands 997 1038 SendCmd "imgflush" … … 1034 1075 } 1035 1076 lappend _obj2datasets($dataobj) $tag 1077 set type [$dataobj type $comp] 1036 1078 if { [info exists _obj2ovride($dataobj-raise)] } { 1037 SendCmd " datasetvisible 1 $tag"1079 SendCmd "$type visible 1 $tag" 1038 1080 SetOpacity $tag 1039 1081 } … … 1057 1099 } 1058 1100 } 1101 if { $_haveGlyphs } { 1102 InitSettings glyphs-outline 1103 } 1104 if { $_haveMolecules } { 1105 InitSettings molecule-outline 1106 } 1107 if { $_havePolydata } { 1108 InitSettings polydata-outline 1109 } 1059 1110 if { $_reset } { 1111 if { $_haveGlyphs } { 1112 InitSettings glyphs-edges glyphs-lighting glyphs-opacity \ 1113 glyphs-visible glyphs-wireframe 1114 } 1115 if { $_havePolydata } { 1116 InitSettings polydata-edges polydata-lighting polydata-opacity \ 1117 polydata-visible polydata-wireframe 1118 } 1119 if { $_haveMolecules } { 1120 InitSettings molecule-edges molecule-lighting molecule-opacity \ 1121 molecule-visible molecule-wireframe molecule-labels 1122 } 1123 1060 1124 set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)] 1061 1125 $_arcball quaternion $q … … 1072 1136 1073 1137 if { $_haveMolecules } { 1074 # FixSettings molecule-representation1138 #InitSettings molecule-representation 1075 1139 } 1076 1140 set _reset 0 … … 1290 1354 1291 1355 # ---------------------------------------------------------------------- 1292 # USAGE: FixSettings <what> ?<value>?1356 # USAGE: InitSettings <what> ?<value>? 1293 1357 # 1294 1358 # Used internally to update rendering settings whenever parameters … … 1296 1360 # to the back end. 1297 1361 # ---------------------------------------------------------------------- 1298 itcl::body Rappture::VtkViewer:: FixSettings { args } {1362 itcl::body Rappture::VtkViewer::InitSettings { args } { 1299 1363 foreach setting $args { 1300 1364 AdjustSetting $setting … … 1314 1378 } 1315 1379 switch -- $what { 1380 "glyphs-opacity" { 1381 foreach dataset [CurrentDatasets -visible $_first] { 1382 foreach { dataobj comp } [split $dataset -] break 1383 if { [$dataobj type $comp] == "glyphs" } { 1384 SetOpacity $dataset 1385 } 1386 } 1387 } 1388 "glyphs-outline" { 1389 set bool $_settings($what) 1390 foreach dataset [CurrentDatasets -visible $_first] { 1391 foreach { dataobj comp } [split $dataset -] break 1392 set type [$dataobj type $comp] 1393 if { $type == "glyphs" } { 1394 SendCmd "outline visible $bool $dataset" 1395 } 1396 } 1397 } 1398 "glyphs-wireframe" { 1399 set bool $_settings($what) 1400 foreach dataset [CurrentDatasets -visible $_first] { 1401 foreach { dataobj comp } [split $dataset -] break 1402 set type [$dataobj type $comp] 1403 if { $type == "glyphs" } { 1404 SendCmd "$type wireframe $bool $dataset" 1405 } 1406 } 1407 } 1408 "glyphs-visible" { 1409 set bool $_settings($what) 1410 foreach dataset [CurrentDatasets -visible $_first] { 1411 foreach { dataobj comp } [split $dataset -] break 1412 set type [$dataobj type $comp] 1413 if { $type == "glyphs" } { 1414 SendCmd "$type visible $bool $dataset" 1415 } 1416 } 1417 } 1418 "glyphs-lighting" { 1419 set bool $_settings($what) 1420 foreach dataset [CurrentDatasets -visible $_first] { 1421 foreach { dataobj comp } [split $dataset -] break 1422 set type [$dataobj type $comp] 1423 if { $type == "glyphs" } { 1424 SendCmd "$type lighting $bool $dataset" 1425 } 1426 } 1427 } 1428 "glyphs-edges" { 1429 set bool $_settings($what) 1430 foreach dataset [CurrentDatasets -visible $_first] { 1431 foreach { dataobj comp } [split $dataset -] break 1432 set type [$dataobj type $comp] 1433 if { $type == "glyphs" } { 1434 SendCmd "$type edges $bool $dataset" 1435 } 1436 } 1437 } 1438 "glyphs-palette" { 1439 set palette [$itk_component(glyphspalette) value] 1440 set _settings($what) $palette 1441 foreach dataset [CurrentDatasets -visible $_first] { 1442 foreach {dataobj comp} [split $dataset -] break 1443 set type [$dataobj type $comp] 1444 if { $type == "glyphs" } { 1445 ChangeColormap $dataobj $comp $palette 1446 # FIXME: fill in current selected fieldname 1447 #SendCmd "glyphs colormode scalar {} $dataset" 1448 } 1449 } 1450 set _legendPending 1 1451 } 1316 1452 "polydata-opacity" { 1317 1453 foreach dataset [CurrentDatasets -visible $_first] { … … 1322 1458 } 1323 1459 } 1460 "polydata-outline" { 1461 set bool $_settings($what) 1462 foreach dataset [CurrentDatasets -visible $_first] { 1463 foreach { dataobj comp } [split $dataset -] break 1464 set type [$dataobj type $comp] 1465 if { $type == "polydata" } { 1466 SendCmd "outline visible $bool $dataset" 1467 } 1468 } 1469 } 1324 1470 "polydata-wireframe" { 1325 set bool $_settings( polydata-wireframe)1471 set bool $_settings($what) 1326 1472 foreach dataset [CurrentDatasets -visible $_first] { 1327 1473 foreach { dataobj comp } [split $dataset -] break … … 1333 1479 } 1334 1480 "polydata-visible" { 1335 set bool $_settings( polydata-visible)1481 set bool $_settings($what) 1336 1482 foreach dataset [CurrentDatasets -visible $_first] { 1337 1483 foreach { dataobj comp } [split $dataset -] break … … 1343 1489 } 1344 1490 "polydata-lighting" { 1345 set bool $_settings( polydata-lighting)1491 set bool $_settings($what) 1346 1492 foreach dataset [CurrentDatasets -visible $_first] { 1347 1493 foreach { dataobj comp } [split $dataset -] break … … 1353 1499 } 1354 1500 "polydata-edges" { 1355 set bool $_settings( polydata-edges)1501 set bool $_settings($what) 1356 1502 foreach dataset [CurrentDatasets -visible $_first] { 1357 1503 foreach { dataobj comp } [split $dataset -] break … … 1364 1510 "polydata-palette" { 1365 1511 set palette [$itk_component(meshpalette) value] 1366 set _settings( polydata-palette) $palette1512 set _settings($what) $palette 1367 1513 foreach dataset [CurrentDatasets -visible $_first] { 1368 1514 foreach {dataobj comp} [split $dataset -] break … … 1377 1523 } 1378 1524 "molecule-opacity" { 1379 set val $_settings(molecule-opacity)1380 set sval [expr { 0.01 * double($val) }]1381 1525 foreach dataset [CurrentDatasets -visible $_first] { 1382 1526 foreach { dataobj comp } [split $dataset -] break … … 1386 1530 } 1387 1531 } 1532 "molecule-outline" { 1533 set bool $_settings($what) 1534 foreach dataset [CurrentDatasets -visible $_first] { 1535 foreach { dataobj comp } [split $dataset -] break 1536 set type [$dataobj type $comp] 1537 if { $type == "molecule" } { 1538 SendCmd "outline visible $bool $dataset" 1539 } 1540 } 1541 } 1388 1542 "molecule-wireframe" { 1389 set bool $_settings( molecule-wireframe)1543 set bool $_settings($what) 1390 1544 foreach dataset [CurrentDatasets -visible $_first] { 1391 1545 foreach { dataobj comp } [split $dataset -] break … … 1397 1551 } 1398 1552 "molecule-visible" { 1399 set bool $_settings( molecule-visible)1553 set bool $_settings($what) 1400 1554 foreach dataset [CurrentDatasets -visible $_first] { 1401 1555 foreach { dataobj comp } [split $dataset -] break … … 1407 1561 } 1408 1562 "molecule-lighting" { 1409 set bool $_settings( molecule-lighting)1563 set bool $_settings($what) 1410 1564 foreach dataset [CurrentDatasets -visible $_first] { 1411 1565 foreach { dataobj comp } [split $dataset -] break … … 1417 1571 } 1418 1572 "molecule-edges" { 1419 set bool $_settings( molecule-edges)1573 set bool $_settings($what) 1420 1574 foreach dataset [CurrentDatasets -visible $_first] { 1421 1575 foreach { dataobj comp } [split $dataset -] break … … 1428 1582 "molecule-palette" { 1429 1583 set palette [$itk_component(moleculepalette) value] 1430 set _ moelculeSettings(palette) $palette1584 set _settings($what) $palette 1431 1585 foreach dataset [CurrentDatasets -visible $_first] { 1432 1586 foreach {dataobj comp} [split $dataset -] break … … 1492 1646 set _settings(molecule-atoms-visible) 0 1493 1647 set _settings(molecule-bonds-visible) 1 1494 set _settings(molecule-bondstyle) cylinder1648 set _settings(molecule-bondstyle) line 1495 1649 set _settings(molecule-atomscale) 1.0 1496 1650 set _settings(molecule-bondscale) 1.0 … … 1525 1679 set value [$itk_component(rscale) value] 1526 1680 set value [$itk_component(rscale) translate $value] 1527 set _settings( molecule-rscale) $value1681 set _settings($what) $value 1528 1682 foreach dataset [CurrentDatasets -visible $_first] { 1529 1683 foreach {dataobj comp} [split $dataset -] break 1530 1684 set type [$dataobj type $comp] 1531 1685 if { $type == "molecule" } { 1532 SendCmd [subst {molecule rscale $_settings( molecule-rscale) $dataset}]1686 SendCmd [subst {molecule rscale $_settings($what) $dataset}] 1533 1687 } 1534 1688 } 1535 1689 } 1536 1690 "molecule-labels" { 1537 set bool $_settings( molecule-labels)1691 set bool $_settings($what) 1538 1692 foreach dataset [CurrentDatasets -visible $_first] { 1539 1693 foreach { dataobj comp } [split $dataset -] break … … 1551 1705 set bool $_axis(labels) 1552 1706 SendCmd "axis labels all $bool" 1707 } 1708 "axis-minorticks" { 1709 set bool $_axis(minorticks) 1710 SendCmd "axis minticks all $bool" 1553 1711 } 1554 1712 "axis-xgrid" { … … 1760 1918 file delete $tmpfile 1761 1919 set output [$reader GetOutput] 1920 if { $output == "" } { 1921 # Invalid VTK file -- loader failed to parse 1922 continue 1923 } 1762 1924 set _limits($tag) [$output GetBounds] 1763 1925 if {$debug} { … … 1818 1980 } 1819 1981 1820 itcl::body Rappture::VtkViewer::Build PolydataTab {} {1982 itcl::body Rappture::VtkViewer::BuildGlyphsTab {} { 1821 1983 1822 1984 set fg [option get $itk_component(hull) font Font] 1823 1985 #set bfg [option get $itk_component(hull) boldFont Font] 1824 1986 1825 set inner [$itk_component(main) insert end \ 1987 set inner [$itk_component(main) insert 0 \ 1988 -title "Glyph Settings" \ 1989 -icon [Rappture::icon volume-on]] 1990 $inner configure -borderwidth 4 1991 1992 checkbutton $inner.glyphs \ 1993 -text "Show Glyphs" \ 1994 -variable [itcl::scope _settings(glyphs-visible)] \ 1995 -command [itcl::code $this AdjustSetting glyphs-visible] \ 1996 -font "Arial 9" -anchor w 1997 1998 checkbutton $inner.outline \ 1999 -text "Show Outline" \ 2000 -variable [itcl::scope _settings(glyphs-outline)] \ 2001 -command [itcl::code $this AdjustSetting glyphs-outline] \ 2002 -font "Arial 9" -anchor w 2003 2004 checkbutton $inner.wireframe \ 2005 -text "Show Wireframe" \ 2006 -variable [itcl::scope _settings(glyphs-wireframe)] \ 2007 -command [itcl::code $this AdjustSetting glyphs-wireframe] \ 2008 -font "Arial 9" -anchor w 2009 2010 checkbutton $inner.lighting \ 2011 -text "Enable Lighting" \ 2012 -variable [itcl::scope _settings(glyphs-lighting)] \ 2013 -command [itcl::code $this AdjustSetting glyphs-lighting] \ 2014 -font "Arial 9" -anchor w 2015 2016 checkbutton $inner.edges \ 2017 -text "Show Edges" \ 2018 -variable [itcl::scope _settings(glyphs-edges)] \ 2019 -command [itcl::code $this AdjustSetting glyphs-edges] \ 2020 -font "Arial 9" -anchor w 2021 2022 label $inner.palette_l -text "Palette" -font "Arial 9" -anchor w 2023 itk_component add glyphspalette { 2024 Rappture::Combobox $inner.palette -width 10 -editable no 2025 } 2026 $inner.palette choices insert end [GetColormapList] 2027 $itk_component(glyphspalette) value "BCGYR" 2028 bind $inner.palette <<Value>> \ 2029 [itcl::code $this AdjustSetting glyphs-palette] 2030 2031 label $inner.opacity_l -text "Opacity" -font "Arial 9" -anchor w 2032 ::scale $inner.opacity -from 0 -to 100 -orient horizontal \ 2033 -variable [itcl::scope _settings(glyphs-opacity)] \ 2034 -width 10 \ 2035 -showvalue off \ 2036 -command [itcl::code $this EventuallySetGlyphsOpacity] 2037 $inner.opacity set $_settings(glyphs-opacity) 2038 2039 blt::table $inner \ 2040 0,0 $inner.glyphs -cspan 2 -anchor w -pady 2 \ 2041 1,0 $inner.outline -cspan 2 -anchor w -pady 2 \ 2042 2,0 $inner.wireframe -cspan 2 -anchor w -pady 2 \ 2043 3,0 $inner.lighting -cspan 2 -anchor w -pady 2 \ 2044 4,0 $inner.edges -cspan 2 -anchor w -pady 2 \ 2045 5,0 $inner.opacity_l -anchor w -pady 2 \ 2046 5,1 $inner.opacity -fill x -pady 2 \ 2047 6,0 $inner.palette_l -anchor w -pady 2 \ 2048 6,1 $inner.palette -fill x -pady 2 2049 2050 blt::table configure $inner r* c* -resize none 2051 blt::table configure $inner r8 c1 -resize expand 2052 } 2053 2054 itcl::body Rappture::VtkViewer::BuildPolydataTab {} { 2055 2056 set fg [option get $itk_component(hull) font Font] 2057 #set bfg [option get $itk_component(hull) boldFont Font] 2058 2059 set inner [$itk_component(main) insert 0 \ 1826 2060 -title "Mesh Settings" \ 1827 2061 -icon [Rappture::icon mesh]] … … 1834 2068 -font "Arial 9" -anchor w 1835 2069 2070 checkbutton $inner.outline \ 2071 -text "Show Outline" \ 2072 -variable [itcl::scope _settings(polydata-outline)] \ 2073 -command [itcl::code $this AdjustSetting polydata-outline] \ 2074 -font "Arial 9" -anchor w 2075 1836 2076 checkbutton $inner.wireframe \ 1837 2077 -text "Show Wireframe" \ … … 1866 2106 -width 10 \ 1867 2107 -showvalue off \ 1868 -command [itcl::code $this AdjustSetting polydata-opacity]2108 -command [itcl::code $this EventuallySetPolydataOpacity] 1869 2109 $inner.opacity set $_settings(polydata-opacity) 1870 2110 1871 2111 blt::table $inner \ 1872 2112 0,0 $inner.mesh -cspan 2 -anchor w -pady 2 \ 1873 1,0 $inner.wireframe -cspan 2 -anchor w -pady 2 \ 1874 2,0 $inner.lighting -cspan 2 -anchor w -pady 2 \ 1875 3,0 $inner.edges -cspan 2 -anchor w -pady 2 \ 1876 4,0 $inner.opacity_l -anchor w -pady 2 \ 1877 4,1 $inner.opacity -fill x -pady 2 \ 1878 5,0 $inner.palette_l -anchor w -pady 2 \ 1879 5,1 $inner.palette -fill x -pady 2 2113 1,0 $inner.outline -cspan 2 -anchor w -pady 2 \ 2114 2,0 $inner.wireframe -cspan 2 -anchor w -pady 2 \ 2115 3,0 $inner.lighting -cspan 2 -anchor w -pady 2 \ 2116 4,0 $inner.edges -cspan 2 -anchor w -pady 2 \ 2117 5,0 $inner.opacity_l -anchor w -pady 2 \ 2118 5,1 $inner.opacity -fill x -pady 2 \ 2119 6,0 $inner.palette_l -anchor w -pady 2 \ 2120 6,1 $inner.palette -fill x -pady 2 1880 2121 1881 2122 blt::table configure $inner r* c* -resize none 1882 blt::table configure $inner r 7c1 -resize expand2123 blt::table configure $inner r8 c1 -resize expand 1883 2124 } 1884 2125 … … 1890 2131 set inner [$itk_component(main) insert end \ 1891 2132 -title "Axis Settings" \ 1892 -icon [Rappture::icon axis 1]]2133 -icon [Rappture::icon axis2]] 1893 2134 $inner configure -borderwidth 4 1894 2135 … … 1920 2161 -command [itcl::code $this AdjustSetting axis-zgrid] \ 1921 2162 -font "Arial 9" 2163 checkbutton $inner.minorticks \ 2164 -text "Minor Ticks" \ 2165 -variable [itcl::scope _axis(minorticks)] \ 2166 -command [itcl::code $this AdjustSetting axis-minorticks] \ 2167 -font "Arial 9" 1922 2168 1923 2169 label $inner.mode_l -text "Mode" -font "Arial 9" … … 1935 2181 1936 2182 blt::table $inner \ 1937 0,0 $inner.visible -anchor w -cspan 2 \ 1938 1,0 $inner.labels -anchor w -cspan 2 \ 1939 2,0 $inner.gridx -anchor w -cspan 2 \ 1940 3,0 $inner.gridy -anchor w -cspan 2 \ 1941 4,0 $inner.gridz -anchor w -cspan 2 \ 1942 5,0 $inner.mode_l -anchor w -cspan 2 -padx { 2 0 } \ 1943 6,0 $inner.mode -fill x -cspan 2 2183 0,0 $inner.visible -anchor w -cspan 4 \ 2184 1,0 $inner.labels -anchor w -cspan 4 \ 2185 2,0 $inner.minorticks -anchor w -cspan 4 \ 2186 4,0 $inner.grid_l -anchor w \ 2187 4,1 $inner.xgrid -anchor w \ 2188 4,2 $inner.ygrid -anchor w \ 2189 4,3 $inner.zgrid -anchor w \ 2190 5,0 $inner.mode_l -anchor w -padx { 2 0 } \ 2191 5,1 $inner.mode -fill x -cspan 3 1944 2192 1945 2193 blt::table configure $inner r* c* -resize none 1946 blt::table configure $inner r7 c1 -resize expand 2194 blt::table configure $inner r7 c6 -resize expand 2195 blt::table configure $inner r3 -height 0.125i 1947 2196 } 1948 2197 … … 2139 2388 set fg [option get $itk_component(hull) font Font] 2140 2389 2141 set inner [$itk_component(main) insert end\2390 set inner [$itk_component(main) insert 0 \ 2142 2391 -title "Molecule Settings" \ 2143 2392 -icon [Rappture::icon molecule]] … … 2148 2397 -variable [itcl::scope _settings(molecule-visible)] \ 2149 2398 -command [itcl::code $this AdjustSetting molecule-visible] \ 2399 -font "Arial 9" 2400 2401 checkbutton $inner.outline \ 2402 -text "Show Outline" \ 2403 -variable [itcl::scope _settings(molecule-outline)] \ 2404 -command [itcl::code $this AdjustSetting molecule-outline] \ 2150 2405 -font "Arial 9" 2151 2406 … … 2256 2511 blt::table $inner \ 2257 2512 0,0 $inner.molecule -anchor w -pady {1 0} \ 2258 1,0 $inner.label -anchor w -pady {1 0} \ 2259 2,0 $inner.edges -anchor w -pady {1 0} \ 2260 3,0 $inner.rep_l -anchor w -pady { 2 0 } \ 2261 4,0 $inner.rep -fill x -pady 2 \ 2262 5,0 $inner.rscale_l -anchor w -pady { 2 0 } \ 2263 6,0 $inner.rscale -fill x -pady 2 \ 2264 7,0 $inner.palette_l -anchor w -pady 0 \ 2265 8,0 $inner.palette -fill x -padx 2 \ 2266 9,0 $inner.atomscale_l -anchor w -pady {3 0} \ 2267 10,0 $inner.atomscale -fill x -padx 2 \ 2268 11,0 $inner.bondscale_l -anchor w -pady {3 0} \ 2269 12,0 $inner.bondscale -fill x -padx 2 \ 2270 13,0 $inner.opacity_l -anchor w -pady {3 0} \ 2271 14,0 $inner.opacity -fill x -padx 2 \ 2272 15,0 $inner.quality_l -anchor w -pady {3 0} \ 2273 16,0 $inner.quality -fill x -padx 2 2513 1,0 $inner.outline -anchor w -pady {1 0} \ 2514 2,0 $inner.label -anchor w -pady {1 0} \ 2515 3,0 $inner.edges -anchor w -pady {1 0} \ 2516 4,0 $inner.rep_l -anchor w -pady { 2 0 } \ 2517 5,0 $inner.rep -fill x -pady 2 \ 2518 6,0 $inner.rscale_l -anchor w -pady { 2 0 } \ 2519 7,0 $inner.rscale -fill x -pady 2 \ 2520 8,0 $inner.palette_l -anchor w -pady 0 \ 2521 9,0 $inner.palette -fill x -padx 2 \ 2522 10,0 $inner.atomscale_l -anchor w -pady {3 0} \ 2523 11,0 $inner.atomscale -fill x -padx 2 \ 2524 12,0 $inner.bondscale_l -anchor w -pady {3 0} \ 2525 13,0 $inner.bondscale -fill x -padx 2 \ 2526 14,0 $inner.opacity_l -anchor w -pady {3 0} \ 2527 15,0 $inner.opacity -fill x -padx 2 \ 2528 16,0 $inner.quality_l -anchor w -pady {3 0} \ 2529 17,0 $inner.quality -fill x -padx 2 2274 2530 2275 2531 blt::table configure $inner r* -resize none 2276 blt::table configure $inner r1 7-resize expand2532 blt::table configure $inner r18 -resize expand 2277 2533 } 2278 2534 … … 2390 2646 "glyphs" { 2391 2647 array set settings { 2392 -color \#FFFFFF2648 -color white 2393 2649 -edgecolor black 2394 2650 -edges 0 … … 2399 2655 -opacity 1.0 2400 2656 -orientGlyphs 0 2657 -outline 0 2401 2658 -ptsize 1.0 2402 2659 -quality 1 … … 2411 2668 set settings(-shape) $shape 2412 2669 } 2670 SendCmd "outline add $tag" 2671 SendCmd "outline color [Color2RGB $settings(-color)] $tag" 2672 SendCmd "outline visible $settings(-outline) $tag" 2673 set _settings(glyphs-outline) $settings(-outline) 2674 2413 2675 SendCmd "glyphs add $settings(-shape) $tag" 2414 2676 SendCmd "glyphs normscale $settings(-normscale) $tag" … … 2428 2690 SendCmd "glyphs lighting $settings(-lighting) $tag" 2429 2691 SendCmd "glyphs opacity $settings(-opacity) $tag" 2692 set _settings(glyphs-opacity) [expr 100.0 * $settings(-opacity)] 2430 2693 SendCmd "glyphs visible $settings(-visible) $tag" 2431 2694 set _settings(glyphs-wireframe) $settings(-wireframe) 2432 2695 } 2433 2696 "molecule" { 2697 array set settings { 2698 -atomscale 0.3 2699 -atomsvisible 1 2700 -bondscale 0.075 2701 -bondstyle "cylinder" 2702 -bondsvisible 1 2703 -color "elementDefault" 2704 -edgecolor black 2705 -edges 0 2706 -labels 0 2707 -lighting 1 2708 -linewidth 1.0 2709 -opacity 1.0 2710 -outline 0 2711 -quality 1.0 2712 -representation "" 2713 -rscale "covalent" 2714 -visible 1 2715 -wireframe 0 2716 } 2717 array set settings $style 2718 2719 SendCmd "outline add $tag" 2720 SendCmd "outline color [Color2RGB white] $tag" 2721 SendCmd "outline visible $settings(-outline) $tag" 2722 set _settings(molecule-outline) $settings(-outline) 2723 2434 2724 SendCmd "molecule add $tag" 2435 SendCmd "molecule ascale $_settings(molecule-atomscale) $tag" 2436 SendCmd "molecule bscale $_settings(molecule-bondscale) $tag" 2437 SendCmd "molecule bstyle $_settings(molecule-bondstyle) $tag" 2438 SendCmd "molecule atoms $_settings(molecule-atoms-visible) $tag" 2439 SendCmd "molecule bonds $_settings(molecule-bonds-visible) $tag" 2725 if {$settings(-representation) != ""} { 2726 switch -- $settings(-representation) { 2727 "ballandstick" { 2728 set _settings(molecule-rscale) covalent 2729 set _settings(molecule-atoms-visible) 1 2730 set _settings(molecule-bonds-visible) 1 2731 set _settings(molecule-bondstyle) cylinder 2732 set _settings(molecule-atomscale) 0.3 2733 set _settings(molecule-bondscale) 0.075 2734 } 2735 "balls" - "spheres" { 2736 set _settings(molecule-rscale) covalent 2737 set _settings(molecule-atoms-visible) 1 2738 set _settings(molecule-bonds-visible) 0 2739 set _settings(molecule-bondstyle) cylinder 2740 set _settings(molecule-atomscale) 0.3 2741 set _settings(molecule-bondscale) 0.075 2742 } 2743 "sticks" { 2744 set _settings(molecule-rscale) none 2745 set _settings(molecule-atoms-visible) 1 2746 set _settings(molecule-bonds-visible) 1 2747 set _settings(molecule-bondstyle) cylinder 2748 set _settings(molecule-atomscale) 0.075 2749 set _settings(molecule-bondscale) 0.075 2750 } 2751 "spacefilling" { 2752 set _settings(molecule-rscale) van_der_waals 2753 set _settings(molecule-atoms-visible) 1 2754 set _settings(molecule-bonds-visible) 0 2755 set _settings(molecule-bondstyle) cylinder 2756 set _settings(molecule-atomscale) 1.0 2757 set _settings(molecule-bondscale) 0.075 2758 } 2759 "rods" { 2760 set _settings(molecule-rscale) none 2761 set _settings(molecule-atoms-visible) 1 2762 set _settings(molecule-bonds-visible) 1 2763 set _settings(molecule-bondstyle) cylinder 2764 set _settings(molecule-atomscale) 0.1 2765 set _settings(molecule-bondscale) 0.1 2766 } 2767 "wireframe" - "lines" { 2768 set _settings(molecule-rscale) none 2769 set _settings(molecule-atoms-visible) 0 2770 set _settings(molecule-bonds-visible) 1 2771 set _settings(molecule-bondstyle) line 2772 set _settings(molecule-atomscale) 1.0 2773 set _settings(molecule-bondscale) 1.0 2774 } 2775 default { 2776 error "unknown representation $value" 2777 } 2778 } 2779 SendCmd "molecule rscale $_settings(molecule-rscale) $tag" 2780 SendCmd "molecule atoms $_settings(molecule-atoms-visible) $tag" 2781 SendCmd "molecule bonds $_settings(molecule-bonds-visible) $tag" 2782 SendCmd "molecule bstyle $_settings(molecule-bondstyle) $tag" 2783 SendCmd "molecule ascale $_settings(molecule-atomscale) $tag" 2784 SendCmd "molecule bscale $_settings(molecule-bondscale) $tag" 2785 $itk_component(representation) value [$itk_component(representation) label $settings(-representation)] 2786 $itk_component(rscale) value [$itk_component(rscale) label $_settings(molecule-rscale)] 2787 switch -- $settings(-representation) { 2788 "ballandstick" - "balls" - "spheres" { 2789 $itk_component(rscale) configure -state normal 2790 } 2791 default { 2792 $itk_component(rscale) configure -state disabled 2793 } 2794 } 2795 } else { 2796 SendCmd "molecule rscale $settings(-rscale) $tag" 2797 set _settings(molecule-rscale) $settings(-rscale) 2798 SendCmd "molecule atoms $settings(-atomsvisible) $tag" 2799 set _settings(molecule-atoms-visible) $settings(-atomsvisible) 2800 SendCmd "molecule bonds $settings(-bondsvisible) $tag" 2801 set _settings(molecule-bonds-visible) $settings(-bondsvisible) 2802 SendCmd "molecule bstyle $settings(-bondstyle) $tag" 2803 set _settings(molecule-bondstyle) $settings(-bondstyle) 2804 SendCmd "molecule ascale $settings(-atomscale) $tag" 2805 set _settings(molecule-atomscale) $settings(-atomscale) 2806 SendCmd "molecule bscale $settings(-bondscale) $tag" 2807 set _settings(molecule-bondscale) $settings(-bondscale) 2808 } 2809 SendCmd "molecule labels $settings(-labels) $tag" 2810 set _settings(molecule-labels) $settings(-labels) 2811 SendCmd "molecule linecolor [Color2RGB $settings(-edgecolor)] $tag" 2812 SendCmd "molecule linewidth $settings(-linewidth) $tag" 2813 SendCmd "molecule edges $settings(-edges) $tag" 2814 set _settings(molecule-edges) $settings(-edges) 2815 SendCmd "molecule lighting $settings(-lighting) $tag" 2816 set _settings(molecule-lighting) $settings(-lighting) 2817 SendCmd "molecule aquality $settings(-quality) $tag" 2818 SendCmd "molecule bquality $settings(-quality) $tag" 2819 set _settings(molecule-quality) $settings(-quality) 2820 SendCmd "molecule visible $settings(-visible) $tag" 2821 set _settings(molecule-visible) $settings(-visible) 2440 2822 set _haveMolecules 1 2441 2823 } … … 2443 2825 array set settings { 2444 2826 -cloudstyle "mesh" 2445 -color \#FFFFFF2827 -color white 2446 2828 -edgecolor black 2447 2829 -edges 1 … … 2449 2831 -linewidth 1.0 2450 2832 -opacity 1.0 2833 -outline 0 2451 2834 -visible 1 2452 2835 -wireframe 0 2453 2836 } 2454 2837 array set settings $style 2838 2839 SendCmd "outline add $tag" 2840 SendCmd "outline color [Color2RGB $settings(-color)] $tag" 2841 SendCmd "outline visible $settings(-outline) $tag" 2842 set _settings(polydata-outline) $settings(-outline) 2843 2455 2844 SendCmd "polydata add $tag" 2456 2845 SendCmd "polydata visible $settings(-visible) $tag" -
branches/r9/gui/scripts/vtkvolumeviewer.tcl
r4343 r4919 61 61 } 62 62 public method scale {args} 63 public method updateTransferFunctions {}64 65 private method BuildViewTab {}66 private method BuildVolumeComponents {}67 private method ComputeAlphamap { cname }68 private method ComputeTransferFunction { cname }69 private method GetColormap { cname color }70 private method GetDatasetsWithComponent { cname }71 private method HideAllMarkers {}72 private method AddNewMarker { x y }73 private method InitComponentSettings { cname }74 private method ParseLevelsOption { cname levels }75 private method ParseMarkersOption { cname markers }76 private method ResetColormap { cname color }77 private method SendTransferFunctions {}78 private method SetInitialTransferFunction { dataobj cname }79 private method SetOrientation { side }80 private method SwitchComponent { cname }81 private method RemoveMarker { x y }82 private method ViewToQuaternion {} {83 return [list $_view(-qw) $_view(-qx) $_view(-qy) $_view(-qz)]84 }85 private method QuaternionToView { q } {86 foreach { _view(-qw) _view(-qx) _view(-qy) _view(-qz) } $q break87 }88 89 private variable _current ""; # Currently selected component90 private variable _volcomponents ; # Array of components found91 private variable _componentsList ; # Array of components found92 private variable _cname2style93 private variable _cname2transferFunction94 private variable _cname2defaultcolormap95 private variable _cname2defaultalphamap96 97 private variable _parsedFunction98 private variable _transferFunctionEditors99 63 100 64 protected method Connect {} … … 115 79 116 80 # The following methods are only used by this class. 117 118 81 private method BuildAxisTab {} 119 82 private method BuildCameraTab {} 83 private method BuildColormap { name colors } 120 84 private method BuildCutplaneTab {} 121 85 private method BuildDownloadPopup { widget command } 86 private method BuildViewTab {} 122 87 private method BuildVolumeTab {} 123 88 private method DrawLegend {} 124 private method DrawLegendOld {}125 89 private method Combo { option } 126 90 private method EnterLegend { x y } 127 91 private method EventuallyResize { w h } 128 private method EventuallyRequestLegend {}129 92 private method EventuallyRotate { q } 130 93 private method EventuallySetCutplane { axis args } … … 136 99 private method PanCamera {} 137 100 private method RequestLegend {} 101 private method SetColormap { dataobj comp } 102 private method ChangeColormap { dataobj comp color } 138 103 private method SetLegendTip { x y } 139 104 private method SetObjectStyle { dataobj comp } … … 162 127 private variable _start 0 163 128 private variable _title "" 164 private variable _seeds165 129 166 130 common _downloadPopup; # download options from popup … … 175 139 private variable _curFldName "" 176 140 private variable _curFldLabel "" 177 private variable _cutplaneCmd "imgcutplane" 178 private variable _allowMultiComponent 0 179 private variable _activeVolumes; # Array of volumes that are active. 141 private variable _colorMode "vmag";# Mode of colormap (vmag or scalar) 180 142 } 181 143 … … 213 175 $_dispatcher register !xcutplane 214 176 $_dispatcher dispatch $this !xcutplane \ 215 "[itcl::code $this AdjustSetting -xcutplaneposition]; list"177 "[itcl::code $this AdjustSetting cutplane-xposition]; list" 216 178 217 179 # Y-Cutplane event 218 180 $_dispatcher register !ycutplane 219 181 $_dispatcher dispatch $this !ycutplane \ 220 "[itcl::code $this AdjustSetting -ycutplaneposition]; list"182 "[itcl::code $this AdjustSetting cutplane-yposition]; list" 221 183 222 184 # Z-Cutplane event 223 185 $_dispatcher register !zcutplane 224 186 $_dispatcher dispatch $this !zcutplane \ 225 "[itcl::code $this AdjustSetting -zcutplaneposition]; list"187 "[itcl::code $this AdjustSetting cutplane-zposition]; list" 226 188 227 189 # … … 234 196 # Initialize the view to some default parameters. 235 197 array set _view { 236 -qw 0.853553237 -qx -0.353553238 -qy 0.353553239 -qz 0.146447240 -zoom 1.0241 -xpan 0242 -ypan 0243 -ortho 0198 qw 0.853553 199 qx -0.353553 200 qy 0.353553 201 qz 0.146447 202 zoom 1.0 203 xpan 0 204 ypan 0 205 ortho 0 244 206 } 245 207 set _arcball [blt::arcball create 100 100] 246 $_arcball quaternion [ViewToQuaternion] 208 set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)] 209 $_arcball quaternion $q 247 210 248 211 array set _settings { 249 -axesvisible 1 250 -axislabelsvisible 1 251 -background black 252 -cutplanelighting 1 253 -cutplaneopacity 100 254 -cutplanesvisible 0 255 -legendvisible 1 256 -volumeambient 40 257 -volumeblendmode composite 258 -volumediffuse 60 259 -volumelighting 1 260 -volumeopacity 50 261 -volumeoutline 0 262 -volumeoutline 0 263 -volumequality 80 264 -volumespecularexponent 90 265 -volumespecularlevel 30 266 -volumethickness 350 267 -volumevisible 1 268 -xcutplaneposition 50 269 -xcutplanevisible 1 270 -xgridvisible 0 271 -ycutplaneposition 50 272 -ycutplanevisible 1 273 -ygridvisible 0 274 -zcutplaneposition 50 275 -zcutplanevisible 1 276 -zgridvisible 0 212 axis-xgrid 0 213 axis-ygrid 0 214 axis-zgrid 0 215 axesVisible 1 216 axisLabels 1 217 background black 218 cutplaneEdges 0 219 cutplane-xvisible 1 220 cutplane-yvisible 1 221 cutplane-zvisible 1 222 cutplane-xposition 50 223 cutplane-yposition 50 224 cutplane-zposition 50 225 cutplaneVisible 0 226 cutplaneLighting 1 227 cutplaneWireframe 0 228 cutplane-opacity 100 229 legendVisible 1 230 outline 0 231 volumeLighting 1 232 volume-material 80 233 volume-opacity 40 234 volume-quality 50 235 volumeVisible 1 236 legendVisible 1 277 237 } 278 238 … … 353 313 -onimage [Rappture::icon volume-on] \ 354 314 -offimage [Rappture::icon volume-off] \ 355 -variable [itcl::scope _settings( -volumevisible)] \356 -command [itcl::code $this AdjustSetting -volumevisible]315 -variable [itcl::scope _settings(volumeVisible)] \ 316 -command [itcl::code $this AdjustSetting volumeVisible] 357 317 } 358 318 $itk_component(volume) select … … 365 325 -onimage [Rappture::icon cutbutton] \ 366 326 -offimage [Rappture::icon cutbutton] \ 367 -variable [itcl::scope _settings( -cutplanesvisible)] \368 -command [itcl::code $this AdjustSetting -cutplanesvisible]327 -variable [itcl::scope _settings(cutplaneVisible)] \ 328 -command [itcl::code $this AdjustSetting cutplaneVisible] 369 329 } 370 330 Rappture::Tooltip::for $itk_component(cutplane) \ 371 331 "Show/Hide cutplanes" 372 332 pack $itk_component(cutplane) -padx 2 -pady 2 333 373 334 374 335 if { [catch { … … 385 346 set _image(legend) [image create photo] 386 347 itk_component add legend { 387 canvas $itk_component(plotarea).legend - height50 -highlightthickness 0348 canvas $itk_component(plotarea).legend -width 50 -highlightthickness 0 388 349 } { 389 350 usual … … 391 352 rename -background -plotbackground plotBackground Background 392 353 } 393 bind $itk_component(legend) <KeyPress-Delete> \394 [itcl::code $this RemoveMarker %x %y]395 bind $itk_component(legend) <Enter> \396 [list focus $itk_component(legend)]397 354 398 355 # Hack around the Tk panewindow. The problem is that the requested … … 402 359 pack forget $itk_component(view) 403 360 blt::table $itk_component(plotarea) \ 404 0,0 $itk_component(view) -fill both -reqwidth $w \ 405 1,0 $itk_component(legend) -fill x 406 blt::table configure $itk_component(plotarea) r1 -resize none 361 0,0 $itk_component(view) -fill both -reqwidth $w 362 blt::table configure $itk_component(plotarea) c1 -resize none 407 363 408 364 # Bindings for rotation via mouse … … 463 419 eval itk_initialize $args 464 420 Connect 465 update466 421 } 467 422 … … 486 441 SendCmd "screen size $_width $_height" 487 442 488 EventuallyRequestLegend443 set _legendPending 1 489 444 set _resizePending 0 490 445 } 491 446 492 447 itcl::body Rappture::VtkVolumeViewer::DoRotate {} { 493 SendCmd "camera orient [ViewToQuaternion]" 448 set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)] 449 SendCmd "camera orient $q" 494 450 set _rotatePending 0 495 451 } … … 505 461 } 506 462 507 itcl::body Rappture::VtkVolumeViewer::EventuallyRequestLegend {} {508 if { !$_legendPending } {509 set _legendPending 1510 $_dispatcher event -idle !legend511 }512 }513 514 463 set rotate_delay 100 515 464 516 465 itcl::body Rappture::VtkVolumeViewer::EventuallyRotate { q } { 517 QuaternionToView $q466 foreach { _view(qw) _view(qx) _view(qy) _view(qz) } $q break 518 467 if { !$_rotatePending } { 519 468 set _rotatePending 1 … … 683 632 # ---------------------------------------------------------------------- 684 633 itcl::body Rappture::VtkVolumeViewer::scale {args} { 685 array unset _limits686 array unset _volcomponents687 688 634 foreach dataobj $args { 689 if { ![$dataobj isvalid] } { 690 continue; # Object doesn't contain valid data. 691 } 692 # Determine limits for each axis. 693 foreach axis {x y z v} { 694 foreach { min max } [$dataobj limits $axis] break 695 if {"" != $min && "" != $max} { 696 if { ![info exists _limits($axis)] } { 697 set _limits($axis) [list $min $max] 698 } else { 699 foreach {amin amax} $_limits($axis) break 700 if {$min < $amin} { 701 set amin $min 702 } 703 if {$max > $amax} { 704 set amax $max 705 } 706 set _limits($axis) [list $amin $amax] 707 } 708 } 709 } 710 # Determine limits for each field. 635 foreach axis { x y z } { 636 set lim [$dataobj limits $axis] 637 if { ![info exists _limits($axis)] } { 638 set _limits($axis) $lim 639 continue 640 } 641 foreach {min max} $lim break 642 foreach {amin amax} $_limits($axis) break 643 if { $amin > $min } { 644 set amin $min 645 } 646 if { $amax < $max } { 647 set amax $max 648 } 649 set _limits($axis) [list $amin $amax] 650 } 711 651 foreach { fname lim } [$dataobj fieldlimits] { 712 652 if { ![info exists _limits($fname)] } { … … 724 664 set _limits($fname) [list $fmin $fmax] 725 665 } 726 # Get limits for each component. 727 foreach cname [$dataobj components] { 728 if { ![info exists _volcomponents($cname)] } { 729 lappend _componentsList $cname 730 } 731 lappend _volcomponents($cname) $dataobj-$cname 732 array unset limits 733 array set limits [$dataobj valueLimits $cname] 734 foreach {min max} $limits(v) break 735 if { ![info exists _limits($cname)] } { 736 set _limits($cname) [list $min $max] 737 } else { 738 foreach {vmin vmax} $_limits($cname) break 739 if { $min < $vmin } { 740 set vmin $min 741 } 742 if { $max > $vmax } { 743 set vmax $max 744 } 745 set _limits($cname) [list $vmin $vmax] 746 } 747 } 748 } 749 BuildVolumeComponents 750 updateTransferFunctions 666 } 751 667 } 752 668 … … 835 751 set session $env(SESSION) 836 752 } 753 lappend info "version" "$Rappture::version" 754 lappend info "build" "$Rappture::build" 755 lappend info "svnurl" "$Rappture::svnurl" 756 lappend info "installdir" "$Rappture::installdir" 837 757 lappend info "hub" [exec hostname] 838 758 lappend info "client" "vtkvolumeviewer" … … 863 783 itcl::body Rappture::VtkVolumeViewer::disconnect {} { 864 784 Disconnect 785 set _reset 1 865 786 } 866 787 … … 886 807 array unset _data 887 808 array unset _colormaps 888 array unset _seeds889 809 array unset _dataset2style 890 810 array unset _obj2datasets 891 892 array unset _cname2style893 array unset _parsedFunction894 array unset _cname2transferFunction895 896 set _resizePending 0897 set _rotatePending 0898 set _cutplanePending 0899 set _legendPending 0900 set _reset 1901 811 } 902 812 … … 934 844 set _hardcopy($tag) $bytes 935 845 } 846 if { $_legendPending } { 847 RequestLegend 848 } 936 849 } 937 850 … … 988 901 set w [winfo width $itk_component(view)] 989 902 set h [winfo height $itk_component(view)] 990 991 903 if { $w < 2 || $h < 2 } { 992 904 $_dispatcher event -idle !rebuild … … 999 911 StartBufferingCommands 1000 912 913 set _legendPending 1 914 1001 915 if { $_width != $w || $_height != $h || $_reset } { 1002 1003 1004 1005 916 set _width $w 917 set _height $h 918 $_arcball resize $w $h 919 DoResize 1006 920 } 1007 921 if { $_reset } { … … 1009 923 # Reset the camera and other view parameters 1010 924 # 1011 $_arcball quaternion [ViewToQuaternion] 1012 if {$_view(-ortho)} { 925 set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)] 926 $_arcball quaternion $q 927 if {$_view(ortho)} { 1013 928 SendCmd "camera mode ortho" 1014 929 } else { … … 1016 931 } 1017 932 DoRotate 1018 InitSettings -volumeoutline -background \1019 -xgridvisible -ygridvisible -zgridvisible -axisflymode \1020 -axesvisible -axislabelsvisible933 InitSettings outline background \ 934 axis-xgrid axis-ygrid axis-zgrid axisFlyMode \ 935 axesVisible axisLabels 1021 936 PanCamera 1022 937 } … … 1025 940 set _first "" 1026 941 1027 SendCmd "volume visible 0" 1028 1029 # No volumes are active (i.e. in the working set of displayed volumes). 1030 # A volume is always invisible if it's not in the working set. A 1031 # volume in the working set may be visible/invisible depending upon the 1032 # global visibility value. 1033 array unset _activeVolumes 942 SendCmd "dataset visible 0" 1034 943 foreach dataobj [get -objects] { 1035 944 if { [info exists _obj2ovride($dataobj-raise)] && $_first == "" } { … … 1093 1002 [$_first fieldinfo $fname] break 1094 1003 # Only scalar fields are valid 1095 if {$ _allowMultiComponent || $components == 1} {1004 if {$components == 1} { 1096 1005 $itk_component(field) choices insert end "$fname" "$label" 1097 1006 $itk_component(fieldmenu) add radiobutton -label "$label" \ … … 1113 1022 } 1114 1023 1115 InitSettings -color \ 1116 -volumeambient -volumediffuse -volumespecularlevel \ 1117 -volumespecularexponent -volumeblendmode -volumethickness \ 1118 -volumeopacity -volumequality -volumevisible \ 1119 -cutplanesvisible \ 1120 -xcutplaneposition -ycutplaneposition -zcutplaneposition \ 1121 -xcutplanevisible -ycutplanevisible -zcutplanevisible 1024 InitSettings volume-palette volume-material volume-quality volumeVisible \ 1025 cutplaneVisible \ 1026 cutplane-xposition cutplane-yposition cutplane-zposition \ 1027 cutplane-xvisible cutplane-yvisible cutplane-zvisible 1122 1028 1123 1029 if { $_reset } { 1124 InitSettings -volumelighting 1125 SendCmd "camera reset" 1126 SendCmd "camera zoom $_view(-zoom)" 1127 RequestLegend 1030 InitSettings volumeLighting 1031 Zoom reset 1128 1032 set _reset 0 1129 1033 } … … 1191 1095 switch -- $option { 1192 1096 "in" { 1193 set _view( -zoom) [expr {$_view(-zoom)*1.25}]1194 SendCmd "camera zoom $_view( -zoom)"1097 set _view(zoom) [expr {$_view(zoom)*1.25}] 1098 SendCmd "camera zoom $_view(zoom)" 1195 1099 } 1196 1100 "out" { 1197 set _view( -zoom) [expr {$_view(-zoom)*0.8}]1198 SendCmd "camera zoom $_view( -zoom)"1101 set _view(zoom) [expr {$_view(zoom)*0.8}] 1102 SendCmd "camera zoom $_view(zoom)" 1199 1103 } 1200 1104 "reset" { 1201 1105 array set _view { 1202 -qw 0.8535531203 -qx -0.3535531204 -qy 0.3535531205 -qz 0.1464471206 -zoom 1.01207 -xpan 01208 -ypan 01106 qw 0.853553 1107 qx -0.353553 1108 qy 0.353553 1109 qz 0.146447 1110 zoom 1.0 1111 xpan 0 1112 ypan 0 1209 1113 } 1210 1114 if { $_first != "" } { … … 1214 1118 } 1215 1119 } 1216 $_arcball quaternion [ViewToQuaternion] 1120 set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)] 1121 $_arcball quaternion $q 1217 1122 DoRotate 1218 1123 SendCmd "camera reset" … … 1222 1127 1223 1128 itcl::body Rappture::VtkVolumeViewer::PanCamera {} { 1224 set x $_view( -xpan)1225 set y $_view( -ypan)1129 set x $_view(xpan) 1130 set y $_view(ypan) 1226 1131 SendCmd "camera pan $x $y" 1227 1132 } … … 1301 1206 set x [expr $x / double($w)] 1302 1207 set y [expr $y / double($h)] 1303 set _view( -xpan) [expr $_view(-xpan) + $x]1304 set _view( -ypan) [expr $_view(-ypan) + $y]1208 set _view(xpan) [expr $_view(xpan) + $x] 1209 set _view(ypan) [expr $_view(ypan) + $y] 1305 1210 PanCamera 1306 1211 return … … 1324 1229 set _click(x) $x 1325 1230 set _click(y) $y 1326 set _view( -xpan) [expr $_view(-xpan) - $dx]1327 set _view( -ypan) [expr $_view(-ypan) - $dy]1231 set _view(xpan) [expr $_view(xpan) - $dx] 1232 set _view(ypan) [expr $_view(ypan) - $dy] 1328 1233 PanCamera 1329 1234 } … … 1347 1252 itcl::body Rappture::VtkVolumeViewer::InitSettings { args } { 1348 1253 foreach spec $args { 1349 if { [info exists _settings($_first ${spec})] } {1254 if { [info exists _settings($_first-$spec)] } { 1350 1255 # Reset global setting with dataobj specific setting 1351 set _settings($spec) $_settings($_first ${spec})1256 set _settings($spec) $_settings($_first-$spec) 1352 1257 } 1353 1258 AdjustSetting $spec … … 1364 1269 itcl::body Rappture::VtkVolumeViewer::AdjustSetting {what {value ""}} { 1365 1270 if { ![isconnected] } { 1366 if { $_reset } {1367 # Just reconnect if we've been reset.1368 Connect1369 }1370 1271 return 1371 1272 } 1372 1273 switch -- $what { 1373 "-current" { 1374 set cname [$itk_component(volcomponents) value] 1375 SwitchComponent $cname 1376 } 1377 "-background" { 1274 "background" { 1378 1275 set bgcolor [$itk_component(background) value] 1379 set _settings(${what}) $bgcolor1380 1276 array set fgcolors { 1381 1277 "black" "white" … … 1388 1284 DrawLegend 1389 1285 } 1390 " -volumeoutline" {1391 set bool $_settings($ {what})1286 "outline" { 1287 set bool $_settings($what) 1392 1288 SendCmd "outline visible 0" 1393 foreach tag [ GetDatasetsWithComponent $_current] {1289 foreach tag [CurrentDatasets -visible] { 1394 1290 SendCmd "outline visible $bool $tag" 1395 1291 } 1396 1292 } 1397 "-legendvisible" { 1398 set bool $_settings(${what}) 1399 set _settings($_current${what}) $bool 1400 if { $bool } { 1401 blt::table $itk_component(plotarea) \ 1402 1,0 $itk_component(legend) -fill x 1403 } else { 1404 blt::table forget $itk_component(legend) 1405 } 1406 } 1407 "-volumevisible" { 1408 set bool $_settings(${what}) 1409 set _settings($_current${what}) $bool 1410 # Only the data objects in the array _obj2ovride(*-raise) are 1411 # in the working set and can be displayed on screen. The global 1412 # volume control determines whether they are visible. 1413 # 1414 # Note: The use of the current component is a hold over from 1415 # nanovis. If we can't display more than one volume, 1416 # we don't have to limit the effects to a specific 1417 # component. 1418 foreach tag [GetDatasetsWithComponent $_current] { 1419 foreach {dataobj cname} [split $tag -] break 1420 if { [info exists _obj2ovride($dataobj-raise)] } { 1421 SendCmd "volume visible $bool $tag" 1422 } 1293 "legendVisible" { 1294 set bool $_settings($what) 1295 set _settings($_current-$what) $bool 1296 } 1297 "volumeVisible" { 1298 set bool $_settings($what) 1299 foreach dataset [CurrentDatasets -visible] { 1300 SendCmd "volume visible $bool $dataset" 1423 1301 } 1424 1302 if { $bool } { … … 1430 1308 } 1431 1309 } 1432 "-volumeblendmode" { 1433 set val [$itk_component(blendmode) value] 1434 set mode [$itk_component(blendmode) translate $val] 1435 set _settings(${what}) $mode 1436 set _settings($_current${what}) $mode 1437 foreach tag [GetDatasetsWithComponent $_current] { 1438 SendCmd "volume blendmode $mode $tag" 1439 } 1440 } 1441 "-volumeambient" { 1442 # Other parts of the code use the -volumeambient setting to 1443 # tell if the component settings have been initialized 1444 if { ![info exists _settings($_current${what})] } { 1445 InitComponentSettings $_current 1446 } 1447 set val $_settings(${what}) 1448 set _settings($_current${what}) $val 1449 set ambient [expr {0.01*$val}] 1450 foreach tag [GetDatasetsWithComponent $_current] { 1451 SendCmd "volume shading ambient $ambient $tag" 1452 } 1453 } 1454 "-volumediffuse" { 1455 set val $_settings(${what}) 1456 set _settings($_current${what}) $val 1310 "volume-material" { 1311 set val $_settings($what) 1457 1312 set diffuse [expr {0.01*$val}] 1458 foreach tag [GetDatasetsWithComponent $_current] { 1459 SendCmd "volume shading diffuse $diffuse $tag" 1460 } 1461 } 1462 "-volumespecularlevel" - "-volumespecularexponent" { 1463 set val $_settings(${what}) 1464 set _settings($_current${what}) $val 1465 set level [expr {0.01*$val}] 1466 set exp $_settings(${what}) 1467 foreach tag [GetDatasetsWithComponent $_current] { 1468 SendCmd "volume shading specular $level $exp $tag" 1469 } 1470 } 1471 "-volumelighting" { 1313 set specular [expr {0.01*$val}] 1314 #set power [expr {sqrt(160*$val+1.0)}] 1315 set power [expr {$val+1.0}] 1316 foreach dataset [CurrentDatasets -visible] { 1317 SendCmd "volume shading diffuse $diffuse $dataset" 1318 SendCmd "volume shading specular $specular $power $dataset" 1319 } 1320 } 1321 "volumeLighting" { 1472 1322 set bool $_settings($what) 1473 set _settings($_current{$what}) $bool 1474 foreach tag [GetDatasetsWithComponent $_current] { 1475 SendCmd "volume lighting $bool $tag" 1476 } 1477 } 1478 "-volumeopacity" { 1479 set val $_settings(${what}) 1480 set _settings($_current${what}) $val 1323 foreach dataset [CurrentDatasets -visible] { 1324 SendCmd "volume lighting $bool $dataset" 1325 } 1326 } 1327 "volume-quality" { 1328 set val $_settings($what) 1481 1329 set val [expr {0.01*$val}] 1482 foreach tag [GetDatasetsWithComponent $_current] { 1483 SendCmd "volume opacity $val $tag" 1484 } 1485 } 1486 "-volumequality" { 1487 set val $_settings(${what}) 1488 set _settings($_current${what}) $val 1489 set val [expr {0.01*$val}] 1490 foreach tag [GetDatasetsWithComponent $_current] { 1491 SendCmd "volume quality $val $tag" 1492 } 1493 } 1494 "-axesvisible" { 1495 set bool $_settings(${what}) 1330 foreach dataset [CurrentDatasets -visible] { 1331 SendCmd "volume quality $val $dataset" 1332 } 1333 } 1334 "axesVisible" { 1335 set bool $_settings($what) 1496 1336 SendCmd "axis visible all $bool" 1497 1337 } 1498 " -axislabelsvisible" {1499 set bool $_settings($ {what})1338 "axisLabels" { 1339 set bool $_settings($what) 1500 1340 SendCmd "axis labels all $bool" 1501 1341 } 1502 " -xgridvisible" - "-ygridvisible" - "-zgridvisible" {1503 set axis [string tolower [string range $what 1 1 ]]1504 set bool $_settings($ {what})1342 "axis-xgrid" - "axis-ygrid" - "axis-zgrid" { 1343 set axis [string range $what 5 5] 1344 set bool $_settings($what) 1505 1345 SendCmd "axis grid $axis $bool" 1506 1346 } 1507 " -axisflymode" {1347 "axisFlyMode" { 1508 1348 set mode [$itk_component(axismode) value] 1509 1349 set mode [$itk_component(axismode) translate $mode] 1510 set _settings($ {what}) $mode1350 set _settings($what) $mode 1511 1351 SendCmd "axis flymode $mode" 1512 1352 } 1513 " -cutplanesvisible" {1514 set bool $_settings($ {what})1353 "cutplaneEdges" { 1354 set bool $_settings($what) 1515 1355 foreach dataset [CurrentDatasets -visible] { 1516 SendCmd " $_cutplaneCmd visible$bool $dataset"1517 } 1518 } 1519 " -cutplanelighting" {1520 set bool $_settings($ {what})1356 SendCmd "cutplane edges $bool $dataset" 1357 } 1358 } 1359 "cutplaneVisible" { 1360 set bool $_settings($what) 1521 1361 foreach dataset [CurrentDatasets -visible] { 1522 if {$_cutplaneCmd != "imgcutplane"} { 1523 SendCmd "$_cutplaneCmd lighting $bool $dataset" 1524 } else { 1525 if {$bool} { 1526 set ambient 0.0 1527 set diffuse 1.0 1528 } else { 1529 set ambient 1.0 1530 set diffuse 0.0 1531 } 1532 SendCmd "imgcutplane material $ambient $diffuse $dataset" 1533 } 1534 } 1535 } 1536 "-cutplaneopacity" { 1537 set val $_settings(${what}) 1362 SendCmd "cutplane visible $bool $dataset" 1363 } 1364 } 1365 "cutplaneWireframe" { 1366 set bool $_settings($what) 1367 foreach dataset [CurrentDatasets -visible] { 1368 SendCmd "cutplane wireframe $bool $dataset" 1369 } 1370 } 1371 "cutplaneLighting" { 1372 set bool $_settings($what) 1373 foreach dataset [CurrentDatasets -visible] { 1374 SendCmd "cutplane lighting $bool $dataset" 1375 } 1376 } 1377 "cutplane-opacity" { 1378 set val $_settings($what) 1538 1379 set sval [expr { 0.01 * double($val) }] 1539 1380 foreach dataset [CurrentDatasets -visible] { 1540 SendCmd " $_cutplaneCmdopacity $sval $dataset"1541 } 1542 } 1543 " -xcutplanevisible" - "-ycutplanevisible" - "-zcutplanevisible" {1544 set axis [string tolower [string range $what 1 1]]1545 set bool $_settings($ {what})1381 SendCmd "cutplane opacity $sval $dataset" 1382 } 1383 } 1384 "cutplane-xvisible" - "cutplane-yvisible" - "cutplane-zvisible" { 1385 set axis [string range $what 9 9] 1386 set bool $_settings($what) 1546 1387 if { $bool } { 1547 1388 $itk_component(${axis}CutScale) configure -state normal \ … … 1552 1393 } 1553 1394 foreach dataset [CurrentDatasets -visible] { 1554 SendCmd " $_cutplaneCmdaxis $axis $bool $dataset"1555 } 1556 } 1557 " -xcutplaneposition" - "-ycutplaneposition" - "-zcutplaneposition" {1558 set axis [string tolower [string range $what 1 1]]1559 set pos [expr $_settings($ {what}) * 0.01]1395 SendCmd "cutplane axis $axis $bool $dataset" 1396 } 1397 } 1398 "cutplane-xposition" - "cutplane-yposition" - "cutplane-zposition" { 1399 set axis [string range $what 9 9] 1400 set pos [expr $_settings($what) * 0.01] 1560 1401 foreach dataset [CurrentDatasets -visible] { 1561 SendCmd " $_cutplaneCmdslice ${axis} ${pos} $dataset"1402 SendCmd "cutplane slice ${axis} ${pos} $dataset" 1562 1403 } 1563 1404 set _cutplanePending 0 1564 1405 } 1565 "-volumethickness" { 1566 set _settings($_current${what}) $_settings(${what}) 1567 updateTransferFunctions 1568 } 1569 "-color" { 1570 set color [$itk_component(colormap) value] 1571 set _settings(${what}) $color 1572 set _settings($_current${what}) $color 1573 ResetColormap $_current $color 1574 } 1575 "-field" { 1406 "volume-palette" { 1407 set palette [$itk_component(palette) value] 1408 set _settings($what) $palette 1409 foreach dataset [CurrentDatasets -visible $_first] { 1410 foreach {dataobj comp} [split $dataset -] break 1411 ChangeColormap $dataobj $comp $palette 1412 } 1413 set _legendPending 1 1414 } 1415 "field" { 1576 1416 set label [$itk_component(field) value] 1577 1417 set fname [$itk_component(field) translate $label] 1578 set _settings($ {what}) $fname1418 set _settings($what) $fname 1579 1419 if { [info exists _fields($fname)] } { 1580 1420 foreach { label units components } $_fields($fname) break 1581 if { !$_allowMultiComponent &&$components > 1 } {1421 if { $components > 1 } { 1582 1422 puts stderr "Can't use a vector field in a volume" 1583 1423 return 1424 } else { 1425 set _colorMode scalar 1584 1426 } 1585 1427 set _curFldName $fname … … 1590 1432 } 1591 1433 foreach dataset [CurrentDatasets -visible $_first] { 1592 SendCmd "dataset scalar $_curFldName $dataset" 1434 #SendCmd "volume colormode $_colorMode ${fname} $dataset" 1435 SendCmd "cutplane colormode $_colorMode ${fname} $dataset" 1593 1436 } 1594 1437 SendCmd "camera reset" … … 1605 1448 # 1606 1449 # Request a new legend from the server. The size of the legend 1607 # is determined from the height of the canvas. 1450 # is determined from the height of the canvas. It will be rotated 1451 # to be vertical when drawn. 1608 1452 # 1609 1453 itcl::body Rappture::VtkVolumeViewer::RequestLegend {} { 1610 set _legendPending 01611 1454 set font "Arial 8" 1612 set lineht [font metrics $ itk_option(-font)-linespace]1455 set lineht [font metrics $font -linespace] 1613 1456 set c $itk_component(legend) 1614 set w [winfo width $c] 1615 set h [winfo height $c] 1616 set h [expr {$h-$lineht-20}] 1617 set w [expr {$w-20}] 1457 set w 12 1458 set h [expr {$_height - 3 * ($lineht + 2)}] 1459 if { $h < 1} { 1460 return 1461 } 1618 1462 # Set the legend on the first volume dataset. 1619 1463 foreach dataset [CurrentDatasets -visible $_first] { … … 1621 1465 if { [info exists _dataset2style($dataset)] } { 1622 1466 SendCmdNoWait \ 1623 "legend2 $_dataset2style($dataset) $w $h" 1624 #"legend $_dataset2style($dataset) scalar $_curFldName {} $w $h 0" 1467 "legend $_dataset2style($dataset) $_colorMode $_curFldName {} $w $h 0" 1625 1468 break; 1626 1469 } 1627 1470 } 1471 } 1472 1473 # 1474 # ChangeColormap -- 1475 # 1476 itcl::body Rappture::VtkVolumeViewer::ChangeColormap {dataobj comp color} { 1477 set tag $dataobj-$comp 1478 if { ![info exist _style($tag)] } { 1479 error "no initial colormap" 1480 } 1481 array set style $_style($tag) 1482 set style(-color) $color 1483 set _style($tag) [array get style] 1484 SetColormap $dataobj $comp 1485 } 1486 1487 # 1488 # SetColormap -- 1489 # 1490 itcl::body Rappture::VtkVolumeViewer::SetColormap { dataobj comp } { 1491 array set style { 1492 -color BCGYR 1493 -levels 6 1494 -opacity 1.0 1495 } 1496 set tag $dataobj-$comp 1497 if { ![info exists _initialStyle($tag)] } { 1498 # Save the initial component style. 1499 set _initialStyle($tag) [$dataobj style $comp] 1500 } 1501 1502 # Override defaults with initial style defined in xml. 1503 array set style $_initialStyle($tag) 1504 1505 if { ![info exists _style($tag)] } { 1506 set _style($tag) [array get style] 1507 } 1508 # Override initial style with current style. 1509 array set style $_style($tag) 1510 1511 set name "$style(-color):$style(-levels):$style(-opacity)" 1512 if { ![info exists _colormaps($name)] } { 1513 BuildColormap $name [array get style] 1514 set _colormaps($name) 1 1515 } 1516 if { ![info exists _dataset2style($tag)] || 1517 $_dataset2style($tag) != $name } { 1518 SendCmd "volume colormap $name $tag" 1519 SendCmd "cutplane colormap $name-opaque $tag" 1520 set _dataset2style($tag) $name 1521 } 1522 } 1523 1524 # 1525 # BuildColormap -- 1526 # 1527 itcl::body Rappture::VtkVolumeViewer::BuildColormap { name styles } { 1528 array set style $styles 1529 set cmap [ColorsToColormap $style(-color)] 1530 if { [llength $cmap] == 0 } { 1531 set cmap "0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0" 1532 } 1533 if { ![info exists _settings(volume-opacity)] } { 1534 set _settings(volume-opacity) $style(-opacity) 1535 } 1536 set max $_settings(volume-opacity) 1537 1538 set opaqueWmap "0.0 1.0 1.0 1.0" 1539 #set wmap "0.0 0.0 0.1 0.0 0.2 0.8 0.98 0.8 0.99 0.0 1.0 0.0" 1540 # Approximate cubic opacity curve 1541 set wmap "0.0 0.0 0.1 0.001 0.2 0.008 0.3 0.027 0.4 0.064 0.5 0.125 0.6 0.216 0.7 0.343 0.8 0.512 0.9 0.729 1.0 1.0" 1542 SendCmd "colormap add $name { $cmap } { $wmap }" 1543 SendCmd "colormap add $name-opaque { $cmap } { $opaqueWmap }" 1628 1544 } 1629 1545 … … 1647 1563 set color $itk_option(-plotforeground) 1648 1564 set rgb [Color2RGB $color] 1649 1565 SendCmd "axis color all $rgb" 1650 1566 SendCmd "outline color $rgb" 1651 1567 SendCmd "cutplane color $rgb" … … 1656 1572 1657 1573 itcl::body Rappture::VtkVolumeViewer::BuildViewTab {} { 1658 1659 set fg [option get $itk_component(hull) font Font] 1660 #set bfg [option get $itk_component(hull) boldFont Font] 1574 set font [option get $itk_component(hull) font Font] 1575 #set bfont [option get $itk_component(hull) boldFont Font] 1661 1576 1662 1577 set inner [$itk_component(main) insert end \ … … 1667 1582 checkbutton $inner.axes \ 1668 1583 -text "Axes" \ 1669 -variable [itcl::scope _settings( -axesvisible)] \1670 -command [itcl::code $this AdjustSetting -axesvisible] \1584 -variable [itcl::scope _settings(axesVisible)] \ 1585 -command [itcl::code $this AdjustSetting axesVisible] \ 1671 1586 -font "Arial 9" 1672 1587 1673 1588 checkbutton $inner.outline \ 1674 1589 -text "Outline" \ 1675 -variable [itcl::scope _settings( -volumeoutline)] \1676 -command [itcl::code $this AdjustSetting -volumeoutline] \1590 -variable [itcl::scope _settings(outline)] \ 1591 -command [itcl::code $this AdjustSetting outline] \ 1677 1592 -font "Arial 9" 1678 1593 1679 1594 checkbutton $inner.legend \ 1680 1595 -text "Legend" \ 1681 -variable [itcl::scope _settings( -legendvisible)] \1682 -command [itcl::code $this AdjustSetting -legendvisible] \1596 -variable [itcl::scope _settings(legendVisible)] \ 1597 -command [itcl::code $this AdjustSetting legendVisible] \ 1683 1598 -font "Arial 9" 1684 1599 1685 1600 checkbutton $inner.volume \ 1686 1601 -text "Volume" \ 1687 -variable [itcl::scope _settings( -volumevisible)] \1688 -command [itcl::code $this AdjustSetting -volumevisible] \1602 -variable [itcl::scope _settings(volumeVisible)] \ 1603 -command [itcl::code $this AdjustSetting volumeVisible] \ 1689 1604 -font "Arial 9" 1690 1605 … … 1698 1613 "grey" "grey" 1699 1614 1700 $itk_component(background) value $_settings( -background)1615 $itk_component(background) value $_settings(background) 1701 1616 bind $inner.background <<Value>> \ 1702 [itcl::code $this AdjustSetting -background]1617 [itcl::code $this AdjustSetting background] 1703 1618 1704 1619 blt::table $inner \ … … 1723 1638 $inner configure -borderwidth 4 1724 1639 1725 label $inner.volcomponents_l -text "Component" -font $font 1726 itk_component add volcomponents { 1727 Rappture::Combobox $inner.volcomponents -editable no 1728 } 1729 bind $inner.volcomponents <<Value>> \ 1730 [itcl::code $this AdjustSetting -current] 1731 1732 checkbutton $inner.visibility \ 1733 -text "Visible" \ 1734 -font $font \ 1735 -variable [itcl::scope _settings(-volumevisible)] \ 1736 -command [itcl::code $this AdjustSetting -volumevisible] 1737 1738 label $inner.lighting_l \ 1739 -text "Lighting / Material Properties" \ 1740 -font "Arial 9 bold" 1640 checkbutton $inner.volume \ 1641 -text "Show Volume" \ 1642 -variable [itcl::scope _settings(volumeVisible)] \ 1643 -command [itcl::code $this AdjustSetting volumeVisible] \ 1644 -font "Arial 9" 1741 1645 1742 1646 checkbutton $inner.lighting \ 1743 1647 -text "Enable Lighting" \ 1744 -font $font \ 1745 -variable [itcl::scope _settings(-volumelighting)] \ 1746 -command [itcl::code $this AdjustSetting -volumelighting] 1747 1748 label $inner.ambient_l \ 1749 -text "Ambient" \ 1750 -font $font 1751 ::scale $inner.ambient -from 0 -to 100 -orient horizontal \ 1752 -variable [itcl::scope _settings(-volumeambient)] \ 1648 -variable [itcl::scope _settings(volumeLighting)] \ 1649 -command [itcl::code $this AdjustSetting volumeLighting] \ 1650 -font "Arial 9" 1651 1652 label $inner.dim_l -text "Dim" -font "Arial 9" 1653 ::scale $inner.material -from 0 -to 100 -orient horizontal \ 1654 -variable [itcl::scope _settings(volume-material)] \ 1655 -width 10 \ 1656 -showvalue off -command [itcl::code $this AdjustSetting volume-material] 1657 label $inner.bright_l -text "Bright" -font "Arial 9" 1658 1659 label $inner.opacity_l -text "Opacity" -font "Arial 9" 1660 ::scale $inner.opacity -from 0 -to 100 -orient horizontal \ 1661 -variable [itcl::scope _settings(volume-opacity)] \ 1662 -width 10 \ 1753 1663 -showvalue off \ 1754 -command [itcl::code $this AdjustSetting -volumeambient] \ 1755 -troughcolor grey92 1756 1757 label $inner.diffuse_l -text "Diffuse" -font $font 1758 ::scale $inner.diffuse -from 0 -to 100 -orient horizontal \ 1759 -variable [itcl::scope _settings(-volumediffuse)] \ 1760 -showvalue off \ 1761 -command [itcl::code $this AdjustSetting -volumediffuse] \ 1762 -troughcolor grey92 1763 1764 label $inner.specularLevel_l -text "Specular" -font $font 1765 ::scale $inner.specularLevel -from 0 -to 100 -orient horizontal \ 1766 -variable [itcl::scope _settings(-volumespecularlevel)] \ 1767 -showvalue off \ 1768 -command [itcl::code $this AdjustSetting -volumespecularlevel] \ 1769 -troughcolor grey92 1770 1771 label $inner.specularExponent_l -text "Shininess" -font $font 1772 ::scale $inner.specularExponent -from 10 -to 128 -orient horizontal \ 1773 -variable [itcl::scope _settings(-volumespecularexponent)] \ 1774 -showvalue off \ 1775 -command [itcl::code $this AdjustSetting -volumespecularexponent] \ 1776 -troughcolor grey92 1777 1778 label $inner.opacity_l -text "Opacity" -font $font 1779 ::scale $inner.opacity -from 0 -to 100 -orient horizontal \ 1780 -variable [itcl::scope _settings(-volumeopacity)] \ 1781 -showvalue off \ 1782 -command [itcl::code $this AdjustSetting -volumeopacity] \ 1783 -troughcolor grey92 1784 1785 label $inner.quality_l -text "Quality" -font $font 1664 -command [itcl::code $this AdjustSetting volume-opacity] 1665 1666 label $inner.quality_l -text "Quality" -font "Arial 9" 1786 1667 ::scale $inner.quality -from 0 -to 100 -orient horizontal \ 1787 -variable [itcl::scope _settings(-volumequality)] \ 1788 -showvalue off \ 1789 -command [itcl::code $this AdjustSetting -volumequality] \ 1790 -troughcolor grey92 1791 1792 label $inner.field_l -text "Field" -font $font 1668 -variable [itcl::scope _settings(volume-quality)] \ 1669 -width 10 \ 1670 -showvalue off -command [itcl::code $this AdjustSetting volume-quality] 1671 1672 itk_component add field_l { 1673 label $inner.field_l -text "Field" -font "Arial 9" 1674 } { 1675 ignore -font 1676 } 1793 1677 itk_component add field { 1794 Rappture::Combobox $inner.field - editable no1678 Rappture::Combobox $inner.field -width 10 -editable no 1795 1679 } 1796 1680 bind $inner.field <<Value>> \ 1797 [itcl::code $this AdjustSetting -field] 1798 1799 label $inner.transferfunction_l \ 1800 -text "Transfer Function" -font "Arial 9 bold" 1801 1802 label $inner.thin -text "Thin" -font $font 1803 ::scale $inner.thickness -from 0 -to 1000 -orient horizontal \ 1804 -variable [itcl::scope _settings(-volumethickness)] \ 1805 -showvalue off \ 1806 -command [itcl::code $this AdjustSetting -volumethickness] \ 1807 -troughcolor grey92 1808 1809 label $inner.thick -text "Thick" -font $font 1810 $inner.thickness set $_settings(-volumethickness) 1811 1812 label $inner.colormap_l -text "Colormap" -font $font 1813 itk_component add colormap { 1814 Rappture::Combobox $inner.colormap -width 10 -editable no 1815 } 1816 $inner.colormap choices insert end [GetColormapList -includeDefault] 1817 1818 bind $inner.colormap <<Value>> \ 1819 [itcl::code $this AdjustSetting -color] 1820 $itk_component(colormap) value "default" 1821 set _settings(-color) "default" 1822 1823 label $inner.blendmode_l -text "Blend Mode" -font $font 1824 itk_component add blendmode { 1825 Rappture::Combobox $inner.blendmode -editable no 1826 } 1827 $inner.blendmode choices insert end \ 1828 "composite" "Composite" \ 1829 "max_intensity" "Maximum Intensity" \ 1830 "additive" "Additive" 1831 1832 $itk_component(blendmode) value \ 1833 "[$itk_component(blendmode) label $_settings(-volumeblendmode)]" 1834 bind $inner.blendmode <<Value>> \ 1835 [itcl::code $this AdjustSetting -volumeblendmode] 1681 [itcl::code $this AdjustSetting field] 1682 1683 label $inner.palette_l -text "Palette" -font "Arial 9" 1684 itk_component add palette { 1685 Rappture::Combobox $inner.palette -width 10 -editable no 1686 } 1687 1688 $inner.palette choices insert end [GetColormapList] 1689 $itk_component(palette) value "BCGYR" 1690 bind $inner.palette <<Value>> \ 1691 [itcl::code $this AdjustSetting volume-palette] 1836 1692 1837 1693 blt::table $inner \ 1838 0,0 $inner.volcomponents_l -anchor e -cspan 2 \ 1839 0,2 $inner.volcomponents -cspan 3 -fill x \ 1840 1,0 $inner.field_l -anchor e -cspan 2 \ 1841 1,2 $inner.field -cspan 3 -fill x \ 1842 2,0 $inner.lighting_l -anchor w -cspan 4 \ 1843 3,1 $inner.lighting -anchor w -cspan 3 \ 1844 4,1 $inner.ambient_l -anchor e -pady 2 \ 1845 4,2 $inner.ambient -cspan 3 -fill x \ 1846 5,1 $inner.diffuse_l -anchor e -pady 2 \ 1847 5,2 $inner.diffuse -cspan 3 -fill x \ 1848 6,1 $inner.specularLevel_l -anchor e -pady 2 \ 1849 6,2 $inner.specularLevel -cspan 3 -fill x \ 1850 7,1 $inner.specularExponent_l -anchor e -pady 2 \ 1851 7,2 $inner.specularExponent -cspan 3 -fill x \ 1852 8,1 $inner.visibility -anchor w -cspan 3 \ 1853 9,1 $inner.quality_l -anchor e -pady 2 \ 1854 9,2 $inner.quality -cspan 3 -fill x \ 1855 10,0 $inner.transferfunction_l -anchor w -cspan 4 \ 1856 11,1 $inner.opacity_l -anchor e -pady 2 \ 1857 11,2 $inner.opacity -cspan 3 -fill x \ 1858 12,1 $inner.colormap_l -anchor e \ 1859 12,2 $inner.colormap -padx 2 -cspan 3 -fill x \ 1860 13,1 $inner.blendmode_l -anchor e \ 1861 13,2 $inner.blendmode -padx 2 -cspan 3 -fill x \ 1862 14,1 $inner.thin -anchor e \ 1863 14,2 $inner.thickness -cspan 2 -fill x \ 1864 14,4 $inner.thick -anchor w 1694 0,0 $inner.field_l -anchor w -pady 2 \ 1695 0,1 $inner.field -anchor w -pady 2 -cspan 2 \ 1696 1,0 $inner.volume -anchor w -pady 2 -cspan 4 \ 1697 2,0 $inner.lighting -anchor w -pady 2 -cspan 4 \ 1698 3,0 $inner.dim_l -anchor e -pady 2 \ 1699 3,1 $inner.material -fill x -pady 2 \ 1700 3,2 $inner.bright_l -anchor w -pady 2 \ 1701 4,0 $inner.quality_l -anchor w -pady 2 -cspan 2 \ 1702 5,0 $inner.quality -fill x -pady 2 -cspan 2 \ 1703 7,0 $inner.palette_l -anchor w -pady 2 \ 1704 7,1 $inner.palette -anchor w -pady 2 -cspan 2 \ 1865 1705 1866 1706 blt::table configure $inner r* c* -resize none 1867 blt::table configure $inner r* -pady { 2 0 } 1868 blt::table configure $inner c2 c3 r15 -resize expand 1869 blt::table configure $inner c0 -width .1i 1707 blt::table configure $inner r8 -resize expand 1870 1708 } 1871 1709 1872 1710 itcl::body Rappture::VtkVolumeViewer::BuildAxisTab {} { 1873 1874 set fg [option get $itk_component(hull) font Font] 1875 #set bfg [option get $itk_component(hull) boldFont Font] 1711 set font [option get $itk_component(hull) font Font] 1712 #set bfont [option get $itk_component(hull) boldFont Font] 1876 1713 1877 1714 set inner [$itk_component(main) insert end \ … … 1882 1719 checkbutton $inner.visible \ 1883 1720 -text "Show Axes" \ 1884 -variable [itcl::scope _settings( -axesvisible)] \1885 -command [itcl::code $this AdjustSetting -axesvisible] \1721 -variable [itcl::scope _settings(axesVisible)] \ 1722 -command [itcl::code $this AdjustSetting axesVisible] \ 1886 1723 -font "Arial 9" 1887 1724 1888 1725 checkbutton $inner.labels \ 1889 1726 -text "Show Axis Labels" \ 1890 -variable [itcl::scope _settings( -axislabelsvisible)] \1891 -command [itcl::code $this AdjustSetting -axislabelsvisible] \1727 -variable [itcl::scope _settings(axisLabels)] \ 1728 -command [itcl::code $this AdjustSetting axisLabels] \ 1892 1729 -font "Arial 9" 1893 1730 1894 1731 checkbutton $inner.gridx \ 1895 1732 -text "Show X Grid" \ 1896 -variable [itcl::scope _settings( -xgridvisible)] \1897 -command [itcl::code $this AdjustSetting -xgridvisible] \1733 -variable [itcl::scope _settings(axis-xgrid)] \ 1734 -command [itcl::code $this AdjustSetting axis-xgrid] \ 1898 1735 -font "Arial 9" 1899 1736 checkbutton $inner.gridy \ 1900 1737 -text "Show Y Grid" \ 1901 -variable [itcl::scope _settings( -ygridvisible)] \1902 -command [itcl::code $this AdjustSetting -ygridvisible] \1738 -variable [itcl::scope _settings(axis-ygrid)] \ 1739 -command [itcl::code $this AdjustSetting axis-ygrid] \ 1903 1740 -font "Arial 9" 1904 1741 checkbutton $inner.gridz \ 1905 1742 -text "Show Z Grid" \ 1906 -variable [itcl::scope _settings( -zgridvisible)] \1907 -command [itcl::code $this AdjustSetting -zgridvisible] \1743 -variable [itcl::scope _settings(axis-zgrid)] \ 1744 -command [itcl::code $this AdjustSetting axis-zgrid] \ 1908 1745 -font "Arial 9" 1909 1746 … … 1919 1756 "outer_edges" "outer" 1920 1757 $itk_component(axismode) value "static" 1921 bind $inner.mode <<Value>> [itcl::code $this AdjustSetting -axisflymode]1758 bind $inner.mode <<Value>> [itcl::code $this AdjustSetting axisFlyMode] 1922 1759 1923 1760 blt::table $inner \ … … 1934 1771 } 1935 1772 1936 1937 1773 itcl::body Rappture::VtkVolumeViewer::BuildCameraTab {} { 1938 1774 set inner [$itk_component(main) insert end \ … … 1941 1777 $inner configure -borderwidth 4 1942 1778 1943 label $inner.view_l -text "view" -font "Arial 9"1944 set f [frame $inner.view]1945 foreach side { front back left right top bottom } {1946 button $f.$side -image [Rappture::icon view$side] \1947 -command [itcl::code $this SetOrientation $side]1948 Rappture::Tooltip::for $f.$side "Change the view to $side"1949 pack $f.$side -side left1950 }1951 blt::table $inner \1952 0,0 $inner.view_l -anchor e -pady 2 \1953 0,1 $inner.view -anchor w -pady 21954 1955 set row 11956 1779 set labels { qx qy qz qw xpan ypan zoom } 1780 set row 0 1957 1781 foreach tag $labels { 1958 label $inner.${tag} -label -text $tag -font "Arial 9"1782 label $inner.${tag}label -text $tag -font "Arial 9" 1959 1783 entry $inner.${tag} -font "Arial 9" -bg white \ 1960 -textvariable [itcl::scope _view(-$tag)] 1961 bind $inner.${tag} <Return> \ 1962 [itcl::code $this camera set -${tag}] 1963 bind $inner.${tag} <KP_Enter> \ 1964 [itcl::code $this camera set -${tag}] 1784 -textvariable [itcl::scope _view($tag)] 1785 bind $inner.${tag} <KeyPress-Return> \ 1786 [itcl::code $this camera set ${tag}] 1965 1787 blt::table $inner \ 1966 $row,0 $inner.${tag} -label -anchor e -pady 2 \1788 $row,0 $inner.${tag}label -anchor e -pady 2 \ 1967 1789 $row,1 $inner.${tag} -anchor w -pady 2 1968 1790 blt::table configure $inner r$row -resize none … … 1971 1793 checkbutton $inner.ortho \ 1972 1794 -text "Orthographic Projection" \ 1973 -variable [itcl::scope _view( -ortho)] \1974 -command [itcl::code $this camera set -ortho] \1795 -variable [itcl::scope _view(ortho)] \ 1796 -command [itcl::code $this camera set ortho] \ 1975 1797 -font "Arial 9" 1976 1798 blt::table $inner \ … … 1979 1801 incr row 1980 1802 1981 blt::table configure $inner r*c0 c1 -resize none1803 blt::table configure $inner c0 c1 -resize none 1982 1804 blt::table configure $inner c2 -resize expand 1983 1805 blt::table configure $inner r$row -resize expand … … 1985 1807 1986 1808 itcl::body Rappture::VtkVolumeViewer::BuildCutplaneTab {} { 1987 1988 set fg [option get $itk_component(hull) font Font] 1809 set font [option get $itk_component(hull) font Font] 1989 1810 1990 1811 set inner [$itk_component(main) insert end \ … … 1996 1817 checkbutton $inner.visible \ 1997 1818 -text "Show Cutplanes" \ 1998 -variable [itcl::scope _settings(-cutplanesvisible)] \ 1999 -command [itcl::code $this AdjustSetting -cutplanesvisible] \ 1819 -variable [itcl::scope _settings(cutplaneVisible)] \ 1820 -command [itcl::code $this AdjustSetting cutplaneVisible] \ 1821 -font "Arial 9" 1822 1823 checkbutton $inner.wireframe \ 1824 -text "Show Wireframe" \ 1825 -variable [itcl::scope _settings(cutplaneWireframe)] \ 1826 -command [itcl::code $this AdjustSetting cutplaneWireframe] \ 2000 1827 -font "Arial 9" 2001 1828 2002 1829 checkbutton $inner.lighting \ 2003 1830 -text "Enable Lighting" \ 2004 -variable [itcl::scope _settings(-cutplanelighting)] \ 2005 -command [itcl::code $this AdjustSetting -cutplanelighting] \ 1831 -variable [itcl::scope _settings(cutplaneLighting)] \ 1832 -command [itcl::code $this AdjustSetting cutplaneLighting] \ 1833 -font "Arial 9" 1834 1835 checkbutton $inner.edges \ 1836 -text "Show Edges" \ 1837 -variable [itcl::scope _settings(cutplaneEdges)] \ 1838 -command [itcl::code $this AdjustSetting cutplaneEdges] \ 2006 1839 -font "Arial 9" 2007 1840 2008 1841 label $inner.opacity_l -text "Opacity" -font "Arial 9" 2009 1842 ::scale $inner.opacity -from 0 -to 100 -orient horizontal \ 2010 -variable [itcl::scope _settings( -cutplaneopacity)] \1843 -variable [itcl::scope _settings(cutplane-opacity)] \ 2011 1844 -width 10 \ 2012 1845 -showvalue off \ 2013 -command [itcl::code $this AdjustSetting -cutplaneopacity]2014 $inner.opacity set $_settings( -cutplaneopacity)1846 -command [itcl::code $this AdjustSetting cutplane-opacity] 1847 $inner.opacity set $_settings(cutplane-opacity) 2015 1848 2016 1849 # X-value slicer... … … 2019 1852 -onimage [Rappture::icon x-cutplane] \ 2020 1853 -offimage [Rappture::icon x-cutplane] \ 2021 -command [itcl::code $this AdjustSetting -xcutplanevisible] \2022 -variable [itcl::scope _settings( -xcutplanevisible)]1854 -command [itcl::code $this AdjustSetting cutplane-xvisible] \ 1855 -variable [itcl::scope _settings(cutplane-xvisible)] 2023 1856 } 2024 1857 Rappture::Tooltip::for $itk_component(xCutButton) \ … … 2031 1864 -borderwidth 1 -highlightthickness 0 \ 2032 1865 -command [itcl::code $this EventuallySetCutplane x] \ 2033 -variable [itcl::scope _settings( -xcutplaneposition)]1866 -variable [itcl::scope _settings(cutplane-xposition)] 2034 1867 } { 2035 1868 usual … … 2047 1880 -onimage [Rappture::icon y-cutplane] \ 2048 1881 -offimage [Rappture::icon y-cutplane] \ 2049 -command [itcl::code $this AdjustSetting -ycutplanevisible] \2050 -variable [itcl::scope _settings( -ycutplanevisible)]1882 -command [itcl::code $this AdjustSetting cutplane-yvisible] \ 1883 -variable [itcl::scope _settings(cutplane-yvisible)] 2051 1884 } 2052 1885 Rappture::Tooltip::for $itk_component(yCutButton) \ … … 2059 1892 -borderwidth 1 -highlightthickness 0 \ 2060 1893 -command [itcl::code $this EventuallySetCutplane y] \ 2061 -variable [itcl::scope _settings( -ycutplaneposition)]1894 -variable [itcl::scope _settings(cutplane-yposition)] 2062 1895 } { 2063 1896 usual … … 2075 1908 -onimage [Rappture::icon z-cutplane] \ 2076 1909 -offimage [Rappture::icon z-cutplane] \ 2077 -command [itcl::code $this AdjustSetting -zcutplanevisible] \2078 -variable [itcl::scope _settings( -zcutplanevisible)]1910 -command [itcl::code $this AdjustSetting cutplane-zvisible] \ 1911 -variable [itcl::scope _settings(cutplane-zvisible)] 2079 1912 } 2080 1913 Rappture::Tooltip::for $itk_component(zCutButton) \ … … 2087 1920 -borderwidth 1 -highlightthickness 0 \ 2088 1921 -command [itcl::code $this EventuallySetCutplane z] \ 2089 -variable [itcl::scope _settings( -zcutplaneposition)]1922 -variable [itcl::scope _settings(cutplane-zposition)] 2090 1923 } { 2091 1924 usual … … 2100 1933 0,0 $inner.visible -anchor w -pady 2 -cspan 4 \ 2101 1934 1,0 $inner.lighting -anchor w -pady 2 -cspan 4 \ 2102 2,0 $inner.opacity_l -anchor w -pady 2 -cspan 3 \ 2103 3,0 $inner.opacity -fill x -pady 2 -cspan 3 \ 2104 4,0 $itk_component(xCutButton) -anchor e -padx 2 -pady 2 \ 2105 5,0 $itk_component(xCutScale) -fill y \ 2106 4,1 $itk_component(yCutButton) -anchor e -padx 2 -pady 2 \ 2107 5,1 $itk_component(yCutScale) -fill y \ 2108 4,2 $itk_component(zCutButton) -anchor e -padx 2 -pady 2 \ 2109 5,2 $itk_component(zCutScale) -fill y \ 1935 2,0 $inner.wireframe -anchor w -pady 2 -cspan 4 \ 1936 3,0 $inner.edges -anchor w -pady 2 -cspan 4 \ 1937 4,0 $inner.opacity_l -anchor w -pady 2 -cspan 3 \ 1938 5,0 $inner.opacity -fill x -pady 2 -cspan 3 \ 1939 6,0 $itk_component(xCutButton) -anchor e -padx 2 -pady 2 \ 1940 7,0 $itk_component(xCutScale) -fill y \ 1941 6,1 $itk_component(yCutButton) -anchor e -padx 2 -pady 2 \ 1942 7,1 $itk_component(yCutScale) -fill y \ 1943 6,2 $itk_component(zCutButton) -anchor e -padx 2 -pady 2 \ 1944 7,2 $itk_component(zCutScale) -fill y \ 2110 1945 2111 1946 blt::table configure $inner r* c* -resize none 2112 blt::table configure $inner r 5c3 -resize expand1947 blt::table configure $inner r7 c3 -resize expand 2113 1948 } 2114 1949 … … 2129 1964 } 2130 1965 switch -- $who { 2131 " -ortho" {2132 if {$_view( -ortho)} {1966 "ortho" { 1967 if {$_view(ortho)} { 2133 1968 SendCmd "camera mode ortho" 2134 1969 } else { … … 2136 1971 } 2137 1972 } 2138 " -xpan" - "-ypan" {1973 "xpan" - "ypan" { 2139 1974 PanCamera 2140 1975 } 2141 " -qx" - "-qy" - "-qz" - "-qw" {2142 set q [ ViewToQuaternion]1976 "qx" - "qy" - "qz" - "qw" { 1977 set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)] 2143 1978 $_arcball quaternion $q 2144 1979 EventuallyRotate $q 2145 1980 } 2146 " -zoom" {2147 SendCmd "camera zoom $_view( -zoom)"1981 "zoom" { 1982 SendCmd "camera zoom $_view(zoom)" 2148 1983 } 2149 1984 } … … 2215 2050 } 2216 2051 2217 itcl::body Rappture::VtkVolumeViewer::SetObjectStyle { dataobj c name} {2052 itcl::body Rappture::VtkVolumeViewer::SetObjectStyle { dataobj comp } { 2218 2053 # Parse style string. 2219 set tag $dataobj-$cname 2220 array set styles { 2221 -color BCGYR 2222 -volumelighting 1 2223 -volumeoutline 0 2224 -volumevisible 1 2225 } 2226 array set styles [$dataobj style $cname] 2054 set tag $dataobj-$comp 2055 set style [$dataobj style $comp] 2056 array set settings { 2057 -color \#808080 2058 -edges 0 2059 -edgecolor black 2060 -linewidth 1.0 2061 -opacity 0.4 2062 -wireframe 0 2063 -lighting 1 2064 -seeds 1 2065 -seedcolor white 2066 -visible 1 2067 } 2068 if { $dataobj != $_first } { 2069 set settings(-opacity) 1 2070 } 2071 array set settings $style 2227 2072 SendCmd "volume add $tag" 2228 set _settings($cname-volumelighting) $styles(-volumelighting) 2229 set _settings($cname-volumeoutline) $styles(-volumeoutline) 2230 set _settings($cname-volumevisible) $styles(-volumevisible) 2231 2232 $itk_component(colormap) value $styles(-color) 2233 2234 SendCmd "$_cutplaneCmd add $tag" 2235 SendCmd "$_cutplaneCmd visible 0 $tag" 2236 SendCmd "volume lighting $styles(-volumelighting) $tag" 2237 SetInitialTransferFunction $dataobj $cname 2238 SendCmd "volume colormap $cname $tag" 2239 SendCmd "$_cutplaneCmd colormap $cname-opaque $tag" 2073 SendCmd "cutplane add $tag" 2074 SendCmd "cutplane visible 0 $tag" 2075 2076 SendCmd "volume lighting $settings(-lighting) $tag" 2077 set _settings(volumeLighting) $settings(-lighting) 2078 SetColormap $dataobj $comp 2240 2079 SendCmd "outline add $tag" 2241 SendCmd "outline visible $styles(-volumeoutline)$tag"2080 SendCmd "outline visible 0 $tag" 2242 2081 } 2243 2082 … … 2257 2096 # ---------------------------------------------------------------------- 2258 2097 itcl::body Rappture::VtkVolumeViewer::ReceiveLegend { colormap title vmin vmax size } { 2259 if { [isconnected] } { 2098 set _legendPending 0 2099 #puts stderr "ReceiveLegend colormap=$colormap title=$title range=$vmin,$vmax size=$size" 2100 if { [IsConnected] } { 2260 2101 set bytes [ReceiveBytes $size] 2261 2102 if { ![info exists _image(legend)] } { … … 2273 2114 # DrawLegend -- 2274 2115 # 2275 itcl::body Rappture::VtkVolumeViewer::DrawLegend {} {2276 if { $_current == "" } {2277 set _current "component"2278 }2279 set cname $_current2280 set c $itk_component(legend)2281 set w [winfo width $c]2282 set h [winfo height $c]2283 set lx 102284 set ly [expr {$h - 1}]2285 if {"" == [$c find withtag colorbar]} {2286 $c create image 10 10 -anchor nw \2287 -image $_image(legend) -tags colorbar2288 $c create text $lx $ly -anchor sw \2289 -fill $itk_option(-plotforeground) -tags "limits text vmin"2290 $c create text [expr {$w-$lx}] $ly -anchor se \2291 -fill $itk_option(-plotforeground) -tags "limits text vmax"2292 $c create text [expr {$w/2}] $ly -anchor s \2293 -fill $itk_option(-plotforeground) -tags "limits text title"2294 $c lower colorbar2295 $c bind colorbar <ButtonRelease-1> [itcl::code $this AddNewMarker %x %y]2296 }2297 2298 # Display the markers used by the current transfer function.2299 HideAllMarkers2300 if { [info exists _transferFunctionEditors($cname)] } {2301 $_transferFunctionEditors($cname) showMarkers $_limits($cname)2302 }2303 2304 foreach {min max} $_limits($cname) break2305 $c itemconfigure vmin -text [format %.2g $min]2306 $c coords vmin $lx $ly2307 2308 $c itemconfigure vmax -text [format %.2g $max]2309 $c coords vmax [expr {$w-$lx}] $ly2310 2311 set title ""2312 if { $_first != "" } {2313 set title [$_first hints label]2314 set units [$_first hints units]2315 if { $units != "" } {2316 set title "$title ($units)"2317 }2318 }2319 $c itemconfigure title -text $title2320 $c coords title [expr {$w/2}] $ly2321 }2322 2323 #2324 # DrawLegendOld --2325 #2326 2116 # Draws the legend in it's own canvas which resides to the right 2327 2117 # of the contour plot area. 2328 2118 # 2329 itcl::body Rappture::VtkVolumeViewer::DrawLegend Old{ } {2119 itcl::body Rappture::VtkVolumeViewer::DrawLegend { } { 2330 2120 set fname $_curFldName 2331 2121 set c $itk_component(view) … … 2343 2133 set title $fname 2344 2134 } 2345 if { $_settings( -legendvisible) } {2135 if { $_settings(legendVisible) } { 2346 2136 set x [expr $w - 2] 2347 2137 if { [$c find withtag "legend"] == "" } { … … 2531 2321 } 2532 2322 2533 #2534 # The -levels option takes a single value that represents the number2535 # of evenly distributed markers based on the current data range. Each2536 # marker is a relative value from 0.0 to 1.0.2537 #2538 itcl::body Rappture::VtkVolumeViewer::ParseLevelsOption { cname levels } {2539 set c $itk_component(legend)2540 set list {}2541 regsub -all "," $levels " " levels2542 if {[string is int $levels]} {2543 for {set i 1} { $i <= $levels } {incr i} {2544 lappend list [expr {double($i)/($levels+1)}]2545 }2546 } else {2547 foreach x $levels {2548 lappend list $x2549 }2550 }2551 set _parsedFunction($cname) 12552 $_transferFunctionEditors($cname) addMarkers $list2553 }2554 2555 #2556 # The -markers option takes a list of zero or more values (the values2557 # may be separated either by spaces or commas) that have the following2558 # format:2559 #2560 # N% Percent of current total data range. Converted to2561 # to a relative value between 0.0 and 1.0.2562 # N Absolute value of marker. If the marker is outside of2563 # the current range, it will be displayed on the outer2564 # edge of the legends, but it range it represents will2565 # not be seen.2566 #2567 itcl::body Rappture::VtkVolumeViewer::ParseMarkersOption { cname markers } {2568 set c $itk_component(legend)2569 set list {}2570 foreach { min max } $_limits($cname) break2571 regsub -all "," $markers " " markers2572 foreach marker $markers {2573 set n [scan $marker "%g%s" value suffix]2574 if { $n == 2 && $suffix == "%" } {2575 # $n% : Set relative value (0..1).2576 lappend list [expr {$value * 0.01}]2577 } else {2578 # $n : absolute value, compute relative2579 lappend list [expr {(double($value)-$min)/($max-$min)]}2580 }2581 }2582 set _parsedFunction($cname) 12583 $_transferFunctionEditors($cname) addMarkers $list2584 }2585 2586 #2587 # SetInitialTransferFunction --2588 #2589 # Creates a transfer function name based on the <style> settings in the2590 # library run.xml file. This placeholder will be used later to create2591 # and send the actual transfer function once the data info has been sent2592 # to us by the render server. [We won't know the volume limits until the2593 # server parses the 3D data and sends back the limits via ReceiveData.]2594 #2595 itcl::body Rappture::VtkVolumeViewer::SetInitialTransferFunction { dataobj cname } {2596 set tag $dataobj-$cname2597 if { ![info exists _cname2transferFunction($cname)] } {2598 ComputeTransferFunction $cname2599 }2600 set _dataset2style($tag) $cname2601 lappend _style2datasets($cname) $tag2602 2603 return $cname2604 }2605 2606 #2607 # ComputeTransferFunction --2608 #2609 # Computes and sends the transfer function to the render server. It's2610 # assumed that the volume data limits are known and that the global2611 # transfer-functions slider values have been set up. Both parts are2612 # needed to compute the relative value (location) of the marker, and2613 # the alpha map of the transfer function.2614 #2615 itcl::body Rappture::VtkVolumeViewer::ComputeTransferFunction { cname } {2616 2617 if { ![info exists _transferFunctionEditors($cname)] } {2618 set _transferFunctionEditors($cname) \2619 [Rappture::TransferFunctionEditor ::\#auto $itk_component(legend) \2620 $cname \2621 -command [itcl::code $this updateTransferFunctions]]2622 }2623 2624 # We have to parse the style attributes for a volume using this2625 # transfer-function *once*. This sets up the initial isomarkers for the2626 # transfer function. The user may add/delete markers, so we have to2627 # maintain a list of markers for each transfer-function. We use the one2628 # of the volumes (the first in the list) using the transfer-function as a2629 # reference.2630 2631 if { ![info exists _parsedFunction($cname)] || ![info exists _cname2transferFunction($cname)] } {2632 array set styles {2633 -color BCGYR2634 -levels 62635 -markers ""2636 }2637 # Accumulate the style from all the datasets using it.2638 foreach tag [GetDatasetsWithComponent $cname] {2639 foreach {dataobj cname} [split [lindex $tag 0] -] break2640 set option [lindex [$dataobj components -style $cname] 0]2641 array set styles $option2642 }2643 set _settings($cname-color) $styles(-color)2644 set cmap [ColorsToColormap $styles(-color)]2645 set _cname2defaultcolormap($cname) $cmap2646 if { [info exists _transferFunctionEditors($cname)] } {2647 eval $_transferFunctionEditors($cname) limits $_limits($cname)2648 }2649 if { [info exists styles(-markers)] &&2650 [llength $styles(-markers)] > 0 } {2651 ParseMarkersOption $cname $styles(-markers)2652 } else {2653 ParseLevelsOption $cname $styles(-levels)2654 }2655 } else {2656 foreach {cmap amap} $_cname2transferFunction($cname) break2657 }2658 2659 set amap [ComputeAlphamap $cname]2660 set opaqueAmap "0.0 1.0 1.0 1.0"2661 set _cname2transferFunction($cname) [list $cmap $amap]2662 SendCmd [list colormap add $cname $cmap $amap]2663 SendCmd [list colormap add $cname-opaque $cmap $opaqueAmap]2664 }2665 2666 #2667 # ResetColormap --2668 #2669 # Changes only the colormap portion of the transfer function.2670 #2671 itcl::body Rappture::VtkVolumeViewer::ResetColormap { cname color } {2672 # Get the current transfer function2673 if { ![info exists _cname2transferFunction($cname)] } {2674 return2675 }2676 foreach { cmap amap } $_cname2transferFunction($cname) break2677 set cmap [GetColormap $cname $color]2678 set _cname2transferFunction($cname) [list $cmap $amap]2679 set opaqueAmap "0.0 1.0 1.0 1.0"2680 SendCmd [list colormap add $cname $cmap $amap]2681 SendCmd [list colormap add $cname-opaque $cmap $opaqueAmap]2682 EventuallyRequestLegend2683 }2684 2685 # ----------------------------------------------------------------------2686 # USAGE: updateTransferFunctions2687 #2688 # This is called by the transfer function editor whenever the2689 # transfer function definition changes.2690 #2691 # ----------------------------------------------------------------------2692 itcl::body Rappture::VtkVolumeViewer::updateTransferFunctions {} {2693 foreach cname [array names _volcomponents] {2694 ComputeTransferFunction $cname2695 }2696 EventuallyRequestLegend2697 }2698 2699 itcl::body Rappture::VtkVolumeViewer::AddNewMarker { x y } {2700 if { ![info exists _transferFunctionEditors($_current)] } {2701 continue2702 }2703 # Add a new marker to the current transfer function2704 $_transferFunctionEditors($_current) newMarker $x $y normal2705 }2706 2707 itcl::body Rappture::VtkVolumeViewer::RemoveMarker { x y } {2708 if { ![info exists _transferFunctionEditors($_current)] } {2709 continue2710 }2711 # Add a new marker to the current transfer function2712 $_transferFunctionEditors($_current) deleteMarker $x $y2713 }2714 2715 itcl::body Rappture::VtkVolumeViewer::SetOrientation { side } {2716 array set positions {2717 front "1 0 0 0"2718 back "0 0 1 0"2719 left "0.707107 0 -0.707107 0"2720 right "0.707107 0 0.707107 0"2721 top "0.707107 -0.707107 0 0"2722 bottom "0.707107 0.707107 0 0"2723 }2724 foreach name { -qw -qx -qy -qz } value $positions($side) {2725 set _view($name) $value2726 }2727 set q [ViewToQuaternion]2728 $_arcball quaternion $q2729 SendCmd "camera orient $q"2730 SendCmd "camera reset"2731 set _view(-xpan) 02732 set _view(-ypan) 02733 set _view(-zoom) 1.02734 }2735 2736 #2737 # InitComponentSettings --2738 #2739 # Initializes the volume settings for a specific component. This2740 # should match what's used as global settings above. This2741 # is called the first time we try to switch to a given component2742 # in SwitchComponent below.2743 #2744 itcl::body Rappture::VtkVolumeViewer::InitComponentSettings { cname } {2745 array set _settings [subst {2746 $cname-color default2747 $cname-volumeambient 402748 $cname-volumeblendmode composite2749 $cname-volumediffuse 602750 $cname-volumelight2side 12751 $cname-volumelighting 12752 $cname-volumeopacity 502753 $cname-volumeoutline 02754 $cname-volumequality 802755 $cname-volumespecularexponent 902756 $cname-volumespecularlevel 302757 $cname-volumethickness 3502758 $cname-volumevisible 12759 }]2760 }2761 2762 #2763 # SwitchComponent --2764 #2765 # This is called when the current component is changed by the2766 # dropdown menu in the volume tab. It synchronizes the global2767 # volume settings with the settings of the new current component.2768 #2769 itcl::body Rappture::VtkVolumeViewer::SwitchComponent { cname } {2770 if { ![info exists _settings(${cname}-volumeambient)] } {2771 InitComponentSettings $cname2772 }2773 # _settings variables change widgets, except for colormap2774 foreach name {2775 -volumeambient2776 -volumeblendmode2777 -volumediffuse2778 -volumelight2side2779 -volumelighting2780 -volumeopacity2781 -volumeoutline2782 -volumequality2783 -volumespecularexponent2784 -volumespecularlevel2785 -volumethickness2786 -volumevisible2787 } {2788 set _settings($name) $_settings(${cname}${name})2789 }2790 $itk_component(colormap) value $_settings($cname-color)2791 set _current $cname; # Reset the current component2792 }2793 2794 itcl::body Rappture::VtkVolumeViewer::ComputeAlphamap { cname } {2795 if { ![info exists _transferFunctionEditors($cname)] } {2796 return [list 0.0 0.0 1.0 1.0]2797 }2798 if { ![info exists _settings($cname-volumeambient)] } {2799 InitComponentSettings $cname2800 }2801 2802 set isovalues [$_transferFunctionEditors($cname) values]2803 2804 # Currently using volume opacity to scale opacity in2805 # the volume shader. The transfer function always sets full2806 # opacity2807 set max 1.0;2808 2809 # Use the component-wise thickness setting from the slider2810 # settings widget2811 # Scale values between 0.00001 and 0.010002812 set delta [expr {double($_settings($cname-volumethickness)) * 0.0001}]2813 set first [lindex $isovalues 0]2814 set last [lindex $isovalues end]2815 set amap ""2816 if { $first == "" || $first != 0.0 } {2817 lappend amap 0.0 0.02818 }2819 foreach x $isovalues {2820 set x1 [expr {$x-$delta-0.00001}]2821 set x2 [expr {$x-$delta}]2822 set x3 [expr {$x+$delta}]2823 set x4 [expr {$x+$delta+0.00001}]2824 if { $x1 < 0.0 } {2825 set x1 0.02826 } elseif { $x1 > 1.0 } {2827 set x1 1.02828 }2829 if { $x2 < 0.0 } {2830 set x2 0.02831 } elseif { $x2 > 1.0 } {2832 set x2 1.02833 }2834 if { $x3 < 0.0 } {2835 set x3 0.02836 } elseif { $x3 > 1.0 } {2837 set x3 1.02838 }2839 if { $x4 < 0.0 } {2840 set x4 0.02841 } elseif { $x4 > 1.0 } {2842 set x4 1.02843 }2844 # add spikes in the middle2845 lappend amap $x1 0.02846 lappend amap $x2 $max2847 lappend amap $x3 $max2848 lappend amap $x4 0.02849 }2850 if { $last == "" || $last != 1.0 } {2851 lappend amap 1.0 0.02852 }2853 return $amap2854 }2855 2856 #2857 # HideAllMarkers --2858 #2859 # Hide all the markers in all the transfer functions. Can't simply2860 # delete and recreate markers from the <style> since the user may2861 # have create, deleted, or moved markers.2862 #2863 itcl::body Rappture::VtkVolumeViewer::HideAllMarkers {} {2864 foreach cname [array names _transferFunctionEditors] {2865 $_transferFunctionEditors($cname) hideMarkers2866 }2867 }2868 2869 2870 #2871 # GetDatasetsWithComponents --2872 #2873 # Returns a list of all the datasets (known by the combination of2874 # their data object and component name) that match the given2875 # component name. For example, this is used where we want to change2876 # the settings of volumes that have the current component.2877 #2878 itcl::body Rappture::VtkVolumeViewer::GetDatasetsWithComponent { cname } {2879 if { ![info exists _volcomponents($cname)] } {2880 return ""2881 }2882 return $_volcomponents($cname)2883 }2884 2885 #2886 # BuildVolumeComponents --2887 #2888 # This is called from the "scale" method which is called when a2889 # new dataset is added or deleted. It repopulates the dropdown2890 # menu of volume component names. It sets the current component2891 # to the first component in the list (of components found).2892 # Finally, if there is only one component, don't display the2893 # label or the combobox in the volume settings tab.2894 #2895 itcl::body Rappture::VtkVolumeViewer::BuildVolumeComponents {} {2896 $itk_component(volcomponents) choices delete 0 end2897 foreach name $_componentsList {2898 $itk_component(volcomponents) choices insert end $name $name2899 }2900 set _current [lindex $_componentsList 0]2901 $itk_component(volcomponents) value $_current2902 set parent [winfo parent $itk_component(volcomponents)]2903 if { [llength $_componentsList] <= 1 } {2904 # Unpack the components label and dropdown if there's only one2905 # component.2906 blt::table forget $parent.volcomponents_l $parent.volcomponents2907 } else {2908 # Pack the components label and dropdown into the table there's2909 # more than one component to select.2910 blt::table $parent \2911 0,0 $parent.volcomponents_l -anchor e -cspan 2 \2912 0,2 $parent.volcomponents -cspan 3 -fill x2913 }2914 }2915 2916 itcl::body Rappture::VtkVolumeViewer::GetColormap { cname color } {2917 if { $color == "default" } {2918 return $_cname2defaultcolormap($cname)2919 }2920 return [ColorsToColormap $color]2921 } -
branches/r9/gui/scripts/xylegend.tcl
r3799 r4919 85 85 private method Lower { args } 86 86 private method Raise { args } 87 private method Recolor {} 87 88 private method PopupMenu { x y } 88 89 private method Rename {} … … 158 159 delete "" 159 160 rename "" 161 recolor "" 160 162 } 161 163 foreach { but icon} $commands { … … 174 176 grid $controls.average -column 1 -row 1 -sticky w 175 177 grid $controls.rename -column 1 -row 2 -sticky w 176 grid $controls.delete -column 1 -row 3 -sticky w 178 grid $controls.recolor -column 1 -row 3 -sticky w 179 grid $controls.delete -column 1 -row 4 -sticky w 177 180 178 181 grid columnconfigure $controls 0 -weight 1 … … 613 616 } 614 617 } 618 619 itcl::body Rappture::XyLegend::Recolor {} { 620 set nodes [$itk_component(legend) curselection] 621 if { $nodes == "" } { 622 return 623 } 624 foreach node $nodes { 625 set elem [$_tree label $node] 626 if { $_lastColorIndex == 0 } { 627 set _lastColorIndex [llength $_autocolors] 628 } 629 incr _lastColorIndex -1 630 set color [lindex $_autocolors $_lastColorIndex] 631 $_graph element configure $elem -color $color 632 set im [$itk_component(legend) entry cget $node -icon] 633 $_graph legend icon $elem $im 634 } 635 } -
branches/r9/gui/scripts/xyresult.tcl
r4207 r4919 81 81 private variable _label2axis; # Maps axis label => axis ID 82 82 private variable _limits; # Axis limits: x-min, x-max, etc. 83 private variable _nextColorIndex 0; # Index for next "-color auto"83 private variable _nextColorIndex -1; # Index for next "-color auto" 84 84 private variable _hilite; # Info for element currently highlighted 85 85 private variable _axis; # Info for axis manipulations … … 250 250 if { $color == "auto" || $color == "autoreset" } { 251 251 if { $color == "autoreset" } { 252 set _nextColorIndex 0252 # set _nextColorIndex 0 253 253 } 254 254 set color [lindex $itk_option(-autocolors) $_nextColorIndex] … … 1067 1067 } 1068 1068 } 1069 incr _nextColorIndex 1069 1070 if {$_nextColorIndex >= [llength $itk_option(-autocolors)]} { 1070 1071 set _nextColorIndex 0 -
branches/r9/lib/rappture/RpEncode.cc
r3362 r4919 212 212 for (p = (unsigned const char *)buf, pend = p + size; p < pend; p++) { 213 213 if (!_base64chars[*p]) { 214 fprintf(stderr, " %c %uis not base64\n", *p, *p);214 fprintf(stderr, "\"%c\" (0x%x) is not base64\n", *p, *p); 215 215 return false; 216 216 } -
branches/r9/pkgs/builder/scripts/main.tcl
r3989 r4919 868 868 869 869 # /apps/rappture/current for 32-bit systems 870 # /apps/share64/rappture/current for 64-bit systems 871 if {$tcl_platform(wordSize) == 8 872 && [file isdirectory /apps/share64/rappture/current]} { 873 set dir /apps/share64/rappture/current 870 if {$tcl_platform(wordSize) == 8 } { 871 if { [file isdirectory /apps/share64/debian7/rappture/current]} { 872 set dir /apps/share64/debian7/rappture/current 873 } elseif { [file isdirectory /apps/share64/debian6/rappture/current]} { 874 set dir /apps/share64/debian6/rappture/current 875 } else { 876 set dir /apps/rappture/current 877 } 874 878 } else { 875 879 set dir /apps/rappture/current -
branches/r9/pkgs/objects/objects/curve/curve.rp
r3177 r4919 168 168 } 169 169 170 if {[string length [$xmlobj get $path.$cname.xerrorbars]] > 0} { 171 error "xerrorbars not fully implemented" 172 } 173 if {[string length [$xmlobj get $path.$cname.yerrorbars]] > 0} { 174 error "yerrorbars not fully implemented" 175 } 176 170 177 set xlen [$xv length] 171 178 set ylen [$yv length] … … 299 306 } 300 307 error "bad option \"$cname\": should be [join [lsort [array names _yvecs]] {, }]" 308 } 309 310 # ------------------------------------------------------------------ 311 # USAGE: xErrorValues <cname> 312 # 313 # Returns the x-axis error values for the specified curve 314 # component <name>. 315 # ------------------------------------------------------------------ 316 method xErrorValues {cname} { 317 # Having this prevents errors, but this feature isn't really 318 # implemented. To be implemented, we must be able to import 319 # and export error values in strings and xml objects. We must 320 # also be able to diff curves with error values, and also 321 # visualize differences in error values. 322 } 323 324 # ------------------------------------------------------------------ 325 # USAGE: yErrorValues <cname> 326 # 327 # Returns the y-axis error values for the specified curve 328 # component <name>. 329 # ------------------------------------------------------------------ 330 method yErrorValues {cname} { 331 # Having this prevents errors, but this feature isn't really 332 # implemented. To be implemented, we must be able to import 333 # and export error values in strings and xml objects. We must 334 # also be able to diff curves with error values, and also 335 # visualize differences in error values. 301 336 } 302 337 -
branches/r9/pkgs/runner/scripts/xauth.tcl
r4858 r4919 30 30 package require sha1 31 31 package require tls 32 http::register https 443 ::tls::socket32 http::register https 443 [list ::tls::socket -tls1 1] 33 33 34 34 namespace eval XAuth {
Note: See TracChangeset
for help on using the changeset viewer.