Changeset 1342 for trunk/gui/scripts/heightmapviewer.tcl
- Timestamp:
- Mar 18, 2009, 2:59:21 PM (16 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/gui/scripts/heightmapviewer.tcl
r1313 r1342 32 32 proc HeightmapViewer_init_resources {} { 33 33 Rappture::resources::register \ 34 34 nanovis_server Rappture::HeightmapViewer::SetServerList 35 35 } 36 36 … … 43 43 44 44 constructor { hostlist args } { 45 45 Rappture::VisViewer::constructor $hostlist 46 46 } { 47 47 # defined below 48 48 } 49 49 destructor { 50 50 # defined below 51 51 } 52 52 53 53 public proc SetServerList { namelist } { 54 54 Rappture::VisViewer::SetServerList "nanovis" $namelist 55 55 } 56 56 public method add {dataobj {settings ""}} … … 60 60 public method download {option args} 61 61 public method parameters {title args} { 62 62 # do nothing 63 63 } 64 64 public method drawer {what who} … … 114 114 $_dispatcher register !legend 115 115 $_dispatcher dispatch $this !legend \ 116 116 "[itcl::code $this _fixSettings legend]; list" 117 117 # Send dataobjs event 118 118 $_dispatcher register !send_dataobjs 119 119 $_dispatcher dispatch $this !send_dataobjs \ 120 120 "[itcl::code $this _send_dataobjs]; list" 121 121 # Rebuild event 122 122 $_dispatcher register !rebuild … … 133 133 # Initialize the view to some default parameters. 134 134 array set view_ { 135 136 137 138 139 140 135 theta 45 136 phi 45 137 psi 0 138 zoom 1.0 139 pan-x 0 140 pan-y 0 141 141 } 142 142 set obj2id_(count) 0 143 143 144 144 itk_component add zoom { 145 145 frame $itk_component(controls).zoom 146 146 } { 147 148 147 usual 148 rename -background -controlbackground controlBackground Background 149 149 } 150 150 pack $itk_component(zoom) -side top 151 151 152 152 itk_component add reset { 153 154 155 156 153 button $itk_component(zoom).reset \ 154 -borderwidth 1 -padx 1 -pady 1 \ 155 -image [Rappture::icon reset-view] \ 156 -command [itcl::code $this _zoom reset] 157 157 } { 158 159 160 158 usual 159 ignore -borderwidth 160 rename -highlightbackground -controlbackground controlBackground Background 161 161 } 162 162 pack $itk_component(reset) -side top -padx 2 -pady { 2 0 } … … 164 164 165 165 itk_component add zoomin { 166 167 168 169 166 button $itk_component(zoom).zin \ 167 -borderwidth 1 -padx 1 -pady 1 \ 168 -image [Rappture::icon zoom-in] \ 169 -command [itcl::code $this _zoom in] 170 170 } { 171 172 173 171 usual 172 ignore -borderwidth 173 rename -highlightbackground -controlbackground controlBackground Background 174 174 } 175 175 pack $itk_component(zoomin) -side top -padx 2 -pady { 2 0 } … … 177 177 178 178 itk_component add zoomout { 179 180 181 182 179 button $itk_component(zoom).zout \ 180 -borderwidth 1 -padx 1 -pady 1 \ 181 -image [Rappture::icon zoom-out] \ 182 -command [itcl::code $this _zoom out] 183 183 } { 184 185 186 184 usual 185 ignore -borderwidth 186 rename -highlightbackground -controlbackground controlBackground Background 187 187 } 188 188 pack $itk_component(zoomout) -side top -padx 2 -pady { 2 0 } … … 190 190 191 191 itk_component add settings_button { 192 193 194 192 label $itk_component(controls).settingsbutton \ 193 -borderwidth 1 -padx 1 -pady 1 \ 194 -relief "raised" -image [Rappture::icon wrench] 195 195 } { 196 197 198 196 usual 197 ignore -borderwidth 198 rename -highlightbackground -controlbackground controlBackground \ 199 199 Background 200 200 } … … 204 204 "Configure settings" 205 205 bind $itk_component(settings_button) <ButtonPress> \ 206 206 [itcl::code $this drawer toggle settings] 207 207 pack $itk_component(settings_button) -side bottom \ 208 208 -padx 2 -pady 2 -anchor e 209 209 210 210 itk_component add camera_button { 211 212 213 211 label $itk_component(controls).camerabutton \ 212 -borderwidth 1 -padx 1 -pady 1 \ 213 -relief "raised" -image [Rappture::icon camera] 214 214 } { 215 216 217 215 usual 216 ignore -borderwidth 217 rename -highlightbackground -controlbackground controlBackground \ 218 218 Background 219 219 } … … 221 221 "Camera settings" 222 222 bind $itk_component(camera_button) <ButtonPress> \ 223 223 [itcl::code $this drawer toggle camera] 224 224 pack $itk_component(camera_button) -side bottom \ 225 225 -padx 2 -pady { 0 2 } -ipadx 1 -ipady 1 … … 231 231 set _image(legend) [image create photo] 232 232 itk_component add legend { 233 233 canvas $itk_component(area).legend -width 30 -highlightthickness 0 234 234 } { 235 236 237 235 usual 236 ignore -highlightthickness 237 rename -background -plotbackground plotBackground Background 238 238 } 239 239 pack $itk_component(legend) -side right -fill y 240 240 pack $itk_component(3dview) -side left -expand yes -fill both 241 241 bind $itk_component(legend) <Configure> \ 242 242 [list $_dispatcher event -idle !legend] 243 243 244 244 # Bindings for rotation via mouse 245 245 bind $itk_component(3dview) <ButtonPress-1> \ 246 246 [itcl::code $this _rotate click %x %y] 247 247 bind $itk_component(3dview) <B1-Motion> \ 248 248 [itcl::code $this _rotate drag %x %y] 249 249 bind $itk_component(3dview) <ButtonRelease-1> \ 250 250 [itcl::code $this _rotate release %x %y] 251 251 bind $itk_component(3dview) <Configure> \ 252 252 [itcl::code $this _send "screen %w %h"] 253 253 254 254 # Bindings for panning via mouse 255 255 bind $itk_component(3dview) <ButtonPress-2> \ 256 256 [itcl::code $this _pan click %x %y] 257 257 bind $itk_component(3dview) <B2-Motion> \ 258 258 [itcl::code $this _pan drag %x %y] 259 259 bind $itk_component(3dview) <ButtonRelease-2> \ 260 260 [itcl::code $this _pan release %x %y] 261 261 262 262 # Bindings for panning via keyboard 263 263 bind $itk_component(3dview) <KeyPress-Left> \ 264 264 [itcl::code $this _pan set -10 0] 265 265 bind $itk_component(3dview) <KeyPress-Right> \ 266 266 [itcl::code $this _pan set 10 0] 267 267 bind $itk_component(3dview) <KeyPress-Up> \ 268 268 [itcl::code $this _pan set 0 -10] 269 269 bind $itk_component(3dview) <KeyPress-Down> \ 270 270 [itcl::code $this _pan set 0 10] 271 271 bind $itk_component(3dview) <Shift-KeyPress-Left> \ 272 272 [itcl::code $this _pan set -2 0] 273 273 bind $itk_component(3dview) <Shift-KeyPress-Right> \ 274 274 [itcl::code $this _pan set 2 0] 275 275 bind $itk_component(3dview) <Shift-KeyPress-Up> \ 276 276 [itcl::code $this _pan set 0 -2] 277 277 bind $itk_component(3dview) <Shift-KeyPress-Down> \ 278 278 [itcl::code $this _pan set 0 2] 279 279 280 280 # Bindings for zoom via keyboard 281 281 bind $itk_component(3dview) <KeyPress-Prior> \ 282 282 [itcl::code $this _zoom out] 283 283 bind $itk_component(3dview) <KeyPress-Next> \ 284 284 [itcl::code $this _zoom in] 285 285 286 286 bind $itk_component(3dview) <Enter> "focus $itk_component(3dview)" 287 287 288 288 if {[string equal "x11" [tk windowingsystem]]} { 289 290 291 289 # Bindings for zoom via mouse 290 bind $itk_component(3dview) <4> [itcl::code $this _zoom out] 291 bind $itk_component(3dview) <5> [itcl::code $this _zoom in] 292 292 } 293 293 … … 320 320 itcl::body Rappture::HeightmapViewer::add {dataobj {settings ""}} { 321 321 array set params { 322 323 324 325 326 327 328 322 -color auto 323 -width 1 324 -linestyle solid 325 -brightness 0 326 -raise 0 327 -description "" 328 -param "" 329 329 } 330 330 foreach {opt val} $settings { 331 332 333 334 331 if {![info exists params($opt)]} { 332 error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]" 333 } 334 set params($opt) $val 335 335 } 336 336 if {$params(-color) == "auto" || $params(-color) == "autoreset"} { 337 338 337 # can't handle -autocolors yet 338 set params(-color) black 339 339 } 340 340 set location [$dataobj hints camera] … … 344 344 set pos [lsearch -exact $dataobj $dlist_] 345 345 if {$pos < 0} { 346 347 348 349 350 346 lappend dlist_ $dataobj 347 set obj2ovride_($dataobj-color) $params(-color) 348 set obj2ovride_($dataobj-width) $params(-width) 349 set obj2ovride_($dataobj-raise) $params(-raise) 350 $_dispatcher event -idle !rebuild 351 351 } 352 352 } … … 362 362 itcl::body Rappture::HeightmapViewer::get {args} { 363 363 if {[llength $args] == 0} { 364 364 set args "-objects" 365 365 } 366 366 … … 368 368 switch -- $op { 369 369 -objects { 370 371 372 373 374 375 376 377 378 379 380 381 382 370 # put the dataobj list in order according to -raise options 371 set dlist $dlist_ 372 foreach obj $dlist { 373 if { [info exists obj2ovride_($obj-raise)] && 374 $obj2ovride_($obj-raise)} { 375 set i [lsearch -exact $dlist $obj] 376 if {$i >= 0} { 377 set dlist [lreplace $dlist $i $i] 378 lappend dlist $obj 379 } 380 } 381 } 382 return $dlist 383 383 } 384 384 -image { 385 386 387 388 389 390 391 392 393 394 395 396 397 398 385 if {[llength $args] != 2} { 386 error "wrong # args: should be \"get -image 3dview|legend\"" 387 } 388 switch -- [lindex $args end] { 389 3dview { 390 return $_image(plot) 391 } 392 legend { 393 return $_image(legend) 394 } 395 default { 396 error "bad image name \"[lindex $args end]\": should be 3dview or legend" 397 } 398 } 399 399 } 400 400 default { 401 401 error "bad option \"$op\": should be -objects or -image" 402 402 } 403 403 } … … 412 412 itcl::body Rappture::HeightmapViewer::delete {args} { 413 413 if {[llength $args] == 0} { 414 414 set args $dlist_ 415 415 } 416 416 … … 418 418 set changed 0 419 419 foreach dataobj $args { 420 421 422 423 424 425 426 427 420 set pos [lsearch -exact $dlist_ $dataobj] 421 if {$pos >= 0} { 422 set dlist_ [lreplace $dlist_ $pos $pos] 423 foreach key [array names obj2ovride_ $dataobj-*] { 424 unset obj2ovride_($key) 425 } 426 set changed 1 427 } 428 428 } 429 429 430 430 # if anything changed, then rebuild the plot 431 431 if {$changed} { 432 432 $_dispatcher event -idle !rebuild 433 433 } 434 434 } … … 445 445 itcl::body Rappture::HeightmapViewer::scale {args} { 446 446 foreach val {xmin xmax ymin ymax zmin zmax vmin vmax} { 447 447 set limits_($val) "" 448 448 } 449 449 foreach obj $args { 450 451 452 453 454 455 456 457 458 459 460 461 462 463 450 foreach axis {x y z v} { 451 foreach {min max} [$obj limits $axis] break 452 if {"" != $min && "" != $max} { 453 if {"" == $limits_(${axis}min)} { 454 set limits_(${axis}min) $min 455 set limits_(${axis}max) $max 456 } else { 457 if {$min < $limits_(${axis}min)} { 458 set limits_(${axis}min) $min 459 } 460 if {$max > $limits_(${axis}max)} { 461 set limits_(${axis}max) $max 462 } 463 } 464 464 set limits_(${axis}range) [expr {$max - $min}] 465 466 465 } 466 } 467 467 } 468 468 } … … 480 480 itcl::body Rappture::HeightmapViewer::download {option args} { 481 481 switch $option { 482 coming { 483 if {[catch { 484 blt::winop snap $itk_component(area) $_image(download) 485 }]} { 486 $_image(download) configure -width 1 -height 1 487 $_image(download) put #000000 488 } 489 } 490 controls { 491 # no controls for this download yet 492 return "" 493 } 494 now { 495 # 496 # Hack alert! Need data in binary format, 497 # so we'll save to a file and read it back. 498 # 499 set tmpfile /tmp/image[pid].jpg 500 $_image(download) write $tmpfile -format jpeg 501 set fid [open $tmpfile r] 502 fconfigure $fid -encoding binary -translation binary 503 set bytes [read $fid] 504 close $fid 505 file delete -force $tmpfile 506 507 return [list .jpg $bytes] 508 } 509 default { 510 error "bad option \"$option\": should be coming, controls, now" 511 } 482 coming { 483 if {[catch { 484 blt::winop snap $itk_component(area) $_image(download) 485 }]} { 486 $_image(download) configure -width 1 -height 1 487 $_image(download) put #000000 488 } 489 } 490 controls { 491 # no controls for this download yet 492 return "" 493 } 494 now { 495 # Get image data (as base64) and decode back to binary. This is 496 # better than writing to temporary files. When we switch the BLT 497 # picture image it won't be necessary to decode the image data. 498 set bytes [$_image(download) data -format "jpeg -quality 100"] 499 set bytes [Rappture::encoding::decode -as b64 $bytes] 500 return [list .jpg $bytes] 501 } 502 default { 503 error "bad option \"$option\": should be coming, controls, now" 504 } 512 505 } 513 506 } … … 524 517 set _hosts [GetServerList "nanovis"] 525 518 if { "" == $_hosts } { 526 519 return 0 527 520 } 528 521 set result [VisViewer::Connect $_hosts] … … 557 550 itcl::body Rappture::HeightmapViewer::_send {string} { 558 551 if {[llength $sendobjs_] > 0} { 559 552 append outbuf_ $string "\n" 560 553 } else { 561 562 563 564 565 554 if {[SendBytes $string]} { 555 foreach line [split $string \n] { 556 SendEcho >>line $line 557 } 558 } 566 559 } 567 560 } … … 579 572 # Reset the overall limits 580 573 if { $sendobjs_ != "" } { 581 582 574 set limits_(vmin) "" 575 set limits_(vmax) "" 583 576 } 584 577 foreach dataobj $sendobjs_ { 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 578 foreach comp [$dataobj components] { 579 set data [$dataobj blob $comp] 580 581 foreach { vmin vmax } [$dataobj limits v] break 582 if { $limits_(vmin) == "" || $vmin < $limits_(vmin) } { 583 set limits_(vmin) $vmin 584 } 585 if { $limits_(vmax) == "" || $vmax > $limits_(vmax) } { 586 set limits_(vmax) $vmax 587 } 588 589 # tell the engine to expect some data 590 set nbytes [string length $data] 591 if { ![SendBytes "heightmap data follows $nbytes"] } { 592 return 593 594 } 595 if { ![SendBytes $data] } { 596 return 597 } 598 set id $obj2id_(count) 599 incr obj2id_(count) 600 set id2obj_($id) [list $dataobj $comp] 601 set obj2id_($dataobj-$comp) $id 602 set receiveIds_($id) 1 603 604 # 605 # Determine the transfer function needed for this volume 606 # and make sure that it's defined on the server. 607 # 608 foreach {sname cmap wmap} [_getTransfuncData $dataobj $comp] break 609 set cmdstr [list "transfunc" "define" $sname $cmap $wmap] 610 if {![SendBytes $cmdstr]} { 611 return 612 } 613 set obj2style_($dataobj-$comp) $sname 614 } 622 615 } 623 616 set sendobjs_ "" … … 627 620 set first [lindex [get] 0] 628 621 if {"" != $first} { 629 630 631 632 622 set axis [$first hints updir] 623 if {"" != $axis} { 624 _send "up $axis" 625 } 633 626 } 634 627 635 628 foreach key [array names obj2id_ *-*] { 636 637 638 639 640 629 set state [string match $first-* $key] 630 _send "heightmap data visible $state $obj2id_($key)" 631 if {[info exists obj2style_($key)]} { 632 _send "heightmap transfunc $obj2style_($key) $obj2id_($key)" 633 } 641 634 } 642 635 … … 657 650 itcl::body Rappture::HeightmapViewer::ReceiveImage {option size} { 658 651 if {[IsConnected]} { 659 660 661 652 set bytes [ReceiveBytes $size] 653 $_image(plot) configure -data $bytes 654 ReceiveEcho <<line "<read $size bytes for [image width $_image(plot)]x[image height $_image(plot)] image>" 662 655 } 663 656 } … … 672 665 itcl::body Rappture::HeightmapViewer::_ReceiveLegend {tf vmin vmax size} { 673 666 if { [IsConnected] } { 674 675 667 set bytes [ReceiveBytes $size] 668 ReceiveEcho <<line "<read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>" 676 669 if 1 { 677 670 set src [image create photo -data $bytes] … … 681 674 $_image(legend) configure -data $bytes 682 675 } 683 684 685 676 set c $itk_component(legend) 677 set w [winfo width $c] 678 set h [winfo height $c] 686 679 set lineht [expr [font metrics $itk_option(-font) -linespace] + 4] 687 688 689 690 691 692 693 694 680 if {"" == [$c find withtag transfunc]} { 681 $c create image 0 [expr $lineht] -anchor ne \ 682 -image $_image(legend) -tags transfunc 683 $c create text 10 [expr {$h-8}] -anchor se \ 684 -fill $itk_option(-plotforeground) -tags vmin 685 $c create text [expr {$w-10}] [expr {$h-8}] -anchor ne \ 686 -fill $itk_option(-plotforeground) -tags vmax 687 } 695 688 $c coords transfunc [expr $w - 5] [expr $lineht] 696 697 698 699 689 $c itemconfigure vmin -text $vmin 690 $c itemconfigure vmax -text $vmax 691 $c coords vmax [expr $w - 5] 2 692 $c coords vmin [expr $w - 5] [expr $h - 2] 700 693 } 701 694 } … … 711 704 # in the midst of sending data? then bail out 712 705 if {[llength $sendobjs_] > 0} { 713 706 return 714 707 } 715 708 # Find any new data that needs to be sent to the server. Queue this up on … … 717 710 # before we rebuild the rest. 718 711 foreach dataobj [get] { 719 720 721 722 723 724 725 712 set comp [lindex [$dataobj components] 0] 713 if {![info exists obj2id_($dataobj-$comp)]} { 714 set i [lsearch -exact $sendobjs_ $dataobj] 715 if {$i < 0} { 716 lappend sendobjs_ $dataobj 717 } 718 } 726 719 } 727 720 if {[llength $sendobjs_] > 0} { 728 729 721 # Send off new data objects 722 $_dispatcher event -idle !send_dataobjs 730 723 } else { 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 724 # Nothing to send -- activate the proper volume 725 set first [lindex [get] 0] 726 if {"" != $first} { 727 set axis [$first hints updir] 728 if {"" != $axis} { 729 _send "up $axis" 730 } 731 } 732 foreach key [array names obj2id_ *-*] { 733 set state [string match $first-* $key] 734 _send "heightmap data visible $state $obj2id_($key)" 735 if {[info exists obj2style_($key)]} { 736 _send "heightmap transfunc $obj2style_($key) $obj2id_($key)" 737 } 738 } 739 $_dispatcher event -idle !legend 747 740 } 748 741 … … 759 752 760 753 if {"" == $itk_option(-plotoutline)} { 761 754 _send "grid linecolor [Color2RGB $itk_option(-plotoutline)]" 762 755 } 763 756 set settings_($this-theta) $view_(theta) … … 784 777 itcl::body Rappture::HeightmapViewer::_zoom {option} { 785 778 switch -- $option { 786 787 779 "in" { 780 set view_(zoom) [expr {$view_(zoom)*1.25}] 788 781 set settings_($this-zoom) $view_(zoom) 789 790 791 782 } 783 "out" { 784 set view_(zoom) [expr {$view_(zoom)*0.8}] 792 785 set settings_($this-zoom) $view_(zoom) 793 794 795 796 797 798 799 786 } 787 "reset" { 788 array set view_ { 789 theta 45 790 phi 45 791 psi 0 792 zoom 1.0 800 793 pan-x 0 801 794 pan-y 0 802 795 } 803 796 set first [lindex [get] 0] 804 797 if { $first != "" } { … … 808 801 } 809 802 } 810 811 812 803 set xyz [Euler2XYZ $view_(theta) $view_(phi) $view_(psi)] 804 _send "camera angle $xyz" 805 _PanCamera 813 806 set settings_($this-theta) $view_(theta) 814 807 set settings_($this-phi) $view_(phi) … … 817 810 set settings_($this-pan-y) $view_(pan-y) 818 811 set settings_($this-zoom) $view_(zoom) 819 812 } 820 813 } 821 814 _send "camera zoom $view_(zoom)" … … 842 835 set settings_($this-pan-x) $view_(pan-x) 843 836 set settings_($this-pan-y) $view_(pan-y) 844 837 return 845 838 } 846 839 if { $option == "click" } { 847 848 849 840 set click_(x) $x 841 set click_(y) $y 842 $itk_component(3dview) configure -cursor hand1 850 843 } 851 844 if { $option == "drag" || $option == "release" } { … … 861 854 } 862 855 if { $option == "release" } { 863 856 $itk_component(3dview) configure -cursor "" 864 857 } 865 858 } … … 881 874 itcl::body Rappture::HeightmapViewer::_rotate {option x y} { 882 875 switch -- $option { 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 876 click { 877 $itk_component(3dview) configure -cursor fleur 878 array set click_ [subst { 879 x $x 880 y $y 881 theta $view_(theta) 882 phi $view_(phi) 883 }] 884 } 885 drag { 886 if {[array size click_] == 0} { 887 _rotate click $x $y 888 } else { 889 set w [winfo width $itk_component(3dview)] 890 set h [winfo height $itk_component(3dview)] 891 if {$w <= 0 || $h <= 0} { 892 return 893 } 894 895 if {[catch { 896 # this fails sometimes for no apparent reason 897 set dx [expr {double($x-$click_(x))/$w}] 898 set dy [expr {double($y-$click_(y))/$h}] 899 }] != 0 } { 900 return 901 } 902 903 # 904 # Rotate the camera in 3D 905 # 906 if {$view_(psi) > 90 || $view_(psi) < -90} { 907 # when psi is flipped around, theta moves backwards 908 set dy [expr {-$dy}] 909 } 910 set theta [expr {$view_(theta) - $dy*180}] 911 while {$theta < 0} { set theta [expr {$theta+180}] } 912 while {$theta > 180} { set theta [expr {$theta-180}] } 913 914 if {abs($theta) >= 30 && abs($theta) <= 160} { 915 set phi [expr {$view_(phi) - $dx*360}] 916 while {$phi < 0} { set phi [expr {$phi+360}] } 917 while {$phi > 360} { set phi [expr {$phi-360}] } 918 set psi $view_(psi) 919 } else { 920 set phi $view_(phi) 921 set psi [expr {$view_(psi) - $dx*360}] 922 while {$psi < -180} { set psi [expr {$psi+360}] } 923 while {$psi > 180} { set psi [expr {$psi-360}] } 924 } 925 926 set view_(theta) $theta 927 set view_(phi) $phi 928 set view_(psi) $psi 929 set xyz [Euler2XYZ $view_(theta) $view_(phi) $view_(psi)] 937 930 set settings_($this-theta) $view_(theta) 938 931 set settings_($this-phi) $view_(phi) 939 932 set settings_($this-psi) $view_(psi) 940 941 942 943 944 945 946 947 948 949 950 951 952 933 _send "camera angle $xyz" 934 set click_(x) $x 935 set click_(y) $y 936 } 937 } 938 release { 939 _rotate drag $x $y 940 $itk_component(3dview) configure -cursor "" 941 catch {unset click_} 942 } 943 default { 944 error "bad option \"$option\": should be click, drag, release" 945 } 953 946 } 954 947 } … … 963 956 itcl::body Rappture::HeightmapViewer::_state {comp} { 964 957 if {[$itk_component($comp) cget -relief] == "sunken"} { 965 958 return "on" 966 959 } 967 960 return "off" … … 977 970 itcl::body Rappture::HeightmapViewer::_fixSettings { what {value ""} } { 978 971 switch -- $what { 979 972 "legend" { 980 973 if { $settings_($this-legend) } { 981 974 pack $itk_component(legend) -side right -fill y … … 983 976 pack forget $itk_component(legend) 984 977 } 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 978 set lineht [expr [font metrics $itk_option(-font) -linespace] + 4] 979 set w [expr {[winfo height $itk_component(legend)] - 2*$lineht}] 980 set h [expr {[winfo width $itk_component(legend)] - 16}] 981 set imap "" 982 set dataobj [lindex [get] 0] 983 if {"" != $dataobj} { 984 set comp [lindex [$dataobj components] 0] 985 if {[info exists obj2id_($dataobj-$comp)]} { 986 set imap $obj2id_($dataobj-$comp) 987 } 988 } 989 if {$w > 0 && $h > 0 && "" != $imap} { 990 _send "heightmap legend $imap $w $h" 991 } else { 992 $itk_component(legend) delete all 993 } 994 } 995 "grid" { 996 if { [IsConnected] } { 997 _send "grid visible $settings_($this-grid)" 998 } 999 } 1000 "axes" { 1001 if { [IsConnected] } { 1002 _send "axis visible $settings_($this-axes)" 1003 } 1004 } 1005 "wireframe" { 1006 if { [IsConnected] } { 1007 _send "heightmap polygon $settings_($this-wireframe)" 1008 } 1009 } 1010 "contourlines" { 1011 if {[IsConnected]} { 1012 set dataobj [lindex [get] 0] 1013 if {"" != $dataobj} { 1014 set comp [lindex [$dataobj components] 0] 1015 if {[info exists obj2id_($dataobj-$comp)]} { 1016 set i $obj2id_($dataobj-$comp) 1017 set bool $settings_($this-contourlines) 1018 _send "heightmap linecontour visible $bool $i" 1019 } 1020 } 1021 } 1022 } 1023 default { 1024 error "don't know how to fix $what: should be grid, axes, contourlines, or legend" 1025 } 1033 1026 } 1034 1027 } … … 1043 1036 itcl::body Rappture::HeightmapViewer::_getTransfuncData {dataobj comp} { 1044 1037 array set style { 1045 1046 1047 1038 -color rainbow 1039 -levels 6 1040 -opacity 0.5 1048 1041 } 1049 1042 array set style [lindex [$dataobj components -style $comp] 0] … … 1051 1044 1052 1045 if {$style(-color) == "rainbow"} { 1053 1046 set style(-color) "white:yellow:green:cyan:blue:magenta" 1054 1047 } 1055 1048 set clist [split $style(-color) :] … … 1058 1051 set range [expr $limits_(vmax) - $limits_(vmin)] 1059 1052 for {set i 0} {$i < [llength $clist]} {incr i} { 1060 1061 1062 1053 set xval [expr {double($i+1)/([llength $clist]+1)}] 1054 set color [lindex $clist $i] 1055 append cmap "$xval [Color2RGB $color] " 1063 1056 } 1064 1057 append cmap "1.0 [Color2RGB $color] " … … 1068 1061 set wmap {} 1069 1062 if {[string is int $levels]} { 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1063 lappend wmap 0.0 0.0 1064 set delta [expr {0.125/($levels+1)}] 1065 for {set i 1} {$i <= $levels} {incr i} { 1066 # add spikes in the middle 1067 set xval [expr {double($i)/($levels+1)}] 1068 lappend wmap [expr {$xval-$delta-0.01}] 0.0 1069 lappend wmap [expr {$xval-$delta}] $opacity 1070 lappend wmap [expr {$xval+$delta}] $opacity 1071 lappend wmap [expr {$xval+$delta+0.01}] 0.0 1072 } 1073 lappend wmap 1.0 0.0 1081 1074 } else { 1082 1083 1084 1085 1086 1087 1088 1089 1075 lappend wmap 0.0 0.0 1076 set delta 0.05 1077 foreach xval [split $levels ,] { 1078 lappend wmap [expr {$xval-$delta}] 0.0 1079 lappend $xval $opacity 1080 lappend [expr {$xval+$delta}] 0.0 1081 } 1082 lappend wmap 1.0 0.0 1090 1083 } 1091 1084 return [list $sname $cmap $wmap] … … 1115 1108 itcl::configbody Rappture::HeightmapViewer::plotoutline { 1116 1109 if {[IsConnected]} { 1117 1110 _send "grid linecolor [Color2RGB $itk_option(-plotoutline)]" 1118 1111 } 1119 1112 } … … 1193 1186 label $inner.title -text "View Settings" -font "Arial 10 bold" 1194 1187 checkbutton $inner.grid \ 1195 1196 1197 1188 -text "grid" \ 1189 -variable [itcl::scope settings_($this-grid)] \ 1190 -command [itcl::code $this _fixSettings grid] \ 1198 1191 -font "Arial 9" 1199 1192 checkbutton $inner.axes \ 1200 1201 1202 1193 -text "axes" \ 1194 -variable ::Rappture::HeightmapViewer::settings_($this-axes) \ 1195 -command [itcl::code $this _fixSettings axes] \ 1203 1196 -font "Arial 9" 1204 1197 checkbutton $inner.contourlines \ 1205 1206 1207 1198 -text "contour lines" \ 1199 -variable ::Rappture::HeightmapViewer::settings_($this-contourlines) \ 1200 -command [itcl::code $this _fixSettings contourlines]\ 1208 1201 -font "Arial 9" 1209 1202 checkbutton $inner.wireframe \ 1210 1203 -text "wireframe" \ 1211 1204 -onvalue "wireframe" -offvalue "fill" \ 1212 1213 1205 -variable ::Rappture::HeightmapViewer::settings_($this-wireframe) \ 1206 -command [itcl::code $this _fixSettings wireframe]\ 1214 1207 -font "Arial 9" 1215 1208 checkbutton $inner.legend \ 1216 1217 1218 1209 -text "legend" \ 1210 -variable ::Rappture::HeightmapViewer::settings_($this-legend) \ 1211 -command [itcl::code $this _fixSettings legend]\ 1219 1212 -font "Arial 9" 1220 1213
Note: See TracChangeset
for help on using the changeset viewer.