- Timestamp:
- Feb 26, 2008, 7:19:02 PM (17 years ago)
- Location:
- trunk/gui/scripts
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/gui/scripts/field2dresult.tcl
r872 r909 42 42 } 43 43 44 # must use this name -- plugs into Rappture::resources::load45 proc field2d_init_resources {} {46 Rappture::resources::register \47 nanovis_server Rappture::NanovisServer::setServer48 }49 50 44 itk::usual Field2DResult { 51 45 keep -background -foreground -cursor -font … … 62 56 array set flags $args 63 57 if { $flags(-mode) == "heightmap" } { 64 set servers [Rappture:: NanovisServer::getServer]58 set servers [Rappture::VisViewer::GetServerList "nanovis"] 65 59 if { $servers == "" } { 66 60 error "No nanovis servers available" -
trunk/gui/scripts/field3dresult.tcl
r839 r909 41 41 } 42 42 43 # must use this name -- plugs into Rappture::resources::load44 proc field3d_init_resources {} {45 Rappture::resources::register \46 nanovis_server Rappture::NanovisServer::setServer47 }48 49 43 itk::usual Field3DResult { 50 44 keep -background -foreground -cursor -font … … 61 55 array set flags $args 62 56 63 set servers [Rappture:: NanovisServer::getServer]57 set servers [Rappture::VisViewer::GetServerList "nanovis"] 64 58 if {"" != $servers && $flags(-mode) != "vtk"} { 65 59 itk_component add renderer { -
trunk/gui/scripts/heightmapviewer.tcl
r839 r909 12 12 # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. 13 13 # ====================================================================== 14 14 15 package require Itk 15 16 package require BLT … … 27 28 -*-helvetica-medium-r-normal-*-12-* widgetDefault 28 29 30 # must use this name -- plugs into Rappture::resources::load 31 proc HeightmapViewer_init_resources {} { 32 Rappture::resources::register \ 33 nanovis_server [list Rappture::VisViewer::SetServerList "nanovis"] 34 } 35 29 36 itcl::class Rappture::HeightmapViewer { 30 inherit itk::Widget37 inherit Rappture::VisViewer 31 38 32 39 itk_option define -plotforeground plotForeground Foreground "" 33 40 itk_option define -plotbackground plotBackground Background "" 34 41 itk_option define -plotoutline plotOutline PlotOutline "" 35 itk_option define -sendcommand sendCommand SendCommand "" 36 itk_option define -receivecommand receiveCommand ReceiveCommand "" 37 38 constructor {hostlist args} { # defined below } 39 destructor { # defined below } 40 42 43 constructor { hostlist args } { 44 Rappture::VisViewer::constructor $hostlist 45 } { 46 # defined below 47 } 48 destructor { 49 # defined below 50 } 51 52 public method isconnected {} 41 53 public method add {dataobj {settings ""}} 42 54 public method get {args} … … 44 56 public method scale {args} 45 57 public method download {option args} 46 public method parameters {title args} { # do nothing } 47 48 public method connect {{hostlist ""}} 49 public method disconnect {} 50 public method isconnected {} 51 52 protected method _send {args} 53 protected method _send_text {string} 58 public method parameters {title args} { 59 # do nothing 60 } 61 protected method Connect {} 62 protected method Disconnect {} 63 64 protected method _send {string} 54 65 protected method _send_dataobjs {} 55 protected method _send_echo {channel {data ""}}56 protected method _receive {}57 66 protected method _receive_image {option size} 58 67 protected method _receive_legend {ivol vmin vmax size} 59 68 protected method _receive_echo {channel {data ""}} 69 protected method _receive_data {args} 60 70 61 71 protected method _rebuild {} 62 protected method _currentHeightMapIds {{what -all}}63 72 protected method _zoom {option} 64 73 protected method _move {option x y} 65 protected method _probe {option args}66 74 67 75 protected method _state {comp} 68 76 protected method _fixSettings {what {value ""}} 69 protected method _fixLegend {}70 protected method _fixGrid {}71 protected method _fixAxes {}72 protected method _fixContourLines {}73 protected method _serverDown {}74 77 protected method _getTransfuncData {dataobj comp} 75 protected method _color2rgb {color} 76 protected method _euler2xyz {theta phi psi} 77 78 private variable _dispatcher "" ;# dispatcher for !events 79 80 private variable _nvhosts "" ;# list of hosts for nanovis server 81 private variable _sid "" ;# socket connection to nanovis server 82 private variable _parser "" ;# interpreter for incoming commands 83 private variable _buffer ;# buffer for incoming/outgoing commands 84 private variable _image ;# image displayed in plotting area 78 79 80 private variable _outbuf ;# buffer for outgoing commands 85 81 86 82 private variable _dlist "" ;# list of data objects … … 88 84 private variable _obj2style ;# maps dataobj => style settings 89 85 private variable _obj2ovride ;# maps dataobj => style override 90 private variable _obj2id ;# maps dataobj => volume ID in server 86 private variable _obj2id ;# maps dataobj => heightmap ID in server 87 private variable _id2obj ;# maps heightmap ID => dataobj in server 91 88 private variable _sendobjs "" ;# list of data objs to send to server 92 89 private variable _receiveids ;# list of data responses from the server 93 90 private variable _click ;# info used for _move operations 94 91 private variable _limits ;# autoscale min/max for all axes 95 92 private variable _view ;# view params for 3D view 96 93 97 private common _s howGrid ;# Array indicates whether grid is on98 private common _showAxes ;# Array indicates whether axis is on 94 private common _settings ;# Array used for checkbuttons and radiobuttons 95 99 96 } 100 97 … … 108 105 # ---------------------------------------------------------------------- 109 106 itcl::body Rappture::HeightmapViewer::constructor {hostlist args} { 110 Rappture::dispatcher _dispatcher107 # Draw legend event 111 108 $_dispatcher register !legend 112 $_dispatcher dispatch $this !legend "[itcl::code $this _fixLegend]; list" 113 $_dispatcher register !serverDown 114 $_dispatcher dispatch $this !serverDown "[itcl::code $this _serverDown]; list" 115 116 set _buffer(in) "" 117 set _buffer(out) "" 109 $_dispatcher dispatch $this !legend \ 110 "[itcl::code $this _fixSettings legend]; list" 111 # Send dataobjs event 112 $_dispatcher register !send_dataobjs 113 $_dispatcher dispatch $this !send_dataobjs \ 114 "[itcl::code $this _send_dataobjs]; list" 115 # Rebuild event 116 $_dispatcher register !rebuild 117 $_dispatcher dispatch $this !rebuild "[itcl::code $this _rebuild]; list" 118 119 set _outbuf "" 118 120 119 121 # 120 # Create a parser tohandle incoming requests122 # Populate parser with commands handle incoming requests 121 123 # 122 set _parser [interp create -safe]123 foreach cmd [$_parser eval {info commands}] {124 $_parser hide $cmd125 }126 124 $_parser alias image [itcl::code $this _receive_image] 127 125 $_parser alias legend [itcl::code $this _receive_legend] 128 129 # 130 # Set up the widgets in the main body 131 # 132 option add hull.width hull.height 133 pack propagate $itk_component(hull) no 126 $_parser alias data [itcl::code $this _receive_data] 134 127 135 128 set _view(theta) 45 … … 141 134 set _view(zfocus) 0 142 135 set _obj2id(count) 0 143 144 itk_component add controls {145 frame $itk_interior.cntls146 } {147 usual148 rename -background -controlbackground controlBackground Background149 }150 pack $itk_component(controls) -side right -fill y151 136 152 137 itk_component add zoom { … … 221 206 set fg [option get $itk_component(hull) font Font] 222 207 223 set ::Rappture::HeightmapViewer::_s howGrid($this) 1208 set ::Rappture::HeightmapViewer::_settings($this-grid) 1 224 209 ::checkbutton $inner.f.grid \ 225 210 -text "Show Grid" \ 226 -variable ::Rappture::HeightmapViewer::_s howGrid($this) \227 -command [itcl::code $this _fix Grid]211 -variable ::Rappture::HeightmapViewer::_settings($this-grid) \ 212 -command [itcl::code $this _fixSettings grid] 228 213 grid $inner.f.grid -row 0 -column 0 -sticky w 229 214 230 set ::Rappture::HeightmapViewer::_s howAxes($this) 1215 set ::Rappture::HeightmapViewer::_settings($this-axes) 1 231 216 ::checkbutton $inner.f.axes \ 232 217 -text "Show Axes" \ 233 -variable ::Rappture::HeightmapViewer::_s howAxes($this) \234 -command [itcl::code $this _fix Axes]218 -variable ::Rappture::HeightmapViewer::_settings($this-axes) \ 219 -command [itcl::code $this _fixSettings axes] 235 220 grid $inner.f.axes -row 1 -column 0 -sticky w 236 221 237 set ::Rappture::HeightmapViewer::_s howContourLines($this) 1222 set ::Rappture::HeightmapViewer::_settings($this-contourlines) 1 238 223 ::checkbutton $inner.f.contour \ 239 224 -text "Show Contour Lines" \ 240 -variable ::Rappture::HeightmapViewer::_s howContourLines($this) \241 -command [itcl::code $this _fix ContourLines]225 -variable ::Rappture::HeightmapViewer::_settings($this-contourlines) \ 226 -command [itcl::code $this _fixSettings contourlines] 242 227 grid $inner.f.contour -row 2 -column 0 -sticky w 243 228 244 # 245 # RENDERING AREA 246 # 247 itk_component add area { 248 frame $itk_interior.area 249 } 250 pack $itk_component(area) -expand yes -fill both 251 229 230 # Legend 252 231 set _image(legend) [image create photo] 253 232 itk_component add legend { … … 261 240 bind $itk_component(legend) <Configure> \ 262 241 [list $_dispatcher event -idle !legend] 263 264 set _image(plot) [image create photo]265 itk_component add 3dview {266 label $itk_component(area).vol -image $_image(plot) \267 -highlightthickness 0268 } {269 usual270 ignore -highlightthickness271 rename -background -plotbackground plotBackground Background272 }273 pack $itk_component(3dview) -expand yes -fill both274 242 275 243 # set up bindings for rotation … … 281 249 [itcl::code $this _move release %x %y] 282 250 bind $itk_component(3dview) <Configure> \ 283 [itcl::code $this _send screen %w %h]251 [itcl::code $this _send "screen %w %h"] 284 252 285 253 set _image(download) [image create photo] … … 287 255 eval itk_initialize $args 288 256 289 connect $hostlist257 Connect 290 258 } 291 259 … … 295 263 itcl::body Rappture::HeightmapViewer::destructor {} { 296 264 set _sendobjs "" ;# stop any send in progress 297 after cancel [itcl::code $this _send_dataobjs]298 after cancel [itcl::code $this _rebuild]265 $_dispatcher cancel !rebuild 266 $_dispatcher cancel !send_dataobjs 299 267 image delete $_image(plot) 300 268 image delete $_image(legend) 301 269 image delete $_image(download) 302 interp delete $_parser303 270 } 304 271 … … 337 304 set _obj2ovride($dataobj-width) $params(-width) 338 305 set _obj2ovride($dataobj-raise) $params(-raise) 339 340 after cancel [itcl::code $this _rebuild] 341 after idle [itcl::code $this _rebuild] 306 $_dispatcher event -idle !rebuild 342 307 } 343 308 } … … 421 386 # if anything changed, then rebuild the plot 422 387 if {$changed} { 423 after cancel [itcl::code $this _rebuild] 424 after idle [itcl::code $this _rebuild] 388 $_dispatcher event -idle !rebuild 425 389 } 426 390 } … … 505 469 506 470 # ---------------------------------------------------------------------- 507 # USAGE: connect ?<host:port>,<host:port>...?471 # USAGE: Connect ?<host:port>,<host:port>...? 508 472 # 509 473 # Clients use this method to establish a connection to a new … … 511 475 # Any existing connection is automatically closed. 512 476 # ---------------------------------------------------------------------- 513 itcl::body Rappture::HeightmapViewer::connect {{hostlist ""}} { 514 disconnect 515 516 if {"" != $hostlist} { set _nvhosts $hostlist } 517 518 if {"" == $_nvhosts} { 477 itcl::body Rappture::HeightmapViewer::Connect {} { 478 Disconnect 479 set _hosts [GetServerList "nanovis"] 480 if { "" == $_hosts } { 519 481 return 0 520 482 } 521 522 blt::busy hold $itk_component(hull); update idletasks 523 524 # HACK ALERT! punt on this for now 525 set memorySize 10000 526 527 # 528 # Connect to the nanovis server. Send the server some estimate 529 # of the size of our job. If it's too busy, that server may 530 # forward us to another. 531 # 532 set try [split $_nvhosts ,] 533 foreach {hostname port} [split [lindex $try 0] :] break 534 set try [lrange $try 1 end] 535 536 while {1} { 537 _send_echo <<line "connecting to $hostname:$port..." 538 if {[catch {socket $hostname $port} sid]} { 539 if {[llength $try] == 0} { 540 return 0 541 } 542 foreach {hostname port} [split [lindex $try 0] :] break 543 set try [lrange $try 1 end] 544 continue 545 } 546 fconfigure $sid -translation binary -encoding binary 547 548 # send memory requirement to the load balancer 549 puts -nonewline $sid [binary format I $memorySize] 550 flush $sid 551 552 # read back a reconnection order 553 set data [read $sid 4] 554 if {[binary scan $data cccc b1 b2 b3 b4] != 4} { 555 error "couldn't read redirection request" 556 } 557 set addr [format "%u.%u.%u.%u" \ 558 [expr {$b1 & 0xff}] \ 559 [expr {$b2 & 0xff}] \ 560 [expr {$b3 & 0xff}] \ 561 [expr {$b4 & 0xff}]] 562 _receive_echo <<line $addr 563 564 if {[string equal $addr "0.0.0.0"]} { 565 fconfigure $sid -buffering line 566 fileevent $sid readable [itcl::code $this _receive] 567 set _sid $sid 568 blt::busy release $itk_component(hull) 569 return 1 570 } 571 set hostname $addr 572 } 573 blt::busy release $itk_component(hull) 574 575 return 0 576 } 577 578 # ---------------------------------------------------------------------- 579 # USAGE: disconnect 483 set result [VisViewer::Connect $_hosts] 484 return $result 485 } 486 487 # ---------------------------------------------------------------------- 488 # USAGE: Disconnect 580 489 # 581 490 # Clients use this method to disconnect from the current rendering 582 491 # server. 583 492 # ---------------------------------------------------------------------- 584 itcl::body Rappture::HeightmapViewer::disconnect {} { 585 if {"" != $_sid} { 586 catch {close $_sid} 587 set _sid "" 588 } 589 590 set _buffer(in) "" 591 set _buffer(out) "" 592 493 itcl::body Rappture::HeightmapViewer::Disconnect {} { 494 VisViewer::Disconnect 495 496 set _outbuf "" 593 497 # disconnected -- no more data sitting on server 594 498 catch {unset _obj2id} 499 array unset _id2obj 595 500 set _obj2id(count) 0 501 set _id2obj(cound) 0 596 502 set _sendobjs "" 597 503 } … … 604 510 # ---------------------------------------------------------------------- 605 511 itcl::body Rappture::HeightmapViewer::isconnected {} { 606 return [ expr {"" != $_sid}]607 } 608 609 # ---------------------------------------------------------------------- 610 # USAGE: _send < arg> <arg> ...512 return [VisViewer::IsConnected] 513 } 514 515 # ---------------------------------------------------------------------- 516 # USAGE: _send <string> 611 517 # 612 518 # Used internally to send commands off to the rendering server. 613 # This is a more convenient form of _send_text, which actually 614 # does the sending. 615 # ---------------------------------------------------------------------- 616 itcl::body Rappture::HeightmapViewer::_send {args} { 617 _send_text $args 618 } 619 620 # ---------------------------------------------------------------------- 621 # USAGE: _send_text <string> 622 # 623 # Used internally to send commands off to the rendering server. 624 # ---------------------------------------------------------------------- 625 itcl::body Rappture::HeightmapViewer::_send_text {string} { 626 if {"" == $_sid} { 519 # ---------------------------------------------------------------------- 520 itcl::body Rappture::HeightmapViewer::_send {string} { 521 if { ![isconnected] } { 627 522 $_dispatcher cancel !serverDown 628 523 set x [expr {[winfo rootx $itk_component(area)]+10}] … … 630 525 Rappture::Tooltip::cue @$x,$y "Connecting..." 631 526 632 if {[catch {connect} ok] == 0 && $ok} { 527 set code [catch { Connect } ok] 528 if { $code == 0 && $ok} { 633 529 set w [winfo width $itk_component(3dview)] 634 530 set h [winfo height $itk_component(3dview)] 635 531 636 if {[catch {puts $_sid "screen $w $h"}]} { 637 disconnect 638 _receive_echo closed 639 $_dispatcher event -after 750 !serverDown 640 } else { 641 _send_echo >>line "screen $w $h" 642 532 if { [Send "screen $w $h"] } { 643 533 set _view(theta) 45 644 534 set _view(phi) 45 645 535 set _view(psi) 0 646 536 set _view(zoom) 1.0 647 after idle [itcl::code $this _rebuild]537 $_dispatcher event -idle !rebuild 648 538 Rappture::Tooltip::cue hide 649 539 } 650 return 651 } 652 Rappture::Tooltip::cue @$x,$y "Can't connect to visualization server. This may be a network problem. Wait a few moments and try resetting the view." 653 return 654 } 655 if {"" != $_sid} { 540 } else { 541 Rappture::Tooltip::cue @$x,$y "Can't connect to visualization server. This may be a network problem. Wait a few moments and try resetting the view." 542 } 543 } else { 656 544 # if we're transmitting objects, then buffer this command 657 545 if {[llength $_sendobjs] > 0} { 658 append _ buffer(out)$string "\n"546 append _outbuf $string "\n" 659 547 } else { 660 if {[catch {puts $_sid $string}]} { 661 disconnect 662 _receive_echo closed 663 $_dispatcher event -after 750 !serverDown 664 } else { 548 if { [Send $string] } { 665 549 foreach line [split $string \n] { 666 _send_echo >>line $line550 SendEcho >>line $line 667 551 } 668 552 } … … 689 573 set length [string length $data] 690 574 set cmdstr "heightmap data follows $length" 691 _send_echo >>line $cmdstr 692 if {[catch {puts $_sid $cmdstr} err]} { 693 disconnect 694 $_dispatcher event -after 750 !serverDown 575 if { ![Send $cmdstr] } { 695 576 return 696 577 } 697 698 578 while {[string length $data] > 0} { 699 579 update … … 701 581 set chunk [string range $data 0 8095] 702 582 set data [string range $data 8096 end] 703 704 _send_echo >>line $chunk 705 if {[catch {puts -nonewline $_sid $chunk} err]} { 706 disconnect 707 $_dispatcher event -after 750 !serverDown 583 if { ![Send $chunk -nonewline] } { 708 584 return 709 585 } 710 catch {flush $_sid} 711 } 712 _send_echo >>line "" 713 puts $_sid "" 714 715 set _obj2id($dataobj-$comp) $_obj2id(count) 586 Flush 587 } 588 Send "" 589 590 set id $_obj2id(count) 716 591 incr _obj2id(count) 592 set _id2obj($id) [list $dataobj $comp] 593 set _obj2id($dataobj-$comp) $id 594 set _receiveids($id) 1 717 595 718 596 # … … 722 600 foreach {sname cmap wmap} [_getTransfuncData $dataobj $comp] break 723 601 set cmdstr [list "transfunc" "define" $sname $cmap $wmap] 724 _send_echo >>line $cmdstr 725 if {[catch {puts $_sid $cmdstr} err]} { 726 disconnect 727 $_dispatcher event -after 750 !serverDown 602 if {![Send $cmdstr]} { 728 603 return 729 604 } 730 731 605 set _obj2style($dataobj-$comp) $sname 732 606 } … … 740 614 set axis [$first hints updir] 741 615 if {"" != $axis} { 742 _send "up " $axis616 _send "up $axis" 743 617 } 744 618 } … … 746 620 foreach key [array names _obj2id *-*] { 747 621 set state [string match $first-* $key] 748 _send "heightmap " "data" "visible" $state $_obj2id($key)622 _send "heightmap data visible $state $_obj2id($key)" 749 623 if {[info exists _obj2style($key)]} { 750 _send "heightmap" "transfunc" $_obj2style($key) $_obj2id($key) 751 } 752 } 753 624 _send "heightmap transfunc $_obj2style($key) $_obj2id($key)" 625 } 626 } 754 627 755 628 # if there are any commands in the buffer, send them now that we're done 756 _send_echo >>line $_buffer(out) 757 if {[catch {puts $_sid $_buffer(out)} err]} { 758 disconnect 759 $_dispatcher event -after 750 !serverDown 760 } 761 set _buffer(out) "" 629 Send $_outbuf 630 set _outbuf "" 762 631 763 632 $_dispatcher event -idle !legend 764 }765 766 # ----------------------------------------------------------------------767 # USAGE: _send_echo <channel> ?<data>?768 #769 # Used internally to echo sent data to clients interested in770 # this widget. If the -sendcommand option is set, then it is771 # invoked in the global scope with the <channel> and <data> values772 # as arguments. Otherwise, this does nothing.773 # ----------------------------------------------------------------------774 itcl::body Rappture::HeightmapViewer::_send_echo {channel {data ""}} {775 if {[string length $itk_option(-sendcommand)] > 0} {776 uplevel #0 $itk_option(-sendcommand) [list $channel $data]777 }778 }779 780 # ----------------------------------------------------------------------781 # USAGE: _receive782 #783 # Invoked automatically whenever a command is received from the784 # rendering server. Reads the incoming command and executes it in785 # a safe interpreter to handle the action.786 # ----------------------------------------------------------------------787 itcl::body Rappture::HeightmapViewer::_receive {} {788 if {"" != $_sid} {789 if {[gets $_sid line] < 0} {790 disconnect791 _receive_echo closed792 $_dispatcher event -after 750 !serverDown793 } elseif {[string equal [string range $line 0 2] "nv>"]} {794 _receive_echo <<line $line795 append _buffer(in) [string range $line 3 end]796 if {[info complete $_buffer(in)]} {797 set request $_buffer(in)798 set _buffer(in) ""799 $_parser eval $request800 }801 } else {802 # this shows errors coming back from the engine803 _receive_echo <<error $line804 }805 }806 633 } 807 634 … … 814 641 # ---------------------------------------------------------------------- 815 642 itcl::body Rappture::HeightmapViewer::_receive_image {option size} { 816 if { "" != $_sid} {817 set bytes [ read $_sid$size]643 if {[isconnected]} { 644 set bytes [Receive $size] 818 645 $_image(plot) configure -data $bytes 819 _receive_echo <<line "<read $size bytes for [image width $_image(plot)]x[image height $_image(plot)] image>"646 ReceiveEcho <<line "<read $size bytes for [image width $_image(plot)]x[image height $_image(plot)] image>" 820 647 } 821 648 } … … 829 656 # ---------------------------------------------------------------------- 830 657 itcl::body Rappture::HeightmapViewer::_receive_legend {ivol vmin vmax size} { 831 if { "" != $_sid} {832 set bytes [ read $_sid$size]658 if { [isconnected] } { 659 set bytes [Receive $size] 833 660 $_image(legend) configure -data $bytes 834 _receive_echo <<line "<read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>"661 ReceiveEcho <<line "<read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>" 835 662 836 663 set c $itk_component(legend) … … 841 668 -image $_image(legend) -tags transfunc 842 669 843 $c bind transfunc <ButtonPress-1> \844 [itcl::code $this _probe start %x %y]845 $c bind transfunc <B1-Motion> \846 [itcl::code $this _probe update %x %y]847 $c bind transfunc <ButtonRelease-1> \848 [itcl::code $this _probe end %x %y]849 850 670 $c create text 10 [expr {$h-8}] -anchor sw \ 851 671 -fill $itk_option(-plotforeground) -tags vmin … … 853 673 -fill $itk_option(-plotforeground) -tags vmax 854 674 } 855 856 675 $c itemconfigure vmin -text $vmin 857 676 $c coords vmin 10 [expr {$h-8}] 858 859 677 $c itemconfigure vmax -text $vmax 860 678 $c coords vmax [expr {$w-10}] [expr {$h-8}] … … 863 681 864 682 # ---------------------------------------------------------------------- 865 # USAGE: _receive_echo <channel> ?<data>? 866 # 867 # Used internally to echo received data to clients interested in 868 # this widget. If the -receivecommand option is set, then it is 869 # invoked in the global scope with the <channel> and <data> values 870 # as arguments. Otherwise, this does nothing. 871 # ---------------------------------------------------------------------- 872 itcl::body Rappture::HeightmapViewer::_receive_echo {channel {data ""}} { 873 if {[string length $itk_option(-receivecommand)] > 0} { 874 uplevel #0 $itk_option(-receivecommand) [list $channel $data] 683 # USAGE: _receive_data <id> <vmin> <vmax> 684 # 685 # Invoked automatically whenever the "legend" command comes in from 686 # the rendering server. Indicates that binary image data with the 687 # specified <size> will follow. 688 # ---------------------------------------------------------------------- 689 itcl::body Rappture::HeightmapViewer::_receive_data { args } { 690 if { [isconnected] } { 691 array set info $args 692 set id $info(id) 693 foreach { dataobj comp } $_id2obj($id) break 694 if { ![info exists _limits($dataobj-vmin] } { 695 set _limits($dataobj-vmin) $info(min) 696 set _limits($dataobj-vmax) $info(max) 697 } else { 698 if { $_limits($dataobj-vmin) > $info(min) } { 699 set _limits($dataobj-vmin) $info(min) 700 } 701 if { $_limits($dataobj-vmax) > $info(max) } { 702 set _limits($dataobj-vmax) $info(max) 703 } 704 } 705 set _limits(vmin) $info(vmin) 706 set _limits(vmax) $info(vmax) 707 lappend _sendobjs2 $dataobj 708 unset _receiveids($info(id)) 709 if { [array size _receiveids] == 0 } { 710 #$_dispatcher event -idle !send_transfuncs 711 } 875 712 } 876 713 } … … 906 743 if {[llength $_sendobjs] > 0} { 907 744 # send off new data objects 908 after idle [itcl::code $this _send_dataobjs]745 $_dispatcher event -idle !send_dataobjs 909 746 } else { 910 747 # nothing to send -- activate the proper volume … … 913 750 set axis [$first hints updir] 914 751 if {"" != $axis} { 915 _send up $axis752 _send "up $axis" 916 753 } 917 754 } 918 755 foreach key [array names _obj2id *-*] { 919 756 set state [string match $first-* $key] 920 _send "heightmap " "data" "visible" $state $_obj2id($key)757 _send "heightmap data visible $state $_obj2id($key)" 921 758 if {[info exists _obj2style($key)]} { 922 _send "heightmap " "transfunc" $_obj2style($key) $_obj2id($key)759 _send "heightmap transfunc $_obj2style($key) $_obj2id($key)" 923 760 } 924 761 } … … 929 766 # Reset the camera and other view parameters 930 767 # 931 eval _send camera angle [_euler2xyz $_view(theta) $_view(phi) $_view(psi)]932 _send camera zoom $_view(zoom)768 _send "camera angle [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)]" 769 _send "camera zoom $_view(zoom)" 933 770 934 771 if {"" == $itk_option(-plotoutline)} { 935 eval _send "grid" "linecolor" [_color2rgb $itk_option(-plotoutline)]772 _send "grid linecolor [Color2RGB $itk_option(-plotoutline)]" 936 773 } 937 _fixGrid 938 _fixAxes 939 _fixContourLines 940 } 941 942 # ---------------------------------------------------------------------- 943 # USAGE: _currentHeightMapIds ?-cutplanes? 944 # 945 # Returns a list of volume server IDs for the current volume being 946 # displayed. This is normally a single ID, but it might be a list 947 # of IDs if the current data object has multiple components. 948 # ---------------------------------------------------------------------- 949 itcl::body Rappture::HeightmapViewer::_currentHeightMapIds {{what -all}} { 950 set rlist "" 951 952 set first [lindex [get] 0] 953 foreach key [array names _obj2id *-*] { 954 if {[string match $first-* $key]} { 955 array set style { 956 -cutplanes 1 957 } 958 foreach {dataobj comp} [split $key -] break 959 array set style [lindex [$dataobj components -style $comp] 0] 960 961 if {$what != "-cutplanes" || $style(-cutplanes)} { 962 lappend rlist $_obj2id($key) 963 } 964 } 965 } 966 return $rlist 774 _fixSettings grid 775 _fixSettings axes 776 _fixSettings contourlines 967 777 } 968 778 … … 979 789 in { 980 790 set _view(zoom) [expr {$_view(zoom)*1.25}] 981 _send camera zoom $_view(zoom)791 _send "camera zoom $_view(zoom)" 982 792 } 983 793 out { 984 794 set _view(zoom) [expr {$_view(zoom)*0.8}] 985 _send camera zoom $_view(zoom)795 _send "camera zoom $_view(zoom)" 986 796 } 987 797 reset { … … 990 800 set _view(psi) 0 991 801 set _view(zoom) 1.0 992 eval _send camera angle [_euler2xyz $_view(theta) $_view(phi) $_view(psi)] 993 _send camera zoom $_view(zoom) 802 set xyz [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)] 803 _send "camera angle $xyz" 804 _send "camera zoom $_view(zoom)" 994 805 } 995 806 } … … 1057 868 set _view(phi) $phi 1058 869 set _view(psi) $psi 1059 eval _send camera angle [_euler2xyz$_view(theta) $_view(phi) $_view(psi)]1060 870 set xyz [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)] 871 _send "camera angle $xyz" 1061 872 set _click(x) $x 1062 873 set _click(y) $y … … 1075 886 1076 887 # ---------------------------------------------------------------------- 1077 # USAGE: _probe start <x> <y>1078 # USAGE: _probe update <x> <y>1079 # USAGE: _probe end <x> <y>1080 #1081 # Used internally to handle the various probe operations, when the1082 # user clicks and drags on the legend area. The probe changes the1083 # transfer function to highlight the area being selected in the1084 # legend.1085 # ----------------------------------------------------------------------1086 itcl::body Rappture::HeightmapViewer::_probe {option args} {1087 set c $itk_component(legend)1088 set w [winfo width $c]1089 set h [winfo height $c]1090 set y0 101091 set y1 [expr {$y0+[image height $_image(legend)]-1}]1092 1093 set dataobj [lindex [get] 0]1094 if {"" == $dataobj} {1095 return1096 }1097 set comp [lindex [$dataobj components] 0]1098 if {![info exists _obj2style($dataobj-$comp)]} {1099 return1100 }1101 1102 switch -- $option {1103 start {1104 # create the probe marker on the legend1105 $c create rect 0 0 5 $h -width 3 \1106 -outline black -fill "" -tags markerbg1107 $c create rect 0 0 5 $h -width 1 \1108 -outline white -fill "" -tags marker1109 1110 # define a new transfer function1111 _send "transfunc" "define" "probe" {0 0 0 0 1 0 0 0} {0 0 1 0}1112 _send "heightmap" "transfunc" "probe" $_obj2id($dataobj-$comp)1113 1114 # now, probe this point1115 eval _probe update $args1116 }1117 update {1118 set x [lindex $args 0]1119 if {$x < 10} {set x 10}1120 if {$x > $w-10} {set x [expr {$w-10}]}1121 foreach tag {markerbg marker} {1122 $c coords $tag [expr {$x-2}] [expr {$y0-2}] \1123 [expr {$x+2}] [expr {$y1+2}]1124 }1125 1126 # value of the probe point, in the range 0-11127 set val [expr {double($x-10)/($w-20)}]1128 set dl [expr {($val > 0.1) ? 0.1 : $val}]1129 set dr [expr {($val < 0.9) ? 0.1 : 1-$val}]1130 1131 # compute a transfer function for the probe value1132 foreach {sname cmap wmap} [_getTransfuncData $dataobj $comp] break1133 set wmap "0.0 0.0 [expr {$val-$dl}] 0.0 $val 1.0 [expr {$val+$dr}] 0.0 1.0 0.0"1134 _send transfunc define "probe" $cmap $wmap1135 }1136 end {1137 $c delete marker markerbg1138 1139 # put the volume back to its old transfer function1140 _send "heightmap" "transfunc" $_obj2style($dataobj-$comp) \1141 $_obj2id($dataobj-$comp)1142 }1143 default {1144 error "bad option \"$option\": should be start, update, end"1145 }1146 }1147 }1148 1149 # ----------------------------------------------------------------------1150 888 # USAGE: _state <component> 1151 889 # … … 1168 906 # to the back end. 1169 907 # ---------------------------------------------------------------------- 1170 itcl::body Rappture::HeightmapViewer::_fixSettings {what {value ""}} { 1171 set inner [$itk_component(controls).panel component inner] 908 itcl::body Rappture::HeightmapViewer::_fixSettings { what {value ""} } { 1172 909 switch -- $what { 1173 light { 1174 if {[isconnected]} { 1175 set val [$inner.scales.light get] 1176 set sval [expr {0.1*$val}] 1177 _send volume shading diffuse $sval 1178 1179 set sval [expr {sqrt($val+1.0)}] 1180 _send volume shading specular $sval 1181 } 1182 } 1183 transp { 1184 if {[isconnected]} { 1185 set val [$inner.scales.transp get] 1186 set sval [expr {0.2*$val+1}] 1187 _send volume shading opacity $sval 1188 } 1189 } 1190 default { 1191 error "don't know how to fix $what" 1192 } 1193 } 1194 } 1195 1196 # ---------------------------------------------------------------------- 1197 # USAGE: _fixLegend 1198 # 1199 # Used internally to update the legend area whenever it changes size 1200 # or when the field changes. Asks the server to send a new legend 1201 # for the current field. 1202 # ---------------------------------------------------------------------- 1203 itcl::body Rappture::HeightmapViewer::_fixLegend {} { 1204 set lineht [font metrics $itk_option(-font) -linespace] 1205 set w [expr {[winfo width $itk_component(legend)]-20}] 1206 set h [expr {[winfo height $itk_component(legend)]-20-$lineht}] 1207 set imap "" 1208 1209 set dataobj [lindex [get] 0] 1210 if {"" != $dataobj} { 1211 set comp [lindex [$dataobj components] 0] 1212 if {[info exists _obj2id($dataobj-$comp)]} { 1213 set imap $_obj2id($dataobj-$comp) 1214 } 1215 } 1216 if {$w > 0 && $h > 0 && "" != $imap} { 1217 _send "heightmap" "legend" $imap $w $h 1218 } else { 1219 $itk_component(legend) delete all 1220 } 1221 } 1222 1223 # ---------------------------------------------------------------------- 1224 # USAGE: _fixGrid 1225 # 1226 # Used internally to update the legend area whenever it changes size 1227 # or when the field changes. Asks the server to send a new legend 1228 # for the current field. 1229 # ---------------------------------------------------------------------- 1230 itcl::body Rappture::HeightmapViewer::_fixGrid {} { 1231 if {[isconnected]} { 1232 _send "grid" "visible" $::Rappture::HeightmapViewer::_showGrid($this) 1233 } 1234 } 1235 1236 1237 # ---------------------------------------------------------------------- 1238 # USAGE: _fixAxes 1239 # ---------------------------------------------------------------------- 1240 itcl::body Rappture::HeightmapViewer::_fixAxes {} { 1241 if {[isconnected]} { 1242 _send "axis" "visible" $::Rappture::HeightmapViewer::_showAxes($this) 1243 } 1244 } 1245 1246 1247 # ---------------------------------------------------------------------- 1248 # USAGE: _fixLineContour 1249 # ---------------------------------------------------------------------- 1250 itcl::body Rappture::HeightmapViewer::_fixContourLines {} { 1251 if {[isconnected]} { 1252 set dataobj [lindex [get] 0] 1253 if {"" != $dataobj} { 1254 set comp [lindex [$dataobj components] 0] 1255 if {[info exists _obj2id($dataobj-$comp)]} { 1256 set i $_obj2id($dataobj-$comp) 1257 _send "heightmap" "linecontour" "visible" \ 1258 $::Rappture::HeightmapViewer::_showContourLines($this) $i 910 "legend" { 911 set lineht [font metrics $itk_option(-font) -linespace] 912 set w [expr {[winfo width $itk_component(legend)]-20}] 913 set h [expr {[winfo height $itk_component(legend)]-20-$lineht}] 914 set imap "" 915 916 set dataobj [lindex [get] 0] 917 if {"" != $dataobj} { 918 set comp [lindex [$dataobj components] 0] 919 if {[info exists _obj2id($dataobj-$comp)]} { 920 set imap $_obj2id($dataobj-$comp) 921 } 922 } 923 if {$w > 0 && $h > 0 && "" != $imap} { 924 _send "heightmap legend $imap $w $h" 925 } else { 926 $itk_component(legend) delete all 1259 927 } 1260 928 } 1261 } 1262 } 1263 1264 1265 # ---------------------------------------------------------------------- 1266 # USAGE: _serverDown 1267 # 1268 # Used internally to let the user know when the connection to the 1269 # visualization server has been lost. Puts up a tip encouraging the user to 1270 # press any control to reconnect. 1271 # 1272 # ---------------------------------------------------------------------- 1273 itcl::body Rappture::HeightmapViewer::_serverDown {} { 1274 set x [expr {[winfo rootx $itk_component(area)]+10}] 1275 set y [expr {[winfo rooty $itk_component(area)]+10}] 1276 Rappture::Tooltip::cue @$x,$y "Lost connection to visualization server. This happens sometimes when there are too many users and the system runs out of memory.\n\nTo reconnect, reset the view or press any other control. Your picture should come right back up." 929 "grid" { 930 if { [isconnected] } { 931 _send "grid visible $_settings($this-grid)" 932 } 933 } 934 "axes" { 935 if { [isconnected] } { 936 _send "axis visible $_settings($this-axes)" 937 } 938 } 939 "contourlines" { 940 if {[isconnected]} { 941 set dataobj [lindex [get] 0] 942 if {"" != $dataobj} { 943 set comp [lindex [$dataobj components] 0] 944 if {[info exists _obj2id($dataobj-$comp)]} { 945 set i $_obj2id($dataobj-$comp) 946 set bool $_settings($this-contourlines) 947 _send "heightmap linecontour visible $bool $i" 948 } 949 } 950 } 951 } 952 default { 953 error "don't know how to fix $what: should be grid, axes, contourlines, or legend" 954 } 955 } 1277 956 } 1278 957 … … 1297 976 } 1298 977 set clist [split $style(-color) :] 1299 set cmap "0.0 [ _color2rgbwhite] "978 set cmap "0.0 [Color2RGB white] " 1300 979 for {set i 0} {$i < [llength $clist]} {incr i} { 1301 980 set xval [expr {double($i+1)/([llength $clist]+1)}] 1302 981 set color [lindex $clist $i] 1303 append cmap "$xval [ _color2rgb$color] "1304 } 1305 append cmap "1.0 [ _color2rgb$color]"982 append cmap "$xval [Color2RGB $color] " 983 } 984 append cmap "1.0 [Color2RGB $color]" 1306 985 1307 986 set max $style(-opacity) … … 1329 1008 1330 1009 # ---------------------------------------------------------------------- 1331 # USAGE: _color2rgb <color>1332 #1333 # Used internally to convert a color name to a set of {r g b} values1334 # needed for the engine. Each r/g/b component is scaled in the1335 # range 0-1.1336 # ----------------------------------------------------------------------1337 itcl::body Rappture::HeightmapViewer::_color2rgb {color} {1338 foreach {r g b} [winfo rgb $itk_component(hull) $color] break1339 set r [expr {$r/65535.0}]1340 set g [expr {$g/65535.0}]1341 set b [expr {$b/65535.0}]1342 return [list $r $g $b]1343 }1344 1345 # ----------------------------------------------------------------------1346 # USAGE: _euler2xyz <theta> <phi> <psi>1347 #1348 # Used internally to convert euler angles for the camera placement1349 # the to angles of rotation about the x/y/z axes, used by the engine.1350 # Returns a list: {xangle, yangle, zangle}.1351 # ----------------------------------------------------------------------1352 itcl::body Rappture::HeightmapViewer::_euler2xyz {theta phi psi} {1353 set xangle [expr {$theta-90.0}]1354 set yangle [expr {180-$phi}]1355 set zangle $psi1356 return [list $xangle $yangle $zangle]1357 }1358 1359 # ----------------------------------------------------------------------1360 1010 # CONFIGURATION OPTION: -plotbackground 1361 1011 # ---------------------------------------------------------------------- 1362 1012 itcl::configbody Rappture::HeightmapViewer::plotbackground { 1363 foreach {r g b} [ _color2rgb$itk_option(-plotbackground)] break1013 foreach {r g b} [Color2RGB $itk_option(-plotbackground)] break 1364 1014 #fix this! 1365 #_send color background $r $g $b1015 #_send "color background $r $g $b" 1366 1016 } 1367 1017 … … 1370 1020 # ---------------------------------------------------------------------- 1371 1021 itcl::configbody Rappture::HeightmapViewer::plotforeground { 1372 foreach {r g b} [ _color2rgb$itk_option(-plotforeground)] break1022 foreach {r g b} [Color2RGB $itk_option(-plotforeground)] break 1373 1023 #fix this! 1374 #_send color background $r $g $b1024 #_send "color background $r $g $b" 1375 1025 } 1376 1026 … … 1380 1030 itcl::configbody Rappture::HeightmapViewer::plotoutline { 1381 1031 if {[isconnected]} { 1382 eval _send "grid" "linecolor" [_color2rgb $itk_option(-plotoutline)]1383 } 1384 } 1032 _send "grid linecolor [Color2RGB $itk_option(-plotoutline)]" 1033 } 1034 } -
trunk/gui/scripts/resources.tcl
r436 r909 45 45 variable optionParser 46 46 foreach {name proc} $args { 47 $optionParser alias $name $proc47 eval $optionParser alias $name $proc 48 48 } 49 49 }
Note: See TracChangeset
for help on using the changeset viewer.