Changeset 5007 for branches/1.4
- Timestamp:
- Feb 11, 2015, 3:10:11 PM (10 years ago)
- Location:
- branches/1.4
- Files:
-
- 10 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/1.4
-
branches/1.4/gui/scripts/field.tcl
r4985 r5007 1 # -*- mode: tcl; indent-tabs-mode: nil -*- 1 # -*- mode: tcl; indent-tabs-mode: nil -*- 2 2 # ---------------------------------------------------------------------- 3 3 # COMPONENT: field - extracts data from an XML description of a field … … 25 25 # unirect2d (deprecated) 26 26 # cloud (x,y point coordinates) (deprecated) 27 # mesh 27 # mesh 28 28 # 3D Datasets 29 # vtk 29 # vtk 30 30 # unirect3d (deprecated) 31 31 # cloud (x,y,z coordinates) (deprecated) 32 # mesh 32 # mesh 33 33 # dx (FIXME: make dx-to-vtk converter work) 34 34 # ucd avs … … 46 46 # With <views>, can specify which viewer for specific datasets. So it's OK 47 47 # for the same dataset to be viewed in more than one way. 48 # o Any 2D dataset can be viewed as a contour/heightmap. 48 # o Any 2D dataset can be viewed as a contour/heightmap. 49 49 # o Any 3D dataset can be viewed as a isosurface. 50 # o Any 2D dataset with vector data can be streamlines or flow. 50 # o Any 2D dataset with vector data can be streamlines or flow. 51 51 # o Any 3D uniform rectilinear dataset can be viewed as a volume. 52 52 # o Any 3D dataset with vector data can be streamlines or flow. … … 59 59 package require BLT 60 60 61 namespace eval Rappture { 62 # forward declaration 61 namespace eval Rappture { 62 # forward declaration 63 63 } 64 64 … … 68 68 private variable _limits; # maps axis name => {z0 z1} limits 69 69 private variable _field "" 70 private variable _comp2fldName ; 71 private variable _comp2type ; 72 private variable _comp2size ; 73 private variable _comp2assoc; 70 private variable _comp2fldName ; # cname => field names. 71 private variable _comp2type ; # cname => type (e.g. "vectors") 72 private variable _comp2size ; # cname => # of components in element 73 private variable _comp2assoc; # cname => association (e.g. pointdata) 74 74 private variable _fld2Components; # field name => number of components 75 75 private variable _fld2Label; # field name => label 76 76 private variable _fld2Units; # field name => units 77 private variable _hints 77 private variable _hints 78 78 private variable _viewer ""; # Hints which viewer to use 79 private variable _xv ""; # For 1D meshes only. Holds the points80 79 private variable _isValid 0; # Indicates if the field contains 81 80 # valid data. … … 83 82 private variable _alwaysConvertDX 0; 84 83 85 constructor {xmlobj path} { 86 # defined below 87 } 88 destructor { 89 # defined below 84 constructor {xmlobj path} { 85 # defined below 86 } 87 destructor { 88 # defined below 90 89 } 91 90 public method blob { cname } … … 127 126 } 128 127 public method viewer {} { 129 return $_viewer 128 return $_viewer 130 129 } 131 130 protected method Build {} 132 131 protected method _getValue {expr} 133 132 134 private variable _path ""; # Path of this object in the XML 133 private variable _path ""; # Path of this object in the XML 135 134 private variable _units "" ; # system of units for this field 136 135 private variable _zmax 0 ;# length of the device … … 144 143 private variable _comp2style ;# maps component name => style settings 145 144 private variable _comp2cntls ;# maps component name => x,y control points 146 private variable _comp2extents 147 private variable _comp2limits; # Array of limits per component 148 private variable _type "" 149 private variable _comp2flowhints 150 private variable _comp2mesh 145 private variable _comp2extents 146 private variable _comp2limits; # Array of limits per component 147 private variable _type "" 148 private variable _comp2flowhints 149 private variable _comp2mesh ;# list of: mesh object, BLT vector of values 150 private variable _values "" ;# Only used for unirect2d - list of values 151 151 private common _counter 0 ;# counter for unique vector names 152 152 153 private method AvsToVtk { cname contents } 154 private method DicomToVtk { cname contents } 155 private method BuildPointsOnMesh { cname } 156 protected method GetAssociation { cname } 157 protected method GetTypeAndSize { cname } 158 protected method ReadVtkDataSet { cname contents } 159 private method InitHints {} 160 161 private method VerifyVtkDataSet { contents } 153 private method AvsToVtk { cname contents } 154 private method DicomToVtk { cname contents } 155 private method BuildPointsOnMesh { cname } 156 protected method GetAssociation { cname } 157 protected method GetTypeAndSize { cname } 158 protected method ReadVtkDataSet { cname contents } 159 private method InitHints {} 160 161 private method VerifyVtkDataSet { contents } 162 162 private method VectorLimits { vector vectorsize {comp -1} } 163 private variable _values ""164 163 } 165 164 … … 229 228 } 230 229 foreach name [array names _comp2mesh] { 231 232 233 230 # Data is in the form of a mesh and a vector. 231 foreach { mesh vector } $_comp2mesh($name) break 232 # Release the mesh (may be shared) 234 233 set class [$mesh info class] 235 234 ${class}::release $mesh 236 235 # Destroy the vector 237 236 blt::vector destroy $vector 238 237 } … … 285 284 # Now handle the tests. 286 285 switch -- $params(what) { 287 -name { 286 -name { 288 287 set rlist $components 289 288 } 290 -style { 289 -style { 291 290 foreach cname $components { 292 291 if { [info exists _comp2style($cname)] } { 293 lappend rlist $_comp2style($cname) 292 lappend rlist $_comp2style($cname) 294 293 } 295 294 } … … 302 301 # USAGE: mesh ?<name>? 303 302 # 304 # Returns a list {xvec yvec} for the specified field component <name>. 305 # If the name is not specified, then it returns the vectors for the 306 # overall field (sum of all components). 303 # For 1D data (curve), returns a BLT vector of x values for the field 304 # component <name>. Otherwise, this method is unused 307 305 # ---------------------------------------------------------------------- 308 306 itcl::body Rappture::Field::mesh {{cname -overall}} { … … 313 311 return [lindex $_comp2xy($cname) 0] ;# return xv 314 312 } 315 if { [info exists _comp2vtk($cname)] } { 316 # FIXME: extract mesh from VTK file data. 317 if { $_comp2dims($cname) == "1D" } { 318 return $_xv 319 } 313 if {[info exists _comp2vtk($cname)]} { 314 # FIXME: extract mesh from VTK file data. 320 315 error "method \"mesh\" is not implemented for VTK file data" 321 316 } 322 317 if {[info exists _comp2dx($cname)]} { 323 return "" ;# no mesh -- it's embedded in the blob data318 error "method \"mesh\" is not implemented for DX file data" 324 319 } 325 320 if {[info exists _comp2mesh($cname)]} { 326 return "" ;# no mesh -- it's embedded in the value data 321 # FIXME: This only works for cloud 322 set mesh [lindex $_comp2mesh($cname) 0] 323 return [$mesh points] 327 324 } 328 325 if {[info exists _comp2unirect2d($cname)]} { 329 set mobj [lindex $_comp2unirect2d($cname) 0]330 return [$ mobjmesh]326 # FIXME: unirect2d mesh is a list: xMin xMax xNum yMin yMax yNum 327 return [$_comp2unirect2d($cname) mesh] 331 328 } 332 329 if {[info exists _comp2unirect3d($cname)]} { 333 set mobj [lindex $_comp2unirect3d($cname) 0]334 return [$ mobjmesh]330 # This returns a list of x,y,z points 331 return [$_comp2unirect3d($cname) mesh] 335 332 } 336 333 error "can't get field mesh: Unknown component \"$cname\": should be one of [join [lsort [array names _comp2dims]] {, }]" … … 340 337 # USAGE: values ?<name>? 341 338 # 342 # Returns a list {xvec yvec} for the specified field component <name>. 343 # If the name is not specified, then it returns the vectors for the 344 # overall field (sum of all components). 339 # For 1D data (curve), returns a BLT vector of field values (y coords) 340 # for the field component <name>. Otherwise, this method is unused 345 341 # ---------------------------------------------------------------------- 346 342 itcl::body Rappture::Field::values {cname} { … … 351 347 return [lindex $_comp2xy($cname) 1] ;# return yv 352 348 } 353 # VTK file data354 349 if { [info exists _comp2vtk($cname)] } { 355 # FIXME: extract the values from the VTK file data 356 if { $_comp2dims($cname) == "1D" } { 357 return $_values 358 } 359 error "method \"values\" is not implemented for vtk file data" 360 } 361 # Points-on-mesh 350 # FIXME: extract the values from the VTK file data 351 error "method \"values\" is not implemented for VTK file data" 352 } 353 if {[info exists _comp2dx($cname)]} { 354 error "method \"values\" is not implemented for DX file data" 355 } 362 356 if { [info exists _comp2mesh($cname)] } { 363 357 set vector [lindex $_comp2mesh($cname) 1] 364 358 return [$vector range 0 end] 365 }366 if {[info exists _comp2dx($cname)]} {367 error "method \"values\" is not implemented for dx file data"368 359 } 369 360 if {[info exists _comp2unirect2d($cname)]} { … … 373 364 return [$_comp2unirect3d($cname) blob] 374 365 } 375 error "can't get field values. Unknown component \"$cname\": should be [join [lsort [array names _comp2dims]] {, }]"366 error "can't get field values. Unknown component \"$cname\": should be one of [join [lsort [array names _comp2dims]] {, }]" 376 367 } 377 368 … … 389 380 } 390 381 if { [info exists _comp2vtk($cname)] } { 391 382 error "blob not implemented for VTK file data" 392 383 } 393 384 if {[info exists _comp2dx($cname)]} { … … 408 399 # USAGE: valueLimits <cname> 409 400 # 410 # Returns an array for the requested component with a list {min max} 401 # Returns an array for the requested component with a list {min max} 411 402 # representing the limits for each axis. 412 403 # ---------------------------------------------------------------------- … … 432 423 1D { 433 424 switch -- $which { 434 x - xlin { 435 set pos 0; set log 0; set axis x 436 437 xlog { 438 set pos 0; set log 1; set axis x 439 440 y - ylin - v - vlin { 441 set pos 1; set log 0; set axis y 442 443 ylog - vlog { 444 set pos 1; set log 1; set axis y 445 425 x - xlin { 426 set pos 0; set log 0; set axis x 427 } 428 xlog { 429 set pos 0; set log 1; set axis x 430 } 431 y - ylin - v - vlin { 432 set pos 1; set log 0; set axis y 433 } 434 ylog - vlog { 435 set pos 1; set log 1; set axis y 436 } 446 437 default { 447 438 error "bad axis \"$which\": should be x, xlin, xlog, y, ylin, ylog, v, vlin, vlog" … … 480 471 default { 481 472 if {[info exists _comp2limits($cname)]} { 482 array set limits $_comp2limits($cname) 483 473 array set limits $_comp2limits($cname) 474 switch -- $which { 484 475 x - xlin - xlog { 485 476 set axis x 486 477 foreach {axisMin axisMax} $limits(x) break 487 478 } 488 479 y - ylin - ylog { 489 480 set axis y 490 481 foreach {axisMin axisMax} $limits(y) break 491 482 } 492 483 z - zlin - zlog { 493 484 set axis z 494 485 foreach {axisMin axisMax} $limits(z) break 495 486 } 496 487 v - vlin - vlog { 497 488 set axis v 498 499 500 501 502 503 489 foreach {axisMin axisMax} $limits(v) break 490 } 491 default { 492 if { ![info exists limits($which)] } { 493 error "limits: unknown axis \"$which\"" 494 } 504 495 set axis v 505 506 507 496 foreach {axisMin axisMax} $limits($which) break 497 } 498 } 508 499 } else { 509 500 set axisMin 0 ;# HACK ALERT! must be OpenDX data … … 545 536 itcl::body Rappture::Field::fieldlimits {} { 546 537 foreach cname [array names _comp2limits] { 547 array set limits $_comp2limits($cname) 538 array set limits $_comp2limits($cname) 548 539 foreach fname [fieldnames $cname] { 549 540 if { ![info exists limits($fname)] } { … … 571 562 return "" 572 563 } 573 564 574 565 # ---------------------------------------------------------------------- 575 566 # USAGE: controls get ?<name>? … … 779 770 set type "" 780 771 if { ([$_field element $cname.constant] != "" && 781 782 772 [$_field element $cname.domain] != "") || 773 [$_field element $cname.xy] != "" } { 783 774 set type "1D" 784 775 } elseif { [$_field element $cname.mesh] != "" && 785 776 [$_field element $cname.values] != ""} { 786 777 set type "points-on-mesh" 787 778 } elseif { [$_field element $cname.vtk] != ""} { 788 789 790 791 792 779 set type "vtk" 780 set viewer [$_field get "about.view"] 781 if { $viewer != "" } { 782 set _viewer $viewer 783 } 793 784 } elseif {[$_field element $cname.opendx] != ""} { 794 785 global env 795 786 if { [info exists env(VTKVOLUME)] } { 796 787 set _viewer "vtkvolume" 797 } 788 } 798 789 set type "opendx" 799 790 } elseif {[$_field element $cname.dx] != ""} { … … 807 798 } elseif {[$_field element $cname.dicom] != ""} { 808 799 set type "dicom" 809 800 } 810 801 set _comp2style($cname) "" 811 802 if { $type == "" } { … … 817 808 set extents [$_field get $cname.extents] 818 809 } else { 819 set extents 1 810 set extents 1 820 811 } 821 812 set _comp2extents($cname) $extents … … 880 871 } 881 872 } elseif {$type == "points-on-mesh"} { 882 873 if { ![BuildPointsOnMesh $cname] } { 883 874 continue; # Ignore this component 884 875 } … … 981 972 return 0 982 973 } 983 # Sanity check. Verify that all components of the field have the same 974 # Sanity check. Verify that all components of the field have the same 984 975 # dimension. 985 976 set dim "" … … 998 989 # the label and units for each field will be specified there. 999 990 # 1000 # FIXME: Test that every <field><component> has the same field names, 991 # FIXME: Test that every <field><component> has the same field names, 1001 992 # units, components. 1002 993 # … … 1070 1061 # isunirect2d -- 1071 1062 # 1072 # Returns if the field is a unirect2d object. 1063 # Returns if the field is a unirect2d object. 1073 1064 # 1074 1065 itcl::body Rappture::Field::isunirect2d { } { … … 1079 1070 # isunirect3d -- 1080 1071 # 1081 # Returns if the field is a unirect3d object. 1072 # Returns if the field is a unirect3d object. 1082 1073 # 1083 1074 itcl::body Rappture::Field::isunirect3d { } { … … 1088 1079 # flowhints -- 1089 1080 # 1090 # Returns the hints associated with a flow vector field. 1081 # Returns the hints associated with a flow vector field. 1091 1082 # 1092 1083 itcl::body Rappture::Field::flowhints { cname } { … … 1100 1091 # style -- 1101 1092 # 1102 # Returns the style associated with a component of the field. 1093 # Returns the style associated with a component of the field. 1103 1094 # 1104 1095 itcl::body Rappture::Field::style { cname } { … … 1137 1128 # extents -- 1138 1129 # 1139 # Returns if the field is a unirect2d object. 1130 # Returns if the field is a unirect2d object. 1140 1131 # 1141 1132 itcl::body Rappture::Field::extents {{cname -overall}} { … … 1153 1144 } 1154 1145 return $max 1155 } 1146 } 1156 1147 if { $cname == "component0"} { 1157 1148 set cname [lindex [components -name] 0] … … 1170 1161 set f [open "$tmpfile" "w"] 1171 1162 fconfigure $f -translation binary -encoding binary 1172 puts $f $contents 1163 puts $f $contents 1173 1164 close $f 1174 1165 … … 1187 1178 set dataAttrs [$dataset GetPointData] 1188 1179 if { $dataAttrs == ""} { 1189 1180 puts stderr "WARNING: No point data found in \"$_path\"" 1190 1181 rename $reader "" 1191 1182 return 0 … … 1204 1195 set f [open "$tmpfile" "w"] 1205 1196 fconfigure $f -translation binary -encoding binary 1206 puts $f $contents 1197 puts $f $contents 1207 1198 close $f 1208 1199 … … 1224 1215 set _dim 0 1225 1216 if { $xmax > $xmin } { 1226 1217 incr _dim 1227 1218 } 1228 1219 if { $ymax > $ymin } { 1229 1220 incr _dim 1230 1221 } 1231 1222 if { $zmax > $zmin } { 1232 1223 incr _dim 1233 1224 } 1234 1225 if { $_viewer == "" } { 1235 1236 1237 1238 1239 1226 if { $_dim == 2 } { 1227 set _viewer contour 1228 } else { 1229 set _viewer isosurface 1230 } 1240 1231 } 1241 1232 set _comp2dims($cname) ${_dim}D … … 1245 1236 for { set i 0 } { $i < $numPoints } { incr i } { 1246 1237 set point [$dataset GetPoint $i] 1247 $xv append [lindex $point 0] 1238 $xv append [lindex $point 0] 1248 1239 } 1249 1240 set yv [blt::vector create \#auto] … … 1262 1253 set numTuples [$array GetNumberOfTuples] 1263 1254 for { set i 0 } { $i < $numTuples } { incr i } { 1264 $yv append [$array GetComponent $i 0] 1255 $yv append [$array GetComponent $i 0] 1265 1256 } 1266 1257 $xv sort $yv 1267 1258 set _comp2xy($cname) [list $xv $yv] 1268 1259 } 1269 lappend limits x [list $xmin $xmax] 1270 lappend limits y [list $ymin $ymax] 1260 lappend limits x [list $xmin $xmax] 1261 lappend limits y [list $ymin $ymax] 1271 1262 lappend limits z [list $zmin $zmax] 1272 1263 set dataAttrs [$dataset GetPointData] 1273 1264 if { $dataAttrs == ""} { 1274 1265 puts stderr "WARNING: No point data found in \"$_path\"" 1275 1266 rename $reader "" 1276 1267 return 0 … … 1280 1271 set numArrays [$dataAttrs GetNumberOfArrays] 1281 1272 if { $numArrays > 0 } { 1282 1283 1284 1285 1273 for {set i 0} {$i < [$dataAttrs GetNumberOfArrays] } {incr i} { 1274 set array [$dataAttrs GetArray $i] 1275 set fname [$dataAttrs GetArrayName $i] 1276 foreach {min max} [$array GetRange -1] break 1286 1277 if {$i == 0} { 1287 1278 set vmin $min 1288 1279 set vmax $max 1289 1280 } 1290 1281 lappend limits $fname [list $min $max] 1291 1282 set _fld2Units($fname) "" 1292 1283 set _fld2Label($fname) $fname 1293 1284 # Let the VTK file override the <type> designated. 1294 1285 set _fld2Components($fname) [$array GetNumberOfComponents] 1295 1286 lappend _comp2fldName($cname) $fname 1296 1297 } 1298 1287 } 1288 } 1289 1299 1290 lappend limits v [list $vmin $vmax] 1300 1291 set _comp2limits($cname) $limits … … 1306 1297 # vtkdata -- 1307 1298 # 1308 # 1309 # 1299 # Returns a string representing the mesh and field data for a specific 1300 # component in the legacy VTK file format. 1310 1301 # 1311 1302 itcl::body Rappture::Field::vtkdata {cname} { … … 1313 1304 set cname "component" 1314 1305 } 1315 # DX: Convert DX to VTK 1306 # DX: Convert DX to VTK 1316 1307 if {[info exists _comp2dx($cname)]} { 1317 1308 set data $_comp2dx($cname) … … 1319 1310 return [Rappture::DxToVtk $data] 1320 1311 } 1321 # Unirect3d: isosurface 1322 if {[info exists _comp2unirect3d($cname)]} { 1323 return [$_comp2unirect3d($cname) vtkdata] 1324 } 1325 # VTK file data: 1312 # VTK file data: 1326 1313 if { [info exists _comp2vtk($cname)] } { 1327 1314 return $_comp2vtk($cname) … … 1329 1316 # Points on mesh: Construct VTK file output. 1330 1317 if { [info exists _comp2mesh($cname)] } { 1331 1332 1318 # Data is in the form mesh and vector 1319 foreach {mesh vector} $_comp2mesh($cname) break 1333 1320 set label $cname 1334 1321 regsub -all { } $label {_} label 1335 1336 1337 1338 1322 append out "# vtk DataFile Version 3.0\n" 1323 append out "[hints label]\n" 1324 append out "ASCII\n" 1325 append out [$mesh vtkdata] 1339 1326 1340 1327 if { $_comp2assoc($cname) == "pointdata" } { … … 1377 1364 } 1378 1365 } 1379 append out [$vector range 0 end] 1366 append out [$vector range 0 end] 1380 1367 append out "\n" 1381 1368 if 0 { 1382 1369 VerifyVtkDataSet $out 1383 1370 } 1384 1385 } 1386 error "can't find vtkdata for $cname . This method should only be called by the vtkheightmap widget"1371 return $out 1372 } 1373 error "can't find vtkdata for $cname" 1387 1374 } 1388 1375 … … 1390 1377 # BuildPointsOnMesh -- 1391 1378 # 1392 # 1393 # 1394 # 1379 # Parses the field XML description to build a mesh and values vector 1380 # representing the field. Right now we handle the deprecated types 1381 # of "cloud", "unirect2d", and "unirect3d" (mostly for flows). 1395 1382 # 1396 1383 itcl::body Rappture::Field::BuildPointsOnMesh {cname} { … … 1401 1388 set path [$_field get $cname.mesh] 1402 1389 if {[$_xmlobj element $path] == ""} { 1403 1404 1390 # Unknown mesh designated. 1391 return 0 1405 1392 } 1406 1393 set viewer [$_field get "about.view"] … … 1422 1409 # Handle bizarre cases that hopefully will be deprecated. 1423 1410 if { $element == "unirect3d" } { 1424 1411 # Special case: unirect3d (should be deprecated) + flow. 1425 1412 if { [$_field element $cname.extents] != "" } { 1426 1413 set vectorsize [$_field get $cname.extents] 1427 1414 } else { 1428 set vectorsize 1 1415 set vectorsize 1 1429 1416 } 1430 1417 set _type unirect3d 1431 1418 set _dim 3 1432 1419 if { $_viewer == "" } { 1433 1420 set _viewer flowvis 1434 1421 } 1435 1436 1437 1438 1422 set _comp2dims($cname) "3D" 1423 set _comp2unirect3d($cname) \ 1424 [Rappture::Unirect3d \#auto $_xmlobj $_field $cname $vectorsize] 1425 set _comp2style($cname) [$_field get $cname.style] 1439 1426 set limits {} 1440 1427 foreach axis { x y z } { 1441 1428 lappend limits $axis [$_comp2unirect3d($cname) limits $axis] 1442 1429 } 1443 # Get the data limits 1430 # Get the data limits 1444 1431 set vector [$_comp2unirect3d($cname) valuesObj] 1445 1432 set minmax [VectorLimits $vector $vectorsize] … … 1447 1434 lappend limits v $minmax 1448 1435 set _comp2limits($cname) $limits 1449 1450 1451 1452 1453 1454 1436 if {[$_field element $cname.flow] != ""} { 1437 set _comp2flowhints($cname) \ 1438 [Rappture::FlowHints ::\#auto $_field $cname $_units] 1439 } 1440 incr _counter 1441 return 1 1455 1442 } 1456 1443 if { $element == "unirect2d" && [$_field element $cname.flow] != "" } { 1457 1444 # Special case: unirect2d (normally deprecated) + flow. 1458 1445 if { [$_field element $cname.extents] != "" } { 1459 1446 set vectorsize [$_field get $cname.extents] 1460 1447 } else { 1461 set vectorsize 1 1448 set vectorsize 1 1462 1449 } 1463 1450 set _type unirect2d 1464 1451 set _dim 2 1465 1452 if { $_viewer == "" } { 1466 1453 set _viewer "flowvis" 1467 1454 } 1468 1469 1470 1471 1472 1473 1474 1455 set _comp2dims($cname) "2D" 1456 set _comp2unirect2d($cname) \ 1457 [Rappture::Unirect2d \#auto $_xmlobj $path] 1458 set _comp2style($cname) [$_field get $cname.style] 1459 set _comp2flowhints($cname) \ 1460 [Rappture::FlowHints ::\#auto $_field $cname $_units] 1461 set _values [$_field get $cname.values] 1475 1462 set limits {} 1476 1463 foreach axis { x y z } { … … 1484 1471 blt::vector destroy $xv 1485 1472 set _comp2limits($cname) $limits 1486 1487 1473 incr _counter 1474 return 1 1488 1475 } 1489 1476 switch -- $element { 1490 1491 1477 "cloud" { 1478 set mesh [Rappture::Cloud::fetch $_xmlobj $path] 1492 1479 set _type cloud 1493 1494 1495 1480 } 1481 "mesh" { 1482 set mesh [Rappture::Mesh::fetch $_xmlobj $path] 1496 1483 set _type mesh 1497 } 1498 1484 } 1485 "unirect2d" { 1499 1486 if { $_viewer == "" } { 1500 1487 set _viewer "heightmap" 1501 1488 } 1502 1489 set mesh [Rappture::Unirect2d::fetch $_xmlobj $path] 1503 1490 set _type unirect2d 1504 1491 } 1505 1492 } 1506 1493 if { ![$mesh isvalid] } { … … 1510 1497 set _dim [$mesh dimensions] 1511 1498 if { $_dim == 3 } { 1512 set dim 0 1499 set dim 0 1513 1500 foreach axis {x y z} { 1514 1501 foreach {min max} [$mesh limits $axis] { … … 1527 1514 return 0 1528 1515 1529 1530 1516 # 1D data: Create vectors for graph widget. 1517 # The prophet tool currently outputs 1D clouds with fields 1531 1518 # Band Structure Lab used to (see isosurface1 test in rappture-bat) 1532 1533 # Is there a natural growth path in generating output from 1D to 1534 1535 1536 # (methods such as xmarkers) or the <curve> need to be added 1537 1538 # 1539 1540 1519 # 1520 # Is there a natural growth path in generating output from 1D to 1521 # higher dimensions? If there isn't, let's kill this in favor 1522 # or explicitly using a <curve> instead. Otherwise, the features 1523 # (methods such as xmarkers) or the <curve> need to be added 1524 # to the <field>. 1525 # 1526 #set xv [blt::vector create x$_counter] 1527 #set yv [blt::vector create y$_counter] 1541 1528 1542 1529 # This only works with a Cloud mesh type, since the points method 1543 1530 # is not implemented for the Mesh object 1544 1531 #$xv set [$mesh points] 1545 1532 # TODO: Put field values in yv 1546 1547 1548 1549 1550 } 1533 #set _comp2dims($cname) "1D" 1534 #set _comp2xy($cname) [list $xv $yv] 1535 #incr _counter 1536 #return 1 1537 } 1551 1538 if {$_dim == 2} { 1552 1553 1554 1539 # 2D data: By default surface or contour plot using heightmap widget. 1540 set v [blt::vector create \#auto] 1541 $v set [$_field get $cname.values] 1555 1542 if { [$v length] == 0 } { 1556 1543 return 0 … … 1579 1566 } 1580 1567 } 1581 1582 1583 1568 set _comp2dims($cname) "[$mesh dimensions]D" 1569 set _comp2mesh($cname) [list $mesh $v] 1570 set _comp2style($cname) [$_field get $cname.style] 1584 1571 if {[$_field element $cname.flow] != ""} { 1585 1572 set _comp2flowhints($cname) \ 1586 1573 [Rappture::FlowHints ::\#auto $_field $cname $_units] 1587 1574 } 1588 1589 1575 incr _counter 1576 array unset _comp2limits $cname 1590 1577 foreach axis { x y z } { 1591 1578 lappend _comp2limits($cname) $axis [$mesh limits $axis] … … 1594 1581 lappend _comp2limits($cname) $cname $minmax 1595 1582 lappend _comp2limits($cname) v $minmax 1596 1597 } 1583 return 1 1584 } 1598 1585 if {$_dim == 3} { 1599 1586 # 3D data: By default isosurfaces plot using isosurface widget. 1600 1587 if { $_viewer == "" } { 1601 1588 set _viewer "isosurface" 1602 1589 } 1603 1604 1590 set v [blt::vector create \#auto] 1591 $v set [$_field get $cname.values] 1605 1592 if { [$v length] == 0 } { 1606 1593 return 0 … … 1640 1627 lappend _comp2limits($cname) $cname $minmax 1641 1628 lappend _comp2limits($cname) v $minmax 1642 1629 return 1 1643 1630 } 1644 1631 error "unhandled case in field dim=$_dim element=$element" … … 1732 1719 "tcoords" 2 1733 1720 "tensors" 9 1734 "vectors" 3 1721 "vectors" 3 1735 1722 } 1736 1723 set type [$_field get $cname.elemtype] 1737 1724 if { $type == "" } { 1738 1725 set type "scalars" 1739 } 1726 } 1740 1727 if { ![info exists type2components($type)] } { 1741 1728 error "unknown <elemtype> \"$type\" in field" … … 1754 1741 set _comp2assoc($cname) "pointdata" 1755 1742 return 1756 } 1743 } 1757 1744 switch -- $assoc { 1758 1745 "pointdata" - "celldata" - "fielddata" { -
branches/1.4/gui/scripts/mesh.tcl
r4788 r5007 1 # -*- mode: tcl; indent-tabs-mode: nil -*- 1 # -*- mode: tcl; indent-tabs-mode: nil -*- 2 2 3 3 # ---------------------------------------------------------------------- … … 18 18 package require Itcl 19 19 20 namespace eval Rappture { 21 # forward declaration 20 namespace eval Rappture { 21 # forward declaration 22 22 } 23 23 24 24 itcl::class Rappture::Mesh { 25 private variable _xmlobj "" ; 26 private variable _mesh "" ; 27 private variable _dim 0;# Dimension of mesh (1, 2, or 3)28 private variable _type ""; 29 private variable _axis2units; 30 private variable _axis2labels; # 31 private variable _hints 32 private variable _limits ; # Array of mesh limits. Keys are33 34 private variable _numPoints 0 ; 35 private variable _numCells 0 ; 36 private variable _vtkdata ""; 25 private variable _xmlobj "" ; # Ref to XML obj with device data 26 private variable _mesh "" ; # Lib obj representing this mesh 27 private variable _dim 0; # Dimension of mesh (1, 2, or 3) 28 private variable _type ""; # Indicates the type of mesh. 29 private variable _axis2units; # System of units for x, y, z 30 private variable _axis2labels; # 31 private variable _hints 32 private variable _limits ; # Array of mesh limits. Keys are 33 # xmin, xmax, ymin, ymax, ... 34 private variable _numPoints 0 ; # # of points in mesh 35 private variable _numCells 0 ; # # of cells in mesh 36 private variable _vtkdata ""; # Mesh in vtk file format. 37 37 private variable _isValid 0; # Indicates if the mesh is valid. 38 constructor {xmlobj path} { 39 # defined below 40 } 41 destructor { 42 # defined below 38 constructor {xmlobj path} { 39 # defined below 40 } 41 destructor { 42 # defined below 43 43 } 44 44 public method points {} … … 58 58 public method vtkdata {{what -partial}} 59 59 public method type {} { 60 60 return $_type 61 61 } 62 62 public method numpoints {} { 63 63 return $_numPoints 64 64 } 65 65 public method numcells {} { 66 67 } 68 69 private common _xp2obj ; 70 private common _obj2ref ; 71 private variable _xv 72 private variable _yv 73 private variable _zv 74 private variable _xCoords "";# For the blt contour only75 private variable _yCoords "";# For the blt contour only76 66 return $_numCells 67 } 68 69 private common _xp2obj ; # used for fetch/release ref counting 70 private common _obj2ref ; # used for fetch/release ref counting 71 private variable _xv "" 72 private variable _yv "" 73 private variable _zv "" 74 private variable _xCoords ""; # For the blt contour only 75 private variable _yCoords ""; # For the blt contour only 76 77 77 private method ReadNodesElements {path} 78 private method GetDimension { path } 79 private method GetDouble { path } 80 private method GetInt { path } 81 private method InitHints {} 78 private method GetDimension { path } 79 private method GetDouble { path } 80 private method GetInt { path } 81 private method InitHints {} 82 82 private method ReadGrid { path } 83 83 private method ReadUnstructuredGrid { path } … … 164 164 foreach u $units axis { x y z } { 165 165 if { $u != "" } { 166 set _axis2units($axis) $u 166 set _axis2units($axis) $u 167 167 } else { 168 set _axis2units($axis) $first 168 set _axis2units($axis) $first 169 169 } 170 170 } … … 179 179 # Meshes comes in a variety of flavors 180 180 # 181 # Dimensionality is determined from the <dimension> tag. 181 # Dimensionality is determined from the <dimension> tag. 182 182 # 183 183 # <vtk> described mesh 184 184 # <element> + <node> definitions 185 # <grid> rectangular mesh 185 # <grid> rectangular mesh 186 186 # <unstructured> homogeneous cell type mesh. 187 187 … … 189 189 set subcount 0 190 190 foreach cname [$_mesh children] { 191 192 193 194 195 } 196 191 foreach type { vtk grid unstructured } { 192 if { $cname == $type } { 193 incr subcount 194 break 195 } 196 } 197 197 } 198 198 if {[$_mesh element "node"] != "" || … … 206 206 } 207 207 if { $subcount > 1 } { 208 208 puts stderr "WARNING: too many mesh types specified for \"$path\"." 209 209 return 210 210 } 211 211 set result 0 212 212 if { [$_mesh element "vtk"] != ""} { 213 213 set result [ReadVtk $path] 214 214 } elseif {[$_mesh element "grid"] != "" } { 215 215 set result [ReadGrid $path] 216 216 } elseif {[$_mesh element "unstructured"] != "" } { 217 217 set result [ReadUnstructuredGrid $path] 218 218 } elseif {[$_mesh element "node"] != "" && [$_mesh element "element"] != ""} { 219 219 set result [ReadNodesElements $path] … … 231 231 232 232 if { $_xCoords != "" } { 233 233 blt::vector destroy $_xCoords 234 234 } 235 235 if { $_yCoords != "" } { 236 237 } 238 } 239 240 # 241 # vtkdata -- 242 # 243 # 244 # 245 # 246 # 247 # 236 blt::vector destroy $_yCoords 237 } 238 } 239 240 # 241 # vtkdata -- 242 # 243 # This is called by the field object to generate a VTK file to send to 244 # the remote render server. Returns the vtkDataSet object containing 245 # (at this point) just the mesh. The field object doesn't know (or 246 # care) what type of mesh is used. The field object will add field 247 # arrays before generating output to send to the remote render server. 248 248 # 249 249 itcl::body Rappture::Mesh::vtkdata {{what -partial}} { 250 250 if {$what == "-full"} { 251 251 append out "# vtk DataFile Version 3.0\n" 252 253 252 append out "[hints label]\n" 253 append out "ASCII\n" 254 254 append out $_vtkdata 255 255 return $out … … 340 340 itcl::body Rappture::Mesh::mesh { {type "vtk"} } { 341 341 switch $type { 342 "vtk" { 343 344 345 default { 346 347 342 "vtk" { 343 return "" 344 } 345 default { 346 error "Requested mesh type \"$type\" is unknown." 347 } 348 348 } 349 349 } … … 443 443 set string [$_xmlobj get $path.dim] 444 444 if { $string == "" } { 445 445 puts stderr "WARNING: no tag <dim> found in mesh \"$path\"." 446 446 return 0 447 447 } … … 479 479 return 0 480 480 } 481 # Create a VTK file with the mesh in it. 481 # Create a VTK file with the mesh in it. 482 482 set _vtkdata [$_xmlobj get $path.vtk] 483 483 append out "# vtk DataFile Version 3.0\n" … … 521 521 set numCurvilinear 0 522 522 foreach axis { x y z } { 523 524 525 526 527 528 529 530 531 523 set min [$_xmlobj get "$path.grid.${axis}axis.min"] 524 set max [$_xmlobj get "$path.grid.${axis}axis.max"] 525 set num [$_xmlobj get "$path.grid.${axis}axis.numpoints"] 526 set coords [$_xmlobj get "$path.grid.${axis}coords"] 527 set dim [$_xmlobj get "$path.grid.${axis}dim"] 528 if { $min != "" && $max != "" && $num != "" && $num > 0 } { 529 set ${axis}Min $min 530 set ${axis}Max $max 531 set ${axis}Num $num 532 532 if {$min > $max} { 533 533 puts stderr "ERROR: grid $axis axis minimum larger than maximum" 534 534 return 0 535 535 } 536 537 538 539 540 536 incr numUniform 537 } elseif { $coords != "" } { 538 incr numRectilinear 539 set ${axis}Coords $coords 540 } elseif { $dim != "" } { 541 541 set ${axis}Num $dim 542 542 incr numCurvilinear … … 545 545 set _dim [expr $numRectilinear + $numUniform + $numCurvilinear] 546 546 if { $_dim == 0 } { 547 547 # No data found. 548 548 puts stderr "WARNING: bad grid \"$path\": no data found" 549 549 return 0 550 550 } 551 551 if { $numCurvilinear > 0 } { … … 560 560 return 0 561 561 } 562 562 if { ![info exists xNum] } { 563 563 puts stderr "WARNING: bad grid \"$path\": invalid dimensions for curvilinear grid: missing <xdim> from grid description." 564 564 return 0 … … 572 572 if { [info exists zNum] } { 573 573 set _dim 3 574 574 set _numPoints [expr $xNum * $yNum * $zNum] 575 575 set _numCells [expr ($xNum > 1 ? ($xNum - 1) : 1) * ($yNum > 1 ? ($yNum - 1) : 1) * ($zNum > 1 ? ($zNum - 1) : 1)] 576 576 if { ($_numPoints*3) != $numCoords } { … … 583 583 } 584 584 $all split $xv $yv $zv 585 585 foreach axis {x y z} { 586 586 set vector [set ${axis}v] 587 587 set _limits($axis) [$vector limits] 588 589 590 591 588 } 589 append out "DATASET STRUCTURED_GRID\n" 590 append out "DIMENSIONS $xNum $yNum $zNum\n" 591 append out "POINTS $_numPoints double\n" 592 592 append out [$all range 0 end] 593 593 append out "\n" 594 594 set _vtkdata $out 595 595 } elseif { [info exists yNum] } { 596 596 set _dim 2 597 597 set _numPoints [expr $xNum * $yNum] 598 598 set _numCells [expr ($xNum > 1 ? ($xNum - 1) : 1) * ($yNum > 1 ? ($yNum - 1) : 1)] 599 599 if { ($_numPoints*2) != $numCoords } { … … 605 605 return 0 606 606 } 607 607 foreach axis {x y} { 608 608 set vector [set ${axis}v] 609 609 set _limits($axis) [$vector limits] 610 610 } 611 611 set _limits(z) [list 0 0] 612 612 $zv seq 0 0 [$xv length] 613 613 $all merge $xv $yv $zv 614 615 616 614 append out "DATASET STRUCTURED_GRID\n" 615 append out "DIMENSIONS $xNum $yNum 1\n" 616 append out "POINTS $_numPoints double\n" 617 617 append out [$all range 0 end] 618 618 append out "\n" 619 619 set _vtkdata $out 620 620 } else { 621 621 set _dim 1 … … 632 632 $zv seq 0 0 [$xv length] 633 633 $all merge $xv $yv $zv 634 635 636 634 append out "DATASET STRUCTURED_GRID\n" 635 append out "DIMENSIONS $xNum 1 1\n" 636 append out "POINTS $_numPoints double\n" 637 637 append out [$all range 0 end] 638 638 append out "\n" 639 640 639 set _vtkdata $out 640 } 641 641 blt::vector destroy $all $xv $yv $zv 642 642 return 1 643 643 } 644 644 if { $numRectilinear == 0 && $numUniform > 0} { 645 # This is the special case where all axes 2D/3D are uniform. 645 # This is the special case where all axes 2D/3D are uniform. 646 646 # This results in a STRUCTURED_POINTS 647 647 if { $_dim == 1 } { … … 651 651 set xSpace [expr ($xMax - $xMin) / double($xNum - 1)] 652 652 } 653 653 set _numPoints $xNum 654 654 set _numCells [expr $xNum - 1] 655 656 657 658 659 655 append out "DATASET STRUCTURED_POINTS\n" 656 append out "DIMENSIONS $xNum 1 1\n" 657 append out "ORIGIN $xMin 0 0\n" 658 append out "SPACING $xSpace 0 0\n" 659 set _vtkdata $out 660 660 set _limits(x) [list $xMin $xMax] 661 661 set _limits(y) [list 0 0] 662 662 set _limits(z) [list 0 0] 663 663 } elseif { $_dim == 2 } { 664 664 if {$xNum == 1} { 665 665 set xSpace 0 … … 672 672 set ySpace [expr ($yMax - $yMin) / double($yNum - 1)] 673 673 } 674 674 set _numPoints [expr $xNum * $yNum] 675 675 set _numCells [expr ($xNum > 1 ? ($xNum - 1) : 1) * ($yNum > 1 ? ($yNum - 1) : 1)] 676 677 678 679 680 681 682 683 676 append out "DATASET STRUCTURED_POINTS\n" 677 append out "DIMENSIONS $xNum $yNum 1\n" 678 append out "ORIGIN $xMin $yMin 0\n" 679 append out "SPACING $xSpace $ySpace 0\n" 680 set _vtkdata $out 681 foreach axis {x y} { 682 set _limits($axis) [list [set ${axis}Min] [set ${axis}Max]] 683 } 684 684 set _limits(z) [list 0 0] 685 685 } elseif { $_dim == 3 } { 686 686 if {$xNum == 1} { 687 687 set xSpace 0 … … 699 699 set zSpace [expr ($zMax - $zMin) / double($zNum - 1)] 700 700 } 701 701 set _numPoints [expr $xNum * $yNum * $zNum] 702 702 set _numCells [expr ($xNum > 1 ? ($xNum - 1) : 1) * ($yNum > 1 ? ($yNum - 1) : 1) * ($zNum > 1 ? ($zNum - 1) : 1)] 703 704 705 706 707 708 709 710 711 } else { 712 703 append out "DATASET STRUCTURED_POINTS\n" 704 append out "DIMENSIONS $xNum $yNum $zNum\n" 705 append out "ORIGIN $xMin $yMin $zMin\n" 706 append out "SPACING $xSpace $ySpace $zSpace\n" 707 set _vtkdata $out 708 foreach axis {x y z} { 709 set _limits($axis) [list [set ${axis}Min] [set ${axis}Max]] 710 } 711 } else { 712 puts stderr "WARNING: bad grid \"$path\": bad dimension \"$_dim\"" 713 713 return 0 714 715 714 } 715 return 1 716 716 } 717 717 # This is the hybrid case. Some axes are uniform, others are nonuniform. 718 718 set xv [blt::vector create \#auto] 719 719 if { [info exists xMin] } { 720 721 } else { 722 723 724 725 720 $xv seq $xMin $xMax $xNum 721 } else { 722 $xv set [$_xmlobj get $path.grid.xcoords] 723 set xMin [$xv min] 724 set xMax [$xv max] 725 set xNum [$xv length] 726 726 } 727 727 set yv [blt::vector create \#auto] … … 740 740 set zv [blt::vector create \#auto] 741 741 if { $_dim == 3 } { 742 743 744 745 746 747 748 749 750 } else { 751 742 if { [info exists zMin] } { 743 $zv seq $zMin $zMax $zNum 744 } else { 745 $zv set [$_xmlobj get $path.grid.zcoords] 746 set zMin [$zv min] 747 set zMax [$zv max] 748 set zNum [$zv length] 749 } 750 } else { 751 set zNum 1 752 752 } 753 753 if { $_dim == 3 } { 754 754 set _numPoints [expr $xNum * $yNum * $zNum] 755 755 set _numCells [expr ($xNum > 1 ? ($xNum - 1) : 1) * ($yNum > 1 ? ($yNum - 1) : 1) * ($zNum > 1 ? ($zNum - 1) : 1)] 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 756 append out "DATASET RECTILINEAR_GRID\n" 757 append out "DIMENSIONS $xNum $yNum $zNum\n" 758 append out "X_COORDINATES $xNum double\n" 759 append out [$xv range 0 end] 760 append out "\n" 761 append out "Y_COORDINATES $yNum double\n" 762 append out [$yv range 0 end] 763 append out "\n" 764 append out "Z_COORDINATES $zNum double\n" 765 append out [$zv range 0 end] 766 append out "\n" 767 set _vtkdata $out 768 foreach axis {x y z} { 769 if { [info exists ${axis}Min] } { 770 set _limits($axis) [list [set ${axis}Min] [set ${axis}Max]] 771 } 772 } 773 773 } elseif { $_dim == 2 } { 774 774 set _numPoints [expr $xNum * $yNum] 775 775 set _numCells [expr ($xNum > 1 ? ($xNum - 1) : 1) * ($yNum > 1 ? ($yNum - 1) : 1)] 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 776 append out "DATASET RECTILINEAR_GRID\n" 777 append out "DIMENSIONS $xNum $yNum 1\n" 778 append out "X_COORDINATES $xNum double\n" 779 append out [$xv range 0 end] 780 append out "\n" 781 append out "Y_COORDINATES $yNum double\n" 782 append out [$yv range 0 end] 783 append out "\n" 784 append out "Z_COORDINATES 1 double\n" 785 append out "0\n" 786 foreach axis {x y} { 787 if { [info exists ${axis}Min] } { 788 set _limits($axis) [list [set ${axis}Min] [set ${axis}Max]] 789 } 790 } 791 791 set _limits(z) [list 0 0] 792 792 set _vtkdata $out 793 793 } elseif { $_dim == 1 } { 794 794 set _numPoints $xNum 795 795 set _numCells [expr $xNum - 1] 796 797 798 799 800 801 802 803 804 796 append out "DATASET RECTILINEAR_GRID\n" 797 append out "DIMENSIONS $xNum 1 1\n" 798 append out "X_COORDINATES $xNum double\n" 799 append out [$xv range 0 end] 800 append out "\n" 801 append out "Y_COORDINATES 1 double\n" 802 append out "0\n" 803 append out "Z_COORDINATES 1 double\n" 804 append out "0\n" 805 805 if { [info exists xMin] } { 806 806 set _limits(x) [list $xMin $xMax] … … 808 808 set _limits(y) [list 0 0] 809 809 set _limits(z) [list 0 0] 810 811 } else { 812 810 set _vtkdata $out 811 } else { 812 puts stderr "WARNING: bad grid \"$path\": invalid dimension \"$_dim\"" 813 813 return 0 814 814 } 815 blt::vector destroy $xv $yv $zv 815 blt::vector destroy $xv $yv $zv 816 816 return 1 817 817 } … … 847 847 set celltypes {} 848 848 foreach { a b c } $triangles { 849 850 851 849 append data " 3 $a $b $c\n" 850 append celltypes "5\n" 851 incr _numCells 852 852 } 853 853 append out "DATASET UNSTRUCTURED_GRID\n" 854 854 append out "POINTS $_numPoints double\n" 855 855 foreach x [$xv range 0 end] y [$yv range 0 end] z [$zv range 0 end] { 856 856 append out " $x $y $z\n" 857 857 } 858 858 set count [expr $_numCells * 4] … … 879 879 set celltypes {} 880 880 foreach { a b c d } $quads { 881 882 883 881 append data " 4 $a $b $c $d\n" 882 append celltypes "9\n" 883 incr _numCells 884 884 } 885 885 append out "DATASET UNSTRUCTURED_GRID\n" 886 886 append out "POINTS $_numPoints double\n" 887 887 foreach x [$xv range 0 end] y [$yv range 0 end] z [$zv range 0 end] { 888 888 append out " $x $y $z\n" 889 889 } 890 890 set count [expr $_numCells * 5] … … 916 916 continue 917 917 } 918 919 918 append data " $numIndices $line\n" 919 incr _numCells 920 920 set count [expr $count + $numIndices + 1] 921 921 } … … 923 923 append out "POINTS $_numPoints double\n" 924 924 foreach x [$xv range 0 end] y [$yv range 0 end] z [$zv range 0 end] { 925 925 append out " $x $y $z\n" 926 926 } 927 927 append out "VERTICES $_numCells $count\n" … … 950 950 continue 951 951 } 952 953 952 append data " $numIndices $line\n" 953 incr _numCells 954 954 set count [expr $count + $numIndices + 1] 955 955 } … … 957 957 append out "POINTS $_numPoints double\n" 958 958 foreach x [$xv range 0 end] y [$yv range 0 end] z [$zv range 0 end] { 959 959 append out " $x $y $z\n" 960 960 } 961 961 append out "LINES $_numCells $count\n" … … 984 984 continue 985 985 } 986 987 986 append data " $numIndices $line\n" 987 incr _numCells 988 988 set count [expr $count + $numIndices + 1] 989 989 } … … 991 991 append out "POINTS $_numPoints double\n" 992 992 foreach x [$xv range 0 end] y [$yv range 0 end] z [$zv range 0 end] { 993 993 append out " $x $y $z\n" 994 994 } 995 995 append out "POLYGONS $_numCells $count\n" … … 1018 1018 continue 1019 1019 } 1020 1021 1020 append data " $numIndices $line\n" 1021 incr _numCells 1022 1022 set count [expr $count + $numIndices + 1] 1023 1023 } … … 1025 1025 append out "POINTS $_numPoints double\n" 1026 1026 foreach x [$xv range 0 end] y [$yv range 0 end] z [$zv range 0 end] { 1027 1027 append out " $x $y $z\n" 1028 1028 } 1029 1029 append out "TRIANGLE_STRIPS $_numCells $count\n" … … 1047 1047 set celltypes {} 1048 1048 foreach { a b c d } $tetras { 1049 1050 1051 1049 append data " 4 $a $b $c $d\n" 1050 append celltypes "10\n" 1051 incr _numCells 1052 1052 } 1053 1053 append out "DATASET UNSTRUCTURED_GRID\n" 1054 1054 append out "POINTS $_numPoints double\n" 1055 1055 foreach x [$xv range 0 end] y [$yv range 0 end] z [$zv range 0 end] { 1056 1056 append out " $x $y $z\n" 1057 1057 } 1058 1058 set count [expr $_numCells * 5] … … 1076 1076 set celltypes {} 1077 1077 foreach { a b c d e f g h } $hexas { 1078 1079 1080 1078 append data " 8 $a $b $c $d $e $f $g $h\n" 1079 append celltypes "12\n" 1080 incr _numCells 1081 1081 } 1082 1082 append out "DATASET UNSTRUCTURED_GRID\n" 1083 1083 append out "POINTS $_numPoints double\n" 1084 1084 foreach x [$xv range 0 end] y [$yv range 0 end] z [$zv range 0 end] { 1085 1085 append out " $x $y $z\n" 1086 1086 } 1087 1087 set count [expr $_numCells * 9] … … 1105 1105 set celltypes {} 1106 1106 foreach { a b c d e f } $wedges { 1107 1108 1109 1107 append data " 6 $a $b $c $d $e $f\n" 1108 append celltypes "13\n" 1109 incr _numCells 1110 1110 } 1111 1111 append out "DATASET UNSTRUCTURED_GRID\n" 1112 1112 append out "POINTS $_numPoints double\n" 1113 1113 foreach x [$xv range 0 end] y [$yv range 0 end] z [$zv range 0 end] { 1114 1114 append out " $x $y $z\n" 1115 1115 } 1116 1116 set count [expr $_numCells * 7] … … 1134 1134 set celltypes {} 1135 1135 foreach { a b c d e } $pyramids { 1136 1137 1138 1136 append data " 5 $a $b $c $d $e\n" 1137 append celltypes "14\n" 1138 incr _numCells 1139 1139 } 1140 1140 append out "DATASET UNSTRUCTURED_GRID\n" 1141 1141 append out "POINTS $_numPoints double\n" 1142 1142 foreach x [$xv range 0 end] y [$yv range 0 end] z [$zv range 0 end] { 1143 1143 append out " $x $y $z\n" 1144 1144 } 1145 1145 set count [expr $_numCells * 6] … … 1153 1153 1154 1154 set _vtkdata $out 1155 return 1 1155 return 1 1156 1156 } 1157 1157 … … 1241 1241 set celltypes [$_xmlobj get $path.unstructured.celltypes] 1242 1242 if { $numCells == 0 && $celltypes != "" } { 1243 1243 puts stderr "WARNING: bad unstuctured grid \"$path\": no <cells> description found." 1244 1244 return 0 1245 1245 } … … 1266 1266 } 1267 1267 } 1268 # Step 2: Allow points to be specified as <points> or 1268 # Step 2: Allow points to be specified as <points> or 1269 1269 # <xcoords>, <ycoords>, <zcoords>. Split and convert into 1270 1270 # 3 vectors, one for each coordinate. … … 1414 1414 set data {} 1415 1415 foreach cname [$_xmlobj children -type node $path] { 1416 1417 } 1416 append data "[$_xmlobj get $path.$cname]\n" 1417 } 1418 1418 Rappture::ReadPoints $data _dim points 1419 1419 if { $_dim == 2 } { 1420 1421 1422 1423 1424 1425 1426 1420 set all [blt::vector create \#auto] 1421 set xv [blt::vector create \#auto] 1422 set yv [blt::vector create \#auto] 1423 set zv [blt::vector create \#auto] 1424 $all set $points 1425 $all split $xv $yv 1426 set _numPoints [$xv length] 1427 1427 set _limits(x) [$xv limits] 1428 1428 set _limits(y) [$yv limits] 1429 1429 set _limits(z) [list 0 0] 1430 1431 1432 1433 1434 1430 # 2D Dataset. All Z coordinates are 0 1431 $zv seq 0.0 0.0 $_numPoints 1432 $all merge $xv $yv $zv 1433 set points [$all range 0 end] 1434 blt::vector destroy $all $xv $yv $zv 1435 1435 } elseif { $_dim == 3 } { 1436 1437 1438 1439 1440 1441 1442 1436 set all [blt::vector create \#auto] 1437 set xv [blt::vector create \#auto] 1438 set yv [blt::vector create \#auto] 1439 set zv [blt::vector create \#auto] 1440 $all set $points 1441 $all split $xv $yv $zv 1442 set _numPoints [$xv length] 1443 1443 set _limits(x) [$xv limits] 1444 1444 set _limits(y) [$yv limits] 1445 1445 set _limits(z) [$zv limits] 1446 1447 1448 } else { 1449 1446 set points [$all range 0 end] 1447 blt::vector destroy $all $xv $yv $zv 1448 } else { 1449 error "bad dimension \"$_dim\" for nodes mesh" 1450 1450 } 1451 1451 array set node2celltype { 1452 1453 1454 1455 1456 1452 3 5 1453 4 10 1454 8 12 1455 6 13 1456 5 14 1457 1457 } 1458 1458 set count 0 … … 1463 1463 foreach cname [$_xmlobj children -type element $path] { 1464 1464 set nodeList [$_mesh get $cname.nodes] 1465 1466 1467 1468 1469 1470 1471 1465 set numNodes [llength $nodeList] 1466 if { ![info exists node2celltype($numNodes)] } { 1467 puts stderr "WARNING: bad nodes/elements mesh \$path\": unknown number of indices \"$_numNodes\": should be 3, 4, 5, 6, or 8" 1468 return 0 1469 } 1470 set celltype $node2celltype($numNodes) 1471 append celltypes " $celltype\n" 1472 1472 if { $celltype == 12 } { 1473 1473 # Formerly used voxels instead of hexahedrons. We're converting … … 1479 1479 } 1480 1480 set nodeList $newList 1481 } 1482 1483 1484 incr count $numNodes 1485 incr count;# One extra for the VTK celltype id.1481 } 1482 append data " $numNodes $nodeList\n" 1483 incr _numCells 1484 incr count $numNodes 1485 incr count; # One extra for the VTK celltype id. 1486 1486 } 1487 1487 … … 1496 1496 append out "\n" 1497 1497 set _vtkdata $out 1498 set _isValid 1 1498 set _isValid 1 1499 1499 } 1500 1500 -
branches/1.4/gui/scripts/visviewer.tcl
r4761 r5007 1 # -*- mode: tcl; indent-tabs-mode: nil -*- 1 # -*- mode: tcl; indent-tabs-mode: nil -*- 2 2 3 3 # ---------------------------------------------------------------------- 4 # VisViewer - 5 # 6 # This class is the base class for the various visualization viewers 4 # VisViewer - 5 # 6 # This class is the base class for the various visualization viewers 7 7 # that use the nanoserver render farm. 8 8 # … … 31 31 private common _done ; # Used to indicate status of send. 32 32 private variable _buffer ; # buffer for incoming/outgoing commands 33 private variable _initialized 33 private variable _initialized 34 34 private variable _isOpen 0 35 35 private variable _afterId -1 … … 71 71 private method SendHelper {} 72 72 private method SendHelper.old {} 73 private method WaitDialog { state } 74 75 protected method ToggleConsole {} 76 private method DebugConsole {} 77 private method BuildConsole {} 78 private method HideConsole {} 79 private method TraceComm { channel {data {}} } 80 private method SendDebugCommand {} 73 private method WaitDialog { state } 74 75 protected method ToggleConsole {} 76 private method DebugConsole {} 77 private method BuildConsole {} 78 private method HideConsole {} 79 private method TraceComm { channel {data {}} } 80 private method SendDebugCommand {} 81 81 82 82 protected method CheckConnection {} … … 85 85 protected method Connect { servers } 86 86 protected method Disconnect {} 87 protected method EnableWaitDialog { timeout } 87 protected method EnableWaitDialog { timeout } 88 88 protected method Euler2XYZ { theta phi psi } 89 89 protected method Flush {} … … 99 99 protected method SendEcho { channel {data ""} } 100 100 protected method StartBufferingCommands {} 101 protected method StartWaiting {} 101 protected method StartWaiting {} 102 102 protected method StopBufferingCommands {} 103 protected method StopWaiting {} 104 105 private method Waiting { option widget } 103 protected method StopWaiting {} 104 105 private method Waiting { option widget } 106 106 107 107 private proc CheckNameList { namelist } { … … 197 197 global env 198 198 if { [info exists env(VISRECORDER)] } { 199 200 201 202 199 set _logging 1 200 if { [file exists /tmp/recording.log] } { 201 file delete /tmp/recording.log 202 } 203 203 } 204 204 eval itk_initialize $args … … 256 256 # Connect to the visualization server (e.g. nanovis, pymolproxy). 257 257 # Creates an event callback that is triggered when we are idle 258 # (no I/O with the server) for some specified time. 258 # (no I/O with the server) for some specified time. 259 259 # 260 260 itcl::body Rappture::VisViewer::Connect { servers } { … … 279 279 set _hostname $server 280 280 fconfigure $_sid -translation binary -encoding binary 281 281 282 282 # Read back the server identification string. 283 283 if { [gets $_sid data] <= 0 } { … … 315 315 after cancel $_afterId 316 316 $_dispatcher cancel !timeout 317 catch {close $_sid} 317 catch {close $_sid} 318 318 set _sid "" 319 319 set _buffer(in) "" … … 340 340 # CheckConection -- 341 341 # 342 # This routine is called whenever we're about to send/receive data on 343 # the socket connection to the visualization server. If we're connected, 344 # then reset the timeout event. Otherwise try to reconnect to the 342 # This routine is called whenever we're about to send/receive data on 343 # the socket connection to the visualization server. If we're connected, 344 # then reset the timeout event. Otherwise try to reconnect to the 345 345 # visualization server. 346 346 # … … 398 398 } 399 399 puts -nonewline $_sid $_buffer(out) 400 flush $_sid 400 flush $_sid 401 401 set _done($this) 1; # Success 402 402 } … … 478 478 # StartWaiting -- 479 479 # 480 # Read some number of bytes from the visualization server. 480 # Read some number of bytes from the visualization server. 481 481 # 482 482 483 483 itcl::body Rappture::VisViewer::StartWaiting {} { 484 484 if { $_waitTimeout > 0 } { 485 after cancel $_afterId 485 after cancel $_afterId 486 486 set _afterId [after $_waitTimeout [itcl::code $this WaitDialog on]] 487 487 } 488 488 } 489 489 490 itcl::body Rappture::VisViewer::StopWaiting {} { 490 itcl::body Rappture::VisViewer::StopWaiting {} { 491 491 if { $_waitTimeout > 0 } { 492 492 WaitDialog off … … 494 494 } 495 495 496 itcl::body Rappture::VisViewer::EnableWaitDialog { value } { 496 itcl::body Rappture::VisViewer::EnableWaitDialog { value } { 497 497 set _waitTimeout $value 498 498 } … … 501 501 # ReceiveBytes -- 502 502 # 503 # Read some number of bytes from the visualization server. 503 # Read some number of bytes from the visualization server. 504 504 # 505 505 itcl::body Rappture::VisViewer::ReceiveBytes { size } { … … 619 619 } 620 620 621 # 621 # 622 622 # ReceiveEcho -- 623 623 # … … 642 642 } 643 643 set inner [frame $itk_component(plotarea).view.splash] 644 $inner configure -relief raised -bd 2 644 $inner configure -relief raised -bd 2 645 645 label $inner.text1 -text "Working...\nPlease wait." \ 646 -font "Arial 10" 647 label $inner.icon 646 -font "Arial 10" 647 label $inner.icon 648 648 pack $inner -expand yes -anchor c 649 649 blt::table $inner \ 650 650 0,0 $inner.text1 -anchor w \ 651 0,1 $inner.icon 651 0,1 $inner.icon 652 652 Waiting start $inner.icon 653 653 } else { … … 709 709 pack $f.send.l -side left 710 710 itk_component add command { 711 711 entry $f.send.e -background white 712 712 } { 713 713 ignore -background 714 714 } 715 715 pack $f.send.e -side left -expand yes -fill x … … 719 719 pack $f.sb -side right -fill y 720 720 itk_component add trace { 721 721 text $f.comm -wrap char -yscrollcommand "$f.sb set" -background white 722 722 } { 723 723 ignore -background 724 724 } 725 725 pack $f.comm -expand yes -fill both … … 729 729 730 730 $itk_component(trace) tag configure error -foreground red \ 731 731 -font -*-courier-medium-o-normal-*-*-120-* 732 732 $itk_component(trace) tag configure incoming -foreground blue 733 733 } … … 741 741 itcl::body Rappture::VisViewer::ToggleConsole {} { 742 742 if { $_debugConsole } { 743 743 set _debugConsole 0 744 744 } else { 745 745 set _debugConsole 1 746 746 } 747 747 DebugConsole … … 751 751 # DebugConsole -- 752 752 # 753 # Based on the value of the variable _debugConsole, turns on/off 754 # debugging. This is done by setting/unsetting a procedure that 755 # is called whenever new characters are received or sent on the 753 # Based on the value of the variable _debugConsole, turns on/off 754 # debugging. This is done by setting/unsetting a procedure that 755 # is called whenever new characters are received or sent on the 756 756 # socket to the render server. Additionally, the debug console 757 757 # is created if necessary and hidden/shown. … … 759 759 itcl::body Rappture::VisViewer::DebugConsole {} { 760 760 if { ![winfo exists .renderconsole] } { 761 761 BuildConsole 762 762 } 763 763 if { $_debugConsole } { 764 765 766 764 $this configure -sendcommand [itcl::code $this TraceComm] 765 $this configure -receivecommand [itcl::code $this TraceComm] 766 wm deiconify .renderconsole 767 767 } else { 768 769 770 768 $this configure -sendcommand "" 769 $this configure -receivecommand "" 770 wm withdraw .renderconsole 771 771 } 772 772 } … … 850 850 -title "Render Server Error" 851 851 set inner [$popup component inner] 852 label $inner.summary -text "" -anchor w 852 label $inner.summary -text "" -anchor w 853 853 854 854 Rappture::Scroller $inner.scrl \ 855 -xscrollmode auto -yscrollmode auto 855 -xscrollmode auto -yscrollmode auto 856 856 text $inner.scrl.text \ 857 857 -font "Arial 9 " -background white -relief sunken -bd 1 \ … … 862 862 blt::table $inner \ 863 863 0,0 $inner.scrl -fill both \ 864 1,0 $inner.ok 865 $inner.scrl.text tag configure normal -font "Arial 9" 866 $inner.scrl.text tag configure italic -font "Arial 9 italic" 864 1,0 $inner.ok 865 $inner.scrl.text tag configure normal -font "Arial 9" 866 $inner.scrl.text tag configure italic -font "Arial 9 italic" 867 867 $inner.scrl.text tag configure bold -font "Arial 10 bold" 868 868 $inner.scrl.text tag configure code -font "Courier 10 bold" … … 873 873 set inner [$popup component inner] 874 874 $inner.scrl.text delete 0.0 end 875 875 876 876 $inner.scrl.text configure -state normal 877 877 $inner.scrl.text insert end "The following error was reported by the render server:\n\n" bold … … 943 943 "blue-to-grey" { 944 944 return { 945 0.0 0.000 0.600 0.800 946 0.14285714285714285 0.400 0.900 1.000 947 0.2857142857142857 0.600 1.000 1.000 948 0.42857142857142855 0.800 1.000 1.000 949 0.5714285714285714 0.900 0.900 0.900 950 0.7142857142857143 0.600 0.600 0.600 951 0.8571428571428571 0.400 0.400 0.400 945 0.0 0.000 0.600 0.800 946 0.14285714285714285 0.400 0.900 1.000 947 0.2857142857142857 0.600 1.000 1.000 948 0.42857142857142855 0.800 1.000 1.000 949 0.5714285714285714 0.900 0.900 0.900 950 0.7142857142857143 0.600 0.600 0.600 951 0.8571428571428571 0.400 0.400 0.400 952 952 1.0 0.200 0.200 0.200 953 953 } 954 954 } 955 955 "white-to-blue" { 956 return { 957 0.0 0.900 1.000 1.000 958 0.1111111111111111 0.800 0.983 1.000 959 0.2222222222222222 0.700 0.950 1.000 960 0.3333333333333333 0.600 0.900 1.000 961 0.4444444444444444 0.500 0.833 1.000 962 0.5555555555555556 0.400 0.750 1.000 963 0.6666666666666666 0.300 0.650 1.000 964 0.7777777777777778 0.200 0.533 1.000 965 0.8888888888888888 0.100 0.400 1.000 956 return { 957 0.0 0.900 1.000 1.000 958 0.1111111111111111 0.800 0.983 1.000 959 0.2222222222222222 0.700 0.950 1.000 960 0.3333333333333333 0.600 0.900 1.000 961 0.4444444444444444 0.500 0.833 1.000 962 0.5555555555555556 0.400 0.750 1.000 963 0.6666666666666666 0.300 0.650 1.000 964 0.7777777777777778 0.200 0.533 1.000 965 0.8888888888888888 0.100 0.400 1.000 966 966 1.0 0.000 0.250 1.000 967 967 } … … 969 969 "brown-to-blue" { 970 970 return { 971 0.0 0.200 0.100 0.000 972 0.09090909090909091 0.400 0.187 0.000 973 0.18181818181818182 0.600 0.379 0.210 974 0.2727272727272727 0.800 0.608 0.480 975 0.36363636363636365 0.850 0.688 0.595 976 0.45454545454545453 0.950 0.855 0.808 977 0.5454545454545454 0.800 0.993 1.000 978 0.6363636363636364 0.600 0.973 1.000 979 0.7272727272727273 0.400 0.940 1.000 980 0.8181818181818182 0.200 0.893 1.000 981 0.9090909090909091 0.000 0.667 0.800 982 1.0 0.000 0.480 0.600 971 0.0 0.200 0.100 0.000 972 0.09090909090909091 0.400 0.187 0.000 973 0.18181818181818182 0.600 0.379 0.210 974 0.2727272727272727 0.800 0.608 0.480 975 0.36363636363636365 0.850 0.688 0.595 976 0.45454545454545453 0.950 0.855 0.808 977 0.5454545454545454 0.800 0.993 1.000 978 0.6363636363636364 0.600 0.973 1.000 979 0.7272727272727273 0.400 0.940 1.000 980 0.8181818181818182 0.200 0.893 1.000 981 0.9090909090909091 0.000 0.667 0.800 982 1.0 0.000 0.480 0.600 983 983 } 984 984 } 985 985 "blue-to-brown" { 986 986 return { 987 0.0 0.000 0.480 0.600 988 0.09090909090909091 0.000 0.667 0.800 989 0.18181818181818182 0.200 0.893 1.000 990 0.2727272727272727 0.400 0.940 1.000 991 0.36363636363636365 0.600 0.973 1.000 992 0.45454545454545453 0.800 0.993 1.000 993 0.5454545454545454 0.950 0.855 0.808 994 0.6363636363636364 0.850 0.688 0.595 995 0.7272727272727273 0.800 0.608 0.480 996 0.8181818181818182 0.600 0.379 0.210 997 0.9090909090909091 0.400 0.187 0.000 998 1.0 0.200 0.100 0.000 987 0.0 0.000 0.480 0.600 988 0.09090909090909091 0.000 0.667 0.800 989 0.18181818181818182 0.200 0.893 1.000 990 0.2727272727272727 0.400 0.940 1.000 991 0.36363636363636365 0.600 0.973 1.000 992 0.45454545454545453 0.800 0.993 1.000 993 0.5454545454545454 0.950 0.855 0.808 994 0.6363636363636364 0.850 0.688 0.595 995 0.7272727272727273 0.800 0.608 0.480 996 0.8181818181818182 0.600 0.379 0.210 997 0.9090909090909091 0.400 0.187 0.000 998 1.0 0.200 0.100 0.000 999 999 } 1000 1000 } … … 1034 1034 set clist { 1035 1035 "#EE82EE" 1036 "#4B0082" 1037 "blue" 1038 "#008000" 1039 "yellow" 1040 "#FFA500" 1041 "red" 1036 "#4B0082" 1037 "blue" 1038 "#008000" 1039 "yellow" 1040 "#FFA500" 1041 "red" 1042 1042 } 1043 1043 } 1044 1044 "BGYOR" { 1045 1045 set clist { 1046 "blue" 1047 "#008000" 1048 "yellow" 1049 "#FFA500" 1050 "red" 1046 "blue" 1047 "#008000" 1048 "yellow" 1049 "#FFA500" 1050 "red" 1051 1051 } 1052 1052 } 1053 1053 "ROYGB" { 1054 1054 set clist { 1055 "red" 1056 "#FFA500" 1057 "yellow" 1058 "#008000" 1059 "blue" 1055 "red" 1056 "#FFA500" 1057 "yellow" 1058 "#008000" 1059 "blue" 1060 1060 } 1061 1061 } 1062 1062 "RYGCB" { 1063 1063 set clist { 1064 "red" 1065 "yellow" 1064 "red" 1065 "yellow" 1066 1066 "green" 1067 1067 "cyan" … … 1071 1071 "BCGYR" { 1072 1072 set clist { 1073 "blue" 1073 "blue" 1074 1074 "cyan" 1075 1075 "green" 1076 "yellow" 1077 "red" 1076 "yellow" 1077 "red" 1078 1078 } 1079 1079 } 1080 1080 "spectral" { 1081 1081 return { 1082 0.0 0.150 0.300 1.000 1083 0.1 0.250 0.630 1.000 1084 0.2 0.450 0.850 1.000 1085 0.3 0.670 0.970 1.000 1086 0.4 0.880 1.000 1.000 1087 0.5 1.000 1.000 0.750 1088 0.6 1.000 0.880 0.600 1089 0.7 1.000 0.680 0.450 1090 0.8 0.970 0.430 0.370 1091 0.9 0.850 0.150 0.196 1082 0.0 0.150 0.300 1.000 1083 0.1 0.250 0.630 1.000 1084 0.2 0.450 0.850 1.000 1085 0.3 0.670 0.970 1.000 1086 0.4 0.880 1.000 1.000 1087 0.5 1.000 1.000 0.750 1088 0.6 1.000 0.880 0.600 1089 0.7 1.000 0.680 0.450 1090 0.8 0.970 0.430 0.370 1091 0.9 0.850 0.150 0.196 1092 1092 1.0 0.650 0.000 0.130 1093 1093 } … … 1095 1095 "green-to-magenta" { 1096 1096 return { 1097 0.0 0.000 0.316 0.000 1098 0.06666666666666667 0.000 0.526 0.000 1099 0.13333333333333333 0.000 0.737 0.000 1100 0.2 0.000 0.947 0.000 1101 0.26666666666666666 0.316 1.000 0.316 1102 0.3333333333333333 0.526 1.000 0.526 1103 0.4 0.737 1.000 0.737 1104 0.4666666666666667 1.000 1.000 1.000 1105 0.5333333333333333 1.000 0.947 1.000 1106 0.6 1.000 0.737 1.000 1107 0.6666666666666666 1.000 0.526 1.000 1108 0.7333333333333333 1.000 0.316 1.000 1109 0.8 0.947 0.000 0.947 1110 0.8666666666666667 0.737 0.000 0.737 1111 0.9333333333333333 0.526 0.000 0.526 1097 0.0 0.000 0.316 0.000 1098 0.06666666666666667 0.000 0.526 0.000 1099 0.13333333333333333 0.000 0.737 0.000 1100 0.2 0.000 0.947 0.000 1101 0.26666666666666666 0.316 1.000 0.316 1102 0.3333333333333333 0.526 1.000 0.526 1103 0.4 0.737 1.000 0.737 1104 0.4666666666666667 1.000 1.000 1.000 1105 0.5333333333333333 1.000 0.947 1.000 1106 0.6 1.000 0.737 1.000 1107 0.6666666666666666 1.000 0.526 1.000 1108 0.7333333333333333 1.000 0.316 1.000 1109 0.8 0.947 0.000 0.947 1110 0.8666666666666667 0.737 0.000 0.737 1111 0.9333333333333333 0.526 0.000 0.526 1112 1112 1.0 0.316 0.000 0.316 1113 1113 } 1114 1114 } 1115 1115 "greyscale" { 1116 return { 1116 return { 1117 1117 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 1118 1118 } … … 1144 1144 # 1145 1145 itcl::body Rappture::VisViewer::StartBufferingCommands { } { 1146 incr _buffering 1146 incr _buffering 1147 1147 if { $_buffering == 1 } { 1148 1148 set _outbuf "" … … 1170 1170 # 1171 1171 # Send commands off to the rendering server. If we're currently 1172 # sending data objects to the server, buffer the commands to be 1172 # sending data objects to the server, buffer the commands to be 1173 1173 # sent later. 1174 1174 # … … 1185 1185 # 1186 1186 # Send commands off to the rendering server. If we're currently 1187 # sending data objects to the server, buffer the commands to be 1187 # sending data objects to the server, buffer the commands to be 1188 1188 # sent later. 1189 1189 # -
branches/1.4/gui/scripts/vtkheightmapviewer.tcl
r4770 r5007 1 # -*- mode: tcl; indent-tabs-mode: nil -*- 1 # -*- mode: tcl; indent-tabs-mode: nil -*- 2 2 # ---------------------------------------------------------------------- 3 3 # COMPONENT: vtkheightmapviewer - Vtk heightmap viewer … … 58 58 public method get {args} 59 59 public method isconnected {} 60 public method parameters {title args} { 61 # do nothing 60 public method parameters {title args} { 61 # do nothing 62 62 } 63 63 public method scale {args} … … 69 69 private method BuildColormap { name } 70 70 private method BuildContourTab {} 71 private method BuildDownloadPopup { widget command } 71 private method BuildDownloadPopup { widget command } 72 72 private method CameraReset {} 73 73 private method Combo { option } … … 78 78 private method DoRotate {} 79 79 private method DrawLegend {} 80 private method EnterLegend { x y } 81 private method EventuallyRequestLegend {} 82 private method EventuallyResize { w h } 80 private method EnterLegend { x y } 81 private method EventuallyRequestLegend {} 82 private method EventuallyResize { w h } 83 83 private method EventuallyRotate { q } 84 private method GetHeightmapScale {} 85 private method GetImage { args } 86 private method GetVtkData { args } 84 private method GetHeightmapScale {} 85 private method GetImage { args } 86 private method GetVtkData { args } 87 87 private method InitSettings { args } 88 private method IsValidObject { dataobj } 88 private method IsValidObject { dataobj } 89 89 private method LeaveLegend {} 90 private method MotionLegend { x y } 90 private method MotionLegend { x y } 91 91 private method Pan {option x y} 92 92 private method PanCamera {} 93 93 private method Pick {x y} 94 private method QuaternionToView { q } { 94 private method QuaternionToView { q } { 95 95 foreach { _view(-qw) _view(-qx) _view(-qy) _view(-qz) } $q break 96 96 } … … 104 104 private method SetCurrentColormap { color } 105 105 private method SetLegendTip { x y } 106 private method SetObjectStyle { dataobj comp } 106 private method SetObjectStyle { dataobj comp } 107 107 private method SetOrientation { side } 108 108 private method UpdateContourList {} 109 private method ViewToQuaternion {} { 109 private method ViewToQuaternion {} { 110 110 return [list $_view(-qw) $_view(-qx) $_view(-qy) $_view(-qz)] 111 111 } … … 116 116 private variable _obj2datasets 117 117 private variable _obj2ovride ; # maps dataobj => style override 118 private variable _comp2scale; 119 private variable _datasets ; # contains all the dataobj-component 118 private variable _comp2scale; # maps dataset to the heightmap scale. 119 private variable _datasets ; # contains all the dataobj-component 120 120 ; # datasets in the server 121 121 private variable _colormaps ; # contains all the colormaps … … 133 133 134 134 private variable _click ; # info used for rotate operations 135 private variable _limits ; # Holds overall limits for all dataobjs 135 private variable _limits ; # Holds overall limits for all dataobjs 136 136 # using the viewer. 137 137 private variable _view ; # view params for 3D view … … 158 158 private variable _rotatePending 0 159 159 private variable _legendPending 0 160 private variable _fieldNames {} 161 private variable _fields 160 private variable _fieldNames {} 161 private variable _fields 162 162 private variable _curFldName "" 163 163 private variable _curFldLabel "" … … 255 255 } { 256 256 usual 257 ignore -highlightthickness -borderwidth -background 257 ignore -highlightthickness -borderwidth -background 258 258 } 259 259 … … 261 261 menu $itk_component(plotarea).menu \ 262 262 -relief flat \ 263 -tearoff no 263 -tearoff no 264 264 } { 265 265 usual … … 281 281 282 282 set _map(id) [$c create image 0 0 -anchor nw -image $_image(plot)] 283 set _map(cwidth) -1 284 set _map(cheight) -1 283 set _map(cwidth) -1 284 set _map(cheight) -1 285 285 set _map(zoom) 1.0 286 286 set _map(original) "" … … 350 350 BuildCameraTab 351 351 } errs] != 0 } { 352 352 global errorInfo 353 353 puts stderr "errs=$errs errorInfo=$errorInfo" 354 354 } 355 355 356 # Hack around the Tk panewindow. The problem is that the requested 356 # Hack around the Tk panewindow. The problem is that the requested 357 357 # size of the 3d view isn't set until an image is retrieved from 358 358 # the server. So the panewindow uses the tiny size. … … 360 360 pack forget $itk_component(view) 361 361 blt::table $itk_component(plotarea) \ 362 0,0 $itk_component(view) -fill both -reqwidth $w 362 0,0 $itk_component(view) -fill both -reqwidth $w 363 363 blt::table configure $itk_component(plotarea) c1 -resize none 364 364 … … 444 444 445 445 itcl::body Rappture::VtkHeightmapViewer::DoRotate {} { 446 SendCmd "camera orient [ViewToQuaternion]" 446 SendCmd "camera orient [ViewToQuaternion]" 447 447 set _rotatePending 0 448 448 } … … 471 471 if { !$_rotatePending } { 472 472 set _rotatePending 1 473 global rotate_delay 473 global rotate_delay 474 474 $_dispatcher event -after $rotate_delay !rotate 475 475 } … … 570 570 continue 571 571 } 572 if {[info exists _obj2ovride($dataobj-raise)] && 572 if {[info exists _obj2ovride($dataobj-raise)] && 573 573 $_obj2ovride($dataobj-raise)} { 574 574 set dlist [linsert $dlist 0 $dataobj] … … 598 598 } 599 599 return $dlist 600 } 600 } 601 601 -image { 602 602 if {[llength $args] != 2} { … … 618 618 } 619 619 620 # 620 # 621 621 # scale -- 622 622 # 623 623 # This gets called either incrementally as new simulations are 624 624 # added or all at once as a sequence of heightmaps. 625 # This accounts for all objects--even those not showing on the 626 # screen. Because of this, the limits are appropriate for all 625 # This accounts for all objects--even those not showing on the 626 # screen. Because of this, the limits are appropriate for all 627 627 # objects as the user scans through data in the ResultSet viewer. 628 628 # … … 816 816 $_dispatcher cancel !legend 817 817 # disconnected -- no more data sitting on server 818 array unset _datasets 819 array unset _data 820 array unset _colormaps 821 array unset _obj2datasets 818 array unset _datasets 819 array unset _data 820 array unset _colormaps 821 array unset _obj2datasets 822 822 global readyForNextFrame 823 823 set readyForNextFrame 1 … … 851 851 set time [clock seconds] 852 852 set date [clock format $time] 853 #puts stderr "$date: received image [image width $_image(plot)]x[image height $_image(plot)] image>" 853 #puts stderr "$date: received image [image width $_image(plot)]x[image height $_image(plot)] image>" 854 854 if { $_start > 0 } { 855 855 set finish [clock clicks -milliseconds] … … 922 922 # Turn on buffering of commands to the server. We don't want to 923 923 # be preempted by a server disconnect/reconnect (which automatically 924 # generates a new call to Rebuild). 924 # generates a new call to Rebuild). 925 925 StartBufferingCommands 926 926 927 927 if { $_width != $w || $_height != $h || $_reset } { 928 929 930 931 932 933 934 928 set _width $w 929 set _height $h 930 $_arcball resize $w $h 931 DoResize 932 if { $_settings(-stretchtofit) } { 933 AdjustSetting -stretchtofit 934 } 935 935 } 936 936 if { $_reset } { 937 938 939 937 # 938 # Reset the camera and other view parameters 939 # 940 940 InitSettings -isheightmap -background 941 941 942 942 # Setting a custom exponent and label format for axes is causing 943 # a problem with rounding. Near zero ticks aren't rounded by 943 # a problem with rounding. Near zero ticks aren't rounded by 944 944 # the %g format. The VTK CubeAxes seem to currently work best 945 # when allowed to automatically set the exponent and precision 946 # based on the axis ranges. This does tend to result in less 947 # visual clutter, so I think it is best to use the automatic 945 # when allowed to automatically set the exponent and precision 946 # based on the axis ranges. This does tend to result in less 947 # visual clutter, so I think it is best to use the automatic 948 948 # settings by default. We can test more fine-grained 949 949 # controls on the axis settings tab if necessary. … … 951 951 #SendCmd "axis exp 0 0 0 1" 952 952 953 954 953 SendCmd "axis lrot z 90" 954 $_arcball quaternion [ViewToQuaternion] 955 955 if {$_settings(-isheightmap) } { 956 956 if { $_view(-ortho)} { … … 961 961 DoRotate 962 962 SendCmd "camera reset" 963 964 963 } 964 PanCamera 965 965 StopBufferingCommands 966 966 SendCmd "imgflush" … … 981 981 if { ![info exists _datasets($tag)] } { 982 982 set bytes [$dataobj vtkdata $comp] 983 if 0 { 983 if 0 { 984 984 set f [open /tmp/vtkheightmap.vtk "w"] 985 985 fconfigure $f -translation binary -encoding binary 986 986 puts -nonewline $f $bytes 987 987 close $f 988 988 } 989 989 set length [string length $bytes] 990 990 if { $_reportClientInfo } { … … 1011 1011 SendCmd "dataset visible 1 $tag" 1012 1012 } 1013 if { ![info exists _comp2scale($tag)] || 1014 1015 1016 1017 1013 if { ![info exists _comp2scale($tag)] || 1014 $_comp2scale($tag) != $scale } { 1015 SendCmd "heightmap heightscale $scale $tag" 1016 set _comp2scale($tag) $scale 1017 } 1018 1018 } 1019 1019 } 1020 1020 if { $_first != "" } { 1021 1022 1023 1021 $itk_component(field) choices delete 0 end 1022 $itk_component(fieldmenu) delete 0 end 1023 array unset _fields 1024 1024 set _curFldName "" 1025 1025 foreach cname [$_first components] { … … 1050 1050 1051 1051 if { $_reset } { 1052 1052 SendCmd "axis tickpos outside" 1053 1053 #SendCmd "axis lformat all %g" 1054 1055 1054 1055 foreach axis { x y z } { 1056 1056 if { $axis == "z" } { 1057 1057 set label [$_first hints label] … … 1059 1059 set label [$_first hints ${axis}label] 1060 1060 } 1061 1062 1061 if { $label == "" } { 1062 if {$axis == "z"} { 1063 1063 if { [string match "component*" $_curFldName] } { 1064 1064 set label [string toupper $axis] … … 1066 1066 set label $_curFldLabel 1067 1067 } 1068 1069 1070 1071 1072 1073 1074 1075 1068 } else { 1069 set label [string toupper $axis] 1070 } 1071 } 1072 # May be a space in the axis label. 1073 SendCmd [list axis name $axis $label] 1074 1075 if {$axis == "z" && [$_first hints ${axis}units] == ""} { 1076 1076 if {$_curFldName != ""} { 1077 1077 set units [lindex $_fields($_curFldName) 1] 1078 1078 } 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1079 } else { 1080 set units [$_first hints ${axis}units] 1081 } 1082 if { $units != "" } { 1083 # May be a space in the axis units. 1084 SendCmd [list axis units $axis $units] 1085 } 1086 } 1087 # 1088 # Reset the camera and other view parameters 1089 # 1090 ResetAxes 1091 $_arcball quaternion [ViewToQuaternion] 1092 1092 if {$_settings(-isheightmap) } { 1093 1093 if { $_view(-ortho)} { … … 1099 1099 SendCmd "camera reset" 1100 1100 } 1101 1102 1103 1101 PanCamera 1102 InitSettings -xgrid -ygrid -zgrid \ 1103 -axisvisible -axislabels -heightmapscale -field -isheightmap \ 1104 1104 -numisolines 1105 1105 if { [array size _fields] < 2 } { … … 1110 1110 } 1111 1111 global readyForNextFrame 1112 set readyForNextFrame 0; 1112 set readyForNextFrame 0; # Don't advance to the next frame 1113 1113 1114 1114 # Actually write the commands to the server socket. If it fails, we don't … … 1128 1128 itcl::body Rappture::VtkHeightmapViewer::CurrentDatasets {args} { 1129 1129 set flag [lindex $args 0] 1130 switch -- $flag { 1130 switch -- $flag { 1131 1131 "-all" { 1132 1132 if { [llength $args] > 1 } { … … 1147 1147 set dlist [get -visible] 1148 1148 } 1149 } 1149 } 1150 1150 default { 1151 1151 set dlist $args … … 1278 1278 foreach tag [CurrentDatasets -visible] { 1279 1279 SendCmd "dataset getscalar pixel $x $y $tag" 1280 } 1280 } 1281 1281 } 1282 1282 … … 1382 1382 "-background" { 1383 1383 set bg [$itk_component(background) value] 1384 1385 1386 1387 "grey""black"1388 1384 array set fgcolors { 1385 "black" "white" 1386 "white" "black" 1387 "grey" "black" 1388 } 1389 1389 set fg $fgcolors($bg) 1390 1390 configure -plotbackground $bg -plotforeground $fg 1391 1391 $itk_component(view) delete "legend" 1392 1392 SendCmd "screen bgcolor [Color2RGB $bg]" 1393 1393 SendCmd "outline color [Color2RGB $fg]" 1394 1394 SendCmd "axis color all [Color2RGB $fg]" 1395 1395 DrawLegend 1396 1396 } 1397 1397 "-colormap" { … … 1400 1400 set color [$itk_component(colormap) value] 1401 1401 set _settings($what) $color 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1402 if { $color == "none" } { 1403 if { $_settings(-colormapvisible) } { 1404 SendCmd "heightmap surface 0" 1405 set _settings(-colormapvisible) 0 1406 } 1407 } else { 1408 if { !$_settings(-colormapvisible) } { 1409 SendCmd "heightmap surface 1" 1410 set _settings(-colormapvisible) 1 1411 } 1412 SetCurrentColormap $color 1413 1413 if {$_settings(-colormapdiscrete)} { 1414 1414 set numColors [expr $_settings(-numisolines) + 1] 1415 1415 SendCmd "colormap res $numColors $color" 1416 1416 } 1417 1417 } 1418 1418 StopBufferingCommands 1419 1419 EventuallyRequestLegend 1420 1420 } 1421 1421 "-colormapvisible" { … … 1460 1460 return 1461 1461 } 1462 1463 1462 set label [$_first hints label] 1463 if { $label == "" } { 1464 1464 if { [string match "component*" $_curFldName] } { 1465 1465 set label Z … … 1467 1467 set label $_curFldLabel 1468 1468 } 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1469 } 1470 # May be a space in the axis label. 1471 SendCmd [list axis name z $label] 1472 1473 if { [$_first hints zunits] == "" } { 1474 set units [lindex $_fields($_curFldName) 1] 1475 } else { 1476 set units [$_first hints zunits] 1477 } 1478 if { $units != "" } { 1479 # May be a space in the axis units. 1480 SendCmd [list axis units z $units] 1481 } 1482 1482 # Get the new limits because the field changed. 1483 1483 ResetAxes … … 1489 1489 } 1490 1490 "-heightmapscale" { 1491 1492 1493 # Have to set the datasets individually because we are 1491 if { $_settings(-isheightmap) } { 1492 set scale [GetHeightmapScale] 1493 # Have to set the datasets individually because we are 1494 1494 # tracking them in _comp2scale. 1495 1495 foreach dataset [CurrentDatasets -all] { 1496 1497 1498 1499 1500 1496 SendCmd "heightmap heightscale $scale $dataset" 1497 set _comp2scale($dataset) $scale 1498 } 1499 ResetAxes 1500 } 1501 1501 } 1502 1502 "-isheightmap" { 1503 1503 set bool $_settings($what) 1504 1504 set c $itk_component(view) 1505 1505 StartBufferingCommands … … 1518 1518 InitSettings -lighting -opacity -outline 1519 1519 set scale [GetHeightmapScale] 1520 # Have to set the datasets individually because we are 1520 # Have to set the datasets individually because we are 1521 1521 # tracking them in _comp2scale. 1522 1522 foreach dataset [CurrentDatasets -all] { … … 1524 1524 set _comp2scale($dataset) $scale 1525 1525 } 1526 1527 1528 1529 1530 1531 1532 1526 if { $bool } { 1527 $itk_component(lighting) configure -state normal 1528 $itk_component(opacity) configure -state normal 1529 $itk_component(scale) configure -state normal 1530 $itk_component(opacity_l) configure -state normal 1531 $itk_component(scale_l) configure -state normal 1532 $itk_component(outline) configure -state disabled 1533 1533 if {$_view(-ortho)} { 1534 1534 SendCmd "camera mode ortho" … … 1536 1536 SendCmd "camera mode persp" 1537 1537 } 1538 1539 1540 1541 1542 1543 1544 1538 } else { 1539 $itk_component(lighting) configure -state disabled 1540 $itk_component(opacity) configure -state disabled 1541 $itk_component(scale) configure -state disabled 1542 $itk_component(opacity_l) configure -state disabled 1543 $itk_component(scale_l) configure -state disabled 1544 $itk_component(outline) configure -state normal 1545 1545 SendCmd "camera mode image" 1546 1546 } … … 1556 1556 set q [ViewToQuaternion] 1557 1557 $_arcball quaternion $q 1558 SendCmd "camera orient $q" 1558 SendCmd "camera orient $q" 1559 1559 } else { 1560 1560 bind $c <ButtonPress-1> {} … … 1563 1563 } 1564 1564 Zoom reset 1565 # Fix the mouse bindings for rotation/panning and the 1565 # Fix the mouse bindings for rotation/panning and the 1566 1566 # camera mode. Ideally we'd create a bindtag for these. 1567 1567 if { $bool } { … … 1578 1578 "-isolinecolor" { 1579 1579 set color [$itk_component(isolinecolor) value] 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1580 if { $color == "none" } { 1581 if { $_settings(-isolinesvisible) } { 1582 SendCmd "heightmap isolines 0" 1583 set _settings(-isolinesvisible) 0 1584 } 1585 } else { 1586 if { !$_settings(-isolinesvisible) } { 1587 SendCmd "heightmap isolines 1" 1588 set _settings(-isolinesvisible) 1 1589 } 1590 SendCmd "heightmap isolinecolor [Color2RGB $color]" 1591 } 1592 DrawLegend 1593 1593 } 1594 1594 "-isolinesvisible" { 1595 1595 set bool $_settings($what) 1596 1596 SendCmd "heightmap isolines $bool" 1597 1597 DrawLegend 1598 1598 } 1599 1599 "-legendvisible" { 1600 1600 if { !$_settings($what) } { 1601 1602 1603 1601 $itk_component(view) delete legend 1602 } 1603 DrawLegend 1604 1604 } 1605 1605 "-lighting" { 1606 1606 if { $_settings(-isheightmap) } { 1607 1607 set _settings(-savelighting) $_settings($what) 1608 1609 1610 1611 1612 1608 set bool $_settings($what) 1609 SendCmd "heightmap lighting $bool" 1610 } else { 1611 SendCmd "heightmap lighting 0" 1612 } 1613 1613 } 1614 1614 "-numisolines" { … … 1629 1629 set _changed($what) 1 1630 1630 set val [expr $_settings($what) * 0.01] 1631 1631 if { $_settings(-isheightmap) } { 1632 1632 set _settings(-saveopacity) $_settings($what) 1633 1633 SendCmd "heightmap opacity $val" 1634 1634 } else { 1635 1635 SendCmd "heightmap opacity 1.0" 1636 1636 } 1637 1637 } 1638 1638 "-outline" { 1639 1640 1639 if { $_settings(-isheightmap) } { 1640 SendCmd "outline visible 0" 1641 1641 } else { 1642 1642 set _settings(-saveoutline) $_settings($what) … … 1644 1644 SendCmd "outline visible $bool" 1645 1645 } 1646 1646 } 1647 1647 "-stretchtofit" { 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1648 set bool $_settings($what) 1649 if { $bool } { 1650 set heightScale [GetHeightmapScale] 1651 if {$heightScale == 0} { 1652 SendCmd "camera aspect window" 1653 } else { 1654 SendCmd "camera aspect square" 1655 } 1656 } else { 1657 SendCmd "camera aspect native" 1658 } 1659 1659 Zoom reset 1660 1660 } 1661 1661 "-wireframe" { 1662 1662 set bool $_settings($what) … … 1668 1668 SendCmd "axis grid $axis $bool" 1669 1669 } 1670 1670 default { 1671 1671 error "don't know how to fix $what" 1672 1672 } … … 1678 1678 # 1679 1679 # Request a new legend from the server. The size of the legend 1680 # is determined from the height of the canvas. 1680 # is determined from the height of the canvas. 1681 1681 # 1682 1682 # This should be called when 1683 # 1684 # 1685 # 1686 # 1687 # 1683 # 1. A new current colormap is set. 1684 # 2. Window is resized. 1685 # 3. The limits of the data have changed. (Just need a redraw). 1686 # 4. Number of isolines have changed. (Just need a redraw). 1687 # 5. Legend becomes visible (Just need a redraw). 1688 1688 # 1689 1689 itcl::body Rappture::VtkHeightmapViewer::RequestLegend {} { … … 1692 1692 set w 12 1693 1693 set lineht [font metrics $font -linespace] 1694 # color ramp height = (canvas height) - (min and max value lines) - 2 1694 # color ramp height = (canvas height) - (min and max value lines) - 2 1695 1695 set h [expr {$_height - 2 * ($lineht + 2)}] 1696 1696 set _legendHeight $h … … 1698 1698 set fname $_curFldName 1699 1699 if { [string match "component*" $fname] } { 1700 1700 set title "" 1701 1701 } else { 1702 1703 1704 1705 1706 1707 1708 1709 1702 if { [info exists _fields($fname)] } { 1703 foreach { title units } $_fields($fname) break 1704 if { $units != "" } { 1705 set title [format "%s (%s)" $title $units] 1706 } 1707 } else { 1708 set title $fname 1709 } 1710 1710 } 1711 1711 # If there's a title too, substract one more line 1712 1712 if { $title != "" } { 1713 incr h -$lineht 1713 incr h -$lineht 1714 1714 } 1715 1715 if { $h < 1 } { … … 1718 1718 # Set the legend on the first heightmap dataset. 1719 1719 if { $_currentColormap != "" } { 1720 1721 1720 set cmap $_currentColormap 1721 #SendCmd "legend $cmap scalar $_curFldName {} $w $h 0" 1722 1722 SendCmd "legend2 $cmap $w $h" 1723 1723 } … … 1773 1773 # Keep track of the colormaps that we build. 1774 1774 if { $name != "none" && ![info exists _colormaps($name)] } { 1775 BuildColormap $name 1775 BuildColormap $name 1776 1776 set _colormaps($name) 1 1777 1777 } … … 1799 1799 itcl::configbody Rappture::VtkHeightmapViewer::mode { 1800 1800 switch -- $itk_option(-mode) { 1801 1802 1803 1804 1805 1806 } 1807 1808 1809 1801 "heightmap" { 1802 set _settings(-isheightmap) 1 1803 } 1804 "contour" { 1805 set _settings(-isheightmap) 0 1806 } 1807 default { 1808 error "unknown mode settings \"$itk_option(-mode)\"" 1809 } 1810 1810 } 1811 1811 if { !$_reset } { … … 1823 1823 SendCmd "screen bgcolor $rgb" 1824 1824 } 1825 1825 $itk_component(view) configure -background $itk_option(-plotbackground) 1826 1826 } 1827 1827 } … … 1863 1863 1864 1864 itk_component add lighting { 1865 1866 1867 1868 1869 1865 checkbutton $inner.lighting \ 1866 -text "Enable Lighting" \ 1867 -variable [itcl::scope _settings(-lighting)] \ 1868 -command [itcl::code $this AdjustSetting -lighting] \ 1869 -font "Arial 9" 1870 1870 } { 1871 1871 ignore -font 1872 1872 } 1873 1873 checkbutton $inner.edges \ … … 1905 1905 1906 1906 itk_component add field_l { 1907 label $inner.field_l -text "Field" -font "Arial 9" 1907 label $inner.field_l -text "Field" -font "Arial 9" 1908 1908 } { 1909 1909 ignore -font … … 1915 1915 [itcl::code $this AdjustSetting -field] 1916 1916 1917 label $inner.colormap_l -text "Colormap" -font "Arial 9" 1917 label $inner.colormap_l -text "Colormap" -font "Arial 9" 1918 1918 itk_component add colormap { 1919 1919 Rappture::Combobox $inner.colormap -width 10 -editable no … … 1924 1924 [itcl::code $this AdjustSetting -colormap] 1925 1925 1926 label $inner.isolinecolor_l -text "Isolines Color" -font "Arial 9" 1926 label $inner.isolinecolor_l -text "Isolines Color" -font "Arial 9" 1927 1927 itk_component add isolinecolor { 1928 1928 Rappture::Combobox $inner.isolinecolor -width 10 -editable no … … 1938 1938 "red" "red" \ 1939 1939 "white" "white" \ 1940 "none""none"1940 "none" "none" 1941 1941 1942 1942 $itk_component(isolinecolor) value $_settings(-isolinecolor) 1943 1943 bind $inner.isolinecolor <<Value>> \ 1944 1945 1946 label $inner.background_l -text "Background Color" -font "Arial 9" 1944 [itcl::code $this AdjustSetting -isolinecolor] 1945 1946 label $inner.background_l -text "Background Color" -font "Arial 9" 1947 1947 itk_component add background { 1948 1948 Rappture::Combobox $inner.background -width 10 -editable no … … 1951 1951 "black" "black" \ 1952 1952 "white" "white" \ 1953 "grey" "grey" 1953 "grey" "grey" 1954 1954 1955 1955 $itk_component(background) value "white" … … 1998 1998 2,0 $inner.isolinecolor_l -anchor w -pady 2 \ 1999 1999 2,1 $inner.isolinecolor -anchor w -pady 2 -fill x \ 2000 2001 2000 3,0 $inner.background_l -anchor w -pady 2 \ 2001 3,1 $inner.background -anchor w -pady 2 -fill x \ 2002 2002 4,0 $inner.numisolines_l -anchor w -pady 2 \ 2003 2003 4,1 $inner.numisolines -anchor w -pady 2 \ … … 2041 2041 -command [itcl::code $this AdjustSetting -axislabels] \ 2042 2042 -font "Arial 9" 2043 label $inner.grid_l -text "Grid" -font "Arial 9" 2043 label $inner.grid_l -text "Grid" -font "Arial 9" 2044 2044 checkbutton $inner.xgrid \ 2045 2045 -text "X" \ … … 2063 2063 -font "Arial 9" 2064 2064 2065 label $inner.mode_l -text "Mode" -font "Arial 9" 2065 label $inner.mode_l -text "Mode" -font "Arial 9" 2066 2066 2067 2067 itk_component add axisflymode { … … 2072 2072 "closest_triad" "closest" \ 2073 2073 "furthest_triad" "farthest" \ 2074 "outer_edges" "outer" 2074 "outer_edges" "outer" 2075 2075 $itk_component(axisflymode) value $_settings(-axisflymode) 2076 2076 bind $inner.mode <<Value>> [itcl::code $this AdjustSetting -axisflymode] … … 2080 2080 1,0 $inner.labels -anchor w -cspan 4 \ 2081 2081 2,0 $inner.minorticks -anchor w -cspan 4 \ 2082 2082 4,0 $inner.grid_l -anchor w \ 2083 2083 4,1 $inner.xgrid -anchor w \ 2084 2084 4,2 $inner.ygrid -anchor w \ 2085 2085 4,3 $inner.zgrid -anchor w \ 2086 2086 5,0 $inner.mode_l -anchor w -padx { 2 0 } \ 2087 5,1 $inner.mode -fill x -cspan 3 2087 5,1 $inner.mode -fill x -cspan 3 2088 2088 2089 2089 blt::table configure $inner r* c* -resize none … … 2144 2144 2145 2145 # 2146 # camera -- 2146 # camera -- 2147 2147 # 2148 2148 itcl::body Rappture::VtkHeightmapViewer::camera {option args} { 2149 switch -- $option { 2149 switch -- $option { 2150 2150 "show" { 2151 2151 puts [array get _view] … … 2195 2195 2196 2196 itcl::body Rappture::VtkHeightmapViewer::GetImage { args } { 2197 if { [image width $_image(download)] > 0 && 2197 if { [image width $_image(download)] > 0 && 2198 2198 [image height $_image(download)] > 0 } { 2199 2199 set bytes [$_image(download) data -format "jpeg -quality 100"] … … 2208 2208 -title "[Rappture::filexfer::label downloadWord] as..." 2209 2209 set inner [$popup component inner] 2210 label $inner.summary -text "" -anchor w 2210 label $inner.summary -text "" -anchor w 2211 2211 radiobutton $inner.vtk_button -text "VTK data file" \ 2212 2212 -variable [itcl::scope _downloadPopup(format)] \ 2213 2213 -font "Arial 9 " \ 2214 -value vtk 2214 -value vtk 2215 2215 Rappture::Tooltip::for $inner.vtk_button "Save as VTK data file." 2216 2216 radiobutton $inner.image_button -text "Image File" \ 2217 2217 -variable [itcl::scope _downloadPopup(format)] \ 2218 2218 -font "Arial 9 " \ 2219 -value image 2219 -value image 2220 2220 Rappture::Tooltip::for $inner.image_button \ 2221 2221 "Save as digital image." … … 2238 2238 2,0 $inner.image_button -anchor w -cspan 2 -padx { 4 0 } \ 2239 2239 4,1 $inner.cancel -width .9i -fill y \ 2240 4,0 $inner.ok -padx 2 -width .9i -fill y 2240 4,0 $inner.ok -padx 2 -width .9i -fill y 2241 2241 blt::table configure $inner r3 -height 4 2242 2242 blt::table configure $inner r4 -pady 4 … … 2249 2249 # SetObjectStyle -- 2250 2250 # 2251 # Set the style of the heightmap/contour object. This gets calls 2251 # Set the style of the heightmap/contour object. This gets calls 2252 2252 # for each dataset once as it is loaded. It can overridden by 2253 2253 # the user controls. … … 2340 2340 #puts stderr "read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>" 2341 2341 if { [catch {DrawLegend} errs] != 0 } { 2342 2343 2342 global errorInfo 2343 puts stderr "errs=$errs errorInfo=$errorInfo" 2344 2344 } 2345 2345 } … … 2358 2358 set font "Arial 8" 2359 2359 set lineht [font metrics $font -linespace] 2360 2360 2361 2361 if { [string match "component*" $fname] } { 2362 2362 set title "" 2363 2363 } else { 2364 2365 2366 2367 2368 2369 2370 2371 2364 if { [info exists _fields($fname)] } { 2365 foreach { title units } $_fields($fname) break 2366 if { $units != "" } { 2367 set title [format "%s (%s)" $title $units] 2368 } 2369 } else { 2370 set title $fname 2371 } 2372 2372 } 2373 2373 set x [expr $w - 2] 2374 2374 if { !$_settings(-legendvisible) } { 2375 2376 2377 } 2375 $c delete legend 2376 return 2377 } 2378 2378 if { [$c find withtag "legend"] == "" } { 2379 set y 2 2380 2379 set y 2 2380 # If there's a legend title, create a text item for the title. 2381 2381 $c create text $x $y \ 2382 2382 -anchor ne \ … … 2386 2386 incr y $lineht 2387 2387 } 2388 2388 $c create text $x $y \ 2389 2389 -anchor ne \ 2390 2390 -fill $itk_option(-plotforeground) -tags "vmax legend" \ 2391 2391 -font $font 2392 2392 incr y $lineht 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2393 $c create image $x $y \ 2394 -anchor ne \ 2395 -image $_image(legend) -tags "colormap legend" 2396 $c create rectangle $x $y 1 1 \ 2397 -fill "" -outline "" -tags "sensor legend" 2398 $c create text $x [expr {$h-2}] \ 2399 -anchor se \ 2400 -fill $itk_option(-plotforeground) -tags "vmin legend" \ 2401 -font $font 2402 $c bind sensor <Enter> [itcl::code $this EnterLegend %x %y] 2403 $c bind sensor <Leave> [itcl::code $this LeaveLegend] 2404 $c bind sensor <Motion> [itcl::code $this MotionLegend %x %y] 2405 2405 } 2406 2406 $c delete isoline … … 2413 2413 # Draw the isolines on the legend. 2414 2414 array unset _isolines 2415 if { $color != "none" && [info exists _limits($_curFldName)] && 2415 if { $color != "none" && [info exists _limits($_curFldName)] && 2416 2416 $_settings(-isolinesvisible) && $_currentNumIsolines > 0 } { 2417 2417 … … 2422 2422 } 2423 2423 set tags "isoline legend" 2424 2425 2426 2427 2424 set offset [expr 2 + $lineht] 2425 if { $title != "" } { 2426 incr offset $lineht 2427 } 2428 2428 foreach value $_contourList { 2429 2429 set norm [expr 1.0 - (($value - $vmin) / $range)] … … 2433 2433 set _isolines([expr $y1 - $off]) $value 2434 2434 } 2435 2436 2435 $c create line $x1 $y1 $x2 $y1 -fill $color -tags $tags 2436 } 2437 2437 } 2438 2438 … … 2443 2443 if { [info exists _limits($_curFldName)] } { 2444 2444 foreach { vmin vmax } $_limits($_curFldName) break 2445 2446 2445 $c itemconfigure vmin -text [format %g $vmin] 2446 $c itemconfigure vmax -text [format %g $vmax] 2447 2447 } 2448 2448 set y 2 … … 2450 2450 if { $title != "" } { 2451 2451 $c itemconfigure title -text $title 2452 2453 2452 $c coords title $x $y 2453 incr y $lineht 2454 2454 } 2455 2455 $c coords vmax $x $y … … 2499 2499 set font "Arial 8" 2500 2500 set lineht [font metrics $font -linespace] 2501 2501 2502 2502 set ih [image height $_image(legend)] 2503 2503 # Subtract off the offset of the color ramp from the top of the canvas … … 2505 2505 2506 2506 if { [string match "component*" $fname] } { 2507 2507 set title "" 2508 2508 } else { 2509 2510 2511 2512 2513 2514 2515 2516 2509 if { [info exists _fields($fname)] } { 2510 foreach { title units } $_fields($fname) break 2511 if { $units != "" } { 2512 set title [format "%s (%s)" $title $units] 2513 } 2514 } else { 2515 set title $fname 2516 } 2517 2517 } 2518 2518 # If there's a legend title, increase the offset by the line height. … … 2530 2530 } 2531 2531 set color [eval format "\#%02x%02x%02x" $pixel] 2532 $_image(swatch) put black -to 0 0 23 23 2533 $_image(swatch) put $color -to 1 1 22 22 2532 $_image(swatch) put black -to 0 0 23 23 2533 $_image(swatch) put $color -to 1 1 22 22 2534 2534 2535 2535 # Compute the value of the point … … 2541 2541 set value 0.0 2542 2542 } 2543 set tipx [expr $x + 15] 2543 set tipx [expr $x + 15] 2544 2544 set tipy [expr $y - 5] 2545 2545 .rappturetooltip configure -icon $_image(swatch) … … 2549 2549 Rappture::Tooltip::text $c [format "$title %g" $value] 2550 2550 } 2551 Rappture::Tooltip::tooltip show $c +$tipx,+$tipy 2551 Rappture::Tooltip::tooltip show $c +$tipx,+$tipy 2552 2552 } 2553 2553 … … 2564 2564 # ---------------------------------------------------------------------- 2565 2565 itcl::body Rappture::VtkHeightmapViewer::Combo {option} { 2566 set c $itk_component(view) 2566 set c $itk_component(view) 2567 2567 switch -- $option { 2568 2568 post { … … 2577 2577 } 2578 2578 deactivate { 2579 $c itemconfigure title -fill $itk_option(-plotforeground) 2579 $c itemconfigure title -fill $itk_option(-plotforeground) 2580 2580 } 2581 2581 invoke { … … 2591 2591 itcl::body Rappture::VtkHeightmapViewer::GetHeightmapScale {} { 2592 2592 if { $_settings(-isheightmap) } { 2593 2594 2595 2596 } 2597 return 0 2598 } 2599 2600 itcl::body Rappture::VtkHeightmapViewer::SetOrientation { side } { 2593 set val $_settings(-heightmapscale) 2594 set sval [expr { $val >= 50 ? double($val)/50.0 : 1.0/(2.0-(double($val)/50.0)) }] 2595 return $sval 2596 } 2597 return 0 2598 } 2599 2600 itcl::body Rappture::VtkHeightmapViewer::SetOrientation { side } { 2601 2601 array set positions { 2602 2602 front "0.707107 0.707107 0 0" … … 2609 2609 foreach name { -qw -qx -qy -qz } value $positions($side) { 2610 2610 set _view($name) $value 2611 } 2611 } 2612 2612 set q [ViewToQuaternion] 2613 2613 $_arcball quaternion $q … … 2619 2619 } 2620 2620 2621 itcl::body Rappture::VtkHeightmapViewer::UpdateContourList {} { 2621 itcl::body Rappture::VtkHeightmapViewer::UpdateContourList {} { 2622 2622 if {$_currentNumIsolines == 0} { 2623 2623 set _contourList "" -
branches/1.4/gui/scripts/vtkimageviewer.tcl
r4770 r5007 1 # -*- mode: tcl; indent-tabs-mode: nil -*- 1 # -*- mode: tcl; indent-tabs-mode: nil -*- 2 2 # ---------------------------------------------------------------------- 3 3 # COMPONENT: vtkimageviewer - Vtk image viewer … … 58 58 public method get {args} 59 59 public method isconnected {} 60 public method parameters {title args} { 61 # do nothing 60 public method parameters {title args} { 61 # do nothing 62 62 } 63 63 public method scale {args} … … 69 69 private method BuildColormap { name } 70 70 private method BuildImageTab {} 71 private method BuildDownloadPopup { widget command } 71 private method BuildDownloadPopup { widget command } 72 72 private method Combo { option } 73 73 private method Connect {} … … 77 77 private method DoRotate {} 78 78 private method DrawLegend {} 79 private method EnterLegend { x y } 80 private method EventuallyRequestLegend {} 81 private method EventuallyResize { w h } 79 private method EnterLegend { x y } 80 private method EventuallyRequestLegend {} 81 private method EventuallyResize { w h } 82 82 private method EventuallyRotate { q } 83 private method GetImage { args } 84 private method GetVtkData { args } 83 private method GetImage { args } 84 private method GetVtkData { args } 85 85 private method InitSettings { args } 86 private method IsValidObject { dataobj } 86 private method IsValidObject { dataobj } 87 87 private method LeaveLegend {} 88 private method MotionLegend { x y } 88 private method MotionLegend { x y } 89 89 private method Pan {option x y} 90 90 private method PanCamera {} 91 91 private method Pick {x y} 92 private method QuaternionToView { q } { 92 private method QuaternionToView { q } { 93 93 foreach { _view(-qw) _view(-qx) _view(-qy) _view(-qz) } $q break 94 94 } … … 101 101 private method SetCurrentColormap { color } 102 102 private method SetLegendTip { x y } 103 private method SetObjectStyle { dataobj comp } 103 private method SetObjectStyle { dataobj comp } 104 104 private method SetOrientation { side } 105 private method ViewToQuaternion {} { 105 private method ViewToQuaternion {} { 106 106 return [list $_view(-qw) $_view(-qx) $_view(-qy) $_view(-qz)] 107 107 } … … 112 112 private variable _obj2datasets 113 113 private variable _obj2ovride ; # maps dataobj => style override 114 private variable _datasets ; # contains all the dataobj-component 114 private variable _datasets ; # contains all the dataobj-component 115 115 ; # datasets in the server 116 116 private variable _colormaps ; # contains all the colormaps … … 128 128 129 129 private variable _click ; # info used for rotate operations 130 private variable _limits ; # Holds overall limits for all dataobjs 130 private variable _limits ; # Holds overall limits for all dataobjs 131 131 # using the viewer. 132 132 private variable _view ; # view params for 3D view … … 153 153 private variable _rotatePending 0 154 154 private variable _legendPending 0 155 private variable _fieldNames {} 156 private variable _fields 155 private variable _fieldNames {} 156 private variable _fields 157 157 private variable _curFldName "" 158 158 private variable _curFldLabel "" … … 243 243 } { 244 244 usual 245 ignore -highlightthickness -borderwidth -background 245 ignore -highlightthickness -borderwidth -background 246 246 } 247 247 … … 249 249 menu $itk_component(plotarea).menu \ 250 250 -relief flat \ 251 -tearoff no 251 -tearoff no 252 252 } { 253 253 usual … … 269 269 270 270 set _map(id) [$c create image 0 0 -anchor nw -image $_image(plot)] 271 set _map(cwidth) -1 272 set _map(cheight) -1 271 set _map(cwidth) -1 272 set _map(cheight) -1 273 273 set _map(zoom) 1.0 274 274 set _map(original) "" … … 338 338 BuildCameraTab 339 339 } errs] != 0 } { 340 340 global errorInfo 341 341 puts stderr "errs=$errs errorInfo=$errorInfo" 342 342 } 343 343 344 # Hack around the Tk panewindow. The problem is that the requested 344 # Hack around the Tk panewindow. The problem is that the requested 345 345 # size of the 3d view isn't set until an image is retrieved from 346 346 # the server. So the panewindow uses the tiny size. … … 348 348 pack forget $itk_component(view) 349 349 blt::table $itk_component(plotarea) \ 350 0,0 $itk_component(view) -fill both -reqwidth $w 350 0,0 $itk_component(view) -fill both -reqwidth $w 351 351 blt::table configure $itk_component(plotarea) c1 -resize none 352 352 … … 432 432 433 433 itcl::body Rappture::VtkImageViewer::DoRotate {} { 434 SendCmd "camera orient [ViewToQuaternion]" 434 SendCmd "camera orient [ViewToQuaternion]" 435 435 set _rotatePending 0 436 436 } … … 459 459 if { !$_rotatePending } { 460 460 set _rotatePending 1 461 global rotate_delay 461 global rotate_delay 462 462 $_dispatcher event -after $rotate_delay !rotate 463 463 } … … 558 558 continue 559 559 } 560 if {[info exists _obj2ovride($dataobj-raise)] && 560 if {[info exists _obj2ovride($dataobj-raise)] && 561 561 $_obj2ovride($dataobj-raise)} { 562 562 set dlist [linsert $dlist 0 $dataobj] … … 586 586 } 587 587 return $dlist 588 } 588 } 589 589 -image { 590 590 if {[llength $args] != 2} { … … 606 606 } 607 607 608 # 608 # 609 609 # scale -- 610 610 # 611 611 # This gets called either incrementally as new simulations are 612 612 # added or all at once as a sequence of images. 613 # This accounts for all objects--even those not showing on the 614 # screen. Because of this, the limits are appropriate for all 613 # This accounts for all objects--even those not showing on the 614 # screen. Because of this, the limits are appropriate for all 615 615 # objects as the user scans through data in the ResultSet viewer. 616 616 # … … 804 804 $_dispatcher cancel !legend 805 805 # disconnected -- no more data sitting on server 806 array unset _datasets 807 array unset _data 808 array unset _colormaps 809 array unset _obj2datasets 806 array unset _datasets 807 array unset _data 808 array unset _colormaps 809 array unset _obj2datasets 810 810 global readyForNextFrame 811 811 set readyForNextFrame 1 … … 839 839 set time [clock seconds] 840 840 set date [clock format $time] 841 #puts stderr "$date: received image [image width $_image(plot)]x[image height $_image(plot)] image>" 841 #puts stderr "$date: received image [image width $_image(plot)]x[image height $_image(plot)] image>" 842 842 if { $_start > 0 } { 843 843 set finish [clock clicks -milliseconds] … … 910 910 # Turn on buffering of commands to the server. We don't want to 911 911 # be preempted by a server disconnect/reconnect (which automatically 912 # generates a new call to Rebuild). 912 # generates a new call to Rebuild). 913 913 StartBufferingCommands 914 914 915 915 if { $_width != $w || $_height != $h || $_reset } { 916 917 918 919 920 921 922 916 set _width $w 917 set _height $h 918 $_arcball resize $w $h 919 DoResize 920 if { $_settings(-stretchtofit) } { 921 AdjustSetting -stretchToFit 922 } 923 923 } 924 924 if { $_reset } { 925 926 927 925 # 926 # Reset the camera and other view parameters 927 # 928 928 InitSettings -view3d -background 929 929 930 931 930 SendCmd "axis lrot z 90" 931 $_arcball quaternion [ViewToQuaternion] 932 932 if {$_settings(-view3d) } { 933 933 if { $_view(-ortho)} { … … 938 938 DoRotate 939 939 SendCmd "camera reset" 940 941 940 } 941 PanCamera 942 942 StopBufferingCommands 943 943 SendCmd "imgflush" … … 957 957 if { ![info exists _datasets($tag)] } { 958 958 set bytes [$dataobj vtkdata $comp] 959 if 0 { 959 if 0 { 960 960 set f [open /tmp/vtkimage.vtk "w"] 961 961 fconfigure $f -translation binary -encoding binary 962 962 puts -nonewline $f $bytes 963 963 close $f 964 964 } 965 965 set length [string length $bytes] 966 966 if { $_reportClientInfo } { … … 990 990 } 991 991 if { $_first != "" } { 992 993 994 992 $itk_component(field) choices delete 0 end 993 $itk_component(fieldmenu) delete 0 end 994 array unset _fields 995 995 set _curFldName "" 996 996 foreach cname [$_first components] { … … 1021 1021 1022 1022 if { $_reset } { 1023 1023 SendCmd "axis tickpos outside" 1024 1024 #SendCmd "axis lformat all %g" 1025 1026 1025 1026 foreach axis { x y z } { 1027 1027 set label [$_first hints ${axis}label] 1028 1029 1030 1031 1032 1033 1034 1028 if { $label == "" } { 1029 set label [string toupper $axis] 1030 } 1031 # May be a space in the axis label. 1032 SendCmd [list axis name $axis $label] 1033 1034 if {$axis == "z" && [$_first hints ${axis}units] == ""} { 1035 1035 if {$_curFldName != ""} { 1036 1036 set units [lindex $_fields($_curFldName) 1] 1037 1037 } 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1038 } else { 1039 set units [$_first hints ${axis}units] 1040 } 1041 if { $units != "" } { 1042 # May be a space in the axis units. 1043 SendCmd [list axis units $axis $units] 1044 } 1045 } 1046 # 1047 # Reset the camera and other view parameters 1048 # 1049 $_arcball quaternion [ViewToQuaternion] 1050 1050 if {$_settings(-view3d) } { 1051 1051 if { $_view(-ortho)} { … … 1057 1057 SendCmd "camera reset" 1058 1058 } 1059 1060 1059 PanCamera 1060 InitSettings -xgrid -ygrid -zgrid \ 1061 1061 -axisvisible -axislabels -field -view3d 1062 1062 if { [array size _fields] < 2 } { … … 1067 1067 } 1068 1068 global readyForNextFrame 1069 set readyForNextFrame 0; 1069 set readyForNextFrame 0; # Don't advance to the next frame 1070 1070 1071 1071 # Actually write the commands to the server socket. If it fails, we don't … … 1085 1085 itcl::body Rappture::VtkImageViewer::CurrentDatasets {args} { 1086 1086 set flag [lindex $args 0] 1087 switch -- $flag { 1087 switch -- $flag { 1088 1088 "-all" { 1089 1089 if { [llength $args] > 1 } { … … 1104 1104 set dlist [get -visible] 1105 1105 } 1106 } 1106 } 1107 1107 default { 1108 1108 set dlist $args … … 1226 1226 foreach tag [CurrentDatasets -visible] { 1227 1227 SendCmd "dataset getscalar pixel $x $y $tag" 1228 } 1228 } 1229 1229 } 1230 1230 … … 1330 1330 "-background" { 1331 1331 set bg [$itk_component(background) value] 1332 1333 1334 1335 "grey""black"1336 1332 array set fgcolors { 1333 "black" "white" 1334 "white" "black" 1335 "grey" "black" 1336 } 1337 1337 set fg $fgcolors($bg) 1338 1338 configure -plotbackground $bg -plotforeground $fg 1339 1339 $itk_component(view) delete "legend" 1340 1340 SendCmd "screen bgcolor [Color2RGB $bg]" 1341 1341 SendCmd "outline color [Color2RGB $fg]" 1342 1342 SendCmd "axis color all [Color2RGB $fg]" 1343 1343 DrawLegend 1344 1344 } 1345 1345 "-backingcolor" { 1346 1346 set color [$itk_component(backingcolor) value] 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1347 if { $color == "none" } { 1348 if { $_settings(-backingvisible) } { 1349 SendCmd "image backing 0" 1350 set _settings(-backingvisible) 0 1351 } 1352 } else { 1353 if { !$_settings(-backingvisible) } { 1354 SendCmd "image backing 1" 1355 set _settings(-backingvisible) 1 1356 } 1357 SendCmd "image color [Color2RGB $color]" 1358 } 1359 1359 } 1360 1360 "-backingvisible" { 1361 1361 set bool $_settings($what) 1362 1362 SendCmd "image backing $bool" 1363 1363 } … … 1372 1372 } 1373 1373 StopBufferingCommands 1374 1374 EventuallyRequestLegend 1375 1375 } 1376 1376 "-colormapdiscrete" { … … 1410 1410 } 1411 1411 "-view3d" { 1412 1412 set bool $_settings($what) 1413 1413 set c $itk_component(view) 1414 1414 StartBufferingCommands … … 1420 1420 } 1421 1421 AdjustSetting -opacity 1422 1423 1424 1422 if { $bool } { 1423 $itk_component(opacity) configure -state normal 1424 $itk_component(opacity_l) configure -state normal 1425 1425 if {$_view(-ortho)} { 1426 1426 SendCmd "camera mode ortho" … … 1429 1429 } 1430 1430 SendCmd "camera aspect native" 1431 1432 1433 1431 } else { 1432 $itk_component(opacity) configure -state disabled 1433 $itk_component(opacity_l) configure -state disabled 1434 1434 SendCmd "camera mode image" 1435 1435 if {$_settings(-stretchtofit)} { … … 1440 1440 set q [ViewToQuaternion] 1441 1441 $_arcball quaternion $q 1442 SendCmd "camera orient $q" 1442 SendCmd "camera orient $q" 1443 1443 } else { 1444 1444 bind $c <ButtonPress-1> {} … … 1447 1447 } 1448 1448 SendCmd "camera reset" 1449 # Fix the mouse bindings for rotation/panning and the 1449 # Fix the mouse bindings for rotation/panning and the 1450 1450 # camera mode. Ideally we'd create a bindtag for these. 1451 1451 if { $bool } { … … 1470 1470 "-legendvisible" { 1471 1471 if { !$_settings($what) } { 1472 1473 1474 1472 $itk_component(view) delete legend 1473 } 1474 DrawLegend 1475 1475 } 1476 1476 "-opacity" { 1477 1477 set _changed($what) 1 1478 1478 if { $_settings(-view3d) } { 1479 1479 set _settings(-saveopacity) $_settings($what) 1480 1480 set val [expr $_settings($what) * 0.01] 1481 1481 SendCmd "image opacity $val" 1482 1482 } else { 1483 1483 SendCmd "image opacity 1.0" 1484 1484 } 1485 1485 } … … 1487 1487 set bool $_settings($what) 1488 1488 SendCmd "outline visible $bool" 1489 1489 } 1490 1490 "-stretchtofit" { 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1491 set bool $_settings($what) 1492 if { $bool } { 1493 if { $_settings(-view3d) } { 1494 SendCmd "camera aspect native" 1495 } else { 1496 SendCmd "camera aspect window" 1497 } 1498 } else { 1499 SendCmd "camera aspect native" 1500 } 1501 } 1502 1502 "-xgrid" - "-ygrid" - "-zgrid" { 1503 1503 set axis [string tolower [string range $what 1 1]] … … 1505 1505 SendCmd "axis grid $axis $bool" 1506 1506 } 1507 1507 default { 1508 1508 error "don't know how to fix $what" 1509 1509 } … … 1515 1515 # 1516 1516 # Request a new legend from the server. The size of the legend 1517 # is determined from the height of the canvas. 1517 # is determined from the height of the canvas. 1518 1518 # 1519 1519 # This should be called when 1520 # 1521 # 1522 # 1523 # 1524 # 1520 # 1. A new current colormap is set. 1521 # 2. Window is resized. 1522 # 3. The limits of the data have changed. (Just need a redraw). 1523 # 4. Number of isolines have changed. (Just need a redraw). 1524 # 5. Legend becomes visible (Just need a redraw). 1525 1525 # 1526 1526 itcl::body Rappture::VtkImageViewer::RequestLegend {} { … … 1529 1529 set w 12 1530 1530 set lineht [font metrics $font -linespace] 1531 # color ramp height = (canvas height) - (min and max value lines) - 2 1531 # color ramp height = (canvas height) - (min and max value lines) - 2 1532 1532 set h [expr {$_height - 2 * ($lineht + 2)}] 1533 1533 set _legendHeight $h … … 1535 1535 set fname $_curFldName 1536 1536 if { [string match "component*" $fname] } { 1537 1537 set title "" 1538 1538 } else { 1539 1540 1541 1542 1543 1544 1545 1546 1539 if { [info exists _fields($fname)] } { 1540 foreach { title units } $_fields($fname) break 1541 if { $units != "" } { 1542 set title [format "%s (%s)" $title $units] 1543 } 1544 } else { 1545 set title $fname 1546 } 1547 1547 } 1548 1548 # If there's a title too, substract one more line 1549 1549 if { $title != "" } { 1550 incr h -$lineht 1550 incr h -$lineht 1551 1551 } 1552 1552 if { $h < 1 } { … … 1555 1555 # Set the legend on the first image dataset. 1556 1556 if { $_currentColormap != "" && $_currentColormap != "none" } { 1557 1557 #SendCmd "legend $_currentColormap scalar $_curFldName {} $w $h 0" 1558 1558 SendCmd "legend2 $_currentColormap $w $h" 1559 1559 } … … 1566 1566 # Keep track of the colormaps that we build. 1567 1567 if { $name != "none" && ![info exists _colormaps($name)] } { 1568 BuildColormap $name 1568 BuildColormap $name 1569 1569 set _colormaps($name) 1 1570 1570 } … … 1593 1593 itcl::configbody Rappture::VtkImageViewer::mode { 1594 1594 switch -- $itk_option(-mode) { 1595 1596 1597 1598 1599 1600 } 1601 1602 1603 1595 "volume" { 1596 set _settings(-view3d) 1 1597 } 1598 "vtkimage" { 1599 set _settings(-view3d) 0 1600 } 1601 default { 1602 error "unknown mode settings \"$itk_option(-mode)\"" 1603 } 1604 1604 } 1605 1605 if { !$_reset } { … … 1617 1617 SendCmd "screen bgcolor $rgb" 1618 1618 } 1619 1619 $itk_component(view) configure -background $itk_option(-plotbackground) 1620 1620 } 1621 1621 } … … 1675 1675 1676 1676 itk_component add field_l { 1677 label $inner.field_l -text "Field" -font "Arial 9" 1677 label $inner.field_l -text "Field" -font "Arial 9" 1678 1678 } { 1679 1679 ignore -font … … 1685 1685 [itcl::code $this AdjustSetting -field] 1686 1686 1687 label $inner.colormap_l -text "Colormap" -font "Arial 9" 1687 label $inner.colormap_l -text "Colormap" -font "Arial 9" 1688 1688 itk_component add colormap { 1689 1689 Rappture::Combobox $inner.colormap -width 10 -editable no … … 1695 1695 [itcl::code $this AdjustSetting -colormap] 1696 1696 1697 label $inner.backingcolor_l -text "Backing Color" -font "Arial 9" 1697 label $inner.backingcolor_l -text "Backing Color" -font "Arial 9" 1698 1698 itk_component add backingcolor { 1699 1699 Rappture::Combobox $inner.backingcolor -width 10 -editable no … … 1709 1709 "red" "red" \ 1710 1710 "white" "white" \ 1711 "none""none"1711 "none" "none" 1712 1712 1713 1713 $itk_component(backingcolor) value $_settings(-backingcolor) 1714 1714 bind $inner.backingcolor <<Value>> \ 1715 1716 1717 label $inner.background_l -text "Background Color" -font "Arial 9" 1715 [itcl::code $this AdjustSetting -backingcolor] 1716 1717 label $inner.background_l -text "Background Color" -font "Arial 9" 1718 1718 itk_component add background { 1719 1719 Rappture::Combobox $inner.background -width 10 -editable no … … 1722 1722 "black" "black" \ 1723 1723 "white" "white" \ 1724 "grey" "grey" 1724 "grey" "grey" 1725 1725 1726 1726 $itk_component(background) value "white" … … 1773 1773 2,0 $inner.backingcolor_l -anchor w -pady 2 \ 1774 1774 2,1 $inner.backingcolor -anchor w -pady 2 -fill x \ 1775 1776 1775 3,0 $inner.background_l -anchor w -pady 2 \ 1776 3,1 $inner.background -anchor w -pady 2 -fill x \ 1777 1777 4,0 $inner.backing -anchor w -pady 2 -cspan 2 \ 1778 1778 5,0 $inner.stretch -anchor w -pady 2 -cspan 2 \ … … 1787 1787 16,1 $inner.window -fill x -pady 2 \ 1788 1788 17,0 $inner.level_l -anchor w -pady 2 \ 1789 17,1 $inner.level -fill x -pady 2 1789 17,1 $inner.level -fill x -pady 2 1790 1790 1791 1791 blt::table configure $inner r* c* -resize none … … 1813 1813 -command [itcl::code $this AdjustSetting -axislabels] \ 1814 1814 -font "Arial 9" 1815 label $inner.grid_l -text "Grid" -font "Arial 9" 1815 label $inner.grid_l -text "Grid" -font "Arial 9" 1816 1816 checkbutton $inner.xgrid \ 1817 1817 -text "X" \ … … 1835 1835 -font "Arial 9" 1836 1836 1837 label $inner.mode_l -text "Mode" -font "Arial 9" 1837 label $inner.mode_l -text "Mode" -font "Arial 9" 1838 1838 1839 1839 itk_component add axisflymode { … … 1844 1844 "closest_triad" "closest" \ 1845 1845 "furthest_triad" "farthest" \ 1846 "outer_edges" "outer" 1846 "outer_edges" "outer" 1847 1847 $itk_component(axisflymode) value $_settings(-axisflymode) 1848 1848 bind $inner.mode <<Value>> [itcl::code $this AdjustSetting -axisflymode] … … 1852 1852 1,0 $inner.labels -anchor w -cspan 4 \ 1853 1853 2,0 $inner.minorticks -anchor w -cspan 4 \ 1854 1854 4,0 $inner.grid_l -anchor w \ 1855 1855 4,1 $inner.xgrid -anchor w \ 1856 1856 4,2 $inner.ygrid -anchor w \ 1857 1857 4,3 $inner.zgrid -anchor w \ 1858 1858 5,0 $inner.mode_l -anchor w -padx { 2 0 } \ 1859 5,1 $inner.mode -fill x -cspan 3 1859 5,1 $inner.mode -fill x -cspan 3 1860 1860 1861 1861 blt::table configure $inner r* c* -resize none … … 1916 1916 1917 1917 # 1918 # camera -- 1918 # camera -- 1919 1919 # 1920 1920 itcl::body Rappture::VtkImageViewer::camera {option args} { 1921 switch -- $option { 1921 switch -- $option { 1922 1922 "show" { 1923 1923 puts [array get _view] … … 1967 1967 1968 1968 itcl::body Rappture::VtkImageViewer::GetImage { args } { 1969 if { [image width $_image(download)] > 0 && 1969 if { [image width $_image(download)] > 0 && 1970 1970 [image height $_image(download)] > 0 } { 1971 1971 set bytes [$_image(download) data -format "jpeg -quality 100"] … … 1980 1980 -title "[Rappture::filexfer::label downloadWord] as..." 1981 1981 set inner [$popup component inner] 1982 label $inner.summary -text "" -anchor w 1982 label $inner.summary -text "" -anchor w 1983 1983 radiobutton $inner.vtk_button -text "VTK data file" \ 1984 1984 -variable [itcl::scope _downloadPopup(format)] \ 1985 1985 -font "Arial 9 " \ 1986 -value vtk 1986 -value vtk 1987 1987 Rappture::Tooltip::for $inner.vtk_button "Save as VTK data file." 1988 1988 radiobutton $inner.image_button -text "Image File" \ 1989 1989 -variable [itcl::scope _downloadPopup(format)] \ 1990 1990 -font "Arial 9 " \ 1991 -value image 1991 -value image 1992 1992 Rappture::Tooltip::for $inner.image_button \ 1993 1993 "Save as digital image." … … 2010 2010 2,0 $inner.image_button -anchor w -cspan 2 -padx { 4 0 } \ 2011 2011 4,1 $inner.cancel -width .9i -fill y \ 2012 4,0 $inner.ok -padx 2 -width .9i -fill y 2012 4,0 $inner.ok -padx 2 -width .9i -fill y 2013 2013 blt::table configure $inner r3 -height 4 2014 2014 blt::table configure $inner r4 -pady 4 … … 2021 2021 # SetObjectStyle -- 2022 2022 # 2023 # Set the style of the image/contour object. This gets calls 2023 # Set the style of the image/contour object. This gets calls 2024 2024 # for each dataset once as it is loaded. It can overridden by 2025 2025 # the user controls. … … 2063 2063 SendCmd "outline visible $_settings(-outline) $tag" 2064 2064 SendCmd "image add $tag" 2065 SetCurrentColormap $style(-color) 2065 SetCurrentColormap $style(-color) 2066 2066 set color [$itk_component(backingcolor) value] 2067 2067 SendCmd "image color [Color2RGB $color] $tag" … … 2094 2094 #puts stderr "read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>" 2095 2095 if { [catch {DrawLegend} errs] != 0 } { 2096 2097 2096 global errorInfo 2097 puts stderr "errs=$errs errorInfo=$errorInfo" 2098 2098 } 2099 2099 } … … 2112 2112 set font "Arial 8" 2113 2113 set lineht [font metrics $font -linespace] 2114 2114 2115 2115 if { [string match "component*" $fname] } { 2116 2116 set title "" 2117 2117 } else { 2118 2119 2120 2121 2122 2123 2124 2125 2118 if { [info exists _fields($fname)] } { 2119 foreach { title units } $_fields($fname) break 2120 if { $units != "" } { 2121 set title [format "%s (%s)" $title $units] 2122 } 2123 } else { 2124 set title $fname 2125 } 2126 2126 } 2127 2127 set x [expr $w - 2] 2128 2128 if { !$_settings(-legendvisible) } { 2129 2130 2131 } 2129 $c delete legend 2130 return 2131 } 2132 2132 if { [$c find withtag "legend"] == "" } { 2133 set y 2 2134 2133 set y 2 2134 # If there's a legend title, create a text item for the title. 2135 2135 $c create text $x $y \ 2136 2136 -anchor ne \ … … 2140 2140 incr y $lineht 2141 2141 } 2142 2142 $c create text $x $y \ 2143 2143 -anchor ne \ 2144 2144 -fill $itk_option(-plotforeground) -tags "vmax legend" \ 2145 2145 -font $font 2146 2146 incr y $lineht 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2147 $c create image $x $y \ 2148 -anchor ne \ 2149 -image $_image(legend) -tags "colormap legend" 2150 $c create rectangle $x $y 1 1 \ 2151 -fill "" -outline "" -tags "sensor legend" 2152 $c create text $x [expr {$h-2}] \ 2153 -anchor se \ 2154 -fill $itk_option(-plotforeground) -tags "vmin legend" \ 2155 -font $font 2156 $c bind sensor <Enter> [itcl::code $this EnterLegend %x %y] 2157 $c bind sensor <Leave> [itcl::code $this LeaveLegend] 2158 $c bind sensor <Motion> [itcl::code $this MotionLegend %x %y] 2159 2159 } 2160 2160 … … 2170 2170 if { [info exists _limits($_curFldName)] } { 2171 2171 foreach { vmin vmax } $_limits($_curFldName) break 2172 2173 2172 $c itemconfigure vmin -text [format %g $vmin] 2173 $c itemconfigure vmax -text [format %g $vmax] 2174 2174 } 2175 2175 set y 2 … … 2177 2177 if { $title != "" } { 2178 2178 $c itemconfigure title -text $title 2179 2180 2179 $c coords title $x $y 2180 incr y $lineht 2181 2181 } 2182 2182 $c coords vmax $x $y … … 2226 2226 set font "Arial 8" 2227 2227 set lineht [font metrics $font -linespace] 2228 2228 2229 2229 set ih [image height $_image(legend)] 2230 2230 # Subtract off the offset of the color ramp from the top of the canvas … … 2232 2232 2233 2233 if { [string match "component*" $fname] } { 2234 2234 set title "" 2235 2235 } else { 2236 2237 2238 2239 2240 2241 2242 2243 2236 if { [info exists _fields($fname)] } { 2237 foreach { title units } $_fields($fname) break 2238 if { $units != "" } { 2239 set title [format "%s (%s)" $title $units] 2240 } 2241 } else { 2242 set title $fname 2243 } 2244 2244 } 2245 2245 # If there's a legend title, increase the offset by the line height. … … 2257 2257 } 2258 2258 set color [eval format "\#%02x%02x%02x" $pixel] 2259 $_image(swatch) put black -to 0 0 23 23 2260 $_image(swatch) put $color -to 1 1 22 22 2259 $_image(swatch) put black -to 0 0 23 23 2260 $_image(swatch) put $color -to 1 1 22 22 2261 2261 2262 2262 # Compute the value of the point … … 2268 2268 set value 0.0 2269 2269 } 2270 set tipx [expr $x + 15] 2270 set tipx [expr $x + 15] 2271 2271 set tipy [expr $y - 5] 2272 2272 .rappturetooltip configure -icon $_image(swatch) … … 2276 2276 Rappture::Tooltip::text $c [format "$title %g" $value] 2277 2277 } 2278 Rappture::Tooltip::tooltip show $c +$tipx,+$tipy 2278 Rappture::Tooltip::tooltip show $c +$tipx,+$tipy 2279 2279 } 2280 2280 … … 2291 2291 # ---------------------------------------------------------------------- 2292 2292 itcl::body Rappture::VtkImageViewer::Combo {option} { 2293 set c $itk_component(view) 2293 set c $itk_component(view) 2294 2294 switch -- $option { 2295 2295 post { … … 2304 2304 } 2305 2305 deactivate { 2306 $c itemconfigure title -fill $itk_option(-plotforeground) 2306 $c itemconfigure title -fill $itk_option(-plotforeground) 2307 2307 } 2308 2308 invoke { … … 2316 2316 } 2317 2317 2318 itcl::body Rappture::VtkImageViewer::SetOrientation { side } { 2318 itcl::body Rappture::VtkImageViewer::SetOrientation { side } { 2319 2319 array set positions { 2320 2320 front "0.707107 0.707107 0 0" … … 2327 2327 foreach name { -qw -qx -qy -qz } value $positions($side) { 2328 2328 set _view($name) $value 2329 } 2329 } 2330 2330 set q [ViewToQuaternion] 2331 2331 $_arcball quaternion $q -
branches/1.4/gui/scripts/vtkmeshviewer.tcl
r4772 r5007 1 # -*- mode: tcl; indent-tabs-mode: nil -*- 1 # -*- mode: tcl; indent-tabs-mode: nil -*- 2 2 # ---------------------------------------------------------------------- 3 3 # COMPONENT: vtkmeshviewer - Vtk mesh viewer … … 58 58 public method isconnected {} 59 59 public method limits { dataobj } 60 public method parameters {title args} { 61 # do nothing 60 public method parameters {title args} { 61 # do nothing 62 62 } 63 63 public method scale {args} … … 67 67 private method BuildAxisTab {} 68 68 private method BuildCameraTab {} 69 private method BuildDownloadPopup { widget command } 69 private method BuildDownloadPopup { widget command } 70 70 private method BuildPolydataTab {} 71 71 private method Connect {} … … 74 74 private method DoResize {} 75 75 private method DoRotate {} 76 private method EventuallyResize { w h } 77 private method EventuallyRotate { q } 78 private method EventuallySetPolydataOpacity {} 79 private method GetImage { args } 80 private method GetVtkData { args } 76 private method EventuallyResize { w h } 77 private method EventuallyRotate { q } 78 private method EventuallySetPolydataOpacity {} 79 private method GetImage { args } 80 private method GetVtkData { args } 81 81 private method InitSettings { args } 82 private method IsValidObject { dataobj } 82 private method IsValidObject { dataobj } 83 83 private method Pan {option x y} 84 84 private method PanCamera {} 85 85 private method Pick {x y} 86 private method QuaternionToView { q } { 86 private method QuaternionToView { q } { 87 87 foreach { _view(-qw) _view(-qx) _view(-qy) _view(-qz) } $q break 88 88 } … … 91 91 private method ReceiveImage { args } 92 92 private method Rotate {option x y} 93 private method SetObjectStyle { dataobj } 93 private method SetObjectStyle { dataobj } 94 94 private method SetOrientation { side } 95 95 private method SetPolydataOpacity {} 96 private method ViewToQuaternion {} { 96 private method ViewToQuaternion {} { 97 97 return [list $_view(-qw) $_view(-qx) $_view(-qy) $_view(-qz)] 98 98 } … … 100 100 101 101 private variable _arcball "" 102 private variable _dlist ""; 102 private variable _dlist ""; # list of data objects 103 103 private variable _obj2datasets 104 private variable _obj2ovride; 105 private variable _datasets; # contains all the dataobj-component106 107 private variable _dataset2style; 108 private variable _style2datasets; # maps tf back to list of109 104 private variable _obj2ovride; # maps dataobj => style override 105 private variable _datasets; # contains all the dataobj-component 106 # datasets in the server 107 private variable _dataset2style; # maps dataobj-component to transfunc 108 private variable _style2datasets; # maps tf back to list of 109 # dataobj-components using the tf. 110 110 private variable _click; # info used for rotate operations 111 111 private variable _limits; # autoscale min/max for all axes … … 200 200 array set _widget { 201 201 -polydataopacity 100 202 } 202 } 203 203 itk_component add view { 204 204 canvas $itk_component(plotarea).view \ … … 211 211 itk_component add fieldmenu { 212 212 menu $itk_component(plotarea).menu -bg black -fg white -relief flat \ 213 -tearoff no 213 -tearoff no 214 214 } { 215 215 usual … … 232 232 233 233 set _map(id) [$c create image 0 0 -anchor nw -image $_image(plot)] 234 set _map(cwidth) -1 235 set _map(cheight) -1 234 set _map(cwidth) -1 235 set _map(cheight) -1 236 236 set _map(zoom) 1.0 237 237 set _map(original) "" … … 279 279 BuildCameraTab 280 280 281 # Hack around the Tk panewindow. The problem is that the requested 281 # Hack around the Tk panewindow. The problem is that the requested 282 282 # size of the 3d view isn't set until an image is retrieved from 283 283 # the server. So the panewindow uses the tiny size. … … 285 285 pack forget $itk_component(view) 286 286 blt::table $itk_component(plotarea) \ 287 0,0 $itk_component(view) -fill both -reqwidth $w 287 0,0 $itk_component(view) -fill both -reqwidth $w 288 288 blt::table configure $itk_component(plotarea) c1 -resize none 289 289 … … 372 372 373 373 itcl::body Rappture::VtkMeshViewer::DoRotate {} { 374 SendCmd "camera orient [ViewToQuaternion]" 374 SendCmd "camera orient [ViewToQuaternion]" 375 375 set _rotatePending 0 376 376 } … … 497 497 continue 498 498 } 499 if {[info exists _obj2ovride($dataobj-raise)] && 499 if {[info exists _obj2ovride($dataobj-raise)] && 500 500 $_obj2ovride($dataobj-raise)} { 501 501 set dlist [linsert $dlist 0 $dataobj] … … 525 525 } 526 526 return $dlist 527 } 527 } 528 528 -image { 529 529 if {[llength $args] != 2} { … … 814 814 # Turn on buffering of commands to the server. We don't want to 815 815 # be preempted by a server disconnect/reconnect (which automatically 816 # generates a new call to Rebuild). 816 # generates a new call to Rebuild). 817 817 StartBufferingCommands 818 818 … … 897 897 InitSettings -polydataedges -polydatalighting -polydataopacity \ 898 898 -polydatavisible -polydatawireframe 899 899 900 900 #SendCmd "axis lformat all %g" 901 901 … … 933 933 itcl::body Rappture::VtkMeshViewer::CurrentDatasets {args} { 934 934 set flag [lindex $args 0] 935 switch -- $flag { 935 switch -- $flag { 936 936 "-all" { 937 937 if { [llength $args] > 1 } { … … 952 952 set dlist [get -visible] 953 953 } 954 } 954 } 955 955 default { 956 956 set dlist $args … … 1068 1068 foreach tag [CurrentDatasets -visible] { 1069 1069 SendCmd "dataset getscalar pixel $x $y $tag" 1070 } 1070 } 1071 1071 } 1072 1072 … … 1245 1245 set f [open "$tmpfile" "w"] 1246 1246 fconfigure $f -translation binary -encoding binary 1247 puts $f $data 1247 puts $f $data 1248 1248 close $f 1249 1249 set reader [vtkDataSetReader $tag-xvtkDataSetReader] … … 1293 1293 -variable [itcl::scope _settings(-polydatavisible)] \ 1294 1294 -command [itcl::code $this AdjustSetting -polydatavisible] \ 1295 -font "Arial 9" -anchor w 1295 -font "Arial 9" -anchor w 1296 1296 1297 1297 checkbutton $inner.outline \ … … 1299 1299 -variable [itcl::scope _settings(-outline)] \ 1300 1300 -command [itcl::code $this AdjustSetting -outline] \ 1301 -font "Arial 9" -anchor w 1301 -font "Arial 9" -anchor w 1302 1302 1303 1303 checkbutton $inner.wireframe \ … … 1305 1305 -variable [itcl::scope _settings(-polydatawireframe)] \ 1306 1306 -command [itcl::code $this AdjustSetting -polydatawireframe] \ 1307 -font "Arial 9" -anchor w 1307 -font "Arial 9" -anchor w 1308 1308 1309 1309 checkbutton $inner.lighting \ … … 1320 1320 1321 1321 itk_component add field_l { 1322 label $inner.field_l -text "Field" -font "Arial 9" 1322 label $inner.field_l -text "Field" -font "Arial 9" 1323 1323 } { 1324 1324 ignore -font … … 1330 1330 [itcl::code $this AdjustSetting -field] 1331 1331 1332 label $inner.opacity_l -text "Opacity" -font "Arial 9" -anchor w 1332 label $inner.opacity_l -text "Opacity" -font "Arial 9" -anchor w 1333 1333 ::scale $inner.opacity -from 0 -to 100 -orient horizontal \ 1334 1334 -variable [itcl::scope _widget(-polydataopacity)] \ … … 1345 1345 4,0 $inner.edges -cspan 2 -anchor w -pady 2 \ 1346 1346 5,0 $inner.opacity_l -anchor w -pady 2 \ 1347 5,1 $inner.opacity -fill x -pady 2 1347 5,1 $inner.opacity -fill x -pady 2 1348 1348 1349 1349 blt::table configure $inner r* c* -resize none … … 1372 1372 -command [itcl::code $this AdjustSetting -axislabels] \ 1373 1373 -font "Arial 9" 1374 label $inner.grid_l -text "Grid" -font "Arial 9" 1374 label $inner.grid_l -text "Grid" -font "Arial 9" 1375 1375 checkbutton $inner.xgrid \ 1376 1376 -text "X" \ … … 1394 1394 -font "Arial 9" 1395 1395 1396 label $inner.mode_l -text "Mode" -font "Arial 9" 1396 label $inner.mode_l -text "Mode" -font "Arial 9" 1397 1397 1398 1398 itk_component add axismode { … … 1403 1403 "closest_triad" "closest" \ 1404 1404 "furthest_triad" "farthest" \ 1405 "outer_edges" "outer" 1405 "outer_edges" "outer" 1406 1406 $itk_component(axismode) value "static" 1407 1407 bind $inner.mode <<Value>> [itcl::code $this AdjustSetting -axismode] … … 1475 1475 1476 1476 # 1477 # camera -- 1477 # camera -- 1478 1478 # 1479 1479 itcl::body Rappture::VtkMeshViewer::camera {option args} { 1480 switch -- $option { 1480 switch -- $option { 1481 1481 "show" { 1482 1482 puts [array get _view] … … 1523 1523 1524 1524 itcl::body Rappture::VtkMeshViewer::GetImage { args } { 1525 if { [image width $_image(download)] > 0 && 1525 if { [image width $_image(download)] > 0 && 1526 1526 [image height $_image(download)] > 0 } { 1527 1527 set bytes [$_image(download) data -format "jpeg -quality 100"] … … 1536 1536 -title "[Rappture::filexfer::label downloadWord] as..." 1537 1537 set inner [$popup component inner] 1538 label $inner.summary -text "" -anchor w 1538 label $inner.summary -text "" -anchor w 1539 1539 radiobutton $inner.vtk_button -text "VTK data file" \ 1540 1540 -variable [itcl::scope _downloadPopup(format)] \ 1541 1541 -font "Helvetica 9 " \ 1542 -value vtk 1542 -value vtk 1543 1543 Rappture::Tooltip::for $inner.vtk_button "Save as VTK data file." 1544 1544 radiobutton $inner.image_button -text "Image File" \ 1545 1545 -variable [itcl::scope _downloadPopup(format)] \ 1546 -value image 1546 -value image 1547 1547 Rappture::Tooltip::for $inner.image_button \ 1548 1548 "Save as digital image." … … 1565 1565 2,0 $inner.image_button -anchor w -cspan 2 -padx { 4 0 } \ 1566 1566 4,1 $inner.cancel -width .9i -fill y \ 1567 4,0 $inner.ok -padx 2 -width .9i -fill y 1567 4,0 $inner.ok -padx 2 -width .9i -fill y 1568 1568 blt::table configure $inner r3 -height 4 1569 1569 blt::table configure $inner r4 -pady 4 … … 1634 1634 } 1635 1635 1636 itcl::body Rappture::VtkMeshViewer::SetOrientation { side } { 1636 itcl::body Rappture::VtkMeshViewer::SetOrientation { side } { 1637 1637 array set positions { 1638 1638 front "1 0 0 0" … … 1645 1645 foreach name { -qw -qx -qy -qz } value $positions($side) { 1646 1646 set _view($name) $value 1647 } 1647 } 1648 1648 set q [ViewToQuaternion] 1649 1649 $_arcball quaternion $q -
branches/1.4/gui/scripts/vtkstreamlinesviewer.tcl
r4943 r5007 1 # -*- mode: tcl; indent-tabs-mode: nil -*- 1 # -*- mode: tcl; indent-tabs-mode: nil -*- 2 2 # ---------------------------------------------------------------------- 3 3 # COMPONENT: vtkstreamlinesviewer - Vtk streamlines object viewer … … 57 57 public method get {args} 58 58 public method isconnected {} 59 public method parameters {title args} { 60 # do nothing 59 public method parameters {title args} { 60 # do nothing 61 61 } 62 62 public method scale {args} … … 68 68 private method BuildColormap { name colors } 69 69 private method BuildCutplaneTab {} 70 private method BuildDownloadPopup { widget command } 70 private method BuildDownloadPopup { widget command } 71 71 private method BuildStreamsTab {} 72 72 private method BuildVolumeTab {} … … 79 79 private method DoReseed {} 80 80 private method DoRotate {} 81 private method EnterLegend { x y } 82 private method EventuallyResize { w h } 83 private method EventuallyReseed { numPoints } 84 private method EventuallyRotate { q } 85 private method EventuallySetCutplane { axis args } 86 private method GetImage { args } 87 private method GetVtkData { args } 81 private method EnterLegend { x y } 82 private method EventuallyResize { w h } 83 private method EventuallyReseed { numPoints } 84 private method EventuallyRotate { q } 85 private method EventuallySetCutplane { axis args } 86 private method GetImage { args } 87 private method GetVtkData { args } 88 88 private method InitSettings { args } 89 private method IsValidObject { dataobj } 89 private method IsValidObject { dataobj } 90 90 private method LeaveLegend {} 91 private method MotionLegend { x y } 91 private method MotionLegend { x y } 92 92 private method Pan {option x y} 93 93 private method PanCamera {} 94 94 private method Pick {x y} 95 private method QuaternionToView { q } { 95 private method QuaternionToView { q } { 96 96 foreach { _view(-qw) _view(-qx) _view(-qy) _view(-qz) } $q break 97 97 } … … 105 105 private method ChangeColormap { dataobj comp color } 106 106 private method SetLegendTip { x y } 107 private method SetObjectStyle { dataobj comp } 108 private method Slice {option args} 107 private method SetObjectStyle { dataobj comp } 108 private method Slice {option args} 109 109 private method SetOrientation { side } 110 private method ViewToQuaternion {} { 110 private method ViewToQuaternion {} { 111 111 return [list $_view(-qw) $_view(-qx) $_view(-qy) $_view(-qz)] 112 112 } … … 118 118 private variable _obj2datasets 119 119 private variable _obj2ovride ; # maps dataobj => style override 120 private variable _datasets ; # contains all the dataobj-component 120 private variable _datasets ; # contains all the dataobj-component 121 121 ; # datasets in the server 122 122 private variable _colormaps ; # contains all the colormaps … … 147 147 private variable _cutplanePending 0 148 148 private variable _legendPending 0 149 private variable _vectorFields 150 private variable _scalarFields 151 private variable _fields 149 private variable _vectorFields 150 private variable _scalarFields 151 private variable _fields 152 152 private variable _curFldName "" 153 153 private variable _curFldLabel "" … … 271 271 itk_component add fieldmenu { 272 272 menu $itk_component(plotarea).menu -bg black -fg white -relief flat \ 273 -tearoff no 273 -tearoff no 274 274 } { 275 275 usual … … 291 291 292 292 set _map(id) [$c create image 0 0 -anchor nw -image $_image(plot)] 293 set _map(cwidth) -1 294 set _map(cheight) -1 293 set _map(cwidth) -1 294 set _map(cheight) -1 295 295 set _map(zoom) 1.0 296 296 set _map(original) "" … … 338 338 -offimage [Rappture::icon volume-off] \ 339 339 -variable [itcl::scope _settings(-volumevisible)] \ 340 -command [itcl::code $this AdjustSetting -volumevisible] 340 -command [itcl::code $this AdjustSetting -volumevisible] 341 341 } 342 342 $itk_component(volume) select … … 362 362 -offimage [Rappture::icon cutbutton] \ 363 363 -variable [itcl::scope _settings(-cutplanevisible)] \ 364 -command [itcl::code $this AdjustSetting -cutplanevisible] 364 -command [itcl::code $this AdjustSetting -cutplanevisible] 365 365 } 366 366 Rappture::Tooltip::for $itk_component(cutplane) \ … … 382 382 set _image(legend) [image create photo] 383 383 itk_component add legend { 384 canvas $itk_component(plotarea).legend -width 50 -highlightthickness 0 384 canvas $itk_component(plotarea).legend -width 50 -highlightthickness 0 385 385 } { 386 386 usual … … 389 389 } 390 390 391 # Hack around the Tk panewindow. The problem is that the requested 391 # Hack around the Tk panewindow. The problem is that the requested 392 392 # size of the 3d view isn't set until an image is retrieved from 393 393 # the server. So the panewindow uses the tiny size. … … 395 395 pack forget $itk_component(view) 396 396 blt::table $itk_component(plotarea) \ 397 0,0 $itk_component(view) -fill both -reqwidth $w 397 0,0 $itk_component(view) -fill both -reqwidth $w 398 398 blt::table configure $itk_component(plotarea) c1 -resize none 399 399 … … 480 480 481 481 itcl::body Rappture::VtkStreamlinesViewer::DoRotate {} { 482 SendCmd "camera orient [ViewToQuaternion]" 482 SendCmd "camera orient [ViewToQuaternion]" 483 483 set _rotatePending 0 484 484 } … … 517 517 if { !$_rotatePending } { 518 518 set _rotatePending 1 519 global rotate_delay 519 global rotate_delay 520 520 $_dispatcher event -after $rotate_delay !rotate 521 521 } … … 621 621 continue 622 622 } 623 if {[info exists _obj2ovride($dataobj-raise)] && 623 if {[info exists _obj2ovride($dataobj-raise)] && 624 624 $_obj2ovride($dataobj-raise)} { 625 625 set dlist [linsert $dlist 0 $dataobj] … … 649 649 } 650 650 return $dlist 651 } 651 } 652 652 -image { 653 653 if {[llength $args] != 2} { … … 791 791 set info {} 792 792 set user "???" 793 793 if { [info exists env(USER)] } { 794 794 set user $env(USER) 795 795 } 796 796 set session "???" 797 797 if { [info exists env(SESSION)] } { 798 798 set session $env(SESSION) 799 799 } 800 800 lappend info "version" "$Rappture::version" 801 801 lappend info "build" "$Rappture::build" … … 851 851 $_dispatcher cancel !legend 852 852 # disconnected -- no more data sitting on server 853 array unset _datasets 854 array unset _data 855 array unset _colormaps 856 array unset _seeds 857 array unset _dataset2style 858 array unset _obj2datasets 853 array unset _datasets 854 array unset _data 855 array unset _colormaps 856 array unset _seeds 857 array unset _dataset2style 858 array unset _obj2datasets 859 859 } 860 860 … … 884 884 set time [clock seconds] 885 885 set date [clock format $time] 886 #puts stderr "$date: received image [image width $_image(plot)]x[image height $_image(plot)] image>" 886 #puts stderr "$date: received image [image width $_image(plot)]x[image height $_image(plot)] image>" 887 887 if { $_start > 0 } { 888 888 set finish [clock clicks -milliseconds] … … 964 964 set _first "" 965 965 if { $_reset } { 966 967 968 969 970 971 966 set _width $w 967 set _height $h 968 $_arcball resize $w $h 969 DoResize 970 InitSettings -xgrid -ygrid -zgrid -axismode \ 971 -axesvisible -axislabelsvisible -axisminorticks 972 972 # This "imgflush" is to force an image returned before vtkvis starts 973 973 # reading a (big) dataset. This will display an empty plot with axes … … 988 988 set bytes [$dataobj vtkdata $comp] 989 989 set length [string length $bytes] 990 if 0 { 990 if 0 { 991 991 set f [open /tmp/vtkstreamlines.vtk "w"] 992 992 fconfigure $f -translation binary -encoding binary 993 993 puts -nonewline $f $bytes 994 994 close $f 995 995 } 996 996 if { $_reportClientInfo } { 997 997 set info {} … … 1032 1032 } 1033 1033 } 1034 1035 1036 1034 $itk_component(field) choices delete 0 end 1035 $itk_component(fieldmenu) delete 0 end 1036 array unset _fields 1037 1037 set _curFldName "" 1038 1038 foreach cname [$_first components] { … … 1068 1068 -volumevisible -volumeedges -volumelighting -volumeopacity \ 1069 1069 -volumewireframe \ 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1070 -cutplanevisible \ 1071 -cutplanexposition -cutplaneyposition -cutplanezposition \ 1072 -cutplanexvisible -cutplaneyvisible -cutplanezvisible 1073 1074 # Reset the camera and other view parameters 1075 $_arcball quaternion [ViewToQuaternion] 1076 if {$_view(-ortho)} { 1077 SendCmd "camera mode ortho" 1078 } else { 1079 SendCmd "camera mode persp" 1080 } 1081 DoRotate 1082 PanCamera 1083 1083 Zoom reset 1084 1084 SendCmd "camera reset" … … 1101 1101 itcl::body Rappture::VtkStreamlinesViewer::CurrentDatasets {args} { 1102 1102 set flag [lindex $args 0] 1103 switch -- $flag { 1103 switch -- $flag { 1104 1104 "-all" { 1105 1105 if { [llength $args] > 1 } { … … 1120 1120 set dlist [get -visible] 1121 1121 } 1122 } 1122 } 1123 1123 default { 1124 1124 set dlist $args … … 1239 1239 foreach tag [CurrentDatasets -visible] { 1240 1240 SendCmdNoWait "dataset getscalar pixel $x $y $tag" 1241 } 1241 } 1242 1242 } 1243 1243 … … 1666 1666 2,0 $inner.edges -anchor w -pady 2 -cspan 3 \ 1667 1667 3,0 $inner.opacity_l -anchor w -pady 2 \ 1668 3,1 $inner.opacity -fill x -pady 2 1668 3,1 $inner.opacity -fill x -pady 2 1669 1669 1670 1670 blt::table configure $inner r* c* -resize none … … 1687 1687 -command [itcl::code $this AdjustSetting -streamlinesvisible] \ 1688 1688 -font "Arial 9" 1689 1689 1690 1690 checkbutton $inner.lighting \ 1691 1691 -text "Enable Lighting" \ … … 1700 1700 -font "Arial 9" 1701 1701 1702 label $inner.mode_l -text "Mode" -font "Arial 9" 1702 label $inner.mode_l -text "Mode" -font "Arial 9" 1703 1703 itk_component add streammode { 1704 1704 Rappture::Combobox $inner.mode -width 10 -editable no … … 1707 1707 "lines" "lines" \ 1708 1708 "ribbons" "ribbons" \ 1709 "tubes" "tubes" 1709 "tubes" "tubes" 1710 1710 $itk_component(streammode) value $_settings(-streamlinesmode) 1711 1711 bind $inner.mode <<Value>> [itcl::code $this AdjustSetting -streamlinesmode] … … 1732 1732 -command [itcl::code $this AdjustSetting -streamlinesscale] 1733 1733 1734 label $inner.field_l -text "Color by" -font "Arial 9" 1734 label $inner.field_l -text "Color by" -font "Arial 9" 1735 1735 itk_component add field { 1736 1736 Rappture::Combobox $inner.field -width 10 -editable no … … 1739 1739 [itcl::code $this AdjustSetting -field] 1740 1740 1741 label $inner.colormap_l -text "Colormap" -font "Arial 9" 1741 label $inner.colormap_l -text "Colormap" -font "Arial 9" 1742 1742 itk_component add colormap { 1743 1743 Rappture::Combobox $inner.colormap -width 10 -editable no … … 1788 1788 -command [itcl::code $this AdjustSetting -axislabelsvisible] \ 1789 1789 -font "Arial 9" 1790 label $inner.grid_l -text "Grid" -font "Arial 9" 1790 label $inner.grid_l -text "Grid" -font "Arial 9" 1791 1791 checkbutton $inner.xgrid \ 1792 1792 -text "X" \ … … 1810 1810 -font "Arial 9" 1811 1811 1812 label $inner.mode_l -text "Mode" -font "Arial 9" 1812 label $inner.mode_l -text "Mode" -font "Arial 9" 1813 1813 1814 1814 itk_component add axismode { … … 1819 1819 "closest_triad" "closest" \ 1820 1820 "furthest_triad" "farthest" \ 1821 "outer_edges" "outer" 1821 "outer_edges" "outer" 1822 1822 $itk_component(axismode) value $_settings(-axismode) 1823 1823 bind $inner.mode <<Value>> [itcl::code $this AdjustSetting -axismode] … … 1893 1893 1894 1894 set fg [option get $itk_component(hull) font Font] 1895 1895 1896 1896 set inner [$itk_component(main) insert end \ 1897 1897 -title "Cutplane Settings" \ 1898 -icon [Rappture::icon cutbutton]] 1898 -icon [Rappture::icon cutbutton]] 1899 1899 1900 1900 $inner configure -borderwidth 4 … … 1950 1950 -command [itcl::code $this EventuallySetCutplane x] \ 1951 1951 -variable [itcl::scope _settings(-cutplanexposition)] \ 1952 1952 -foreground red3 -font "Arial 9 bold" 1953 1953 } { 1954 1954 usual … … 1979 1979 -command [itcl::code $this EventuallySetCutplane y] \ 1980 1980 -variable [itcl::scope _settings(-cutplaneyposition)] \ 1981 1981 -foreground green3 -font "Arial 9 bold" 1982 1982 } { 1983 1983 usual … … 2008 2008 -command [itcl::code $this EventuallySetCutplane z] \ 2009 2009 -variable [itcl::scope _settings(-cutplanezposition)] \ 2010 2010 -foreground blue3 -font "Arial 9 bold" 2011 2011 } { 2012 2012 usual … … 2024 2024 3,0 $inner.opacity_l -anchor w -pady 2 -cspan 1 \ 2025 2025 3,1 $inner.opacity -fill x -pady 2 -cspan 3 \ 2026 2026 4,0 $itk_component(xCutButton) -anchor w -padx 2 -pady 2 \ 2027 2027 5,0 $itk_component(yCutButton) -anchor w -padx 2 -pady 2 \ 2028 2028 6,0 $itk_component(zCutButton) -anchor w -padx 2 -pady 2 \ … … 2036 2036 2037 2037 # 2038 # camera -- 2038 # camera -- 2039 2039 # 2040 2040 itcl::body Rappture::VtkStreamlinesViewer::camera {option args} { 2041 switch -- $option { 2041 switch -- $option { 2042 2042 "show" { 2043 2043 puts [array get _view] … … 2087 2087 2088 2088 itcl::body Rappture::VtkStreamlinesViewer::GetImage { args } { 2089 if { [image width $_image(download)] > 0 && 2089 if { [image width $_image(download)] > 0 && 2090 2090 [image height $_image(download)] > 0 } { 2091 2091 set bytes [$_image(download) data -format "jpeg -quality 100"] … … 2100 2100 -title "[Rappture::filexfer::label downloadWord] as..." 2101 2101 set inner [$popup component inner] 2102 label $inner.summary -text "" -anchor w 2102 label $inner.summary -text "" -anchor w 2103 2103 radiobutton $inner.vtk_button -text "VTK data file" \ 2104 2104 -variable [itcl::scope _downloadPopup(format)] \ 2105 2105 -font "Helvetica 9 " \ 2106 -value vtk 2106 -value vtk 2107 2107 Rappture::Tooltip::for $inner.vtk_button "Save as VTK data file." 2108 2108 radiobutton $inner.image_button -text "Image File" \ 2109 2109 -variable [itcl::scope _downloadPopup(format)] \ 2110 -value image 2110 -value image 2111 2111 Rappture::Tooltip::for $inner.image_button \ 2112 2112 "Save as digital image." … … 2129 2129 2,0 $inner.image_button -anchor w -cspan 2 -padx { 4 0 } \ 2130 2130 4,1 $inner.cancel -width .9i -fill y \ 2131 4,0 $inner.ok -padx 2 -width .9i -fill y 2131 4,0 $inner.ok -padx 2 -width .9i -fill y 2132 2132 blt::table configure $inner r3 -height 4 2133 2133 blt::table configure $inner r4 -pady 4 … … 2196 2196 set _legendPending 0 2197 2197 set _title $title 2198 regsub {\(mag\)} $title "" _title 2198 regsub {\(mag\)} $title "" _title 2199 2199 if { [IsConnected] } { 2200 2200 set bytes [ReceiveBytes $size] … … 2223 2223 set font "Arial 8" 2224 2224 set lineht [font metrics $font -linespace] 2225 2225 2226 2226 if { [info exists _fields($fname)] } { 2227 2227 foreach { title units } $_fields($fname) break … … 2235 2235 set x [expr $w - 2] 2236 2236 if { [$c find withtag "legend"] == "" } { 2237 set y 2 2237 set y 2 2238 2238 $c create text $x $y \ 2239 2239 -anchor ne \ … … 2310 2310 set font "Arial 8" 2311 2311 set lineht [font metrics $font -linespace] 2312 2312 2313 2313 set imgHeight [image height $_image(legend)] 2314 2314 set coords [$c coords colormap] … … 2333 2333 } 2334 2334 set color [eval format "\#%02x%02x%02x" $pixel] 2335 $_image(swatch) put black -to 0 0 23 23 2336 $_image(swatch) put $color -to 1 1 22 22 2335 $_image(swatch) put black -to 0 0 23 23 2336 $_image(swatch) put $color -to 1 1 22 22 2337 2337 .rappturetooltip configure -icon $_image(swatch) 2338 2338 … … 2345 2345 set value 0.0 2346 2346 } 2347 set tipx [expr $x + 15] 2347 set tipx [expr $x + 15] 2348 2348 set tipy [expr $y - 5] 2349 2349 Rappture::Tooltip::text $c "$title $value" 2350 Rappture::Tooltip::tooltip show $c +$tipx,+$tipy 2350 Rappture::Tooltip::tooltip show $c +$tipx,+$tipy 2351 2351 } 2352 2352 … … 2393 2393 # ---------------------------------------------------------------------- 2394 2394 itcl::body Rappture::VtkStreamlinesViewer::Combo {option} { 2395 set c $itk_component(view) 2395 set c $itk_component(view) 2396 2396 switch -- $option { 2397 2397 post { … … 2406 2406 } 2407 2407 deactivate { 2408 $c itemconfigure title -fill white 2408 $c itemconfigure title -fill white 2409 2409 } 2410 2410 invoke { … … 2418 2418 } 2419 2419 2420 itcl::body Rappture::VtkStreamlinesViewer::SetOrientation { side } { 2420 itcl::body Rappture::VtkStreamlinesViewer::SetOrientation { side } { 2421 2421 array set positions { 2422 2422 front "1 0 0 0" … … 2429 2429 foreach name { -qw -qx -qy -qz } value $positions($side) { 2430 2430 set _view($name) $value 2431 } 2431 } 2432 2432 set q [ViewToQuaternion] 2433 2433 $_arcball quaternion $q 2434 SendCmd "camera orient $q" 2434 SendCmd "camera orient $q" 2435 2435 SendCmd "camera reset" 2436 2436 set _view(-xpan) 0 -
branches/1.4/gui/scripts/vtksurfaceviewer.tcl
r4768 r5007 1 # -*- mode: tcl; indent-tabs-mode: nil -*- 1 # -*- mode: tcl; indent-tabs-mode: nil -*- 2 2 # ---------------------------------------------------------------------- 3 3 # COMPONENT: vtksurfaceviewer - Vtk 3D boundary surface viewer … … 57 57 public method get {args} 58 58 public method isconnected {} 59 public method parameters {title args} { 60 # do nothing 59 public method parameters {title args} { 60 # do nothing 61 61 } 62 62 public method scale {args} … … 67 67 private method BuildCameraTab {} 68 68 private method BuildColormap { name } 69 private method BuildDownloadPopup { widget command } 69 private method BuildDownloadPopup { widget command } 70 70 private method BuildSurfaceTab {} 71 71 private method Combo { option } … … 76 76 private method DoRotate {} 77 77 private method DrawLegend {} 78 private method EnterLegend { x y } 79 private method EventuallyRequestLegend {} 80 private method EventuallyResize { w h } 81 private method EventuallyRotate { q } 82 private method GetImage { args } 83 private method GetVtkData { args } 78 private method EnterLegend { x y } 79 private method EventuallyRequestLegend {} 80 private method EventuallyResize { w h } 81 private method EventuallyRotate { q } 82 private method GetImage { args } 83 private method GetVtkData { args } 84 84 private method InitSettings { args } 85 private method IsValidObject { dataobj } 85 private method IsValidObject { dataobj } 86 86 private method LeaveLegend {} 87 private method MotionLegend { x y } 87 private method MotionLegend { x y } 88 88 private method Pan {option x y} 89 89 private method PanCamera {} 90 90 private method Pick {x y} 91 private method QuaternionToView { q } { 91 private method QuaternionToView { q } { 92 92 foreach { _view(-qw) _view(-qx) _view(-qy) _view(-qz) } $q break 93 93 } … … 103 103 private method SetOrientation { side } 104 104 private method UpdateContourList {} 105 private method ViewToQuaternion {} { 105 private method ViewToQuaternion {} { 106 106 return [list $_view(-qw) $_view(-qx) $_view(-qy) $_view(-qz)] 107 107 } … … 113 113 private variable _obj2datasets 114 114 private variable _obj2ovride ; # maps dataobj => style override 115 private variable _datasets ; # contains all the dataobj-component 115 private variable _datasets ; # contains all the dataobj-component 116 116 ; # datasets in the server 117 117 private variable _colormaps ; # contains all the colormaps … … 148 148 private variable _legendPending 0 149 149 private variable _field "" 150 private variable _colorMode "scalar"; 151 private variable _fieldNames {} 152 private variable _fields 150 private variable _colorMode "scalar"; # Mode of colormap (vmag or scalar) 151 private variable _fieldNames {} 152 private variable _fields 153 153 private variable _curFldName "" 154 154 private variable _curFldLabel "" … … 243 243 itk_component add fieldmenu { 244 244 menu $itk_component(plotarea).menu -bg black -fg white -relief flat \ 245 -tearoff 0 245 -tearoff 0 246 246 } { 247 247 usual … … 263 263 264 264 set _map(id) [$c create image 0 0 -anchor nw -image $_image(plot)] 265 set _map(cwidth) -1 266 set _map(cheight) -1 265 set _map(cwidth) -1 266 set _map(cheight) -1 267 267 set _map(zoom) 1.0 268 268 set _map(original) "" … … 311 311 -offimage [Rappture::icon volume-off] \ 312 312 -variable [itcl::scope _settings(-surfacevisible)] \ 313 -command [itcl::code $this AdjustSetting -surfacevisible] 313 -command [itcl::code $this AdjustSetting -surfacevisible] 314 314 } 315 315 $itk_component(surface) select … … 329 329 set _image(legend) [image create photo] 330 330 itk_component add legend { 331 canvas $itk_component(plotarea).legend -width 50 -highlightthickness 0 331 canvas $itk_component(plotarea).legend -width 50 -highlightthickness 0 332 332 } { 333 333 usual … … 336 336 } 337 337 338 # Hack around the Tk panewindow. The problem is that the requested 338 # Hack around the Tk panewindow. The problem is that the requested 339 339 # size of the 3d view isn't set until an image is retrieved from 340 340 # the server. So the panewindow uses the tiny size. … … 342 342 pack forget $itk_component(view) 343 343 blt::table $itk_component(plotarea) \ 344 0,0 $itk_component(view) -fill both -reqwidth $w 344 0,0 $itk_component(view) -fill both -reqwidth $w 345 345 blt::table configure $itk_component(plotarea) c1 -resize none 346 346 … … 429 429 430 430 itcl::body Rappture::VtkSurfaceViewer::DoRotate {} { 431 SendCmd "camera orient [ViewToQuaternion]" 431 SendCmd "camera orient [ViewToQuaternion]" 432 432 set _rotatePending 0 433 433 } … … 456 456 if { !$_rotatePending } { 457 457 set _rotatePending 1 458 global rotate_delay 458 global rotate_delay 459 459 $_dispatcher event -after $rotate_delay !rotate 460 460 } … … 555 555 continue 556 556 } 557 if {[info exists _obj2ovride($dataobj-raise)] && 557 if {[info exists _obj2ovride($dataobj-raise)] && 558 558 $_obj2ovride($dataobj-raise)} { 559 559 set dlist [linsert $dlist 0 $dataobj] … … 583 583 } 584 584 return $dlist 585 } 585 } 586 586 -image { 587 587 if {[llength $args] != 2} { … … 819 819 #set w [image width $_image(plot)] 820 820 #set h [image height $_image(plot)] 821 #puts stderr "$date: received image ${w}x${h} image" 821 #puts stderr "$date: received image ${w}x${h} image" 822 822 if { $_start > 0 } { 823 823 set finish [clock clicks -milliseconds] … … 890 890 # Turn on buffering of commands to the server. We don't want to 891 891 # be preempted by a server disconnect/reconnect (which automatically 892 # generates a new call to Rebuild). 892 # generates a new call to Rebuild). 893 893 StartBufferingCommands 894 894 … … 960 960 961 961 if { $_first != "" } { 962 963 964 962 $itk_component(field) choices delete 0 end 963 $itk_component(fieldmenu) delete 0 end 964 array unset _fields 965 965 set _curFldName "" 966 966 foreach cname [$_first components] { … … 990 990 InitSettings -isolinesvisible -surfacevisible -outline 991 991 if { $_reset } { 992 992 # These are settings that rely on a dataset being loaded. 993 993 InitSettings \ 994 994 -surfacelighting \ 995 995 -field \ 996 996 -surfaceedges -surfacelighting -surfaceopacity \ 997 997 -surfacewireframe \ 998 998 -numcontours 999 999 1000 1000 Zoom reset 1001 1001 foreach axis { x y z } { 1002 1002 # Another problem fixed by a <view>. We looking into a data 1003 1003 # object for the name of the axes. This should be global to 1004 1004 # the viewer itself. 1005 1006 1005 set label [$_first hints ${axis}label] 1006 if { $label == "" } { 1007 1007 set label [string toupper $axis] 1008 1009 1010 1008 } 1009 # May be a space in the axis label. 1010 SendCmd [list axis name $axis $label] 1011 1011 } 1012 1012 if { [array size _fields] < 2 } { … … 1032 1032 itcl::body Rappture::VtkSurfaceViewer::CurrentDatasets {args} { 1033 1033 set flag [lindex $args 0] 1034 switch -- $flag { 1034 switch -- $flag { 1035 1035 "-all" { 1036 1036 if { [llength $args] > 1 } { … … 1051 1051 set dlist [get -visible] 1052 1052 } 1053 } 1053 } 1054 1054 default { 1055 1055 set dlist $args … … 1170 1170 foreach tag [CurrentDatasets -visible] { 1171 1171 SendCmd "dataset getscalar pixel $x $y $tag" 1172 } 1172 } 1173 1173 } 1174 1174 … … 1274 1274 "-background" { 1275 1275 set bgcolor [$itk_component(background) value] 1276 1277 1278 1279 "grey""black"1280 1276 array set fgcolors { 1277 "black" "white" 1278 "white" "black" 1279 "grey" "black" 1280 } 1281 1281 configure -plotbackground $bgcolor \ 1282 1283 1284 1282 -plotforeground $fgcolors($bgcolor) 1283 $itk_component(view) delete "legend" 1284 DrawLegend 1285 1285 } 1286 1286 "-colormap" { … … 1289 1289 set color [$itk_component(colormap) value] 1290 1290 set _settings($what) $color 1291 1292 1293 1291 if { $color == "none" } { 1292 if { $_settings(-colormapvisible) } { 1293 SendCmd "contour2d colormode constant {}" 1294 1294 SendCmd "polydata colormode constant {}" 1295 1296 1297 1298 1299 1295 set _settings(-colormapvisible) 0 1296 } 1297 } else { 1298 if { !$_settings(-colormapvisible) } { 1299 #SendCmd "contour2d colormode $_colorMode $_curFldName" 1300 1300 SendCmd "polydata colormode $_colorMode $_curFldName" 1301 1302 1303 1301 set _settings(-colormapvisible) 1 1302 } 1303 SetCurrentColormap $color 1304 1304 if {$_settings(-colormapdiscrete)} { 1305 1305 set numColors [expr $_settings(-numcontours) + 1] 1306 1306 SendCmd "colormap res $numColors $color" 1307 1307 } 1308 1308 } 1309 1309 StopBufferingCommands 1310 1310 EventuallyRequestLegend 1311 1311 } 1312 1312 "-colormapdiscrete" { … … 1357 1357 "-isolinecolor" { 1358 1358 set color [$itk_component(isolineColor) value] 1359 1359 set _settings($what) $color 1360 1360 SendCmd "contour2d linecolor [Color2RGB $color]" 1361 1361 DrawLegend 1362 1362 } 1363 1363 "-isolinesvisible" { 1364 1364 set bool $_settings($what) 1365 1366 1365 SendCmd "contour2d visible $bool" 1366 DrawLegend 1367 1367 } 1368 1368 "-legendvisible" { 1369 1369 if { !$_settings($what) } { 1370 1370 $itk_component(view) delete legend 1371 1372 1371 } 1372 DrawLegend 1373 1373 } 1374 1374 "-numcontours" { … … 1388 1388 "-outline" { 1389 1389 set bool $_settings($what) 1390 1390 SendCmd "outline visible $bool" 1391 1391 } 1392 1392 "-surfaceedges" { 1393 1393 set bool $_settings($what) 1394 1394 SendCmd "polydata edges $bool" 1395 1395 } 1396 1396 "-surfacelighting" { 1397 1397 set bool $_settings($what) 1398 1398 SendCmd "polydata lighting $bool" 1399 1399 } 1400 1400 "-surfaceopacity" { 1401 1401 set val $_settings($what) 1402 1402 set sval [expr { 0.01 * double($val) }] 1403 1403 SendCmd "polydata opacity $sval" 1404 1404 } 1405 1405 "-surfacevisible" { 1406 1406 set bool $_settings($what) 1407 1407 SendCmd "polydata visible $bool" 1408 1408 if { $bool } { 1409 1409 Rappture::Tooltip::for $itk_component(surface) \ … … 1413 1413 "Show the surface" 1414 1414 } 1415 1415 DrawLegend 1416 1416 } 1417 1417 "-surfacewireframe" { 1418 1418 set bool $_settings($what) 1419 1419 SendCmd "polydata wireframe $bool" 1420 1420 } 1421 1421 "-xgrid" - "-ygrid" - "-zgrid" { … … 1434 1434 # 1435 1435 # Request a new legend from the server. The size of the legend 1436 # is determined from the height of the canvas. 1436 # is determined from the height of the canvas. 1437 1437 # 1438 1438 # This should be called when 1439 # 1440 # 1441 # 1442 # 1443 # 1439 # 1. A new current colormap is set. 1440 # 2. Window is resized. 1441 # 3. The limits of the data have changed. (Just need a redraw). 1442 # 4. Number of isolines have changed. (Just need a redraw). 1443 # 5. Legend becomes visible (Just need a redraw). 1444 1444 # 1445 1445 itcl::body Rappture::VtkSurfaceViewer::RequestLegend {} { … … 1457 1457 } 1458 1458 if { [string match "component*" $fname] } { 1459 1459 set title "" 1460 1460 } else { 1461 1462 1463 1464 1465 1466 1467 1468 1461 if { [info exists _fields($fname)] } { 1462 foreach { title units } $_fields($fname) break 1463 if { $units != "" } { 1464 set title [format "%s (%s)" $title $units] 1465 } 1466 } else { 1467 set title $fname 1468 } 1469 1469 } 1470 1470 # If there's a title too, subtract one more line 1471 1471 if { $title != "" } { 1472 incr h -$lineht 1472 incr h -$lineht 1473 1473 } 1474 1474 # Set the legend on the first heightmap dataset. 1475 1475 if { $_currentColormap != "" } { 1476 1477 1476 set cmap $_currentColormap 1477 SendCmdNoWait "legend $cmap scalar $_curFldName {} $w $h 0" 1478 1478 } 1479 1479 } … … 1495 1495 if { [isconnected] } { 1496 1496 set rgb [Color2RGB $itk_option(-plotforeground)] 1497 1497 SendCmd "axis color all $rgb" 1498 1498 SendCmd "outline color $rgb" 1499 1499 } … … 1558 1558 -font "Arial 9" 1559 1559 1560 label $inner.linecolor_l -text "Isolines" -font "Arial 9" 1560 label $inner.linecolor_l -text "Isolines" -font "Arial 9" 1561 1561 itk_component add isolineColor { 1562 1562 Rappture::Combobox $inner.linecolor -width 10 -editable 0 … … 1572 1572 "red" "red" \ 1573 1573 "white" "white" \ 1574 "none""none"1574 "none" "none" 1575 1575 1576 1576 $itk_component(isolineColor) value "white" 1577 1577 bind $inner.linecolor <<Value>> \ 1578 1579 1580 label $inner.background_l -text "Background" -font "Arial 9" 1578 [itcl::code $this AdjustSetting -isolinecolor] 1579 1580 label $inner.background_l -text "Background" -font "Arial 9" 1581 1581 itk_component add background { 1582 1582 Rappture::Combobox $inner.background -width 10 -editable 0 … … 1585 1585 "black" "black" \ 1586 1586 "white" "white" \ 1587 "grey" "grey" 1587 "grey" "grey" 1588 1588 1589 1589 $itk_component(background) value $_settings(-background) … … 1599 1599 1600 1600 itk_component add field_l { 1601 label $inner.field_l -text "Field" -font "Arial 9" 1601 label $inner.field_l -text "Field" -font "Arial 9" 1602 1602 } { 1603 1603 ignore -font … … 1609 1609 [itcl::code $this AdjustSetting -field] 1610 1610 1611 label $inner.colormap_l -text "Colormap" -font "Arial 9" 1611 label $inner.colormap_l -text "Colormap" -font "Arial 9" 1612 1612 itk_component add colormap { 1613 1613 Rappture::Combobox $inner.colormap -width 10 -editable 0 … … 1635 1635 2,0 $inner.linecolor_l -anchor w -pady 2 \ 1636 1636 2,1 $inner.linecolor -anchor w -pady 2 -fill x \ 1637 1638 1637 3,0 $inner.background_l -anchor w -pady 2 \ 1638 3,1 $inner.background -anchor w -pady 2 -fill x \ 1639 1639 4,0 $inner.numcontours_l -anchor w -pady 2 \ 1640 1640 4,1 $inner.numcontours -anchor w -pady 2 \ … … 1674 1674 -command [itcl::code $this AdjustSetting -axislabels] \ 1675 1675 -font "Arial 9" 1676 label $inner.grid_l -text "Grid" -font "Arial 9" 1676 label $inner.grid_l -text "Grid" -font "Arial 9" 1677 1677 checkbutton $inner.xgrid \ 1678 1678 -text "X" \ … … 1696 1696 -font "Arial 9" 1697 1697 1698 label $inner.mode_l -text "Mode" -font "Arial 9" 1698 label $inner.mode_l -text "Mode" -font "Arial 9" 1699 1699 1700 1700 itk_component add axisMode { … … 1705 1705 "closest_triad" "closest" \ 1706 1706 "furthest_triad" "farthest" \ 1707 "outer_edges" "outer" 1707 "outer_edges" "outer" 1708 1708 $itk_component(axisMode) value $_settings(-axismode) 1709 1709 bind $inner.mode <<Value>> [itcl::code $this AdjustSetting -axismode] … … 1777 1777 1778 1778 # 1779 # camera -- 1779 # camera -- 1780 1780 # 1781 1781 itcl::body Rappture::VtkSurfaceViewer::camera {option args} { 1782 switch -- $option { 1782 switch -- $option { 1783 1783 "show" { 1784 1784 puts [array get _view] … … 1828 1828 1829 1829 itcl::body Rappture::VtkSurfaceViewer::GetImage { args } { 1830 if { [image width $_image(download)] > 0 && 1830 if { [image width $_image(download)] > 0 && 1831 1831 [image height $_image(download)] > 0 } { 1832 1832 set bytes [$_image(download) data -format "jpeg -quality 100"] … … 1841 1841 -title "[Rappture::filexfer::label downloadWord] as..." 1842 1842 set inner [$popup component inner] 1843 label $inner.summary -text "" -anchor w 1843 label $inner.summary -text "" -anchor w 1844 1844 radiobutton $inner.vtk_button -text "VTK data file" \ 1845 1845 -variable [itcl::scope _downloadPopup(format)] \ 1846 1846 -font "Arial 9 " \ 1847 -value vtk 1847 -value vtk 1848 1848 Rappture::Tooltip::for $inner.vtk_button "Save as VTK data file." 1849 1849 radiobutton $inner.image_button -text "Image File" \ 1850 1850 -variable [itcl::scope _downloadPopup(format)] \ 1851 1851 -font "Arial 9 " \ 1852 -value image 1852 -value image 1853 1853 Rappture::Tooltip::for $inner.image_button \ 1854 1854 "Save as digital image." … … 1871 1871 2,0 $inner.image_button -anchor w -cspan 2 -padx { 4 0 } \ 1872 1872 4,1 $inner.cancel -width .9i -fill y \ 1873 4,0 $inner.ok -padx 2 -width .9i -fill y 1873 4,0 $inner.ok -padx 2 -width .9i -fill y 1874 1874 blt::table configure $inner r3 -height 4 1875 1875 blt::table configure $inner r4 -pady 4 … … 1932 1932 set _settings(-isolinesvisible) $style(-isolinesvisible) 1933 1933 set _settings(-surfacevisible) $style(-surfacevisible) 1934 1934 1935 1935 SendCmd "outline add $tag" 1936 1936 SendCmd "outline color [Color2RGB $itk_option(-plotforeground)] $tag" … … 1948 1948 SendCmd "polydata opacity $style(-opacity) $tag" 1949 1949 set _settings(-surfaceopacity) [expr $style(-opacity) * 100.0] 1950 SetCurrentColormap $style(-color) 1950 SetCurrentColormap $style(-color) 1951 1951 SendCmd "polydata wireframe $style(-wireframe) $tag" 1952 1952 set _settings(-surfacewireframe) $style(-wireframe) … … 2003 2003 set font "Arial 8" 2004 2004 set lineht [font metrics $font -linespace] 2005 2005 2006 2006 set ih [image height $_image(legend)] 2007 2007 set iy [expr $y - ($lineht + 2)] 2008 2008 2009 2009 if { [string match "component*" $fname] } { 2010 2010 set title "" 2011 2011 } else { 2012 2013 2014 2015 2016 2017 2018 2019 2012 if { [info exists _fields($fname)] } { 2013 foreach { title units } $_fields($fname) break 2014 if { $units != "" } { 2015 set title [format "%s (%s)" $title $units] 2016 } 2017 } else { 2018 set title $fname 2019 } 2020 2020 } 2021 2021 # If there's a legend title, increase the offset by the line height. … … 2031 2031 } 2032 2032 set color [eval format "\#%02x%02x%02x" $pixel] 2033 $_image(swatch) put black -to 0 0 23 23 2034 $_image(swatch) put $color -to 1 1 22 22 2033 $_image(swatch) put black -to 0 0 23 23 2034 $_image(swatch) put $color -to 1 1 22 22 2035 2035 .rappturetooltip configure -icon $_image(swatch) 2036 2036 … … 2043 2043 set value 0.0 2044 2044 } 2045 set tx [expr $x + 15] 2045 set tx [expr $x + 15] 2046 2046 set ty [expr $y - 5] 2047 2047 if { [info exists _isolines($y)] } { … … 2050 2050 Rappture::Tooltip::text $c [format "$title %g" $value] 2051 2051 } 2052 Rappture::Tooltip::tooltip show $c +$tx,+$ty 2053 } 2054 2055 # 2056 # ReceiveLegend -- 2057 # 2058 # 2059 # 2060 # 2052 Rappture::Tooltip::tooltip show $c +$tx,+$ty 2053 } 2054 2055 # 2056 # ReceiveLegend -- 2057 # 2058 # Invoked automatically whenever the "legend" command comes in from 2059 # the rendering server. Indicates that binary image data with the 2060 # specified <size> will follow. 2061 2061 # 2062 2062 itcl::body Rappture::VtkSurfaceViewer::ReceiveLegend { colormap title min max size } { 2063 2063 #puts stderr "ReceiveLegend colormap=$colormap title=$title range=$min,$max size=$size" 2064 2064 set _title $title 2065 regsub {\(mag\)} $title "" _title 2065 regsub {\(mag\)} $title "" _title 2066 2066 if { [IsConnected] } { 2067 2067 set bytes [ReceiveBytes $size] … … 2072 2072 #puts stderr "read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>" 2073 2073 if { [catch {DrawLegend} errs] != 0 } { 2074 2075 2074 global errorInfo 2075 puts stderr "errs=$errs errorInfo=$errorInfo" 2076 2076 } 2077 2077 } … … 2092 2092 2093 2093 if { [string match "component*" $fname] } { 2094 2094 set title "" 2095 2095 } else { 2096 2097 2098 2099 2100 2101 2102 2103 2096 if { [info exists _fields($fname)] } { 2097 foreach { title units } $_fields($fname) break 2098 if { $units != "" } { 2099 set title [format "%s (%s)" $title $units] 2100 } 2101 } else { 2102 set title $fname 2103 } 2104 2104 } 2105 2105 set x [expr $w - 2] 2106 2106 if { !$_settings(-legendvisible) } { 2107 2108 2109 } 2107 $c delete legend 2108 return 2109 } 2110 2110 if { [$c find withtag "legend"] == "" } { 2111 set y 2 2112 2111 set y 2 2112 # If there's a legend title, create a text item for the title. 2113 2113 $c create text $x $y \ 2114 2115 2116 -font $font 2114 -anchor ne \ 2115 -fill $itk_option(-plotforeground) -tags "title legend" \ 2116 -font $font 2117 2117 if { $title != "" } { 2118 2118 incr y $lineht 2119 2119 } 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2120 $c create text $x $y \ 2121 -anchor ne \ 2122 -fill $itk_option(-plotforeground) -tags "vmax legend" \ 2123 -font $font 2124 incr y $lineht 2125 $c create image $x $y \ 2126 -anchor ne \ 2127 -image $_image(legend) -tags "colormap legend" 2128 $c create rectangle $x $y 1 1 \ 2129 -fill "" -outline "" -tags "sensor legend" 2130 $c create text $x [expr {$h-2}] \ 2131 -anchor se \ 2132 -fill $itk_option(-plotforeground) -tags "vmin legend" \ 2133 -font $font 2134 $c bind sensor <Enter> [itcl::code $this EnterLegend %x %y] 2135 $c bind sensor <Leave> [itcl::code $this LeaveLegend] 2136 $c bind sensor <Motion> [itcl::code $this MotionLegend %x %y] 2137 2137 } 2138 2138 $c delete isoline … … 2153 2153 } 2154 2154 set tags "isoline legend" 2155 2156 2157 2158 2155 set offset [expr 2 + $lineht] 2156 if { $title != "" } { 2157 incr offset $lineht 2158 } 2159 2159 foreach value $_contourList { 2160 2160 set norm [expr 1.0 - (($value - $vmin) / $range)] … … 2175 2175 if { [info exists _limits($_curFldName)] } { 2176 2176 foreach { vmin vmax } $_limits($_curFldName) break 2177 2178 2177 $c itemconfigure vmin -text [format %g $vmin] 2178 $c itemconfigure vmax -text [format %g $vmax] 2179 2179 } 2180 2180 set y 2 … … 2182 2182 if { $title != "" } { 2183 2183 $c itemconfigure title -text $title 2184 2185 2184 $c coords title $x $y 2185 incr y $lineht 2186 2186 $c raise title 2187 2187 } … … 2206 2206 # ---------------------------------------------------------------------- 2207 2207 itcl::body Rappture::VtkSurfaceViewer::Combo {option} { 2208 set c $itk_component(view) 2208 set c $itk_component(view) 2209 2209 switch -- $option { 2210 2210 post { … … 2221 2221 } 2222 2222 deactivate { 2223 $c itemconfigure title -fill $itk_option(-plotforeground) 2223 $c itemconfigure title -fill $itk_option(-plotforeground) 2224 2224 } 2225 2225 invoke { … … 2239 2239 # Keep track of the colormaps that we build. 2240 2240 if { ![info exists _colormaps($name)] } { 2241 BuildColormap $name 2241 BuildColormap $name 2242 2242 set _colormaps($name) 1 2243 2243 } … … 2261 2261 } 2262 2262 2263 itcl::body Rappture::VtkSurfaceViewer::SetOrientation { side } { 2263 itcl::body Rappture::VtkSurfaceViewer::SetOrientation { side } { 2264 2264 array set positions { 2265 2265 front "1 0 0 0" … … 2282 2282 } 2283 2283 2284 itcl::body Rappture::VtkSurfaceViewer::UpdateContourList {} { 2284 itcl::body Rappture::VtkSurfaceViewer::UpdateContourList {} { 2285 2285 if { ![info exists _limits($_curFldName)] } { 2286 2286 return -
branches/1.4/gui/scripts/vtkviewer.tcl
r4775 r5007 1 # -*- mode: tcl; indent-tabs-mode: nil -*- 1 # -*- mode: tcl; indent-tabs-mode: nil -*- 2 2 # ---------------------------------------------------------------------- 3 3 # COMPONENT: vtkviewer - Vtk drawing object viewer … … 58 58 public method isconnected {} 59 59 public method limits { dataobj } 60 public method parameters {title args} { 61 # do nothing 60 public method parameters {title args} { 61 # do nothing 62 62 } 63 63 public method scale {args} … … 69 69 private method BuildColormap { name styles } 70 70 private method BuildCutawayTab {} 71 private method BuildDownloadPopup { widget command } 71 private method BuildDownloadPopup { widget command } 72 72 private method BuildGlyphsTab {} 73 73 private method BuildMoleculeTab {} … … 80 80 private method DoRotate {} 81 81 private method DrawLegend {} 82 private method EnterLegend { x y } 83 private method EventuallyResize { w h } 84 private method EventuallyRotate { q } 85 private method EventuallySetAtomScale { args } 86 private method EventuallySetBondScale { args } 87 private method EventuallySetGlyphsOpacity { args } 88 private method EventuallySetMoleculeOpacity { args } 89 private method EventuallySetMoleculeQuality { args } 90 private method EventuallySetPolydataOpacity { args } 91 private method GetImage { args } 92 private method GetVtkData { args } 82 private method EnterLegend { x y } 83 private method EventuallyResize { w h } 84 private method EventuallyRotate { q } 85 private method EventuallySetAtomScale { args } 86 private method EventuallySetBondScale { args } 87 private method EventuallySetGlyphsOpacity { args } 88 private method EventuallySetMoleculeOpacity { args } 89 private method EventuallySetMoleculeQuality { args } 90 private method EventuallySetPolydataOpacity { args } 91 private method GetImage { args } 92 private method GetVtkData { args } 93 93 private method InitSettings { args } 94 private method IsValidObject { dataobj } 94 private method IsValidObject { dataobj } 95 95 private method LeaveLegend {} 96 private method MotionLegend { x y } 96 private method MotionLegend { x y } 97 97 private method Pan {option x y} 98 98 private method PanCamera {} 99 99 private method Pick {x y} 100 private method QuaternionToView { q } { 100 private method QuaternionToView { q } { 101 101 foreach { _view(-qw) _view(-qx) _view(-qy) _view(-qz) } $q break 102 102 } … … 114 114 private method SetMoleculeOpacity {} 115 115 private method SetMoleculeQuality {} 116 private method SetObjectStyle { dataobj comp } 116 private method SetObjectStyle { dataobj comp } 117 117 private method SetOpacity { dataset } 118 118 private method SetOrientation { side } 119 119 private method SetPolydataOpacity {} 120 private method Slice {option args} 121 private method ViewToQuaternion {} { 120 private method Slice {option args} 121 private method ViewToQuaternion {} { 122 122 return [list $_view(-qw) $_view(-qx) $_view(-qy) $_view(-qz)] 123 123 } … … 125 125 126 126 private variable _arcball "" 127 private variable _dlist ""; 127 private variable _dlist ""; # list of data objects 128 128 private variable _obj2datasets 129 private variable _obj2ovride; 130 private variable _datasets; # contains all the dataobj-component131 132 private variable _colormaps; 133 134 private variable _dataset2style; 135 private variable _style2datasets; # maps tf back to list of136 129 private variable _obj2ovride; # maps dataobj => style override 130 private variable _datasets; # contains all the dataobj-component 131 # datasets in the server 132 private variable _colormaps; # contains all the colormaps 133 # in the server. 134 private variable _dataset2style; # maps dataobj-component to transfunc 135 private variable _style2datasets; # maps tf back to list of 136 # dataobj-components using the tf. 137 137 private variable _click; # info used for rotate operations 138 138 private variable _limits; # autoscale min/max for all axes … … 319 319 320 320 set _map(id) [$c create image 0 0 -anchor nw -image $_image(plot)] 321 set _map(cwidth) -1 322 set _map(cheight) -1 321 set _map(cwidth) -1 322 set _map(cheight) -1 323 323 set _map(zoom) 1.0 324 324 set _map(original) "" … … 373 373 set _image(legend) [image create photo] 374 374 itk_component add legend { 375 canvas $itk_component(plotarea).legend -width 50 -highlightthickness 0 375 canvas $itk_component(plotarea).legend -width 50 -highlightthickness 0 376 376 } { 377 377 usual … … 380 380 } 381 381 382 # Hack around the Tk panewindow. The problem is that the requested 382 # Hack around the Tk panewindow. The problem is that the requested 383 383 # size of the 3d view isn't set until an image is retrieved from 384 384 # the server. So the panewindow uses the tiny size. … … 386 386 pack forget $itk_component(view) 387 387 blt::table $itk_component(plotarea) \ 388 0,0 $itk_component(view) -fill both -reqwidth $w 388 0,0 $itk_component(view) -fill both -reqwidth $w 389 389 blt::table configure $itk_component(plotarea) c1 -resize none 390 390 … … 473 473 474 474 itcl::body Rappture::VtkViewer::DoRotate {} { 475 SendCmd "camera orient [ViewToQuaternion]" 475 SendCmd "camera orient [ViewToQuaternion]" 476 476 set _rotatePending 0 477 477 } … … 674 674 continue 675 675 } 676 if {[info exists _obj2ovride($dataobj-raise)] && 676 if {[info exists _obj2ovride($dataobj-raise)] && 677 677 $_obj2ovride($dataobj-raise)} { 678 678 set dlist [linsert $dlist 0 $dataobj] … … 702 702 } 703 703 return $dlist 704 } 704 } 705 705 -image { 706 706 if {[llength $args] != 2} { … … 925 925 # disconnected -- no more data sitting on server 926 926 set _outbuf "" 927 array unset _datasets 928 array unset _data 929 array unset _colormaps 927 array unset _datasets 928 array unset _data 929 array unset _colormaps 930 930 global readyForNextFrame 931 931 set readyForNextFrame 1 … … 1029 1029 # Turn on buffering of commands to the server. We don't want to 1030 1030 # be preempted by a server disconnect/reconnect (which automatically 1031 # generates a new call to Rebuild). 1031 # generates a new call to Rebuild). 1032 1032 StartBufferingCommands 1033 1033 … … 1123 1123 if { $_haveGlyphs } { 1124 1124 InitSettings glyphs-edges glyphs-lighting glyphs-opacity \ 1125 glyphs-visible glyphs-wireframe 1125 glyphs-visible glyphs-wireframe 1126 1126 } 1127 1127 if { $_havePolydata } { 1128 1128 InitSettings polydata-edges polydata-lighting polydata-opacity \ 1129 polydata-visible polydata-wireframe 1129 polydata-visible polydata-wireframe 1130 1130 } 1131 1131 if { $_haveMolecules } { … … 1147 1147 1148 1148 if { $_haveMolecules } { 1149 #InitSettings molecule-representation 1149 #InitSettings molecule-representation 1150 1150 } 1151 1151 set _reset 0 … … 1170 1170 itcl::body Rappture::VtkViewer::CurrentDatasets {args} { 1171 1171 set flag [lindex $args 0] 1172 switch -- $flag { 1172 switch -- $flag { 1173 1173 "-all" { 1174 1174 if { [llength $args] > 1 } { … … 1189 1189 set dlist [get -visible] 1190 1190 } 1191 } 1191 } 1192 1192 default { 1193 1193 set dlist $args … … 1308 1308 foreach tag [CurrentDatasets -visible] { 1309 1309 SendCmd "dataset getscalar pixel $x $y $tag" 1310 } 1310 } 1311 1311 } 1312 1312 … … 1754 1754 } 1755 1755 } 1756 "axis-xposition" - "axis-yposition" - "axis-zposition" - 1756 "axis-xposition" - "axis-yposition" - "axis-zposition" - 1757 1757 "axis-xdirection" - "axis-ydirection" - "axis-zdirection" { 1758 1758 set axis [string range $what 5 5] … … 1912 1912 set f [open "$tmpfile" "w"] 1913 1913 fconfigure $f -translation binary -encoding binary 1914 puts $f $data 1914 puts $f $data 1915 1915 close $f 1916 1916 set reader [vtkDataSetReader $tag-xvtkDataSetReader] … … 2006 2006 -variable [itcl::scope _settings(glyphs-visible)] \ 2007 2007 -command [itcl::code $this AdjustSetting glyphs-visible] \ 2008 -font "Arial 9" -anchor w 2008 -font "Arial 9" -anchor w 2009 2009 2010 2010 checkbutton $inner.outline \ … … 2012 2012 -variable [itcl::scope _settings(glyphs-outline)] \ 2013 2013 -command [itcl::code $this AdjustSetting glyphs-outline] \ 2014 -font "Arial 9" -anchor w 2014 -font "Arial 9" -anchor w 2015 2015 2016 2016 checkbutton $inner.wireframe \ … … 2018 2018 -variable [itcl::scope _settings(glyphs-wireframe)] \ 2019 2019 -command [itcl::code $this AdjustSetting glyphs-wireframe] \ 2020 -font "Arial 9" -anchor w 2020 -font "Arial 9" -anchor w 2021 2021 2022 2022 checkbutton $inner.lighting \ … … 2032 2032 -font "Arial 9" -anchor w 2033 2033 2034 label $inner.palette_l -text "Palette" -font "Arial 9" -anchor w 2034 label $inner.palette_l -text "Palette" -font "Arial 9" -anchor w 2035 2035 itk_component add glyphspalette { 2036 2036 Rappture::Combobox $inner.palette -width 10 -editable no … … 2041 2041 [itcl::code $this AdjustSetting glyphs-palette] 2042 2042 2043 label $inner.opacity_l -text "Opacity" -font "Arial 9" -anchor w 2043 label $inner.opacity_l -text "Opacity" -font "Arial 9" -anchor w 2044 2044 ::scale $inner.opacity -from 0 -to 100 -orient horizontal \ 2045 2045 -variable [itcl::scope _settings(glyphs-opacity)] \ … … 2058 2058 5,1 $inner.opacity -fill x -pady 2 \ 2059 2059 6,0 $inner.palette_l -anchor w -pady 2 \ 2060 6,1 $inner.palette -fill x -pady 2 2060 6,1 $inner.palette -fill x -pady 2 2061 2061 2062 2062 blt::table configure $inner r* c* -resize none … … 2078 2078 -variable [itcl::scope _settings(polydata-visible)] \ 2079 2079 -command [itcl::code $this AdjustSetting polydata-visible] \ 2080 -font "Arial 9" -anchor w 2080 -font "Arial 9" -anchor w 2081 2081 2082 2082 checkbutton $inner.outline \ … … 2084 2084 -variable [itcl::scope _settings(polydata-outline)] \ 2085 2085 -command [itcl::code $this AdjustSetting polydata-outline] \ 2086 -font "Arial 9" -anchor w 2086 -font "Arial 9" -anchor w 2087 2087 2088 2088 checkbutton $inner.wireframe \ … … 2090 2090 -variable [itcl::scope _settings(polydata-wireframe)] \ 2091 2091 -command [itcl::code $this AdjustSetting polydata-wireframe] \ 2092 -font "Arial 9" -anchor w 2092 -font "Arial 9" -anchor w 2093 2093 2094 2094 checkbutton $inner.lighting \ … … 2104 2104 -font "Arial 9" -anchor w 2105 2105 2106 label $inner.palette_l -text "Palette" -font "Arial 9" -anchor w 2106 label $inner.palette_l -text "Palette" -font "Arial 9" -anchor w 2107 2107 itk_component add meshpalette { 2108 2108 Rappture::Combobox $inner.palette -width 10 -editable no … … 2113 2113 [itcl::code $this AdjustSetting polydata-palette] 2114 2114 2115 label $inner.opacity_l -text "Opacity" -font "Arial 9" -anchor w 2115 label $inner.opacity_l -text "Opacity" -font "Arial 9" -anchor w 2116 2116 ::scale $inner.opacity -from 0 -to 100 -orient horizontal \ 2117 2117 -variable [itcl::scope _settings(polydata-opacity)] \ … … 2130 2130 5,1 $inner.opacity -fill x -pady 2 \ 2131 2131 6,0 $inner.palette_l -anchor w -pady 2 \ 2132 6,1 $inner.palette -fill x -pady 2 2132 6,1 $inner.palette -fill x -pady 2 2133 2133 2134 2134 blt::table configure $inner r* c* -resize none … … 2157 2157 -command [itcl::code $this AdjustSetting axis-labels] \ 2158 2158 -font "Arial 9" 2159 label $inner.grid_l -text "Grid" -font "Arial 9" 2159 label $inner.grid_l -text "Grid" -font "Arial 9" 2160 2160 checkbutton $inner.xgrid \ 2161 2161 -text "X" \ … … 2179 2179 -font "Arial 9" 2180 2180 2181 label $inner.mode_l -text "Mode" -font "Arial 9" 2181 label $inner.mode_l -text "Mode" -font "Arial 9" 2182 2182 2183 2183 itk_component add axismode { … … 2188 2188 "closest_triad" "closest" \ 2189 2189 "furthest_triad" "farthest" \ 2190 "outer_edges" "outer" 2190 "outer_edges" "outer" 2191 2191 $itk_component(axismode) value "static" 2192 2192 bind $inner.mode <<Value>> [itcl::code $this AdjustSetting axis-mode] … … 2262 2262 2263 2263 set fg [option get $itk_component(hull) font Font] 2264 2264 2265 2265 set inner [$itk_component(main) insert end \ 2266 2266 -title "Cutaway Along Axis" \ 2267 -icon [Rappture::icon cutbutton]] 2267 -icon [Rappture::icon cutbutton]] 2268 2268 2269 2269 $inner configure -borderwidth 4 … … 2305 2305 -variable [itcl::scope _axis(xdirection)] 2306 2306 } 2307 set _axis(xdirection) -1 2307 set _axis(xdirection) -1 2308 2308 Rappture::Tooltip::for $itk_component(xDirButton) \ 2309 2309 "Toggle the direction of the X-axis cutaway" … … 2347 2347 Rappture::Tooltip::for $itk_component(yDirButton) \ 2348 2348 "Toggle the direction of the Y-axis cutaway" 2349 set _axis(ydirection) -1 2349 set _axis(ydirection) -1 2350 2350 2351 2351 # Z-value slicer... … … 2384 2384 -variable [itcl::scope _axis(zdirection)] 2385 2385 } 2386 set _axis(zdirection) -1 2386 set _axis(zdirection) -1 2387 2387 Rappture::Tooltip::for $itk_component(zDirButton) \ 2388 2388 "Toggle the direction of the Z-axis cutaway" … … 2452 2452 $inner.rep choices insert end \ 2453 2453 "ballandstick" "Ball and Stick" \ 2454 "spheres" 2455 "sticks" "Sticks"\2456 "rods" 2457 "wireframe" "Wireframe" 2458 "spacefilling" "Space Filling" 2454 "spheres" "Spheres" \ 2455 "sticks" "Sticks" \ 2456 "rods" "Rods" \ 2457 "wireframe" "Wireframe" \ 2458 "spacefilling" "Space Filling" 2459 2459 2460 2460 bind $inner.rep <<Value>> \ … … 2469 2469 } 2470 2470 $inner.rscale choices insert end \ 2471 "atomic" 2472 "covalent" 2473 "van_der_waals" "VDW"\2474 "none" 2471 "atomic" "Atomic" \ 2472 "covalent" "Covalent" \ 2473 "van_der_waals" "VDW" \ 2474 "none" "Constant" 2475 2475 2476 2476 bind $inner.rscale <<Value>> \ … … 2478 2478 $inner.rscale value "Covalent" 2479 2479 2480 label $inner.palette_l -text "Palette" -font "Arial 9" 2480 label $inner.palette_l -text "Palette" -font "Arial 9" 2481 2481 itk_component add moleculepalette { 2482 2482 Rappture::Combobox $inner.palette -width 10 -editable no … … 2543 2543 16,0 $inner.quality_l -anchor w -pady {3 0} \ 2544 2544 17,0 $inner.quality -fill x -padx 2 2545 2545 2546 2546 blt::table configure $inner r* -resize none 2547 2547 blt::table configure $inner r18 -resize expand … … 2549 2549 2550 2550 # 2551 # camera -- 2551 # camera -- 2552 2552 # 2553 2553 itcl::body Rappture::VtkViewer::camera {option args} { 2554 switch -- $option { 2554 switch -- $option { 2555 2555 "show" { 2556 2556 puts [array get _view] … … 2600 2600 2601 2601 itcl::body Rappture::VtkViewer::GetImage { args } { 2602 if { [image width $_image(download)] > 0 && 2602 if { [image width $_image(download)] > 0 && 2603 2603 [image height $_image(download)] > 0 } { 2604 2604 set bytes [$_image(download) data -format "jpeg -quality 100"] … … 2613 2613 -title "[Rappture::filexfer::label downloadWord] as..." 2614 2614 set inner [$popup component inner] 2615 label $inner.summary -text "" -anchor w 2615 label $inner.summary -text "" -anchor w 2616 2616 radiobutton $inner.vtk_button -text "VTK data file" \ 2617 2617 -variable [itcl::scope _downloadPopup(format)] \ 2618 2618 -font "Helvetica 9 " \ 2619 -value vtk 2619 -value vtk 2620 2620 Rappture::Tooltip::for $inner.vtk_button "Save as VTK data file." 2621 2621 radiobutton $inner.image_button -text "Image File" \ 2622 2622 -variable [itcl::scope _downloadPopup(format)] \ 2623 -value image 2623 -value image 2624 2624 Rappture::Tooltip::for $inner.image_button \ 2625 2625 "Save as digital image." … … 2642 2642 2,0 $inner.image_button -anchor w -cspan 2 -padx { 4 0 } \ 2643 2643 4,1 $inner.cancel -width .9i -fill y \ 2644 4,0 $inner.ok -padx 2 -width .9i -fill y 2644 4,0 $inner.ok -padx 2 -width .9i -fill y 2645 2645 blt::table configure $inner r3 -height 4 2646 2646 blt::table configure $inner r4 -pady 4 … … 2919 2919 set font "Arial 8" 2920 2920 set lineht [font metrics $font -linespace] 2921 2921 2922 2922 if { $_settings(legend) } { 2923 2923 set x [expr $w - 2] … … 2984 2984 set font "Arial 8" 2985 2985 set lineht [font metrics $font -linespace] 2986 2986 2987 2987 set imgHeight [image height $_image(legend)] 2988 2988 set coords [$c coords colormap] … … 2998 2998 } 2999 2999 set color [eval format "\#%02x%02x%02x" $pixel] 3000 $_image(swatch) put black -to 0 0 23 23 3001 $_image(swatch) put $color -to 1 1 22 22 3000 $_image(swatch) put black -to 0 0 23 23 3001 $_image(swatch) put $color -to 1 1 22 22 3002 3002 .rappturetooltip configure -icon $_image(swatch) 3003 3003 … … 3005 3005 set t [expr 1.0 - (double($imgY) / double($imgHeight-1))] 3006 3006 set value [expr $t * ($_limits(vmax) - $_limits(vmin)) + $_limits(vmin)] 3007 set tipx [expr $x + 15] 3007 set tipx [expr $x + 15] 3008 3008 set tipy [expr $y - 5] 3009 3009 Rappture::Tooltip::text $c "$_title $value" 3010 Rappture::Tooltip::tooltip show $c +$tipx,+$tipy 3010 Rappture::Tooltip::tooltip show $c +$tipx,+$tipy 3011 3011 } 3012 3012 … … 3041 3041 } 3042 3042 3043 itcl::body Rappture::VtkViewer::SetOrientation { side } { 3043 itcl::body Rappture::VtkViewer::SetOrientation { side } { 3044 3044 array set positions { 3045 3045 front "1 0 0 0" … … 3052 3052 foreach name { -qw -qx -qy -qz } value $positions($side) { 3053 3053 set _view($name) $value 3054 } 3054 } 3055 3055 set q [ViewToQuaternion] 3056 3056 $_arcball quaternion $q … … 3062 3062 } 3063 3063 3064 itcl::body Rappture::VtkViewer::SetOpacity { dataset } { 3064 itcl::body Rappture::VtkViewer::SetOpacity { dataset } { 3065 3065 foreach {dataobj comp} [split $dataset -] break 3066 3066 set type [$dataobj type $comp]
Note: See TracChangeset
for help on using the changeset viewer.