Changeset 5004
- Timestamp:
- Feb 11, 2015, 2:40:57 PM (10 years ago)
- File:
-
- 1 edited
-
trunk/gui/scripts/vtkheightmapviewer.tcl (modified) (88 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/gui/scripts/vtkheightmapviewer.tcl
r4997 r5004 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 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 1074 1075 1075 set units "" 1076 1076 if {$axis == "z" && [$_first hints ${axis}units] == ""} { 1077 1077 if {$_curFldName != ""} { 1078 1078 set units [lindex $_fields($_curFldName) 1] 1079 1079 } 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1080 } else { 1081 set units [$_first hints ${axis}units] 1082 } 1083 if { $units != "" } { 1084 # May be a space in the axis units. 1085 SendCmd [list axis units $axis $units] 1086 } 1087 } 1088 # 1089 # Reset the camera and other view parameters 1090 # 1091 ResetAxes 1092 $_arcball quaternion [ViewToQuaternion] 1093 1093 if {$_settings(-isheightmap) } { 1094 1094 if { $_view(-ortho)} { … … 1100 1100 SendCmd "camera reset" 1101 1101 } 1102 1103 1104 1102 PanCamera 1103 InitSettings -xgrid -ygrid -zgrid \ 1104 -axisvisible -axislabels -heightmapscale -field -isheightmap \ 1105 1105 -numisolines 1106 1106 if { [array size _fields] < 2 } { … … 1111 1111 } 1112 1112 global readyForNextFrame 1113 set readyForNextFrame 0; 1113 set readyForNextFrame 0; # Don't advance to the next frame 1114 1114 1115 1115 # Actually write the commands to the server socket. If it fails, we don't … … 1129 1129 itcl::body Rappture::VtkHeightmapViewer::CurrentDatasets {args} { 1130 1130 set flag [lindex $args 0] 1131 switch -- $flag { 1131 switch -- $flag { 1132 1132 "-all" { 1133 1133 if { [llength $args] > 1 } { … … 1148 1148 set dlist [get -visible] 1149 1149 } 1150 } 1150 } 1151 1151 default { 1152 1152 set dlist $args … … 1279 1279 foreach tag [CurrentDatasets -visible] { 1280 1280 SendCmd "dataset getscalar pixel $x $y $tag" 1281 } 1281 } 1282 1282 } 1283 1283 … … 1383 1383 "-background" { 1384 1384 set bg [$itk_component(background) value] 1385 1386 1387 1388 "grey""black"1389 1385 array set fgcolors { 1386 "black" "white" 1387 "white" "black" 1388 "grey" "black" 1389 } 1390 1390 set fg $fgcolors($bg) 1391 1391 configure -plotbackground $bg -plotforeground $fg 1392 1392 $itk_component(view) delete "legend" 1393 1393 SendCmd "screen bgcolor [Color2RGB $bg]" 1394 1394 SendCmd "outline color [Color2RGB $fg]" 1395 1395 SendCmd "axis color all [Color2RGB $fg]" 1396 1396 DrawLegend 1397 1397 } 1398 1398 "-colormap" { … … 1401 1401 set color [$itk_component(colormap) value] 1402 1402 set _settings($what) $color 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1403 if { $color == "none" } { 1404 if { $_settings(-colormapvisible) } { 1405 SendCmd "heightmap surface 0" 1406 set _settings(-colormapvisible) 0 1407 } 1408 } else { 1409 if { !$_settings(-colormapvisible) } { 1410 SendCmd "heightmap surface 1" 1411 set _settings(-colormapvisible) 1 1412 } 1413 SetCurrentColormap $color 1414 1414 if {$_settings(-colormapdiscrete)} { 1415 1415 set numColors [expr $_settings(-numisolines) + 1] 1416 1416 SendCmd "colormap res $numColors $color" 1417 1417 } 1418 1418 } 1419 1419 StopBufferingCommands 1420 1420 EventuallyRequestLegend 1421 1421 } 1422 1422 "-colormapvisible" { … … 1461 1461 return 1462 1462 } 1463 1464 1463 set label [$_first hints label] 1464 if { $label == "" } { 1465 1465 if { [string match "component*" $_curFldName] } { 1466 1466 set label Z … … 1468 1468 set label $_curFldLabel 1469 1469 } 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1470 } 1471 # May be a space in the axis label. 1472 SendCmd [list axis name z $label] 1473 1474 if { [$_first hints zunits] == "" } { 1475 set units [lindex $_fields($_curFldName) 1] 1476 } else { 1477 set units [$_first hints zunits] 1478 } 1479 if { $units != "" } { 1480 # May be a space in the axis units. 1481 SendCmd [list axis units z $units] 1482 } 1483 1483 # Get the new limits because the field changed. 1484 1484 ResetAxes … … 1490 1490 } 1491 1491 "-heightmapscale" { 1492 1493 1494 # Have to set the datasets individually because we are 1492 if { $_settings(-isheightmap) } { 1493 set scale [GetHeightmapScale] 1494 # Have to set the datasets individually because we are 1495 1495 # tracking them in _comp2scale. 1496 1496 foreach dataset [CurrentDatasets -all] { 1497 1498 1499 1500 1501 1497 SendCmd "heightmap heightscale $scale $dataset" 1498 set _comp2scale($dataset) $scale 1499 } 1500 ResetAxes 1501 } 1502 1502 } 1503 1503 "-isheightmap" { 1504 1504 set bool $_settings($what) 1505 1505 set c $itk_component(view) 1506 1506 StartBufferingCommands … … 1519 1519 InitSettings -lighting -opacity -outline 1520 1520 set scale [GetHeightmapScale] 1521 # Have to set the datasets individually because we are 1521 # Have to set the datasets individually because we are 1522 1522 # tracking them in _comp2scale. 1523 1523 foreach dataset [CurrentDatasets -all] { … … 1525 1525 set _comp2scale($dataset) $scale 1526 1526 } 1527 1528 1529 1530 1531 1532 1533 1527 if { $bool } { 1528 $itk_component(lighting) configure -state normal 1529 $itk_component(opacity) configure -state normal 1530 $itk_component(scale) configure -state normal 1531 $itk_component(opacity_l) configure -state normal 1532 $itk_component(scale_l) configure -state normal 1533 $itk_component(outline) configure -state disabled 1534 1534 if {$_view(-ortho)} { 1535 1535 SendCmd "camera mode ortho" … … 1537 1537 SendCmd "camera mode persp" 1538 1538 } 1539 1540 1541 1542 1543 1544 1545 1539 } else { 1540 $itk_component(lighting) configure -state disabled 1541 $itk_component(opacity) configure -state disabled 1542 $itk_component(scale) configure -state disabled 1543 $itk_component(opacity_l) configure -state disabled 1544 $itk_component(scale_l) configure -state disabled 1545 $itk_component(outline) configure -state normal 1546 1546 SendCmd "camera mode image" 1547 1547 } … … 1557 1557 set q [ViewToQuaternion] 1558 1558 $_arcball quaternion $q 1559 SendCmd "camera orient $q" 1559 SendCmd "camera orient $q" 1560 1560 } else { 1561 1561 bind $c <ButtonPress-1> {} … … 1564 1564 } 1565 1565 Zoom reset 1566 # Fix the mouse bindings for rotation/panning and the 1566 # Fix the mouse bindings for rotation/panning and the 1567 1567 # camera mode. Ideally we'd create a bindtag for these. 1568 1568 if { $bool } { … … 1579 1579 "-isolinecolor" { 1580 1580 set color [$itk_component(isolinecolor) value] 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1581 if { $color == "none" } { 1582 if { $_settings(-isolinesvisible) } { 1583 SendCmd "heightmap isolines 0" 1584 set _settings(-isolinesvisible) 0 1585 } 1586 } else { 1587 if { !$_settings(-isolinesvisible) } { 1588 SendCmd "heightmap isolines 1" 1589 set _settings(-isolinesvisible) 1 1590 } 1591 SendCmd "heightmap isolinecolor [Color2RGB $color]" 1592 } 1593 DrawLegend 1594 1594 } 1595 1595 "-isolinesvisible" { 1596 1596 set bool $_settings($what) 1597 1597 SendCmd "heightmap isolines $bool" 1598 1598 DrawLegend 1599 1599 } 1600 1600 "-legendvisible" { 1601 1601 if { !$_settings($what) } { 1602 1603 1604 1602 $itk_component(view) delete legend 1603 } 1604 DrawLegend 1605 1605 } 1606 1606 "-lighting" { 1607 1607 if { $_settings(-isheightmap) } { 1608 1608 set _settings(-savelighting) $_settings($what) 1609 1610 1611 1612 1613 1609 set bool $_settings($what) 1610 SendCmd "heightmap lighting $bool" 1611 } else { 1612 SendCmd "heightmap lighting 0" 1613 } 1614 1614 } 1615 1615 "-numisolines" { … … 1630 1630 set _changed($what) 1 1631 1631 set val [expr $_settings($what) * 0.01] 1632 1632 if { $_settings(-isheightmap) } { 1633 1633 set _settings(-saveopacity) $_settings($what) 1634 1634 SendCmd "heightmap opacity $val" 1635 1635 } else { 1636 1636 SendCmd "heightmap opacity 1.0" 1637 1637 } 1638 1638 } 1639 1639 "-outline" { 1640 1641 1640 if { $_settings(-isheightmap) } { 1641 SendCmd "outline visible 0" 1642 1642 } else { 1643 1643 set _settings(-saveoutline) $_settings($what) … … 1645 1645 SendCmd "outline visible $bool" 1646 1646 } 1647 1647 } 1648 1648 "-stretchtofit" { 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1649 set bool $_settings($what) 1650 if { $bool } { 1651 set heightScale [GetHeightmapScale] 1652 if {$heightScale == 0} { 1653 SendCmd "camera aspect window" 1654 } else { 1655 SendCmd "camera aspect square" 1656 } 1657 } else { 1658 SendCmd "camera aspect native" 1659 } 1660 1660 Zoom reset 1661 1661 } 1662 1662 "-wireframe" { 1663 1663 set bool $_settings($what) … … 1669 1669 SendCmd "axis grid $axis $bool" 1670 1670 } 1671 1671 default { 1672 1672 error "don't know how to fix $what" 1673 1673 } … … 1679 1679 # 1680 1680 # Request a new legend from the server. The size of the legend 1681 # is determined from the height of the canvas. 1681 # is determined from the height of the canvas. 1682 1682 # 1683 1683 # This should be called when 1684 # 1685 # 1686 # 1687 # 1688 # 1684 # 1. A new current colormap is set. 1685 # 2. Window is resized. 1686 # 3. The limits of the data have changed. (Just need a redraw). 1687 # 4. Number of isolines have changed. (Just need a redraw). 1688 # 5. Legend becomes visible (Just need a redraw). 1689 1689 # 1690 1690 itcl::body Rappture::VtkHeightmapViewer::RequestLegend {} { … … 1693 1693 set w 12 1694 1694 set lineht [font metrics $font -linespace] 1695 # color ramp height = (canvas height) - (min and max value lines) - 2 1695 # color ramp height = (canvas height) - (min and max value lines) - 2 1696 1696 set h [expr {$_height - 2 * ($lineht + 2)}] 1697 1697 set _legendHeight $h … … 1699 1699 set fname $_curFldName 1700 1700 if { [string match "component*" $fname] } { 1701 1701 set title "" 1702 1702 } else { 1703 1704 1705 1706 1707 1708 1709 1710 1703 if { [info exists _fields($fname)] } { 1704 foreach { title units } $_fields($fname) break 1705 if { $units != "" } { 1706 set title [format "%s (%s)" $title $units] 1707 } 1708 } else { 1709 set title $fname 1710 } 1711 1711 } 1712 1712 # If there's a title too, substract one more line 1713 1713 if { $title != "" } { 1714 incr h -$lineht 1714 incr h -$lineht 1715 1715 } 1716 1716 if { $h < 1 } { … … 1719 1719 # Set the legend on the first heightmap dataset. 1720 1720 if { $_currentColormap != "" } { 1721 1722 1721 set cmap $_currentColormap 1722 #SendCmd "legend $cmap scalar $_curFldName {} $w $h 0" 1723 1723 SendCmd "legend2 $cmap $w $h" 1724 1724 } … … 1774 1774 # Keep track of the colormaps that we build. 1775 1775 if { $name != "none" && ![info exists _colormaps($name)] } { 1776 BuildColormap $name 1776 BuildColormap $name 1777 1777 set _colormaps($name) 1 1778 1778 } … … 1800 1800 itcl::configbody Rappture::VtkHeightmapViewer::mode { 1801 1801 switch -- $itk_option(-mode) { 1802 1803 1804 1805 1806 1807 } 1808 1809 1810 1802 "heightmap" { 1803 set _settings(-isheightmap) 1 1804 } 1805 "contour" { 1806 set _settings(-isheightmap) 0 1807 } 1808 default { 1809 error "unknown mode settings \"$itk_option(-mode)\"" 1810 } 1811 1811 } 1812 1812 if { !$_reset } { … … 1824 1824 SendCmd "screen bgcolor $rgb" 1825 1825 } 1826 1826 $itk_component(view) configure -background $itk_option(-plotbackground) 1827 1827 } 1828 1828 } … … 1864 1864 1865 1865 itk_component add lighting { 1866 1867 1868 1869 1870 1866 checkbutton $inner.lighting \ 1867 -text "Enable Lighting" \ 1868 -variable [itcl::scope _settings(-lighting)] \ 1869 -command [itcl::code $this AdjustSetting -lighting] \ 1870 -font "Arial 9" 1871 1871 } { 1872 1872 ignore -font 1873 1873 } 1874 1874 checkbutton $inner.edges \ … … 1906 1906 1907 1907 itk_component add field_l { 1908 label $inner.field_l -text "Field" -font "Arial 9" 1908 label $inner.field_l -text "Field" -font "Arial 9" 1909 1909 } { 1910 1910 ignore -font … … 1916 1916 [itcl::code $this AdjustSetting -field] 1917 1917 1918 label $inner.colormap_l -text "Colormap" -font "Arial 9" 1918 label $inner.colormap_l -text "Colormap" -font "Arial 9" 1919 1919 itk_component add colormap { 1920 1920 Rappture::Combobox $inner.colormap -width 10 -editable no … … 1925 1925 [itcl::code $this AdjustSetting -colormap] 1926 1926 1927 label $inner.isolinecolor_l -text "Isolines Color" -font "Arial 9" 1927 label $inner.isolinecolor_l -text "Isolines Color" -font "Arial 9" 1928 1928 itk_component add isolinecolor { 1929 1929 Rappture::Combobox $inner.isolinecolor -width 10 -editable no … … 1939 1939 "red" "red" \ 1940 1940 "white" "white" \ 1941 "none""none"1941 "none" "none" 1942 1942 1943 1943 $itk_component(isolinecolor) value $_settings(-isolinecolor) 1944 1944 bind $inner.isolinecolor <<Value>> \ 1945 1946 1947 label $inner.background_l -text "Background Color" -font "Arial 9" 1945 [itcl::code $this AdjustSetting -isolinecolor] 1946 1947 label $inner.background_l -text "Background Color" -font "Arial 9" 1948 1948 itk_component add background { 1949 1949 Rappture::Combobox $inner.background -width 10 -editable no … … 1952 1952 "black" "black" \ 1953 1953 "white" "white" \ 1954 "grey" "grey" 1954 "grey" "grey" 1955 1955 1956 1956 $itk_component(background) value "white" … … 1999 1999 2,0 $inner.isolinecolor_l -anchor w -pady 2 \ 2000 2000 2,1 $inner.isolinecolor -anchor w -pady 2 -fill x \ 2001 2002 2001 3,0 $inner.background_l -anchor w -pady 2 \ 2002 3,1 $inner.background -anchor w -pady 2 -fill x \ 2003 2003 4,0 $inner.numisolines_l -anchor w -pady 2 \ 2004 2004 4,1 $inner.numisolines -anchor w -pady 2 \ … … 2042 2042 -command [itcl::code $this AdjustSetting -axislabels] \ 2043 2043 -font "Arial 9" 2044 label $inner.grid_l -text "Grid" -font "Arial 9" 2044 label $inner.grid_l -text "Grid" -font "Arial 9" 2045 2045 checkbutton $inner.xgrid \ 2046 2046 -text "X" \ … … 2064 2064 -font "Arial 9" 2065 2065 2066 label $inner.mode_l -text "Mode" -font "Arial 9" 2066 label $inner.mode_l -text "Mode" -font "Arial 9" 2067 2067 2068 2068 itk_component add axisflymode { … … 2073 2073 "closest_triad" "closest" \ 2074 2074 "furthest_triad" "farthest" \ 2075 "outer_edges" "outer" 2075 "outer_edges" "outer" 2076 2076 $itk_component(axisflymode) value $_settings(-axisflymode) 2077 2077 bind $inner.mode <<Value>> [itcl::code $this AdjustSetting -axisflymode] … … 2081 2081 1,0 $inner.labels -anchor w -cspan 4 \ 2082 2082 2,0 $inner.minorticks -anchor w -cspan 4 \ 2083 2083 4,0 $inner.grid_l -anchor w \ 2084 2084 4,1 $inner.xgrid -anchor w \ 2085 2085 4,2 $inner.ygrid -anchor w \ 2086 2086 4,3 $inner.zgrid -anchor w \ 2087 2087 5,0 $inner.mode_l -anchor w -padx { 2 0 } \ 2088 5,1 $inner.mode -fill x -cspan 3 2088 5,1 $inner.mode -fill x -cspan 3 2089 2089 2090 2090 blt::table configure $inner r* c* -resize none … … 2145 2145 2146 2146 # 2147 # camera -- 2147 # camera -- 2148 2148 # 2149 2149 itcl::body Rappture::VtkHeightmapViewer::camera {option args} { 2150 switch -- $option { 2150 switch -- $option { 2151 2151 "show" { 2152 2152 puts [array get _view] … … 2196 2196 2197 2197 itcl::body Rappture::VtkHeightmapViewer::GetImage { args } { 2198 if { [image width $_image(download)] > 0 && 2198 if { [image width $_image(download)] > 0 && 2199 2199 [image height $_image(download)] > 0 } { 2200 2200 set bytes [$_image(download) data -format "jpeg -quality 100"] … … 2209 2209 -title "[Rappture::filexfer::label downloadWord] as..." 2210 2210 set inner [$popup component inner] 2211 label $inner.summary -text "" -anchor w 2211 label $inner.summary -text "" -anchor w 2212 2212 radiobutton $inner.vtk_button -text "VTK data file" \ 2213 2213 -variable [itcl::scope _downloadPopup(format)] \ 2214 2214 -font "Arial 9 " \ 2215 -value vtk 2215 -value vtk 2216 2216 Rappture::Tooltip::for $inner.vtk_button "Save as VTK data file." 2217 2217 radiobutton $inner.image_button -text "Image File" \ 2218 2218 -variable [itcl::scope _downloadPopup(format)] \ 2219 2219 -font "Arial 9 " \ 2220 -value image 2220 -value image 2221 2221 Rappture::Tooltip::for $inner.image_button \ 2222 2222 "Save as digital image." … … 2239 2239 2,0 $inner.image_button -anchor w -cspan 2 -padx { 4 0 } \ 2240 2240 4,1 $inner.cancel -width .9i -fill y \ 2241 4,0 $inner.ok -padx 2 -width .9i -fill y 2241 4,0 $inner.ok -padx 2 -width .9i -fill y 2242 2242 blt::table configure $inner r3 -height 4 2243 2243 blt::table configure $inner r4 -pady 4 … … 2250 2250 # SetObjectStyle -- 2251 2251 # 2252 # Set the style of the heightmap/contour object. This gets calls 2252 # Set the style of the heightmap/contour object. This gets calls 2253 2253 # for each dataset once as it is loaded. It can overridden by 2254 2254 # the user controls. … … 2341 2341 #puts stderr "read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>" 2342 2342 if { [catch {DrawLegend} errs] != 0 } { 2343 2344 2343 global errorInfo 2344 puts stderr "errs=$errs errorInfo=$errorInfo" 2345 2345 } 2346 2346 } … … 2359 2359 set font "Arial 8" 2360 2360 set lineht [font metrics $font -linespace] 2361 2361 2362 2362 if { [string match "component*" $fname] } { 2363 2363 set title "" 2364 2364 } else { 2365 2366 2367 2368 2369 2370 2371 2372 2365 if { [info exists _fields($fname)] } { 2366 foreach { title units } $_fields($fname) break 2367 if { $units != "" } { 2368 set title [format "%s (%s)" $title $units] 2369 } 2370 } else { 2371 set title $fname 2372 } 2373 2373 } 2374 2374 set x [expr $w - 2] 2375 2375 if { !$_settings(-legendvisible) } { 2376 2377 2378 } 2376 $c delete legend 2377 return 2378 } 2379 2379 if { [$c find withtag "legend"] == "" } { 2380 set y 2 2381 2380 set y 2 2381 # If there's a legend title, create a text item for the title. 2382 2382 $c create text $x $y \ 2383 2383 -anchor ne \ … … 2387 2387 incr y $lineht 2388 2388 } 2389 2389 $c create text $x $y \ 2390 2390 -anchor ne \ 2391 2391 -fill $itk_option(-plotforeground) -tags "vmax legend" \ 2392 2392 -font $font 2393 2393 incr y $lineht 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2394 $c create image $x $y \ 2395 -anchor ne \ 2396 -image $_image(legend) -tags "colormap legend" 2397 $c create rectangle $x $y 1 1 \ 2398 -fill "" -outline "" -tags "sensor legend" 2399 $c create text $x [expr {$h-2}] \ 2400 -anchor se \ 2401 -fill $itk_option(-plotforeground) -tags "vmin legend" \ 2402 -font $font 2403 $c bind sensor <Enter> [itcl::code $this EnterLegend %x %y] 2404 $c bind sensor <Leave> [itcl::code $this LeaveLegend] 2405 $c bind sensor <Motion> [itcl::code $this MotionLegend %x %y] 2406 2406 } 2407 2407 $c delete isoline … … 2414 2414 # Draw the isolines on the legend. 2415 2415 array unset _isolines 2416 if { $color != "none" && [info exists _limits($_curFldName)] && 2416 if { $color != "none" && [info exists _limits($_curFldName)] && 2417 2417 $_settings(-isolinesvisible) && $_currentNumIsolines > 0 } { 2418 2418 … … 2423 2423 } 2424 2424 set tags "isoline legend" 2425 2426 2427 2428 2425 set offset [expr 2 + $lineht] 2426 if { $title != "" } { 2427 incr offset $lineht 2428 } 2429 2429 foreach value $_contourList { 2430 2430 set norm [expr 1.0 - (($value - $vmin) / $range)] … … 2434 2434 set _isolines([expr $y1 - $off]) $value 2435 2435 } 2436 2437 2436 $c create line $x1 $y1 $x2 $y1 -fill $color -tags $tags 2437 } 2438 2438 } 2439 2439 … … 2444 2444 if { [info exists _limits($_curFldName)] } { 2445 2445 foreach { vmin vmax } $_limits($_curFldName) break 2446 2447 2446 $c itemconfigure vmin -text [format %g $vmin] 2447 $c itemconfigure vmax -text [format %g $vmax] 2448 2448 } 2449 2449 set y 2 … … 2451 2451 if { $title != "" } { 2452 2452 $c itemconfigure title -text $title 2453 2454 2453 $c coords title $x $y 2454 incr y $lineht 2455 2455 } 2456 2456 $c coords vmax $x $y … … 2500 2500 set font "Arial 8" 2501 2501 set lineht [font metrics $font -linespace] 2502 2502 2503 2503 set ih [image height $_image(legend)] 2504 2504 # Subtract off the offset of the color ramp from the top of the canvas … … 2506 2506 2507 2507 if { [string match "component*" $fname] } { 2508 2508 set title "" 2509 2509 } else { 2510 2511 2512 2513 2514 2515 2516 2517 2510 if { [info exists _fields($fname)] } { 2511 foreach { title units } $_fields($fname) break 2512 if { $units != "" } { 2513 set title [format "%s (%s)" $title $units] 2514 } 2515 } else { 2516 set title $fname 2517 } 2518 2518 } 2519 2519 # If there's a legend title, increase the offset by the line height. … … 2531 2531 } 2532 2532 set color [eval format "\#%02x%02x%02x" $pixel] 2533 $_image(swatch) put black -to 0 0 23 23 2534 $_image(swatch) put $color -to 1 1 22 22 2533 $_image(swatch) put black -to 0 0 23 23 2534 $_image(swatch) put $color -to 1 1 22 22 2535 2535 2536 2536 # Compute the value of the point … … 2542 2542 set value 0.0 2543 2543 } 2544 set tipx [expr $x + 15] 2544 set tipx [expr $x + 15] 2545 2545 set tipy [expr $y - 5] 2546 2546 .rappturetooltip configure -icon $_image(swatch) … … 2550 2550 Rappture::Tooltip::text $c [format "$title %g" $value] 2551 2551 } 2552 Rappture::Tooltip::tooltip show $c +$tipx,+$tipy 2552 Rappture::Tooltip::tooltip show $c +$tipx,+$tipy 2553 2553 } 2554 2554 … … 2565 2565 # ---------------------------------------------------------------------- 2566 2566 itcl::body Rappture::VtkHeightmapViewer::Combo {option} { 2567 set c $itk_component(view) 2567 set c $itk_component(view) 2568 2568 switch -- $option { 2569 2569 post { … … 2578 2578 } 2579 2579 deactivate { 2580 $c itemconfigure title -fill $itk_option(-plotforeground) 2580 $c itemconfigure title -fill $itk_option(-plotforeground) 2581 2581 } 2582 2582 invoke { … … 2592 2592 itcl::body Rappture::VtkHeightmapViewer::GetHeightmapScale {} { 2593 2593 if { $_settings(-isheightmap) } { 2594 2595 2596 2597 } 2598 return 0 2599 } 2600 2601 itcl::body Rappture::VtkHeightmapViewer::SetOrientation { side } { 2594 set val $_settings(-heightmapscale) 2595 set sval [expr { $val >= 50 ? double($val)/50.0 : 1.0/(2.0-(double($val)/50.0)) }] 2596 return $sval 2597 } 2598 return 0 2599 } 2600 2601 itcl::body Rappture::VtkHeightmapViewer::SetOrientation { side } { 2602 2602 array set positions { 2603 2603 front "0.707107 0.707107 0 0" … … 2610 2610 foreach name { -qw -qx -qy -qz } value $positions($side) { 2611 2611 set _view($name) $value 2612 } 2612 } 2613 2613 set q [ViewToQuaternion] 2614 2614 $_arcball quaternion $q … … 2620 2620 } 2621 2621 2622 itcl::body Rappture::VtkHeightmapViewer::UpdateContourList {} { 2622 itcl::body Rappture::VtkHeightmapViewer::UpdateContourList {} { 2623 2623 if {$_currentNumIsolines == 0} { 2624 2624 set _contourList ""
Note: See TracChangeset
for help on using the changeset viewer.
