- Timestamp:
- May 14, 2009 10:22:16 PM (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/gui/scripts/heightmapviewer.tcl
r1391 r1437 64 64 protected method Disconnect {} 65 65 66 protected method _send {string}67 protected method _send_dataobjs {}66 protected method SendCmd {string} 67 protected method SendDataObjs {} 68 68 protected method ReceiveImage { args } 69 private method _ReceiveLegend {tf vmin vmax size} 70 private method _BuildViewTab {} 71 private method _BuildCameraTab {} 72 private method _PanCamera {} 73 protected method _receive_echo {channel {data ""}} 74 75 protected method _rebuild {} 76 protected method _zoom {option} 77 protected method _pan {option x y} 78 protected method _rotate {option x y} 79 80 protected method _state {comp} 81 protected method _fixSettings {what {value ""}} 82 protected method _getTransfuncData {dataobj comp} 69 private method ReceiveLegend {tf vmin vmax size} 70 private method BuildViewTab {} 71 private method BuildCameraTab {} 72 private method PanCamera {} 73 74 protected method Rebuild {} 75 protected method Zoom {option} 76 protected method Pan {option x y} 77 protected method Rotate {option x y} 78 79 protected method State {comp} 80 protected method FixSettings {what {value ""}} 81 protected method GetTransfuncData {dataobj comp} 83 82 private method Resize { w h } 84 83 85 private variable outbuf_ ;# buffer for outgoing commands 86 87 private variable dlist_ "" ;# list of data objects 88 private variable obj2style_ ;# maps dataobj => style settings 89 private variable obj2ovride_ ;# maps dataobj => style override 90 private variable obj2id_ ;# maps dataobj => heightmap ID in server 91 private variable id2obj_ ;# maps heightmap ID => dataobj in server 92 private variable sendobjs_ "" ;# list of data objs to send to server 93 private variable receiveIds_ ;# list of data responses from the server 94 private variable click_ ;# info used for _rotate operations 95 private variable limits_ ;# autoscale min/max for all axes 96 private variable view_ ;# view params for 3D view 97 private common settings_ ;# Array used for checkbuttons and radiobuttons 98 private common hardcopy_ 84 private variable _outbuf ;# buffer for outgoing commands 85 86 private variable _dlist "" ;# list of data objects 87 private variable _obj2style ;# maps dataobj => style settings 88 private variable _obj2ovride ;# maps dataobj => style override 89 private variable _obj2id ;# maps dataobj => heightmap ID in server 90 private variable _id2obj ;# maps heightmap ID => dataobj in server 91 private variable _sendobjs "" ;# list of data objs to send to server 92 private variable _receiveIds ;# list of data responses from the server 93 private variable _click ;# info used for Rotate operations 94 private variable _limits ;# autoscale min/max for all axes 95 private variable _view ;# view params for 3D view 96 private common _settings ;# Array of used for global variables 97 # for checkbuttons and radiobuttons. 98 private common _hardcopy 99 private variable _buffering 0 99 100 } 100 101 … … 111 112 $_dispatcher register !legend 112 113 $_dispatcher dispatch $this !legend \ 113 "[itcl::code $this _fixSettings legend]; list"114 "[itcl::code $this FixSettings legend]; list" 114 115 # Send dataobjs event 115 116 $_dispatcher register !send_dataobjs 116 117 $_dispatcher dispatch $this !send_dataobjs \ 117 "[itcl::code $this _send_dataobjs]; list"118 "[itcl::code $this SendDataObjs]; list" 118 119 # Rebuild event 119 120 $_dispatcher register !rebuild 120 $_dispatcher dispatch $this !rebuild "[itcl::code $this _rebuild]; list"121 122 set outbuf_""121 $_dispatcher dispatch $this !rebuild "[itcl::code $this Rebuild]; list" 122 123 set _outbuf "" 123 124 124 125 # … … 126 127 # 127 128 $_parser alias image [itcl::code $this ReceiveImage] 128 $_parser alias legend [itcl::code $this _ReceiveLegend]129 $_parser alias legend [itcl::code $this ReceiveLegend] 129 130 130 131 # Initialize the view to some default parameters. 131 array set view_{132 array set _view { 132 133 theta 45 133 134 phi 45 … … 137 138 pan-y 0 138 139 } 139 set obj2id_(count) 0140 set _obj2id(count) 0 140 141 141 142 set f [$itk_component(main) component controls] … … 149 150 -highlightthickness 0 \ 150 151 -image [Rappture::icon reset-view] \ 151 -command [itcl::code $this _zoom reset]152 -command [itcl::code $this Zoom reset] 152 153 } { 153 154 usual … … 161 162 -highlightthickness 0 \ 162 163 -image [Rappture::icon zoom-in] \ 163 -command [itcl::code $this _zoom in]164 -command [itcl::code $this Zoom in] 164 165 } { 165 166 usual … … 173 174 -highlightthickness 0 \ 174 175 -image [Rappture::icon zoom-out] \ 175 -command [itcl::code $this _zoom out]176 -command [itcl::code $this Zoom out] 176 177 } { 177 178 usual … … 181 182 Rappture::Tooltip::for $itk_component(zoomout) "Zoom out" 182 183 183 _BuildViewTab184 _BuildCameraTab184 BuildViewTab 185 BuildCameraTab 185 186 186 187 # Legend … … 203 204 # Bindings for rotation via mouse 204 205 bind $itk_component(3dview) <ButtonPress-1> \ 205 [itcl::code $this _rotate click %x %y]206 [itcl::code $this Rotate click %x %y] 206 207 bind $itk_component(3dview) <B1-Motion> \ 207 [itcl::code $this _rotate drag %x %y]208 [itcl::code $this Rotate drag %x %y] 208 209 bind $itk_component(3dview) <ButtonRelease-1> \ 209 [itcl::code $this _rotate release %x %y]210 [itcl::code $this Rotate release %x %y] 210 211 bind $itk_component(3dview) <Configure> \ 211 212 [itcl::code $this Resize %w %h] … … 213 214 # Bindings for panning via mouse 214 215 bind $itk_component(3dview) <ButtonPress-2> \ 215 [itcl::code $this _pan click %x %y]216 [itcl::code $this Pan click %x %y] 216 217 bind $itk_component(3dview) <B2-Motion> \ 217 [itcl::code $this _pan drag %x %y]218 [itcl::code $this Pan drag %x %y] 218 219 bind $itk_component(3dview) <ButtonRelease-2> \ 219 [itcl::code $this _pan release %x %y]220 [itcl::code $this Pan release %x %y] 220 221 221 222 # Bindings for panning via keyboard 222 223 bind $itk_component(3dview) <KeyPress-Left> \ 223 [itcl::code $this _pan set -10 0]224 [itcl::code $this Pan set -10 0] 224 225 bind $itk_component(3dview) <KeyPress-Right> \ 225 [itcl::code $this _pan set 10 0]226 [itcl::code $this Pan set 10 0] 226 227 bind $itk_component(3dview) <KeyPress-Up> \ 227 [itcl::code $this _pan set 0 -10]228 [itcl::code $this Pan set 0 -10] 228 229 bind $itk_component(3dview) <KeyPress-Down> \ 229 [itcl::code $this _pan set 0 10]230 [itcl::code $this Pan set 0 10] 230 231 bind $itk_component(3dview) <Shift-KeyPress-Left> \ 231 [itcl::code $this _pan set -2 0]232 [itcl::code $this Pan set -2 0] 232 233 bind $itk_component(3dview) <Shift-KeyPress-Right> \ 233 [itcl::code $this _pan set 2 0]234 [itcl::code $this Pan set 2 0] 234 235 bind $itk_component(3dview) <Shift-KeyPress-Up> \ 235 [itcl::code $this _pan set 0 -2]236 [itcl::code $this Pan set 0 -2] 236 237 bind $itk_component(3dview) <Shift-KeyPress-Down> \ 237 [itcl::code $this _pan set 0 2]238 [itcl::code $this Pan set 0 2] 238 239 239 240 # Bindings for zoom via keyboard 240 241 bind $itk_component(3dview) <KeyPress-Prior> \ 241 [itcl::code $this _zoom out]242 [itcl::code $this Zoom out] 242 243 bind $itk_component(3dview) <KeyPress-Next> \ 243 [itcl::code $this _zoom in]244 [itcl::code $this Zoom in] 244 245 245 246 bind $itk_component(3dview) <Enter> "focus $itk_component(3dview)" … … 247 248 if {[string equal "x11" [tk windowingsystem]]} { 248 249 # Bindings for zoom via mouse 249 bind $itk_component(3dview) <4> [itcl::code $this _zoom out]250 bind $itk_component(3dview) <5> [itcl::code $this _zoom in]250 bind $itk_component(3dview) <4> [itcl::code $this Zoom out] 251 bind $itk_component(3dview) <5> [itcl::code $this Zoom in] 251 252 } 252 253 … … 260 261 # ---------------------------------------------------------------------- 261 262 itcl::body Rappture::HeightmapViewer::destructor {} { 262 set sendobjs_"" ;# stop any send in progress263 set _sendobjs "" ;# stop any send in progress 263 264 $_dispatcher cancel !rebuild 264 265 $_dispatcher cancel !send_dataobjs … … 297 298 set location [$dataobj hints camera] 298 299 if { $location != "" } { 299 array set view_$location300 } 301 set pos [lsearch -exact $dataobj $ dlist_]300 array set _view $location 301 } 302 set pos [lsearch -exact $dataobj $_dlist] 302 303 if {$pos < 0} { 303 lappend dlist_$dataobj304 set obj2ovride_($dataobj-color) $params(-color)305 set obj2ovride_($dataobj-width) $params(-width)306 set obj2ovride_($dataobj-raise) $params(-raise)304 lappend _dlist $dataobj 305 set _obj2ovride($dataobj-color) $params(-color) 306 set _obj2ovride($dataobj-width) $params(-width) 307 set _obj2ovride($dataobj-raise) $params(-raise) 307 308 $_dispatcher event -idle !rebuild 308 309 } … … 326 327 -objects { 327 328 # put the dataobj list in order according to -raise options 328 set dlist $ dlist_329 set dlist $_dlist 329 330 foreach obj $dlist { 330 if { [info exists obj2ovride_($obj-raise)] &&331 $ obj2ovride_($obj-raise)} {331 if { [info exists _obj2ovride($obj-raise)] && 332 $_obj2ovride($obj-raise)} { 332 333 set i [lsearch -exact $dlist $obj] 333 334 if {$i >= 0} { … … 369 370 itcl::body Rappture::HeightmapViewer::delete { args } { 370 371 if {[llength $args] == 0} { 371 set args $ dlist_372 set args $_dlist 372 373 } 373 374 … … 375 376 set changed 0 376 377 foreach dataobj $args { 377 set pos [lsearch -exact $ dlist_$dataobj]378 set pos [lsearch -exact $_dlist $dataobj] 378 379 if {$pos >= 0} { 379 set dlist_ [lreplace $dlist_$pos $pos]380 foreach key [array names obj2ovride_$dataobj-*] {381 unset obj2ovride_($key)380 set _dlist [lreplace $_dlist $pos $pos] 381 foreach key [array names _obj2ovride $dataobj-*] { 382 unset _obj2ovride($key) 382 383 } 383 384 set changed 1 … … 402 403 itcl::body Rappture::HeightmapViewer::scale { args } { 403 404 foreach val {xmin xmax ymin ymax zmin zmax vmin vmax} { 404 set limits_($val) ""405 set _limits($val) "" 405 406 } 406 407 foreach obj $args { … … 408 409 foreach {min max} [$obj limits $axis] break 409 410 if {"" != $min && "" != $max} { 410 if {"" == $ limits_(${axis}min)} {411 set limits_(${axis}min) $min412 set limits_(${axis}max) $max411 if {"" == $_limits(${axis}min)} { 412 set _limits(${axis}min) $min 413 set _limits(${axis}max) $max 413 414 } else { 414 if {$min < $ limits_(${axis}min)} {415 set limits_(${axis}min) $min415 if {$min < $_limits(${axis}min)} { 416 set _limits(${axis}min) $min 416 417 } 417 if {$max > $ limits_(${axis}max)} {418 set limits_(${axis}max) $max418 if {$max > $_limits(${axis}max)} { 419 set _limits(${axis}max) $max 419 420 } 420 421 } 421 set limits_(${axis}range) [expr {$max - $min}]422 set _limits(${axis}range) [expr {$max - $min}] 422 423 } 423 424 } … … 490 491 VisViewer::Disconnect 491 492 492 set outbuf_""493 set _outbuf "" 493 494 # disconnected -- no more data sitting on server 494 catch {unset obj2id_}495 array unset id2obj_496 set obj2id_(count) 0497 set id2obj_(cound) 0498 set sendobjs_""499 } 500 501 # 502 # _send495 catch {unset _obj2id} 496 array unset _id2obj 497 set _obj2id(count) 0 498 set _id2obj(cound) 0 499 set _sendobjs "" 500 } 501 502 # 503 # SendCmd 503 504 # 504 505 # Send commands off to the rendering server. If we're currently … … 506 507 # sent later. 507 508 # 508 itcl::body Rappture:: HeightmapViewer::_send {string} {509 if { [llength $sendobjs_] > 0} {510 append outbuf_$string "\n"509 itcl::body Rappture::NanovisViewer::SendCmd {string} { 510 if { $_buffering } { 511 append _outbuf $string "\n" 511 512 } else { 512 if {[SendBytes $string]} { 513 foreach line [split $string \n] { 514 SendEcho >>line $line 515 } 516 } 517 } 518 } 519 520 # ---------------------------------------------------------------------- 521 # USAGE: _send_dataobjs 513 foreach line [split $string \n] { 514 SendEcho >>line $line 515 } 516 SendBytes "$string\n" 517 } 518 } 519 520 # ---------------------------------------------------------------------- 521 # USAGE: SendDataObjs 522 522 # 523 523 # Used internally to send a series of volume objects off to the … … 525 525 # between so the interface doesn't lock up. 526 526 # ---------------------------------------------------------------------- 527 itcl::body Rappture::HeightmapViewer:: _send_dataobjs {} {527 itcl::body Rappture::HeightmapViewer::SendDataObjs {} { 528 528 blt::busy hold $itk_component(hull); update idletasks 529 529 530 530 # Reset the overall limits 531 if { $ sendobjs_!= "" } {532 set limits_(vmin) ""533 set limits_(vmax) ""534 } 535 foreach dataobj $ sendobjs_{531 if { $_sendobjs != "" } { 532 set _limits(vmin) "" 533 set _limits(vmax) "" 534 } 535 foreach dataobj $_sendobjs { 536 536 foreach comp [$dataobj components] { 537 537 set data [$dataobj blob $comp] 538 538 539 539 foreach { vmin vmax } [$dataobj limits v] break 540 if { $ limits_(vmin) == "" || $vmin < $limits_(vmin) } {541 set limits_(vmin) $vmin542 } 543 if { $ limits_(vmax) == "" || $vmax > $limits_(vmax) } {544 set limits_(vmax) $vmax540 if { $_limits(vmin) == "" || $vmin < $_limits(vmin) } { 541 set _limits(vmin) $vmin 542 } 543 if { $_limits(vmax) == "" || $vmax > $_limits(vmax) } { 544 set _limits(vmax) $vmax 545 545 } 546 546 547 547 # tell the engine to expect some data 548 548 set nbytes [string length $data] 549 if { ![SendBytes "heightmap data follows $nbytes "] } {549 if { ![SendBytes "heightmap data follows $nbytes\n"] } { 550 550 return 551 551 … … 554 554 return 555 555 } 556 set id $ obj2id_(count)557 incr obj2id_(count)558 set id2obj_($id) [list $dataobj $comp]559 set obj2id_($dataobj-$comp) $id560 set receiveIds_($id) 1556 set id $_obj2id(count) 557 incr _obj2id(count) 558 set _id2obj($id) [list $dataobj $comp] 559 set _obj2id($dataobj-$comp) $id 560 set _receiveIds($id) 1 561 561 562 562 # … … 564 564 # and make sure that it's defined on the server. 565 565 # 566 foreach {sname cmap wmap} [_getTransfuncData $dataobj $comp] break 567 set cmdstr [list "transfunc" "define" $sname $cmap $wmap] 568 if {![SendBytes $cmdstr]} { 569 return 570 } 571 set obj2style_($dataobj-$comp) $sname 572 } 573 } 574 set sendobjs_ "" 566 foreach {sname cmap wmap} [GetTransfuncData $dataobj $comp] break 567 SendCmd [list "transfunc" "define" $sname $cmap $wmap] 568 set _obj2style($dataobj-$comp) $sname 569 } 570 } 571 set _sendobjs "" 575 572 blt::busy release $itk_component(hull) 573 574 # Turn on buffering of commands to the server. We don't want to 575 # be preempted by a server disconnect/reconnect (which automatically 576 # generates a new call to Rebuild). 577 set _buffering 1 576 578 577 579 # activate the proper volume … … 580 582 set axis [$first hints updir] 581 583 if {"" != $axis} { 582 _send "up $axis"583 } 584 } 585 586 foreach key [array names obj2id_*-*] {584 SendCmd "up $axis" 585 } 586 } 587 588 foreach key [array names _obj2id *-*] { 587 589 set state [string match $first-* $key] 588 _send "heightmap data visible $state $obj2id_($key)" 589 if {[info exists obj2style_($key)]} { 590 _send "heightmap transfunc $obj2style_($key) $obj2id_($key)" 591 } 592 } 593 594 # if there are any commands in the buffer, send them now that we're done 595 SendBytes $outbuf_ 596 set outbuf_ "" 597 590 SendCmd "heightmap data visible $state $_obj2id($key)" 591 if {[info exists _obj2style($key)]} { 592 SendCmd "heightmap transfunc $_obj2style($key) $_obj2id($key)" 593 } 594 } 595 596 # Actually write the commands to the server socket. If it fails, we don't 597 # care. We're finished here. 598 SendBytes $_outbuf; 599 set _buffering 0; # Turn off buffering. 600 set _outbuf ""; # Clear the buffer. 598 601 $_dispatcher event -idle !legend 599 602 } … … 621 624 } elseif { $info(type) == "print" } { 622 625 set tag $this-print-$info(-token) 623 set hardcopy_($tag) $bytes624 } 625 } 626 627 # ---------------------------------------------------------------------- 628 # USAGE: _ReceiveLegend <tf> <vmin> <vmax> <size>626 set _hardcopy($tag) $bytes 627 } 628 } 629 630 # ---------------------------------------------------------------------- 631 # USAGE: ReceiveLegend <tf> <vmin> <vmax> <size> 629 632 # 630 633 # Invoked automatically whenever the "legend" command comes in from … … 632 635 # specified <size> will follow. 633 636 # ---------------------------------------------------------------------- 634 itcl::body Rappture::HeightmapViewer:: _ReceiveLegend {tf vmin vmax size} {637 itcl::body Rappture::HeightmapViewer::ReceiveLegend {tf vmin vmax size} { 635 638 if { [IsConnected] } { 636 639 set bytes [ReceiveBytes $size] … … 664 667 665 668 # ---------------------------------------------------------------------- 666 # USAGE: _rebuild669 # USAGE: Rebuild 667 670 # 668 671 # Called automatically whenever something changes that affects the … … 670 673 # widget to display new data. 671 674 # ---------------------------------------------------------------------- 672 itcl::body Rappture::HeightmapViewer:: _rebuild {} {675 itcl::body Rappture::HeightmapViewer::Rebuild {} { 673 676 # in the midst of sending data? then bail out 674 if {[llength $ sendobjs_] > 0} {677 if {[llength $_sendobjs] > 0} { 675 678 return 676 679 } 680 # Turn on buffering of commands to the server. We don't want to 681 # be preempted by a server disconnect/reconnect (which automatically 682 # generates a new call to Rebuild). 683 set _buffering 1 684 677 685 # Find any new data that needs to be sent to the server. Queue this up on 678 # the sendobjs_list, and send it out a little at a time. Do this first,686 # the _sendobjs list, and send it out a little at a time. Do this first, 679 687 # before we rebuild the rest. 680 688 foreach dataobj [get] { 681 689 set comp [lindex [$dataobj components] 0] 682 if {![info exists obj2id_($dataobj-$comp)]} {683 set i [lsearch -exact $ sendobjs_$dataobj]690 if {![info exists _obj2id($dataobj-$comp)]} { 691 set i [lsearch -exact $_sendobjs $dataobj] 684 692 if {$i < 0} { 685 lappend sendobjs_$dataobj686 } 687 } 688 } 689 if {[llength $ sendobjs_] > 0} {693 lappend _sendobjs $dataobj 694 } 695 } 696 } 697 if {[llength $_sendobjs] > 0} { 690 698 # Send off new data objects 691 699 $_dispatcher event -idle !send_dataobjs … … 696 704 set axis [$first hints updir] 697 705 if {"" != $axis} { 698 _send "up $axis"699 } 700 } 701 foreach key [array names obj2id_*-*] {706 SendCmd "up $axis" 707 } 708 } 709 foreach key [array names _obj2id *-*] { 702 710 set state [string match $first-* $key] 703 _send "heightmap data visible $state $obj2id_($key)"704 if {[info exists obj2style_($key)]} {705 _send "heightmap transfunc $obj2style_($key) $obj2id_($key)"711 SendCmd "heightmap data visible $state $_obj2id($key)" 712 if {[info exists _obj2style($key)]} { 713 SendCmd "heightmap transfunc $_obj2style($key) $_obj2id($key)" 706 714 } 707 715 } … … 715 723 716 724 # Reset the camera and other view parameters 717 set xyz [Euler2XYZ $ view_(theta) $view_(phi) $view_(psi)]718 _send "camera angle $xyz"719 _PanCamera720 _send "camera zoom $view_(zoom)"725 set xyz [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)] 726 SendCmd "camera angle $xyz" 727 PanCamera 728 SendCmd "camera zoom $_view(zoom)" 721 729 722 730 if {"" == $itk_option(-plotoutline)} { 723 _send "grid linecolor [Color2RGB $itk_option(-plotoutline)]"731 SendCmd "grid linecolor [Color2RGB $itk_option(-plotoutline)]" 724 732 } 725 set settings_($this-theta) $view_(theta) 726 set settings_($this-phi) $view_(phi) 727 set settings_($this-psi) $view_(psi) 728 set settings_($this-pan-x) $view_(pan-x) 729 set settings_($this-pan-y) $view_(pan-y) 730 set settings_($this-zoom) $view_(zoom) 731 732 _fixSettings wireframe 733 _fixSettings grid 734 _fixSettings axes 735 _fixSettings contourlines 736 } 737 738 # ---------------------------------------------------------------------- 739 # USAGE: _zoom in 740 # USAGE: _zoom out 741 # USAGE: _zoom reset 733 set _settings($this-theta) $_view(theta) 734 set _settings($this-phi) $_view(phi) 735 set _settings($this-psi) $_view(psi) 736 set _settings($this-pan-x) $_view(pan-x) 737 set _settings($this-pan-y) $_view(pan-y) 738 set _settings($this-zoom) $_view(zoom) 739 740 FixSettings wireframe 741 FixSettings grid 742 FixSettings axes 743 FixSettings contourlines 744 745 # Actually write the commands to the server socket. If it fails, we don't 746 # care. We're finished here. 747 SendBytes $_outbuf; 748 set _buffering 0; # Turn off buffering. 749 set _outbuf ""; # Clear the buffer. 750 } 751 752 # ---------------------------------------------------------------------- 753 # USAGE: Zoom in 754 # USAGE: Zoom out 755 # USAGE: Zoom reset 742 756 # 743 757 # Called automatically when the user clicks on one of the zoom 744 758 # controls for this widget. Changes the zoom for the current view. 745 759 # ---------------------------------------------------------------------- 746 itcl::body Rappture::HeightmapViewer:: _zoom {option} {760 itcl::body Rappture::HeightmapViewer::Zoom {option} { 747 761 switch -- $option { 748 762 "in" { 749 set view_(zoom) [expr {$view_(zoom)*1.25}]750 set settings_($this-zoom) $view_(zoom)763 set _view(zoom) [expr {$_view(zoom)*1.25}] 764 set _settings($this-zoom) $_view(zoom) 751 765 } 752 766 "out" { 753 set view_(zoom) [expr {$view_(zoom)*0.8}]754 set settings_($this-zoom) $view_(zoom)767 set _view(zoom) [expr {$_view(zoom)*0.8}] 768 set _settings($this-zoom) $_view(zoom) 755 769 } 756 770 "reset" { 757 array set view_{771 array set _view { 758 772 theta 45 759 773 phi 45 … … 767 781 set location [$first hints camera] 768 782 if { $location != "" } { 769 array set view_$location783 array set _view $location 770 784 } 771 785 } 772 set xyz [Euler2XYZ $ view_(theta) $view_(phi) $view_(psi)]773 _send "camera angle $xyz"774 _PanCamera775 set settings_($this-theta) $view_(theta)776 set settings_($this-phi) $view_(phi)777 set settings_($this-psi) $view_(psi)778 set settings_($this-pan-x) $view_(pan-x)779 set settings_($this-pan-y) $view_(pan-y)780 set settings_($this-zoom) $view_(zoom)781 } 782 } 783 _send "camera zoom $view_(zoom)"784 } 785 786 # ---------------------------------------------------------------------- 787 # USAGE: $this _pan click x y788 # $this _pan drag x y789 # $this _pan release x y786 set xyz [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)] 787 SendCmd "camera angle $xyz" 788 PanCamera 789 set _settings($this-theta) $_view(theta) 790 set _settings($this-phi) $_view(phi) 791 set _settings($this-psi) $_view(psi) 792 set _settings($this-pan-x) $_view(pan-x) 793 set _settings($this-pan-y) $_view(pan-y) 794 set _settings($this-zoom) $_view(zoom) 795 } 796 } 797 SendCmd "camera zoom $_view(zoom)" 798 } 799 800 # ---------------------------------------------------------------------- 801 # USAGE: $this Pan click x y 802 # $this Pan drag x y 803 # $this Pan release x y 790 804 # 791 805 # Called automatically when the user clicks on one of the zoom 792 806 # controls for this widget. Changes the zoom for the current view. 793 807 # ---------------------------------------------------------------------- 794 itcl::body Rappture::HeightmapViewer:: _pan {option x y} {808 itcl::body Rappture::HeightmapViewer::Pan {option x y} { 795 809 # Experimental stuff 796 810 set w [winfo width $itk_component(3dview)] 797 811 set h [winfo height $itk_component(3dview)] 798 812 if { $option == "set" } { 799 set x [expr ($x / double($w)) * $ limits_(xrange)]800 set y [expr ($y / double($h)) * $ limits_(yrange)]801 set view_(pan-x) [expr $view_(pan-x) + $x]802 set view_(pan-y) [expr $view_(pan-y) + $y]803 _PanCamera804 set settings_($this-pan-x) $view_(pan-x)805 set settings_($this-pan-y) $view_(pan-y)813 set x [expr ($x / double($w)) * $_limits(xrange)] 814 set y [expr ($y / double($h)) * $_limits(yrange)] 815 set _view(pan-x) [expr $_view(pan-x) + $x] 816 set _view(pan-y) [expr $_view(pan-y) + $y] 817 PanCamera 818 set _settings($this-pan-x) $_view(pan-x) 819 set _settings($this-pan-y) $_view(pan-y) 806 820 return 807 821 } 808 822 if { $option == "click" } { 809 set click_(x) $x810 set click_(y) $y823 set _click(x) $x 824 set _click(y) $y 811 825 $itk_component(3dview) configure -cursor hand1 812 826 } 813 827 if { $option == "drag" || $option == "release" } { 814 set dx [expr (($ click_(x) - $x)/double($w)) * $limits_(xrange)]815 set dy [expr (($ click_(y) - $y)/double($h)) * $limits_(yrange)]816 set click_(x) $x817 set click_(y) $y818 set view_(pan-x) [expr $view_(pan-x) - $dx]819 set view_(pan-y) [expr $view_(pan-y) - $dy]820 _PanCamera821 set settings_($this-pan-x) $view_(pan-x)822 set settings_($this-pan-y) $view_(pan-y)828 set dx [expr (($_click(x) - $x)/double($w)) * $_limits(xrange)] 829 set dy [expr (($_click(y) - $y)/double($h)) * $_limits(yrange)] 830 set _click(x) $x 831 set _click(y) $y 832 set _view(pan-x) [expr $_view(pan-x) - $dx] 833 set _view(pan-y) [expr $_view(pan-y) - $dy] 834 PanCamera 835 set _settings($this-pan-x) $_view(pan-x) 836 set _settings($this-pan-y) $_view(pan-y) 823 837 } 824 838 if { $option == "release" } { … … 827 841 } 828 842 829 itcl::body Rappture::HeightmapViewer:: _PanCamera {} {830 set x [expr ($ view_(pan-x)) / $limits_(xrange)]831 set y [expr ($ view_(pan-y)) / $limits_(yrange)]832 _send "camera pan $x $y"833 } 834 835 # ---------------------------------------------------------------------- 836 # USAGE: _rotate click <x> <y>837 # USAGE: _rotate drag <x> <y>838 # USAGE: _rotate release <x> <y>843 itcl::body Rappture::HeightmapViewer::PanCamera {} { 844 set x [expr ($_view(pan-x)) / $_limits(xrange)] 845 set y [expr ($_view(pan-y)) / $_limits(yrange)] 846 SendCmd "camera pan $x $y" 847 } 848 849 # ---------------------------------------------------------------------- 850 # USAGE: Rotate click <x> <y> 851 # USAGE: Rotate drag <x> <y> 852 # USAGE: Rotate release <x> <y> 839 853 # 840 854 # Called automatically when the user clicks/drags/releases in the 841 855 # plot area. Moves the plot according to the user's actions. 842 856 # ---------------------------------------------------------------------- 843 itcl::body Rappture::HeightmapViewer:: _rotate {option x y} {857 itcl::body Rappture::HeightmapViewer::Rotate {option x y} { 844 858 switch -- $option { 845 859 click { 846 860 $itk_component(3dview) configure -cursor fleur 847 array set click_[subst {861 array set _click [subst { 848 862 x $x 849 863 y $y 850 theta $ view_(theta)851 phi $ view_(phi)864 theta $_view(theta) 865 phi $_view(phi) 852 866 }] 853 867 } 854 868 drag { 855 if {[array size click_] == 0} {856 _rotate click $x $y869 if {[array size _click] == 0} { 870 Rotate click $x $y 857 871 } else { 858 872 set w [winfo width $itk_component(3dview)] … … 864 878 if {[catch { 865 879 # this fails sometimes for no apparent reason 866 set dx [expr {double($x-$ click_(x))/$w}]867 set dy [expr {double($y-$ click_(y))/$h}]880 set dx [expr {double($x-$_click(x))/$w}] 881 set dy [expr {double($y-$_click(y))/$h}] 868 882 }] != 0 } { 869 883 return … … 873 887 # Rotate the camera in 3D 874 888 # 875 if {$ view_(psi) > 90 || $view_(psi) < -90} {889 if {$_view(psi) > 90 || $_view(psi) < -90} { 876 890 # when psi is flipped around, theta moves backwards 877 891 set dy [expr {-$dy}] 878 892 } 879 set theta [expr {$ view_(theta) - $dy*180}]893 set theta [expr {$_view(theta) - $dy*180}] 880 894 while {$theta < 0} { set theta [expr {$theta+180}] } 881 895 while {$theta > 180} { set theta [expr {$theta-180}] } 882 896 883 897 if {abs($theta) >= 30 && abs($theta) <= 160} { 884 set phi [expr {$ view_(phi) - $dx*360}]898 set phi [expr {$_view(phi) - $dx*360}] 885 899 while {$phi < 0} { set phi [expr {$phi+360}] } 886 900 while {$phi > 360} { set phi [expr {$phi-360}] } 887 set psi $ view_(psi)901 set psi $_view(psi) 888 902 } else { 889 set phi $ view_(phi)890 set psi [expr {$ view_(psi) - $dx*360}]903 set phi $_view(phi) 904 set psi [expr {$_view(psi) - $dx*360}] 891 905 while {$psi < -180} { set psi [expr {$psi+360}] } 892 906 while {$psi > 180} { set psi [expr {$psi-360}] } 893 907 } 894 908 895 set view_(theta) $theta896 set view_(phi) $phi897 set view_(psi) $psi898 set xyz [Euler2XYZ $ view_(theta) $view_(phi) $view_(psi)]899 set settings_($this-theta) $view_(theta)900 set settings_($this-phi) $view_(phi)901 set settings_($this-psi) $view_(psi)902 _send "camera angle $xyz"903 set click_(x) $x904 set click_(y) $y909 set _view(theta) $theta 910 set _view(phi) $phi 911 set _view(psi) $psi 912 set xyz [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)] 913 set _settings($this-theta) $_view(theta) 914 set _settings($this-phi) $_view(phi) 915 set _settings($this-psi) $_view(psi) 916 SendCmd "camera angle $xyz" 917 set _click(x) $x 918 set _click(y) $y 905 919 } 906 920 } 907 921 release { 908 _rotate drag $x $y922 Rotate drag $x $y 909 923 $itk_component(3dview) configure -cursor "" 910 catch {unset click_}924 catch {unset _click} 911 925 } 912 926 default { … … 917 931 918 932 # ---------------------------------------------------------------------- 919 # USAGE: _state <component>933 # USAGE: State <component> 920 934 # 921 935 # Used internally to determine the state of a toggle button. … … 923 937 # Returns on/off for the state of the button. 924 938 # ---------------------------------------------------------------------- 925 itcl::body Rappture::HeightmapViewer:: _state {comp} {939 itcl::body Rappture::HeightmapViewer::State {comp} { 926 940 if {[$itk_component($comp) cget -relief] == "sunken"} { 927 941 return "on" … … 931 945 932 946 # ---------------------------------------------------------------------- 933 # USAGE: _fixSettings <what> ?<value>?947 # USAGE: FixSettings <what> ?<value>? 934 948 # 935 949 # Used internally to update rendering settings whenever parameters … … 937 951 # to the back end. 938 952 # ---------------------------------------------------------------------- 939 itcl::body Rappture::HeightmapViewer:: _fixSettings { what {value ""} } {953 itcl::body Rappture::HeightmapViewer::FixSettings { what {value ""} } { 940 954 switch -- $what { 941 955 "legend" { 942 if { $ settings_($this-legend) } {956 if { $_settings($this-legend) } { 943 957 pack $itk_component(legend) -side left -fill y 944 958 } else { … … 952 966 if {"" != $dataobj} { 953 967 set comp [lindex [$dataobj components] 0] 954 if {[info exists obj2id_($dataobj-$comp)]} {955 set imap $ obj2id_($dataobj-$comp)968 if {[info exists _obj2id($dataobj-$comp)]} { 969 set imap $_obj2id($dataobj-$comp) 956 970 } 957 971 } 958 972 if {$w > 0 && $h > 0 && "" != $imap} { 959 _send "heightmap legend $imap $w $h"973 SendCmd "heightmap legend $imap $w $h" 960 974 } else { 961 975 $itk_component(legend) delete all … … 964 978 "grid" { 965 979 if { [IsConnected] } { 966 _send "grid visible $settings_($this-grid)"980 SendCmd "grid visible $_settings($this-grid)" 967 981 } 968 982 } 969 983 "axes" { 970 984 if { [IsConnected] } { 971 _send "axis visible $settings_($this-axes)"985 SendCmd "axis visible $_settings($this-axes)" 972 986 } 973 987 } 974 988 "wireframe" { 975 989 if { [IsConnected] } { 976 _send "heightmap polygon $settings_($this-wireframe)"990 SendCmd "heightmap polygon $_settings($this-wireframe)" 977 991 } 978 992 } … … 982 996 if {"" != $dataobj} { 983 997 set comp [lindex [$dataobj components] 0] 984 if {[info exists obj2id_($dataobj-$comp)]} {985 set i $ obj2id_($dataobj-$comp)986 set bool $ settings_($this-contourlines)987 _send "heightmap linecontour visible $bool $i"998 if {[info exists _obj2id($dataobj-$comp)]} { 999 set i $_obj2id($dataobj-$comp) 1000 set bool $_settings($this-contourlines) 1001 SendCmd "heightmap linecontour visible $bool $i" 988 1002 } 989 1003 } … … 997 1011 998 1012 # ---------------------------------------------------------------------- 999 # USAGE: _getTransfuncData <dataobj> <comp>1013 # USAGE: GetTransfuncData <dataobj> <comp> 1000 1014 # 1001 1015 # Used internally to compute the colormap and alpha map used to define … … 1003 1017 # Returns: name {v r g b ...} {v w ...} 1004 1018 # ---------------------------------------------------------------------- 1005 itcl::body Rappture::HeightmapViewer:: _getTransfuncData {dataobj comp} {1019 itcl::body Rappture::HeightmapViewer::GetTransfuncData {dataobj comp} { 1006 1020 array set style { 1007 1021 -color rainbow … … 1018 1032 set color white 1019 1033 set cmap "0.0 [Color2RGB $color] " 1020 set range [expr $ limits_(vmax) - $limits_(vmin)]1034 set range [expr $_limits(vmax) - $_limits(vmin)] 1021 1035 for {set i 0} {$i < [llength $clist]} {incr i} { 1022 1036 set xval [expr {double($i+1)/([llength $clist]+1)}] … … 1060 1074 foreach {r g b} [Color2RGB $itk_option(-plotbackground)] break 1061 1075 #fix this! 1062 # _send "color background $r $g $b"1076 #SendCmd "color background $r $g $b" 1063 1077 } 1064 1078 … … 1069 1083 foreach {r g b} [Color2RGB $itk_option(-plotforeground)] break 1070 1084 #fix this! 1071 # _send "color background $r $g $b"1085 #SendCmd "color background $r $g $b" 1072 1086 } 1073 1087 … … 1077 1091 itcl::configbody Rappture::HeightmapViewer::plotoutline { 1078 1092 if {[IsConnected]} { 1079 _send "grid linecolor [Color2RGB $itk_option(-plotoutline)]"1093 SendCmd "grid linecolor [Color2RGB $itk_option(-plotoutline)]" 1080 1094 } 1081 1095 } … … 1088 1102 switch -- $option { 1089 1103 "show" { 1090 puts [array get view_]1104 puts [array get _view] 1091 1105 } 1092 1106 "set" { 1093 1107 set who [lindex $args 0] 1094 set x $ settings_($this-$who)1108 set x $_settings($this-$who) 1095 1109 set code [catch { string is double $x } result] 1096 1110 if { $code != 0 || !$result } { 1097 set settings_($this-$who) $view_($who)1111 set _settings($this-$who) $_view($who) 1098 1112 return 1099 1113 } 1100 1114 switch -- $who { 1101 1115 "pan-x" - "pan-y" { 1102 set view_($who) $settings_($this-$who)1103 _PanCamera1116 set _view($who) $_settings($this-$who) 1117 PanCamera 1104 1118 } 1105 1119 "phi" - "theta" - "psi" { 1106 set view_($who) $settings_($this-$who)1107 set xyz [Euler2XYZ $ view_(theta) $view_(phi) $view_(psi)]1108 _send "camera angle $xyz"1120 set _view($who) $_settings($this-$who) 1121 set xyz [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)] 1122 SendCmd "camera angle $xyz" 1109 1123 } 1110 1124 "zoom" { 1111 set view_($who) $settings_($this-$who)1112 _send "camera zoom $view_(zoom)"1125 set _view($who) $_settings($this-$who) 1126 SendCmd "camera zoom $_view(zoom)" 1113 1127 } 1114 1128 } … … 1117 1131 } 1118 1132 1119 itcl::body Rappture::HeightmapViewer:: _BuildViewTab {} {1133 itcl::body Rappture::HeightmapViewer::BuildViewTab {} { 1120 1134 set fg [option get $itk_component(hull) font Font] 1121 1135 … … 1132 1146 legend 1 1133 1147 } { 1134 set settings_($this-$key) $value1148 set _settings($this-$key) $value 1135 1149 } 1136 1150 1137 1151 checkbutton $inner.grid \ 1138 1152 -text "grid" \ 1139 -variable [itcl::scope settings_($this-grid)] \1140 -command [itcl::code $this _fixSettings grid] \1153 -variable [itcl::scope _settings($this-grid)] \ 1154 -command [itcl::code $this FixSettings grid] \ 1141 1155 -font "Arial 9" 1142 1156 checkbutton $inner.axes \ 1143 1157 -text "axes" \ 1144 -variable ::Rappture::HeightmapViewer:: settings_($this-axes) \1145 -command [itcl::code $this _fixSettings axes] \1158 -variable ::Rappture::HeightmapViewer::_settings($this-axes) \ 1159 -command [itcl::code $this FixSettings axes] \ 1146 1160 -font "Arial 9" 1147 1161 checkbutton $inner.contourlines \ 1148 1162 -text "contour lines" \ 1149 -variable ::Rappture::HeightmapViewer:: settings_($this-contourlines) \1150 -command [itcl::code $this _fixSettings contourlines]\1163 -variable ::Rappture::HeightmapViewer::_settings($this-contourlines) \ 1164 -command [itcl::code $this FixSettings contourlines]\ 1151 1165 -font "Arial 9" 1152 1166 checkbutton $inner.wireframe \ 1153 1167 -text "wireframe" \ 1154 1168 -onvalue "wireframe" -offvalue "fill" \ 1155 -variable ::Rappture::HeightmapViewer:: settings_($this-wireframe) \1156 -command [itcl::code $this _fixSettings wireframe]\1169 -variable ::Rappture::HeightmapViewer::_settings($this-wireframe) \ 1170 -command [itcl::code $this FixSettings wireframe]\ 1157 1171 -font "Arial 9" 1158 1172 checkbutton $inner.legend \ 1159 1173 -text "legend" \ 1160 -variable ::Rappture::HeightmapViewer:: settings_($this-legend) \1161 -command [itcl::code $this _fixSettings legend]\1174 -variable ::Rappture::HeightmapViewer::_settings($this-legend) \ 1175 -command [itcl::code $this FixSettings legend]\ 1162 1176 -font "Arial 9" 1163 1177 … … 1177 1191 } 1178 1192 1179 itcl::body Rappture::HeightmapViewer:: _BuildCameraTab {} {1193 itcl::body Rappture::HeightmapViewer::BuildCameraTab {} { 1180 1194 set fg [option get $itk_component(hull) font Font] 1181 1195 … … 1190 1204 label $inner.${tag}label -text $tag -font "Arial 9" 1191 1205 entry $inner.${tag} -font "Arial 9" -bg white -width 10 \ 1192 -textvariable [itcl::scope settings_($this-$tag)]1206 -textvariable [itcl::scope _settings($this-$tag)] 1193 1207 bind $inner.${tag} <KeyPress-Return> \ 1194 1208 [itcl::code $this camera set ${tag}] … … 1206 1220 itcl::body Rappture::HeightmapViewer::Resize { w h } { 1207 1221 #puts stderr "w=$w h=$h" 1208 _send "screen $w $h"1209 } 1222 SendCmd "screen $w $h" 1223 }
Note: See TracChangeset
for help on using the changeset viewer.