Changeset 3029 for branches/blt4
- Timestamp:
- Jun 10, 2012, 9:04:26 PM (12 years ago)
- Location:
- branches/blt4/gui/scripts
- Files:
-
- 1 added
- 8 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/blt4/gui/scripts/Makefile.in
r2988 r3029 45 45 $(srcdir)/drawingentry.tcl \ 46 46 $(srcdir)/drawingcontrols.tcl \ 47 $(srcdir)/drawingentry.tcl \ 47 48 $(srcdir)/dropdown.tcl \ 48 49 $(srcdir)/dropdownlist.tcl \ … … 97 98 $(srcdir)/resources.tcl \ 98 99 $(srcdir)/resultset.tcl \ 100 $(srcdir)/resultselector.tcl \ 99 101 $(srcdir)/resultviewer.tcl \ 100 102 $(srcdir)/scroller.tcl \ -
branches/blt4/gui/scripts/analyzer.tcl
r3025 r3029 59 59 public method reset {{when -eventually}} 60 60 public method load {xmlobj} 61 public method clear {{xmlobj " "}}61 public method clear {{xmlobj "all"}} 62 62 public method download {option args} 63 63 … … 66 66 protected method _autoLabel {xmlobj path title cntVar} 67 67 protected method _fixResult {} 68 protected method _fixResultSet {args} 68 69 protected method _fixSize {} 69 70 protected method _fixSimControl {} … … 81 82 private variable _appName "" ;# Name of application 82 83 private variable _control "manual" ;# start mode 83 private variable _r uns "" ;# list of XML objects withresults84 private variable _resultset "" ;# ResultSet object with all results 84 85 private variable _pages 0 ;# number of pages for result sets 85 86 private variable _label2page ;# maps output label => result set … … 104 105 set _tool $tool 105 106 107 # use this to store all simulation results 108 set _resultset [Rappture::ResultSet ::#auto] 109 $_resultset notify add $this [itcl::code $this _fixResultSet] 110 111 # widget settings... 106 112 itk_option add hull.width hull.height 107 113 pack propagate $itk_component(hull) no … … 267 273 pack $w.top.l -side left 268 274 269 itk_component add resultselector {275 itk_component add viewselector { 270 276 Rappture::Combobox $w.top.sel -width 10 -editable no 271 277 } { … … 273 279 rename -font -textfont textFont Font 274 280 } 275 pack $itk_component( resultselector) -side left -expand yes -fill x276 bind $itk_component( resultselector) <<Value>> [itcl::code $this _fixResult]277 bind $itk_component( resultselector) <Enter> \281 pack $itk_component(viewselector) -side left -expand yes -fill x 282 bind $itk_component(viewselector) <<Value>> [itcl::code $this _fixResult] 283 bind $itk_component(viewselector) <Enter> \ 278 284 [itcl::code $this download coming] 279 285 280 Rappture::Tooltip::for $itk_component( resultselector) \286 Rappture::Tooltip::for $itk_component(viewselector) \ 281 287 "@[itcl::code $this _resultTooltip]" 282 288 283 $itk_component( resultselector) choices insert end \289 $itk_component(viewselector) choices insert end \ 284 290 --- "---" 285 291 … … 293 299 [itcl::code $this download coming] 294 300 295 $itk_component( resultselector) choices insert end \301 $itk_component(viewselector) choices insert end \ 296 302 @download [Rappture::filexfer::label download] 297 303 … … 316 322 317 323 set f [$itk_component(results) insert end -fraction 0.1] 318 itk_component add resultset { 319 Rappture::ResultSet $f.rset \ 320 -clearcommand [itcl::code $this clear] \ 321 -settingscommand [itcl::code $this _plot] \ 322 -promptcommand [itcl::code $this _simState] 323 } 324 pack $itk_component(resultset) -expand yes -fill both 325 bind $itk_component(resultset) <<Control>> [itcl::code $this _fixSize] 324 itk_component add resultselector { 325 Rappture::ResultSelector $f.rsel -resultset $_resultset \ 326 -settingscommand [itcl::code $this _plot] 327 } 328 pack $itk_component(resultselector) -expand yes -fill both 329 bind $itk_component(resultselector) <<Layout>> [itcl::code $this _fixSize] 326 330 bind $itk_component(results) <Configure> [itcl::code $this _fixSize] 327 331 … … 367 371 # ---------------------------------------------------------------------- 368 372 itcl::body Rappture::Analyzer::destructor {} { 369 foreach obj $_runs {370 itcl::delete object $obj371 }372 373 after cancel [itcl::code $this simulate] 374 itcl::delete object $_resultset 373 375 } 374 376 … … 387 389 # check to see if simulation is really needed 388 390 $_tool sync 389 if {[$ itk_component(resultset)contains [$_tool xml object]]391 if {[$_resultset contains [$_tool xml object]] 390 392 && ![string equal $_control "manual-resim"]} { 391 393 # not needed -- show results and return … … 475 477 # check to see if simulation is really needed 476 478 $_tool sync 477 if {![$ itk_component(resultset)contains [$_tool xml object]]479 if {![$_resultset contains [$_tool xml object]] 478 480 || [string equal $_control "manual-resim"]} { 479 481 # if control mode is "auto", then simulate right away … … 532 534 } 533 535 534 lappend _runs $xmlobj 535 536 # Detect molecule elements that contain trajectory data and convert 537 # to sequences. 538 _trajToSequence $xmlobj output 539 540 # Go through the analysis and find all result sets. 541 set haveresults 0 542 foreach item [_reorder [$xmlobj children output]] { 543 switch -glob -- $item { 544 log* { 545 _autoLabel $xmlobj output.$item "Output Log" counters 546 } 547 number* { 548 _autoLabel $xmlobj output.$item "Number" counters 549 } 550 integer* { 551 _autoLabel $xmlobj output.$item "Integer" counters 552 } 553 string* { 554 _autoLabel $xmlobj output.$item "String" counters 555 } 556 histogram* - curve* - field* { 557 _autoLabel $xmlobj output.$item "Plot" counters 558 } 559 drawing* { 560 _autoLabel $xmlobj output.$item "Drawing" counters 561 } 562 structure* { 563 _autoLabel $xmlobj output.$item "Structure" counters 564 } 565 table* { 566 _autoLabel $xmlobj output.$item "Energy Levels" counters 567 } 568 sequence* { 569 _autoLabel $xmlobj output.$item "Sequence" counters 570 } 571 default { 572 if 0 { 573 puts stderr "unknown output $item" 574 } 575 } 576 } 577 set label [$xmlobj get output.$item.about.group] 578 if {"" == $label} { 579 set label [$xmlobj get output.$item.about.label] 580 } 581 582 set hidden [$xmlobj get output.$item.hide] 583 set hidden [expr {"" != $hidden && $hidden}] 584 585 if {"" != $label && !$hidden} { 586 set haveresults 1 587 } 588 } 589 # if there are any valid results, add them to the resultset 590 if {$haveresults} { 591 set index [$itk_component(resultset) add $xmlobj] 592 593 # add each result to a result viewer 594 foreach item [_reorder [$xmlobj children output]] { 595 set label [$xmlobj get output.$item.about.group] 596 if {"" == $label} { 597 set label [$xmlobj get output.$item.about.label] 598 } 599 set hidden [$xmlobj get output.$item.hide] 600 if { $hidden == "" } { 601 set hidden 0 602 } 603 if {"" != $label && !$hidden} { 604 if {![info exists _label2page($label)]} { 605 set name "page[incr _pages]" 606 set page [$itk_component(resultpages) insert end $name] 607 set _label2page($label) $page 608 set _label2desc($label) \ 609 [$xmlobj get output.$item.about.description] 610 Rappture::ResultViewer $page.rviewer 611 pack $page.rviewer -expand yes -fill both -pady 4 612 613 set end [$itk_component(resultselector) \ 614 choices index -value ---] 615 if {$end < 0} { 616 set end "end" 617 } 618 $itk_component(resultselector) choices insert $end \ 619 $name $label 620 } 621 622 # add/replace the latest result into this viewer 623 set page $_label2page($label) 624 625 if {![info exists reset($page)]} { 626 $page.rviewer clear $index 627 set reset($page) 1 628 } 629 $page.rviewer add $index $xmlobj output.$item 630 } 631 } 632 } 633 634 # show the first page by default 635 set max [$itk_component(resultselector) choices size] 636 for {set i 0} {$i < $max} {incr i} { 637 set first [$itk_component(resultselector) choices get -label $i] 638 if {$first != ""} { 639 set page [$itk_component(resultselector) choices get -value $i] 640 set char [string index $page 0] 641 if {$char != "@" && $char != "-"} { 642 $itk_component(resultpages) current $page 643 $itk_component(resultselector) value $first 644 set _lastlabel $first 645 break 646 } 647 } 648 } 536 $_resultset add $xmlobj 537 538 # NOTE: Adding will trigger a !change event on the ResultSet 539 # object, which will trigger calls to _fixResultSet to add 540 # the results to display. 649 541 } 650 542 … … 656 548 # Otherwise, all results are cleared. 657 549 # ---------------------------------------------------------------------- 658 itcl::body Rappture::Analyzer::clear {{xmlobj ""}} { 659 if {$xmlobj ne ""} { 660 set i [lsearch -exact $_runs $xmlobj] 661 if {$i >= 0} { 662 itcl::delete object $xmlobj 663 set _runs [lreplace $_runs $i $i] 664 665 # delete this result from all viewers 666 foreach label [array names _label2page] { 667 set page $_label2page($label) 668 $page.rviewer clear $xmlobj 669 } 670 } 550 itcl::body Rappture::Analyzer::clear {{xmlobj "all"}} { 551 if {$xmlobj eq "" || $xmlobj eq "all"} { 552 $_resultset clear 671 553 } else { 672 # clear everything 673 foreach obj $_runs { 674 itcl::delete object $obj 675 } 676 set _runs "" 677 } 678 679 if {[llength $_runs] == 0} { 680 # reset the size of the controls area 681 set ht [winfo height $itk_component(results)] 682 set cntlht [$itk_component(resultset) size -controlarea] 683 set frac [expr {double($cntlht)/$ht}] 684 $itk_component(results) fraction end $frac 685 686 foreach label [array names _label2page] { 687 set page $_label2page($label) 688 destroy $page.rviewer 689 } 690 $itk_component(resultselector) value "" 691 $itk_component(resultselector) choices delete 0 end 692 catch {unset _label2page} 693 catch {unset _label2desc} 694 set _plotlist "" 695 696 $itk_component(resultselector) choices insert end --- "---" 697 $itk_component(resultselector) choices insert end \ 698 @download [Rappture::filexfer::label download] 699 set _lastlabel "" 700 } 701 702 # 703 # HACK ALERT!! 704 # The following statement should be in place, but it causes 705 # vtk to dump core. Leave it out until we can fix the core dump. 706 # In the mean time, we leak memory... 707 # 708 #$itk_component(resultpages) delete -all 709 #set _pages 0 710 711 _simState on 712 _fixSimControl 713 reset 554 $_resultset clear $xmlobj 555 } 556 557 # NOTE: Clearing will trigger a !change event on the ResultSet 558 # object, which will trigger calls to _fixResultSet to clean up 559 # the results being displayed. 714 560 } 715 561 … … 723 569 # ---------------------------------------------------------------------- 724 570 itcl::body Rappture::Analyzer::download {option args} { 725 set title [$itk_component( resultselector) value]726 set page [$itk_component( resultselector) translate $title]571 set title [$itk_component(viewselector) value] 572 set page [$itk_component(viewselector) translate $title] 727 573 728 574 switch -- $option { … … 784 630 set ext "" 785 631 set f [$itk_component(resultpages) page $page] 786 set item [$itk_component( resultselector) value]632 set item [$itk_component(viewselector) value] 787 633 set result [$f.rviewer download now $widget $_appName $item] 788 634 if { $result == "" } { … … 820 666 # 821 667 # Used internally to update the plot shown in the current result 822 # viewer whenever the resultse tsettings have changed. Causes the668 # viewer whenever the resultselector settings have changed. Causes the 823 669 # desired results to show up on screen. 824 670 # ---------------------------------------------------------------------- … … 826 672 set _plotlist $args 827 673 828 set page [$itk_component( resultselector) value]829 set page [$itk_component( resultselector) translate $page]674 set page [$itk_component(viewselector) value] 675 set page [$itk_component(viewselector) translate $page] 830 676 if {"" != $page} { 831 677 set f [$itk_component(resultpages) page $page] … … 906 752 # ---------------------------------------------------------------------- 907 753 itcl::body Rappture::Analyzer::_fixResult {} { 908 set name [$itk_component( resultselector) value]754 set name [$itk_component(viewselector) value] 909 755 set page "" 910 756 if {"" != $name} { 911 set page [$itk_component( resultselector) translate $name]757 set page [$itk_component(viewselector) translate $name] 912 758 } 913 759 if {$page == "@download"} { 914 760 # put the combobox back to its last value 915 $itk_component( resultselector) component entry configure -state normal916 $itk_component( resultselector) component entry delete 0 end917 $itk_component( resultselector) component entry insert end $_lastlabel918 $itk_component( resultselector) component entry configure -state disabled761 $itk_component(viewselector) component entry configure -state normal 762 $itk_component(viewselector) component entry delete 0 end 763 $itk_component(viewselector) component entry insert end $_lastlabel 764 $itk_component(viewselector) component entry configure -state disabled 919 765 # perform the actual download 920 766 download start $itk_component(download) 921 767 } elseif {$page == "---"} { 922 768 # put the combobox back to its last value 923 $itk_component( resultselector) component entry configure -state normal924 $itk_component( resultselector) component entry delete 0 end925 $itk_component( resultselector) component entry insert end $_lastlabel926 $itk_component( resultselector) component entry configure -state disabled769 $itk_component(viewselector) component entry configure -state normal 770 $itk_component(viewselector) component entry delete 0 end 771 $itk_component(viewselector) component entry insert end $_lastlabel 772 $itk_component(viewselector) component entry configure -state disabled 927 773 } elseif {$page != ""} { 928 774 set _lastlabel $name … … 939 785 940 786 # ---------------------------------------------------------------------- 787 # USAGE: _fixResultSet ?<eventData>...? 788 # 789 # Used internally to react to changes within the ResultSet. When a 790 # result is added, a new result viewer is created for the object. 791 # When all results are cleared, the viewers are deleted. 792 # ---------------------------------------------------------------------- 793 itcl::body Rappture::Analyzer::_fixResultSet {args} { 794 array set eventData $args 795 switch -- $eventData(op) { 796 add { 797 set xmlobj $eventData(what) 798 799 # Detect molecule elements that contain trajectory data 800 # and convert to sequences. 801 _trajToSequence $xmlobj output 802 803 # Go through the analysis and find all result sets. 804 set haveresults 0 805 foreach item [_reorder [$xmlobj children output]] { 806 switch -glob -- $item { 807 log* { 808 _autoLabel $xmlobj output.$item "Output Log" counters 809 } 810 number* { 811 _autoLabel $xmlobj output.$item "Number" counters 812 } 813 integer* { 814 _autoLabel $xmlobj output.$item "Integer" counters 815 } 816 string* { 817 _autoLabel $xmlobj output.$item "String" counters 818 } 819 histogram* - curve* - field* { 820 _autoLabel $xmlobj output.$item "Plot" counters 821 } 822 drawing* { 823 _autoLabel $xmlobj output.$item "Drawing" counters 824 } 825 structure* { 826 _autoLabel $xmlobj output.$item "Structure" counters 827 } 828 table* { 829 _autoLabel $xmlobj output.$item "Energy Levels" counters 830 } 831 sequence* { 832 _autoLabel $xmlobj output.$item "Sequence" counters 833 } 834 } 835 set label [$xmlobj get output.$item.about.group] 836 if {"" == $label} { 837 set label [$xmlobj get output.$item.about.label] 838 } 839 840 set hidden [$xmlobj get output.$item.hide] 841 set hidden [expr {"" != $hidden && $hidden}] 842 843 if {"" != $label && !$hidden} { 844 set haveresults 1 845 } 846 } 847 848 # if there are any valid results, add them to the resultset 849 if {$haveresults} { 850 set index [$_resultset get simnum $xmlobj] 851 852 # add each result to a result viewer 853 foreach item [_reorder [$xmlobj children output]] { 854 set label [$xmlobj get output.$item.about.group] 855 if {"" == $label} { 856 set label [$xmlobj get output.$item.about.label] 857 } 858 set hidden [$xmlobj get output.$item.hide] 859 if { $hidden == "" } { 860 set hidden 0 861 } 862 if {"" != $label && !$hidden} { 863 if {![info exists _label2page($label)]} { 864 set name "page[incr _pages]" 865 set page [$itk_component(resultpages) \ 866 insert end $name] 867 set _label2page($label) $page 868 set _label2desc($label) \ 869 [$xmlobj get output.$item.about.description] 870 Rappture::ResultViewer $page.rviewer 871 pack $page.rviewer -expand yes -fill both -pady 4 872 873 set end [$itk_component(viewselector) \ 874 choices index -value ---] 875 if {$end < 0} { 876 set end "end" 877 } 878 $itk_component(viewselector) choices insert $end \ 879 $name $label 880 } 881 882 # add/replace the latest result into this viewer 883 set page $_label2page($label) 884 885 if {![info exists reset($page)]} { 886 $page.rviewer clear $index 887 set reset($page) 1 888 } 889 $page.rviewer add $index $xmlobj output.$item 890 } 891 } 892 } 893 894 # show the first page by default 895 set max [$itk_component(viewselector) choices size] 896 for {set i 0} {$i < $max} {incr i} { 897 set first [$itk_component(viewselector) choices get -label $i] 898 if {$first != ""} { 899 set page [$itk_component(viewselector) choices get -value $i] 900 set char [string index $page 0] 901 if {$char != "@" && $char != "-"} { 902 $itk_component(resultpages) current $page 903 $itk_component(viewselector) value $first 904 set _lastlabel $first 905 break 906 } 907 } 908 } 909 } 910 clear { 911 set xmlobj $eventData(what) 912 if {$xmlobj ne "all"} { 913 # delete this result from all viewers 914 foreach label [array names _label2page] { 915 set page $_label2page($label) 916 $page.rviewer clear $xmlobj 917 } 918 } 919 920 if {[$_resultset size] == 0} { 921 # reset the size of the controls area 922 set ht [winfo height $itk_component(results)] 923 set cntlht [$itk_component(resultselector) size -controlarea] 924 set frac [expr {double($cntlht)/$ht}] 925 $itk_component(results) fraction end $frac 926 927 foreach label [array names _label2page] { 928 set page $_label2page($label) 929 destroy $page.rviewer 930 } 931 $itk_component(resultpages) delete -all 932 set _pages 0 933 934 $itk_component(viewselector) value "" 935 $itk_component(viewselector) choices delete 0 end 936 catch {unset _label2page} 937 catch {unset _label2desc} 938 set _plotlist "" 939 940 $itk_component(viewselector) choices insert end --- "---" 941 $itk_component(viewselector) choices insert end \ 942 @download [Rappture::filexfer::label download] 943 set _lastlabel "" 944 } 945 946 # fix Simulate button state 947 reset 948 } 949 default { 950 error "don't know how to handle op \"$eventData(op)\"" 951 } 952 } 953 } 954 955 # ---------------------------------------------------------------------- 941 956 # USAGE: _fixSize 942 957 # … … 948 963 set ht [winfo height $itk_component(results)] 949 964 if {$ht <= 1} { set ht [winfo reqheight $itk_component(results)] } 950 set cntlht [$itk_component(resultse t) size -controlarea]965 set cntlht [$itk_component(resultselector) size -controlarea] 951 966 set frac [expr {double($cntlht)/$ht}] 952 967 … … 1119 1134 itcl::body Rappture::Analyzer::_resultTooltip {} { 1120 1135 set tip "" 1121 set name [$itk_component( resultselector) value]1136 set name [$itk_component(viewselector) value] 1122 1137 if {[info exists _label2desc($name)] && 1123 1138 [string length $_label2desc($name)] > 0} { … … 1151 1166 # with no data, requiring simulation. 1152 1167 # 1153 if {[$itk_component(resultse t) size -controls] >= 2} {1168 if {[$itk_component(resultselector) size -controls] >= 2} { 1154 1169 pack $itk_interior.simol -fill x -before $itk_interior.nb 1155 1170 } else { -
branches/blt4/gui/scripts/field.tcl
r3026 r3029 22 22 destructor { # defined below } 23 23 24 public method blob {{what -overall}} 24 25 public method components {args} 25 public method mesh {{what -overall}}26 public method values {{what -overall}}27 public method blob {{what -overall}}28 public method limits {axis}29 26 public method controls {option args} 27 public method extents {{what -overall}} 28 public method flowhints { cname } 30 29 public method hints {{key ""}} 31 public method style { cname }32 30 public method isunirect2d {} 33 31 public method isunirect3d {} 32 public method limits {axis} 33 public method mesh {{what -overall}} 34 public method style { cname } 35 public method typeof { cname } 36 public method values {{what -overall}} 34 37 public method viewer {} 35 public method datatype { cname }36 public method extents {{what -overall}}37 public method flowhints { cname }38 38 public method vtkdata {{what -overall}} 39 39 40 40 protected method _build {} 41 41 protected method _getValue {expr} … … 61 61 private variable _comp2cntls ;# maps component name => x,y control points 62 62 private variable _comp2extents 63 private variable _comp2limits 63 64 private variable _type "" 64 65 private variable _comp2flowhints … … 66 67 67 68 private method ConvertToVtkData { cname } 69 private method ReadVtkDataSet { cname contents } 70 private variable _fields {} 68 71 } 69 72 … … 201 204 return [$mobj mesh] 202 205 } 203 if { $_type == "vtkcontour"} {206 if { [info exists _comp2vtkcontour($what)] } { 204 207 error "method \"mesh\" is not implemented for vtkcontour" 205 208 } … … 240 243 } 241 244 if { [info exists _comp2vtkcontour($what)] } { 242 error " values: not implemented for contours"245 error "method \"values\" is not implemented for vtkcontour" 243 246 } 244 247 if { [info exists _comp2vtkstreamlines($what)] } { … … 299 302 error "bad option \"$what\": should be [join [lsort [array names _comp2dims]] {, }]" 300 303 } 304 301 305 302 306 # ---------------------------------------------------------------------- … … 823 827 error "bad redirection path \"$path\"" 824 828 } 825 puts stderr path=$path826 829 set element [$_xmlobj element -as type $path] 827 830 if { $element != "vtk" } { … … 835 838 set _comp2dims($cname) "2D" 836 839 # Allow redirects to another element. 837 set vtkdata [$_field get $cname.vtk] 838 set _comp2vtkcontour($cname) $vtkdata 840 841 set data [$_field get $cname.vtk] 842 ReadVtkDataSet $cname $data 843 set _comp2vtkcontour($cname) $data 839 844 set _comp2style($cname) [$_field get $cname.style] 840 845 incr _counter … … 998 1003 999 1004 # 1000 # type --1005 # typeof -- 1001 1006 # 1002 1007 # Returns the style associated with a component of the field. … … 1032 1037 } 1033 1038 1034 itcl::body Rappture::Field::viewer { what} {1039 itcl::body Rappture::Field::viewer { } { 1035 1040 return $_type 1036 1041 } … … 1078 1083 } 1079 1084 if { [info exists _comp2vtkcontour($what)] } { 1080 return $_comp2vtkcontour($what)1085 return [blob $what] 1081 1086 } 1082 1087 if { [info exists _comp2vtkstreamlines($what)] } { … … 1091 1096 itcl::body Rappture::Field::ConvertToVtkData { comp } { 1092 1097 set ds "" 1093 puts stderr "dataobj type =[$dataobj typeof $comp]"1094 1098 switch -- [typeof $comp] { 1095 1099 "unirect2d" { … … 1180 1184 return $out 1181 1185 } 1186 1187 itcl::body Rappture::Field::ReadVtkDataSet { comp contents } { 1188 package require vtk 1189 1190 set reader $this-datasetreader 1191 vtkDataSetReader $reader 1192 1193 # Write the contents to a file just in case it's binary. 1194 set tmpfile file[pid].vtk 1195 set f [open "$tmpfile" "w"] 1196 fconfigure $f -translation binary -encoding binary 1197 puts $f $contents 1198 close $f 1199 $reader SetFileName $tmpfile 1200 $reader ReadAllScalarsOn 1201 $reader ReadAllVectorsOn 1202 $reader ReadAllFieldsOn 1203 $reader Update 1204 set dataset [$reader GetOutput] 1205 set limits {} 1206 foreach {xmin xmax ymin ymax zmin zmax} [$dataset GetBounds] break 1207 lappend limits xmin $xmin xmax $xmax ymin $ymin ymax $ymax 1208 set dataAttrs [$dataset GetPointData] 1209 if { $dataAttrs == ""} { 1210 puts stderr "No point data" 1211 } 1212 for {set i 0} {$i < [$dataAttrs GetNumberOfArrays] } {incr i} { 1213 set array [$dataAttrs GetArray $i] 1214 set name [$dataAttrs GetArrayName $i] 1215 foreach {min max} [$array GetRange] break 1216 lappend limits $name-min $min $name-max $max 1217 lappend _fields $name 1218 } 1219 set _comp2limits($comp) $limits 1220 puts stderr limits=$limits 1221 $reader Delete 1222 file delete $tmpfile 1223 } 1224 -
branches/blt4/gui/scripts/radiodial.tcl
r1923 r3029 559 559 return -1 560 560 } 561 # FIXME: 562 set str [list $str] 561 563 for {set nv 0} {$nv < [llength $_values]} {incr nv} { 562 564 set v [lindex $_values $nv] … … 565 567 } 566 568 } 567 error "bad value \"$str\": should be something matching the raw values \"[join $_values ,]\"" 569 570 # didn't match -- build a return string of possible values 571 set labels "" 572 foreach vlist $_values { 573 foreach v $vlist { 574 lappend labels "\"$_val2label($v)\"" 575 } 576 } 577 error "bad value \"$str\": should be one of [join $labels ,]" 568 578 } 569 579 -
branches/blt4/gui/scripts/resultset.tcl
r3025 r3029 1 2 # ---------------------------------------------------------------------- 3 # COMPONENT: ResultSet - controls for a collection of related results 4 # 5 # This widget stores a collection of results that all represent 6 # the same quantity, but for various ranges of input values. 7 # It also manages the controls to select and visualize the data. 1 # ---------------------------------------------------------------------- 2 # COMPONENT: ResultSet - set of XML objects for simulated results 3 # 4 # This data structure collects all of the simulated results 5 # produced by a series of tool runs. It is used by the Analyzer, 6 # ResultSelector, and other widgets to keep track of all known runs 7 # and visualize the result that is currently selected. Each run 8 # has an index number ("#1", "#2", "#3", etc.) that can be used to 9 # label the run and refer to it later. 8 10 # ====================================================================== 9 11 # AUTHOR: Michael McLennan, Purdue University 10 # Copyright (c) 2004-20 05Purdue Research Foundation12 # Copyright (c) 2004-2012 Purdue Research Foundation 11 13 # 12 14 # See the file "license.terms" for information on usage and 13 15 # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. 14 16 # ====================================================================== 15 package require Itk 16 17 option add *ResultSet.width 4i widgetDefault 18 option add *ResultSet.height 4i widgetDefault 19 option add *ResultSet.missingData skip widgetDefault 20 option add *ResultSet.controlbarBackground gray widgetDefault 21 option add *ResultSet.controlbarForeground white widgetDefault 22 option add *ResultSet.activeControlBackground #ffffcc widgetDefault 23 option add *ResultSet.activeControlForeground black widgetDefault 24 option add *ResultSet.controlActiveForeground blue widgetDefault 25 option add *ResultSet.toggleBackground gray widgetDefault 26 option add *ResultSet.toggleForeground white widgetDefault 27 option add *ResultSet.textFont \ 28 -*-helvetica-medium-r-normal-*-12-* widgetDefault 29 option add *ResultSet.boldFont \ 30 -*-helvetica-bold-r-normal-*-12-* widgetDefault 17 package require Itcl 31 18 32 19 itcl::class Rappture::ResultSet { 33 inherit itk::Widget34 35 itk_option define -activecontrolbackground activeControlBackground Background ""36 itk_option define -activecontrolforeground activeControlForeground Foreground ""37 itk_option define -controlactiveforeground controlActiveForeground Foreground ""38 itk_option define -togglebackground toggleBackground Background ""39 itk_option define -toggleforeground toggleForeground Foreground ""40 itk_option define -textfont textFont Font ""41 itk_option define -boldfont boldFont Font ""42 itk_option define -foreground foreground Foreground ""43 itk_option define -clearcommand clearCommand ClearCommand ""44 itk_option define -settingscommand settingsCommand SettingsCommand ""45 itk_option define -promptcommand promptCommand PromptCommand ""46 47 20 constructor {args} { # defined below } 48 21 destructor { # defined below } … … 50 23 public method add {xmlobj} 51 24 public method clear {{xmlobj ""}} 52 public method Activate {column} 25 public method diff {option args} 26 public method find {collist vallist} 27 public method get {collist xmlobj} 53 28 public method contains {xmlobj} 54 public method size {{what -results}} 55 56 protected method _doClear {what} 57 protected method _doSettings {{cmd ""}} 58 protected method _control {option args} 59 protected method _fixControls {args} 60 protected method _fixLayout {args} 61 protected method _fixNumResults {} 62 protected method _fixSettings {args} 63 protected method _fixValue {column why} 64 protected method _drawValue {column widget wmax} 65 protected method _toggleAll {{column "current"}} 66 protected method _getValues {column {which ""}} 67 protected method _getTooltip {role column} 68 protected method _getParamDesc {which {index "current"}} 29 public method size {} 30 31 public method notify {option args} 32 protected method _notifyHandler {args} 33 69 34 protected method _addOneResult {tuples xmlobj {simnum ""}} 70 35 … … 72 37 private variable _results "" ;# tuple of known results 73 38 private variable _resultnum 0 ;# counter for result #1, #2, etc. 74 private variable _recent "" ;# most recent result in _results 75 private variable _active "" ;# column with active control 76 private variable _plotall 0 ;# non-zero => plot all active results 77 private variable _layout ;# info used in _fixLayout 78 private variable _counter 0 ;# counter for unique control names 79 private variable _settings 0 ;# non-zero => _fixSettings in progress 80 81 private common _cntlInfo ;# maps column name => control info 39 private variable _notify ;# info used for notify command 82 40 } 83 41 84 itk::usual ResultSet {85 keep -background -foreground -cursor -font86 }87 88 42 # ---------------------------------------------------------------------- 89 43 # CONSTRUCTOR 90 44 # ---------------------------------------------------------------------- 91 45 itcl::body Rappture::ResultSet::constructor {args} { 92 option add hull.width hull.height93 pack propagate $itk_component(hull) no94 95 46 # create a dispatcher for events 96 47 Rappture::dispatcher _dispatcher 97 $_dispatcher register !fixcntls 98 $_dispatcher dispatch $this !fixcntls \ 99 [itcl::code $this _fixControls] 100 $_dispatcher register !layout 101 $_dispatcher dispatch $this !layout \ 102 [itcl::code $this _fixLayout] 103 $_dispatcher register !settings 104 $_dispatcher dispatch $this !settings \ 105 [itcl::code $this _fixSettings] 106 107 # initialize controls info 108 set _cntlInfo($this-all) "" 109 110 # initialize layout info 111 set _layout(mode) "usual" 112 set _layout(active) "" 48 $_dispatcher register !change 49 $_dispatcher dispatch $this !change \ 50 [itcl::code $this _notifyHandler] 113 51 114 52 # create a list of tuples for data … … 117 55 $_results column insert end -name simnum -label "simulation number" 118 56 119 120 itk_component add cntls { 121 frame $itk_interior.cntls 122 } { 123 usual 124 rename -background -controlbarbackground controlbarBackground Background 125 rename -highlightbackground -controlbarbackground controlbarBackground Background 126 } 127 pack $itk_component(cntls) -fill x -pady {0 2} 128 129 itk_component add clearall { 130 button $itk_component(cntls).clearall -text "Clear" -state disabled \ 131 -padx 1 -pady 1 \ 132 -relief flat -overrelief raised \ 133 -command [itcl::code $this _doClear all] 134 } { 135 usual 136 rename -background -controlbarbackground controlbarBackground Background 137 rename -foreground -controlbarforeground controlbarForeground Foreground 138 rename -highlightbackground -controlbarbackground controlbarBackground Background 139 } 140 pack $itk_component(clearall) -side right -padx 2 -pady 1 141 Rappture::Tooltip::for $itk_component(clearall) \ 142 "Clears all results collected so far." 143 144 itk_component add clear { 145 button $itk_component(cntls).clear -text "Clear One" -state disabled \ 146 -padx 1 -pady 1 \ 147 -relief flat -overrelief raised \ 148 -command [itcl::code $this _doClear current] 149 } { 150 usual 151 rename -background -controlbarbackground controlbarBackground Background 152 rename -foreground -controlbarforeground controlbarForeground Foreground 153 rename -highlightbackground -controlbarbackground controlbarBackground Background 154 } 155 pack $itk_component(clear) -side right -padx 2 -pady 1 156 Rappture::Tooltip::for $itk_component(clear) \ 157 "Clears the result that is currently selected." 158 159 itk_component add status { 160 label $itk_component(cntls).status -anchor w \ 161 -text "No results" -padx 0 -pady 0 162 } { 163 usual 164 rename -background -controlbarbackground controlbarBackground Background 165 rename -foreground -controlbarforeground controlbarForeground Foreground 166 rename -highlightbackground -controlbarbackground controlbarBackground Background 167 } 168 pack $itk_component(status) -side left -padx 2 -pady {2 0} 169 170 itk_component add dials { 171 frame $itk_interior.dials 172 } 173 pack $itk_component(dials) -expand yes -fill both 174 bind $itk_component(dials) <Configure> \ 175 [list $_dispatcher event -after 10 !layout why resize] 176 177 # create the permanent controls in the "short list" area 178 set dials $itk_component(dials) 179 frame $dials.bg 180 Rappture::Radiodial $dials.dial -valuewidth 0 181 Rappture::Tooltip::for $dials.dial \ 182 "@[itcl::code $this _getTooltip dial active]" 183 184 set fn [option get $itk_component(hull) textFont Font] 185 label $dials.all -text "All" -padx 8 \ 186 -borderwidth 1 -relief raised -font $fn 187 Rappture::Tooltip::for $dials.all \ 188 "@[itcl::code $this _getTooltip all active]" 189 bind $dials.all <ButtonRelease> [itcl::code $this _toggleAll] 190 191 frame $dials.labelmore 192 label $dials.labelmore.arrow -bitmap [Rappture::icon empty] -borderwidth 0 193 pack $dials.labelmore.arrow -side left -fill y 194 label $dials.labelmore.name -text "more parameters..." -font $fn \ 195 -borderwidth 0 -padx 0 -pady 1 196 pack $dials.labelmore.name -side left 197 label $dials.labelmore.value 198 pack $dials.labelmore.value -side left 199 200 eval itk_initialize $args 57 # clear notification info 58 set _notify(ALL) "" 59 60 eval configure $args 201 61 } 202 62 … … 205 65 # ---------------------------------------------------------------------- 206 66 itcl::body Rappture::ResultSet::destructor {} { 67 clear 207 68 itcl::delete object $_results 208 69 } … … 218 79 # ---------------------------------------------------------------------- 219 80 itcl::body Rappture::ResultSet::add {xmlobj} { 220 # make sure we fix up controls at some point221 $_dispatcher event -idle !fixcntls222 223 #224 # If this is the first result, then there are no diffs.225 # Add it right in.226 #227 81 set xmlobj0 [$_results get -format xmlobj end] 228 if {"" == $xmlobj0} { 229 # first element -- always add 82 if {$xmlobj0 eq ""} { 83 # 84 # If this is the first result, then there are no diffs. 85 # Add it right in. 86 # 230 87 set simnum "#[incr _resultnum]" 231 88 $_results insert end [list $xmlobj $simnum] 232 _fixNumResults 233 set _recent $xmlobj 234 return $simnum 235 } 236 237 # 238 # For all later results, find the diffs and add any new columns 239 # into the results tuple. The latest result is the most recent. 240 # 241 set simnum [_addOneResult $_results $xmlobj] 242 set _recent $xmlobj 243 _fixNumResults 89 } else { 90 # 91 # For all later results, find the diffs and add any new columns 92 # into the results tuple. The latest result is the most recent. 93 # 94 set simnum [_addOneResult $_results $xmlobj] 95 } 96 97 # make sure we fix up associated controls 98 $_dispatcher event -now !change op add what $xmlobj 244 99 245 100 return $simnum … … 253 108 # ---------------------------------------------------------------------- 254 109 itcl::body Rappture::ResultSet::clear {{xmlobj ""}} { 255 set shortlist $itk_component(dials)256 set controlsChanged 0257 258 # clear any currently highlighted result259 _doSettings260 261 110 if {$xmlobj ne ""} { 262 111 # … … 269 118 set irun [$_results find -format xmlobj $xmlobj] 270 119 if {[llength $irun] == 1} { 271 # figure out where we are in the active control, and 272 # what value we should display after this one is deleted 273 set vlist "" 274 foreach {label val} [_getValues $_active all] { 275 lappend vlist $label 276 } 277 set ipos [lsearch $vlist $_cntlInfo($this-$_active-value)] 278 279 set vcurr "" 280 set vnext "" 281 if {$ipos >= 0} { 282 # try to stay at this value, if we can 283 set vcurr [lindex $vlist $ipos] 284 285 # fall back to this value, if we have to 286 if {$ipos > 0} { incr ipos -1 } else { incr ipos } 287 set vnext [lindex $vlist $ipos] 288 } 289 290 # delete the value from the tuples of all results 120 # grab a description of what we're about to delete 121 set dlist [list simnum [$_results get -format simnum $irun]] 122 foreach col [lrange [$_results column names] 2 end] { 123 set raw [lindex [Rappture::LibraryObj::value $xmlobj $col] 0] 124 lappend dlist $col $raw ;# use "raw" (user-readable) label 125 } 126 127 # delete this from the tuples of all results 128 itcl::delete object $xmlobj 291 129 $_results delete $irun 292 130 … … 309 147 set _results $new 310 148 311 # delete any adjuster controls that disappeared 312 foreach col $_cntlInfo($this-all) { 313 if {[$_results column names $col] eq ""} { 314 set id $_cntlInfo($this-$col-id) 315 destroy $shortlist.label$id 316 array unset _cntlInfo $this-$col* 317 318 set i [lsearch -exact $_cntlInfo($this-all) $col] 319 if {$i >= 0} { 320 set _cntlInfo($this-all) [lreplace $_cntlInfo($this-all) $i $i] 149 # make sure we fix up associated controls at some point 150 $_dispatcher event -now !change op clear what $dlist 151 } 152 } else { 153 # 154 # Delete all results. 155 # 156 for {set irun 0} {$irun < [$_results size]} {incr irun} { 157 set xo [$_results get -format xmlobj $irun] 158 itcl::delete object $xo 159 } 160 $_results delete 0 end 161 162 # make sure we fix up associated controls at some point 163 $_dispatcher event -now !change op clear what all 164 } 165 166 if {[$_results size] == 0} { 167 # no results left? then reset to a clean state 168 eval $_results column delete [lrange [$_results column names] 2 end] 169 set _resultnum 0 170 } 171 } 172 173 # ---------------------------------------------------------------------- 174 # USAGE: diff names 175 # USAGE: diff values <column> ?<which>? 176 # 177 # Returns information about the diffs in the current set of known 178 # results. The "diff names" returns a list of column names for 179 # parameters that have diffs. (These are the columns in the tuples.) 180 # 181 # The "diff values" returns the various values associated with a 182 # particular <column> name. If the optional <which> is specified, 183 # then it is treated as an index into the list of values--0 for the 184 # first value, 1 for the second, etc. Each value is returned as 185 # a list with two words. The first is the the label associated with 186 # the value. The second is the normalized (numeric) value, which can 187 # be sorted to get a particular ordering. 188 # ---------------------------------------------------------------------- 189 itcl::body Rappture::ResultSet::diff {option args} { 190 switch -- $option { 191 names { 192 return [$_results column names] 193 } 194 values { 195 if {[llength $args] < 1} { 196 error "wrong # args: should be \"diff values col ?which?\"" 197 } 198 set col [lindex $args 0] 199 200 set which "all" 201 if {[llength $args] > 1} { 202 set which [lindex $args 1] 203 } 204 205 if {$which eq "all"} { 206 set rlist "" 207 # build an array of normalized values and their labels 208 if {$col == "simnum"} { 209 set nruns [$_results size] 210 for {set n 0} {$n < $nruns} {incr n} { 211 set simnum [$_results get -format simnum $n] 212 lappend rlist $simnum $n 321 213 } 322 323 if {$col == $_active} { 324 # control is going away -- switch to sim # control 325 set simnum0 [$_results get -format simnum 0] 326 set _cntlInfo($this-simnum-value) $simnum0 327 Activate simnum 214 } else { 215 set havenums 1 216 foreach rec [$_results get -format [list xmlobj $col]] { 217 set xo [lindex $rec 0] 218 set v [lindex $rec 1] 219 foreach {raw norm} \ 220 [Rappture::LibraryObj::value $xo $col] break 221 222 if {![info exists unique($v)]} { 223 # keep only unique label strings 224 set unique($v) $norm 225 } 226 if {$havenums && ![string is double $norm]} { 227 set havenums 0 228 } 328 229 } 329 set controlsChanged 1 330 } 331 } 332 333 # can we find a tuple with the desired value for the active col? 334 if {$_active ne "" && $vcurr ne ""} { 335 set found "" 336 if {[$_results find -format $_active $vcurr] ne ""} { 337 set found $vcurr 338 } elseif {$vnext ne "" && [$_results find -format $_active $vnext] ne ""} { 339 set found $vnext 340 } 341 342 if {$found ne ""} { 343 # set the control to a value we were able to find 344 # this will trigger !settings and other adjustments 345 set _cntlInfo($this-$_active-value) $found 230 231 if {!$havenums} { 232 # don't have normalized nums? then sort and create nums 233 set rlist "" 234 set n 0 235 foreach val [lsort -dictionary [array names unique]] { 236 lappend rlist $val [incr n] 237 } 238 } else { 239 set rlist [array get unique] 240 } 241 } 242 return $rlist 243 } 244 245 # treat the "which" parameter as an XML object 246 set irun [lindex [$_results find -format xmlobj $which] 0] 247 if {$irun ne ""} { 248 if {$col == "simnum"} { 249 set val [$_results get -format simnum $irun] 346 250 } else { 347 # if all else fails, show solution #1 348 set simnum0 [$_results get -format simnum 0] 349 set _cntlInfo($this-simnum-value) $simnum0 350 Activate simnum 351 } 352 } 353 } 354 } else { 355 # 356 # Delete all results. 357 # 358 $_results delete 0 end 359 360 # delete all adjuster controls 361 foreach col $_cntlInfo($this-all) { 362 set id $_cntlInfo($this-$col-id) 363 destroy $shortlist.label$id 364 } 365 set controlsChanged 1 366 } 367 368 if {[$_results size] == 0} { 369 # 370 # No results left? Then clean everything up. 371 # 372 373 array unset _cntlInfo $this-* 374 # clean up control info 375 foreach key [array names _cntlInfo $this-*] { 376 catch {unset _cntlInfo($key)} 377 } 378 set _cntlInfo($this-all) "" 379 set _counter 0 380 set _resultnum 0 381 382 # clear out all results 383 eval $_results column delete [lrange [$_results column names] 2 end] 384 set _recent "" 385 set _active "" 386 387 set _plotall 0 388 $itk_component(dials).all configure -relief raised \ 389 -background $itk_option(-background) \ 390 -foreground $itk_option(-foreground) 391 } 392 393 # update status and Clear button 394 _fixNumResults 395 $_dispatcher event -idle !fixcntls 396 397 # let clients know that the number of controls has changed 398 if {$controlsChanged} { 399 event generate $itk_component(hull) <<Control>> 400 } 401 402 # if there's a callback for clearing, invoke it now... 403 if {[string length $itk_option(-clearcommand)] > 0} { 404 uplevel #0 $itk_option(-clearcommand) $xmlobj 405 } 406 } 407 408 # ---------------------------------------------------------------------- 409 # USAGE: Activate <column> 410 # 411 # Clients use this to activate a particular column in the set of 412 # controls. When a column is active, its label is bold and its 413 # value has a radiodial in the "short list" area. 414 # ---------------------------------------------------------------------- 415 itcl::body Rappture::ResultSet::Activate {column} { 416 set allowed [$_results column names] 417 if {[lsearch $allowed $column] < 0} { 418 error "bad value \"$column\": should be one of [join $allowed {, }]" 419 } 420 421 # column is now active 422 set _active $column 423 424 # keep track of usage, so we know which controls are popular 425 incr _cntlInfo($this-$column-usage) 426 427 # fix controls at next idle point 428 $_dispatcher event -idle !layout why data 429 $_dispatcher event -idle !settings column $_active 251 # Be careful giving singleton elements as the 252 # "columns" argument to "Tuples::get". It is 253 # expecting a list. 254 foreach {raw norm} \ 255 [Rappture::LibraryObj::value $which $col] break 256 return [list $norm $raw] 257 } 258 } 259 } 260 default { 261 error "bad option \"$option\": should be names or values" 262 } 263 } 264 } 265 266 # ---------------------------------------------------------------------- 267 # USAGE: find <columnList> <valueList> 268 # 269 # Searches through the results for a set of tuple values that match 270 # the <valueList> for the given <columnList>. Returns a list of 271 # matching xml objects or "" if there is no match. If the <valueList> 272 # is *, then it returns a list of all xml objects. 273 # ---------------------------------------------------------------------- 274 itcl::body Rappture::ResultSet::find {collist vallist} { 275 if {$vallist eq "*"} { 276 return [$_results get -format xmlobj] 277 } 278 279 set rlist "" 280 foreach irun [$_results find -format $collist $vallist] { 281 lappend rlist [$_results get -format xmlobj $irun] 282 } 283 return $rlist 284 } 285 286 # ---------------------------------------------------------------------- 287 # USAGE: get <columnList> <xmlobj> 288 # 289 # Returns values for the specified <columnList> for the given <xmlobj>. 290 # This is a way of querying associated data for the given object. 291 # ---------------------------------------------------------------------- 292 itcl::body Rappture::ResultSet::get {collist xmlobj} { 293 set irun [lindex [$_results find -format xmlobj $xmlobj] 0] 294 if {$irun ne ""} { 295 return [lindex [$_results get -format $collist $irun] 0] 296 } 297 return "" 430 298 } 431 299 … … 499 367 500 368 # ---------------------------------------------------------------------- 501 # USAGE: size ?-results|-controls|-controlarea? 502 # 503 # Returns various measures for the size of this area: 504 # -results ....... number of results loaded 505 # -controls ...... number of distinct control parameters 506 # -controlarea ... minimum size of usable control area, in pixels 507 # ---------------------------------------------------------------------- 508 itcl::body Rappture::ResultSet::size {{what -results}} { 509 switch -- $what { 510 -results { 511 return [$_results size] 512 } 513 -controls { 514 return [llength $_cntlInfo($this-all)] 515 } 516 -controlarea { 517 set ht [winfo reqheight $itk_component(cntls)] 518 incr ht 2 ;# padding below controls 519 520 set normalLine [font metrics $itk_option(-textfont) -linespace] 521 incr normalLine 2 ;# padding 522 set boldLine [font metrics $itk_option(-boldfont) -linespace] 523 incr boldLine 2 ;# padding 524 525 set numcntls [llength $_cntlInfo($this-all)] 526 switch -- $numcntls { 527 0 - 1 { 528 # 0 = no controls (no data at all) 529 # 1 = run control, but only 1 run so far 530 # add nothing 369 # USAGE: size 370 # 371 # Returns the number of results currently stored in the set. 372 # ---------------------------------------------------------------------- 373 itcl::body Rappture::ResultSet::size {} { 374 return [$_results size] 375 } 376 377 # ---------------------------------------------------------------------- 378 # USAGE: notify add <client> ?!event !event ...? <command> 379 # USAGE: notify get ?<client>? ?!event? 380 # USAGE: notify remove <client> ?!event !event ...? 381 # 382 # Clients use this to add/remove requests for notifications about 383 # various events that signal changes to the data in each ResultSet. 384 # 385 # The "notify add" operation takes a <client> name (any unique string 386 # identifying the client), an optional list of events, and the <command> 387 # that should be called for the callback. 388 # 389 # The "notify get" command returns information about clients and their 390 # registered callbacks. With no args, it returns a list of <client> 391 # names. If the <client> is specified, it returns a list of !events. 392 # If the <client> and !event is specified, it returns the <command>. 393 # 394 # The "notify remove" command removes any callback associated with 395 # a given <client>. If no particular !events are specified, then it 396 # removes callbacks for all events. 397 # ---------------------------------------------------------------------- 398 itcl::body Rappture::ResultSet::notify {option args} { 399 set allEvents {!change} 400 switch -- $option { 401 add { 402 if {[llength $args] < 2} { 403 error "wrong # args: should be \"notify add caller ?!event !event ...? command" 404 } 405 set caller [lindex $args 0] 406 set command [lindex $args end] 407 if {[llength $args] > 2} { 408 set events [lrange $args 1 end-1] 409 } else { 410 set events $allEvents 411 } 412 413 foreach name $events { 414 if {[lsearch -exact $allEvents $name] < 0} { 415 error "bad event \"$name\": should be [join $allEvents ,]" 416 } 417 if {[lsearch $_notify(ALL) $caller] < 0} { 418 lappend _notify(ALL) $caller 419 } 420 set _notify($caller-$name) $command 421 } 422 } 423 get { 424 switch -- [llength $args] { 425 0 { 426 return $_notify(ALL) 427 } 428 1 { 429 set caller [lindex $args 0] 430 set rlist "" 431 foreach key [array names _notify $caller-*] { 432 lappend rlist [lindex [split $key -] end] 433 } 434 return $rlist 435 } 436 2 { 437 set caller [lindex $args 0] 438 set name [lindex $args 1] 439 if {[info exists _notify($caller-$name)]} { 440 return $_notify($caller-$name) 441 } 442 return "" 531 443 } 532 444 default { 533 # non-active controls 534 incr ht [expr {($numcntls-1)*$normalLine}] 535 # active control 536 incr ht $boldLine 537 # dial for active control 538 incr ht [winfo reqheight $itk_component(dials).dial] 539 # padding around active control 540 incr ht 4 541 } 542 } 543 return $ht 445 error "wrong # args: should be \"notify get ?caller? ?!event?\"" 446 } 447 } 448 } 449 remove { 450 if {[llength $args] < 1} { 451 error "wrong # args: should be \"notify remove caller ?!event !event ...?" 452 } 453 set caller [lindex $args 0] 454 if {[llength $args] > 1} { 455 set events [lrange $args 1 end] 456 } else { 457 set events $allEvents 458 } 459 460 foreach name $events { 461 catch {unset _notify($caller-$name)} 462 } 463 if {[llength [array names _notify $caller-*]] == 0} { 464 set i [lsearch $_notify(ALL) $caller] 465 if {$i >= 0} { 466 set _notify(ALL) [lreplace $_notify(ALL) $i $i] 467 } 468 } 544 469 } 545 470 default { 546 error "bad option \"$what\": should be -results, -controls, or -controlarea" 547 } 548 } 549 } 550 551 # ---------------------------------------------------------------------- 552 # USAGE: _doClear all|current 553 # 554 # Invoked automatically when the user presses the "Clear One" or 555 # "Clear All" buttons. Invokes the -clearcommand to clear all data 556 # from this resultset and all other resultsets in an Analyzer. 557 # ---------------------------------------------------------------------- 558 itcl::body Rappture::ResultSet::_doClear {what} { 559 switch -- $what { 560 current { 561 set xmlobj "" 562 # value of xmlobj control is something like "#1" or "#2" 563 set irun [$_results find -format simnum $_cntlInfo($this-simnum-value)] 564 if {$irun ne ""} { 565 # convert index to a real xmlobj object 566 set xmlobj [$_results get -format xmlobj $irun] 567 } 568 clear $xmlobj 569 } 570 all { 571 clear 572 } 573 default { error "bad option \"$what\": should be current or all" } 574 } 575 } 576 577 # ---------------------------------------------------------------------- 578 # USAGE: _doSettings ?<command>? 579 # 580 # Used internally whenever the result selection changes to invoke 581 # the -settingscommand. This will notify some external widget, which 582 # with perform the plotting action specified in the <command>. 583 # ---------------------------------------------------------------------- 584 itcl::body Rappture::ResultSet::_doSettings {{cmd ""}} { 585 if {[string length $itk_option(-settingscommand)] > 0} { 586 uplevel #0 $itk_option(-settingscommand) $cmd 587 } 588 } 589 590 # ---------------------------------------------------------------------- 591 # USAGE: _control bind <widget> <column> 592 # USAGE: _control hilite <state> <column> <panel> 593 # USAGE: _control load <widget> <column> 594 # 595 # Used internally to manage the interactivity of controls. The "bind" 596 # operation sets up bindings on the label/value for each control, so 597 # you can mouse over and click on a control to activate it. The 598 # "hilite" operation controls highlighting of the control. The "load" 599 # operation loads data into the specified radiodial <widget>. 600 # ---------------------------------------------------------------------- 601 itcl::body Rappture::ResultSet::_control {option args} { 602 switch -- $option { 603 bind { 604 if {[llength $args] != 2} { 605 error "wrong # args: should be _control bind widget column" 606 } 607 set widget [lindex $args 0] 608 set col [lindex $args 1] 609 610 set panel [winfo parent $widget] 611 if {[string match label* [winfo name $panel]]} { 612 set panel [winfo parent $panel] 613 } 614 615 bind $widget <Enter> \ 616 [itcl::code $this _control hilite on $col $panel] 617 bind $widget <Leave> \ 618 [itcl::code $this _control hilite off $col $panel] 619 bind $widget <ButtonRelease> [itcl::code $this Activate $col] 620 } 621 hilite { 622 if {[llength $args] != 3} { 623 error "wrong # args: should be _control hilite state column panel" 624 } 625 if {$_layout(mode) != "usual"} { 626 # abbreviated controls? then skip highlighting 627 return 628 } 629 set state [lindex $args 0] 630 set col [lindex $args 1] 631 set panel [lindex $args 2] 632 633 if {[string index $col 0] == "@"} { 634 # handle artificial names like "@more" 635 set id [string range $col 1 end] 636 } else { 637 # get id for ordinary columns 638 set id $_cntlInfo($this-$col-id) 639 } 640 641 # highlight any non-active entries 642 if {$col != $_active} { 643 if {$state} { 644 set fg $itk_option(-controlactiveforeground) 645 $panel.label$id.name configure -fg $fg 646 $panel.label$id.value configure -fg $fg 647 $panel.label$id.arrow configure -fg $fg \ 648 -bitmap [Rappture::icon rarrow2] 649 } else { 650 set fg $itk_option(-foreground) 651 $panel.label$id.name configure -fg $fg 652 $panel.label$id.value configure -fg $fg 653 $panel.label$id.arrow configure -fg $fg \ 654 -bitmap [Rappture::icon empty] 655 } 656 } 657 } 658 load { 659 if {[llength $args] != 2} { 660 error "wrong # args: should be _control load widget column" 661 } 662 set dial [lindex $args 0] 663 set col [lindex $args 1] 664 665 $dial clear 666 foreach {label val} [_getValues $col all] { 667 $dial add $label $val 668 } 669 } 670 default { 671 error "bad option \"$option\": should be bind, hilite, or load" 672 } 673 } 674 } 675 676 # ---------------------------------------------------------------------- 677 # USAGE: _fixControls ?<eventArgs...>? 678 # 679 # Called automatically at the idle point after one or more results 680 # have been added to this result set. Scans through all existing 681 # data and updates controls used to select the data. 682 # ---------------------------------------------------------------------- 683 itcl::body Rappture::ResultSet::_fixControls {args} { 684 if {[$_results size] == 0} { 685 return 686 } 687 688 set shortlist $itk_component(dials) 689 grid columnconfigure $shortlist 1 -weight 1 690 691 # 692 # Scan through all columns in the data and create any 693 # controls that just appeared. 694 # 695 $shortlist.dial configure -variable "" 696 697 set nadded 0 698 foreach col [$_results column names] { 699 set xmlobj [$_results get -format xmlobj 0] 700 701 # 702 # If this column doesn't have a control yet, then 703 # create one. 704 # 705 if {![info exists _cntlInfo($this-$col-id)]} { 706 set tip "" 707 if {$col eq "xmlobj"} { 708 continue 709 } elseif {$col eq "simnum"} { 710 set quantity "Simulation" 711 set tip "List of all simulations that you have performed so far." 712 } else { 713 # search for the first XML object with this element defined 714 foreach xmlobj [$_results get -format xmlobj] { 715 set quantity [$xmlobj get $col.about.label] 716 set tip [$xmlobj get $col.about.description] 717 if {"" != $quantity} { 718 break 719 } 720 } 721 if {"" == $quantity && "" != $xmlobj} { 722 set quantity [$xmlobj element -as id $col] 723 } 724 } 725 726 # Create the controls for the "short list" area. 727 set fn $itk_option(-textfont) 728 set w $shortlist.label$_counter 729 set row [lindex [grid size $shortlist] 1] 730 frame $w 731 grid $w -row $row -column 1 -sticky ew 732 label $w.arrow -bitmap [Rappture::icon empty] -borderwidth 0 733 pack $w.arrow -side left -fill y 734 _control bind $w.arrow $col 735 736 label $w.name -text $quantity -anchor w \ 737 -borderwidth 0 -padx 0 -pady 1 -font $fn 738 pack $w.name -side left 739 bind $w.name <Configure> [itcl::code $this _fixValue $col resize] 740 _control bind $w.name $col 741 742 label $w.value -anchor w \ 743 -borderwidth 0 -padx 0 -pady 1 -font $fn 744 pack $w.value -side left 745 bind $w.value <Configure> [itcl::code $this _fixValue $col resize] 746 _control bind $w.value $col 747 748 Rappture::Tooltip::for $w \ 749 "@[itcl::code $this _getTooltip label $col]" 750 751 # create a record for this control 752 lappend _cntlInfo($this-all) $col 753 set _cntlInfo($this-$col-id) $_counter 754 set _cntlInfo($this-$col-label) $quantity 755 set _cntlInfo($this-$col-tip) $tip 756 set _cntlInfo($this-$col-value) "" 757 set _cntlInfo($this-$col-usage) 0 758 set _cntlInfo($this-$col) "" 759 760 trace add variable _cntlInfo($this-$col-value) write \ 761 "[itcl::code $this _fixValue $col value]; list" 762 763 incr _counter 764 765 # fix the shortlist layout to show as many controls as we can 766 $_dispatcher event -now !layout why data 767 768 # let clients know that a new control appeared 769 # so they can fix the overall size accordingly 770 event generate $itk_component(hull) <<Control>> 771 772 incr nadded 773 } 774 775 # 776 # Determine the unique values for this column and load 777 # them into the control. 778 # 779 set id $_cntlInfo($this-$col-id) 780 781 if {$col == $_layout(active)} { 782 _control load $shortlist.dial $col 783 $shortlist.dial configure -variable \ 784 "::Rappture::ResultSet::_cntlInfo($this-$col-value)" 785 } 786 } 787 788 # 789 # Activate the most recent control. If a bunch of controls 790 # were just added, then activate the "Simulation" control, 791 # since that's the easiest way to page through results. 792 # 793 if {$nadded > 0} { 794 if {[$_results column names] == 3 || $nadded == 1} { 795 Activate [lindex $_cntlInfo($this-all) end] 796 } else { 797 Activate simnum 798 } 799 } 800 801 # 802 # Set all controls to the settings of the most recent addition. 803 # Setting the value slot will trigger the !settings event, which 804 # will then fix all other controls to match the one that changed. 805 # 806 set irun [lindex [$_results find -format xmlobj $_recent] 0] 807 if {$irun ne ""} { 808 set simnum [$_results get -format simnum $irun] 809 set _cntlInfo($this-simnum-value) $simnum 810 } 811 } 812 813 # ---------------------------------------------------------------------- 814 # USAGE: _fixLayout ?<eventArgs...>? 815 # 816 # Called automatically at the idle point after the controls have 817 # changed, or the size of the window has changed. Fixes the layout 818 # so that the active control is displayed, and other recent controls 819 # are shown above and/or below. At the very least, we must show the 820 # "more options..." control. 821 # ---------------------------------------------------------------------- 822 itcl::body Rappture::ResultSet::_fixLayout {args} { 823 array set eventdata $args 824 825 set shortlist $itk_component(dials) 826 827 # clear out the short list area 828 foreach w [grid slaves $shortlist] { 829 grid forget $w 830 } 831 832 # reset all labels back to an ordinary font/background 833 set fn $itk_option(-textfont) 834 set bg $itk_option(-background) 835 set fg $itk_option(-foreground) 836 foreach col $_cntlInfo($this-all) { 837 set id $_cntlInfo($this-$col-id) 838 $shortlist.label$id configure -background $bg 839 $shortlist.label$id.arrow configure -background $bg \ 840 -bitmap [Rappture::icon empty] 841 $shortlist.label$id.name configure -font $fn -background $bg 842 $shortlist.label$id.value configure -background $bg 843 } 844 845 # only 1 result? then we don't need any controls 846 if {[$_results size] < 2} { 847 return 848 } 849 850 # compute the number of controls that will fit in the shortlist area 851 set dials $itk_component(dials) 852 set h [winfo height $dials] 853 set normalLine [font metrics $itk_option(-textfont) -linespace] 854 set boldLine [font metrics $itk_option(-boldfont) -linespace] 855 set active [expr {$boldLine+[winfo reqheight $dials.dial]+4}] 856 857 if {$h < $active+$normalLine} { 858 # active control kinda big? then show parameter values only 859 set _layout(mode) abbreviated 860 set ncntls [expr {int(floor(double($h)/$normalLine))}] 861 } else { 862 set _layout(mode) usual 863 set ncntls [expr {int(floor(double($h-$active)/$normalLine))+1}] 864 } 865 866 # find the controls with the most usage 867 set order "" 868 foreach col $_cntlInfo($this-all) { 869 lappend order [list $col $_cntlInfo($this-$col-usage)] 870 } 871 set order [lsort -integer -decreasing -index 1 $order] 872 873 set mostUsed "" 874 if {[llength $order] <= $ncntls} { 875 # plenty of space? then show all controls 876 foreach item $order { 877 lappend mostUsed [lindex $item 0] 878 } 879 } else { 880 # otherwise, limit to the most-used controls 881 foreach item [lrange $order 0 [expr {$ncntls-1}]] { 882 lappend mostUsed [lindex $item 0] 883 } 884 885 # make sure the active control is included 886 if {"" != $_active && [lsearch -exact $mostUsed $_active] < 0} { 887 set mostUsed [lreplace [linsert $mostUsed 0 $_active] end end] 888 } 889 890 # if there are more controls, add the "more parameters..." entry 891 if {$ncntls > 2} { 892 set mostUsed [lreplace $mostUsed end end @more] 893 set rest [expr {[llength $order]-($ncntls-1)}] 894 if {$rest == 1} { 895 $dials.labelmore.name configure -text "1 more parameter..." 896 } else { 897 $dials.labelmore.name configure -text "$rest more parameters..." 898 } 899 } 900 } 901 902 # draw the active control 903 set row 0 904 foreach col [concat $_cntlInfo($this-all) @more] { 905 # this control not on the short list? then ignore it 906 if {[lsearch $mostUsed $col] < 0} { 907 continue 908 } 909 910 if {[string index $col 0] == "@"} { 911 set id [string range $col 1 end] 912 } else { 913 set id $_cntlInfo($this-$col-id) 914 } 915 grid $shortlist.label$id -row $row -column 1 -sticky ew -padx 4 916 917 if {$col == $_active} { 918 if {$_layout(mode) == "usual"} { 919 # put the background behind the active control in the shortlist 920 grid $shortlist.bg -row $row -rowspan 2 \ 921 -column 0 -columnspan 2 -sticky nsew 922 lower $shortlist.bg 923 924 # place the All and dial in the shortlist area 925 grid $shortlist.all -row $row -rowspan 2 -column 0 \ 926 -sticky nsew -padx 2 -pady 2 927 grid $shortlist.dial -row [expr {$row+1}] -column 1 \ 928 -sticky ew -padx 4 929 incr row 930 931 if {$_layout(active) != $_active} { 932 $shortlist.dial configure -variable "" 933 _control load $shortlist.dial $col 934 $shortlist.dial configure -variable \ 935 "::Rappture::ResultSet::_cntlInfo($this-$col-value)" 936 set _layout(active) $_active 937 } 938 } 939 } 940 incr row 941 } 942 943 # highlight the active control 944 if {[info exists _cntlInfo($this-$_active-id)]} { 945 set id $_cntlInfo($this-$_active-id) 946 set bf $itk_option(-boldfont) 947 set fg $itk_option(-activecontrolforeground) 948 set bg $itk_option(-activecontrolbackground) 949 950 if {$_layout(mode) == "usual"} { 951 $shortlist.label$id configure -background $bg 952 $shortlist.label$id.arrow configure -foreground $fg \ 953 -background $bg -bitmap [Rappture::icon rarrow] 954 $shortlist.label$id.name configure -foreground $fg \ 955 -background $bg -font $bf 956 $shortlist.label$id.value configure -foreground $fg \ 957 -background $bg 958 $shortlist.dial configure -background $bg 959 $shortlist.bg configure -background $bg 960 961 if {[$shortlist.all cget -relief] == "raised"} { 962 $shortlist.all configure -foreground $fg -background $bg 963 } 964 } 965 } 966 } 967 968 # ---------------------------------------------------------------------- 969 # USAGE: _fixNumResults 970 # 971 # Used internally to update the number of results displayed near the 972 # top of this widget. If there is only 1 result, then there is also 973 # a single "Clear" button. If there are no results, the clear button 974 # is diabled. 975 # ---------------------------------------------------------------------- 976 itcl::body Rappture::ResultSet::_fixNumResults {} { 977 switch [$_results size] { 978 0 { 979 $itk_component(status) configure -text "No results" 980 $itk_component(clearall) configure -state disabled -text "Clear" 981 pack forget $itk_component(clear) 982 } 983 1 { 984 $itk_component(status) configure -text "1 result" 985 $itk_component(clearall) configure -state normal -text "Clear" 986 pack forget $itk_component(clear) 987 } 988 default { 989 $itk_component(status) configure -text "[$_results size] results" 990 $itk_component(clearall) configure -state normal -text "Clear All" 991 $itk_component(clear) configure -state normal 992 pack $itk_component(clear) -side right \ 993 -after $itk_component(clearall) -padx {0 6} 994 } 995 } 996 } 997 998 # ---------------------------------------------------------------------- 999 # USAGE: _fixSettings ?<eventArgs...>? 1000 # 1001 # Called automatically at the idle point after a control has changed 1002 # to load new data into the plotting area at the top of this result 1003 # set. Extracts the current tuple of control values from the control 1004 # area, then finds the corresponding data values. Loads the data 1005 # by invoking a -settingscommand callback with parameters that 1006 # describe what data should be plotted. 1007 # ---------------------------------------------------------------------- 1008 itcl::body Rappture::ResultSet::_fixSettings {args} { 1009 array set eventdata $args 1010 if {[info exists eventdata(column)]} { 1011 set changed $eventdata(column) 1012 } else { 1013 set changed "" 1014 } 1015 1016 if {[info exists _cntlInfo($this-$_active-label)]} { 1017 lappend params $_cntlInfo($this-$_active-label) 1018 } else { 1019 lappend params "???" 1020 } 1021 if { $_active == "" } { 1022 return; # Nothing active. Don't do anything. 1023 } 1024 eval lappend params [_getValues $_active all] 1025 1026 switch -- [$_results size] { 1027 0 { 1028 # no data? then do nothing 1029 return 1030 } 1031 1 { 1032 # only one data set? then plot it 1033 set simnum [$_results get -format simnum 0] 1034 _doSettings [list \ 1035 $simnum [list -width 2 \ 1036 -param [_getValues $_active current] \ 1037 -description [_getParamDesc all] \ 1038 ] \ 1039 params $params \ 1040 ] 1041 return 1042 } 1043 } 1044 1045 # 1046 # Find the selected run. If the run setting changed, then 1047 # look at its current value. Otherwise, search the results 1048 # for a tuple that matches the current settings. 1049 # 1050 if {$changed == "xmlobj" || $changed == "simnum"} { 1051 set irun [$_results find -format simnum $_cntlInfo($this-simnum-value)] 1052 } else { 1053 set format "" 1054 set tuple "" 1055 foreach col [lrange [$_results column names] 2 end] { 1056 lappend format $col 1057 lappend tuple $_cntlInfo($this-$col-value) 1058 } 1059 set irun [lindex [$_results find -format $format -- $tuple] 0] 1060 1061 if {"" == $irun && "" != $changed} { 1062 # 1063 # No data for these settings. Try leaving the next 1064 # column open, then the next, and so forth, until 1065 # we find some data. 1066 # 1067 # allcols: foo bar baz qux 1068 # ^^^changed 1069 # 1070 # search: baz qux foo 1071 # 1072 set val $_cntlInfo($this-$changed-value) 1073 set allcols [lrange [$_results column names] 2 end] 1074 set i [lsearch -exact $allcols $changed] 1075 set search [concat \ 1076 [lrange $allcols [expr {$i+1}] end] \ 1077 [lrange $allcols 0 [expr {$i-1}]] \ 1078 ] 1079 set nsearch [llength $search] 1080 1081 for {set i 0} {$i < $nsearch} {incr i} { 1082 set format $changed 1083 set tuple [list $val] 1084 for {set j [expr {$i+1}]} {$j < $nsearch} {incr j} { 1085 set col [lindex $search $j] 1086 lappend format $col 1087 lappend tuple $_cntlInfo($this-$col-value) 1088 } 1089 set irun [lindex [$_results find -format $format -- $tuple] 0] 1090 if {"" != $irun} { 1091 break 1092 } 1093 } 1094 } 1095 } 1096 1097 # 1098 # If we found a particular run, then load its values into all 1099 # controls. 1100 # 1101 if {"" != $irun} { 1102 # stop reacting to value changes 1103 set _settings 1 1104 1105 set format [lrange [$_results column names] 2 end] 1106 if {[llength $format] == 1} { 1107 set data [$_results get -format $format $irun] 1108 } else { 1109 set data [lindex [$_results get -format $format $irun] 0] 1110 } 1111 1112 foreach col $format val $data { 1113 set _cntlInfo($this-$col-value) $val 1114 } 1115 set simnum [$_results get -format simnum $irun] 1116 set _cntlInfo($this-simnum-value) $simnum 1117 1118 # okay, react to value changes again 1119 set _settings 0 1120 } 1121 1122 # 1123 # Search for tuples matching the current setting and 1124 # plot them. 1125 # 1126 if {$_plotall && $_active == "simnum"} { 1127 set format "" 1128 } else { 1129 set format "" 1130 set tuple "" 1131 foreach col [lrange [$_results column names] 2 end] { 1132 if {!$_plotall || $col != $_active} { 1133 lappend format $col 1134 lappend tuple $_cntlInfo($this-$col-value) 1135 } 1136 } 1137 } 1138 1139 if {"" != $format} { 1140 set ilist [$_results find -format $format -- $tuple] 1141 } else { 1142 set ilist [$_results find] 1143 } 1144 1145 if {[llength $ilist] > 0} { 1146 # search for the result for these settings 1147 set format "" 1148 set tuple "" 1149 foreach col [lrange [$_results column names] 2 end] { 1150 lappend format $col 1151 lappend tuple $_cntlInfo($this-$col-value) 1152 } 1153 set icurr [$_results find -format $format -- $tuple] 1154 1155 if {[llength $ilist] == 1} { 1156 # single result -- always use active color 1157 set i [lindex $ilist 0] 1158 set simnum [$_results get -format simnum $i] 1159 set plist [list \ 1160 $simnum [list -width 2 \ 1161 -param [_getValues $_active $i] \ 1162 -description [_getParamDesc all $i] \ 1163 ] \ 1164 params $params \ 1165 ] 1166 } else { 1167 # 1168 # Get the color for all points according to 1169 # the color spectrum. 1170 # 1171 set plist [list params $params] 1172 foreach i $ilist { 1173 set simnum [$_results get -format simnum $i] 1174 if {$i == $icurr} { 1175 lappend plist $simnum [list -width 3 -raise 1 \ 1176 -param [_getValues $_active $i] \ 1177 -description [_getParamDesc all $i]] 1178 } else { 1179 lappend plist $simnum [list -brightness 0.7 -width 1 \ 1180 -param [_getValues $_active $i] \ 1181 -description [_getParamDesc all $i]] 1182 } 1183 } 1184 } 1185 1186 # 1187 # Load up the matching plots 1188 # 1189 _doSettings $plist 1190 } 1191 } 1192 1193 # ---------------------------------------------------------------------- 1194 # USAGE: _fixValue <columnName> <why> 1195 # 1196 # Called automatically whenver a value for a parameter dial changes. 1197 # Updates the interface to display the new value. The <why> is a 1198 # reason for the change, which may be "resize" (draw old value in 1199 # new size) or "value" (value changed). 1200 # ---------------------------------------------------------------------- 1201 itcl::body Rappture::ResultSet::_fixValue {col why} { 1202 if {[info exists _cntlInfo($this-$col-id)]} { 1203 set id $_cntlInfo($this-$col-id) 1204 1205 set widget $itk_component(dials).label$id 1206 set wmax [winfo width $itk_component(dials).dial] 1207 if {$wmax <= 1} { 1208 set wmax [expr {round(0.9*[winfo width $itk_component(cntls)])}] 1209 } 1210 _drawValue $col $widget $wmax 1211 1212 if {$why == "value" && !$_settings} { 1213 # keep track of usage, so we know which controls are popular 1214 incr _cntlInfo($this-$col-usage) 1215 1216 # adjust the settings according to the value in the column 1217 $_dispatcher event -idle !settings column $col 1218 } 1219 } 1220 } 1221 1222 # ---------------------------------------------------------------------- 1223 # USAGE: _drawValue <columnName> <widget> <widthMax> 1224 # 1225 # Used internally to fix the rendering of a "quantity = value" display. 1226 # If the name/value in <widget> are smaller than <widthMax>, then the 1227 # full "quantity = value" string is displayed. Otherwise, an 1228 # abbreviated form is displayed. 1229 # ---------------------------------------------------------------------- 1230 itcl::body Rappture::ResultSet::_drawValue {col widget wmax} { 1231 set quantity $_cntlInfo($this-$col-label) 1232 regsub -all {\n} $quantity " " quantity ;# take out newlines 1233 1234 set newval $_cntlInfo($this-$col-value) 1235 regsub -all {\n} $newval " " newval ;# take out newlines 1236 1237 set lfont [$widget.name cget -font] 1238 set vfont [$widget.value cget -font] 1239 1240 set wn [font measure $lfont $quantity] 1241 set wv [font measure $lfont " = $newval"] 1242 set w [expr {$wn + $wv}] 1243 1244 if {$w <= $wmax} { 1245 # if the text fits, then shown "quantity = value" 1246 $widget.name configure -text $quantity 1247 $widget.value configure -text " = $newval" 1248 } else { 1249 # Otherwise, we'll have to appreviate. 1250 # If the value is really long, then just show a little bit 1251 # of it. Otherwise, show as much of the value as we can. 1252 if {[string length $newval] > 30} { 1253 set frac 0.8 1254 } else { 1255 set frac 0.2 1256 } 1257 set wNameSpace [expr {round($frac*$wmax)}] 1258 set wValueSpace [expr {$wmax-$wNameSpace}] 1259 1260 # fit as much of the "quantity" label in the space available 1261 if {$wn < $wNameSpace} { 1262 $widget.name configure -text $quantity 1263 set wValueSpace [expr {$wmax-$wn}] 1264 } else { 1265 set wDots [font measure $lfont "..."] 1266 set wchar [expr {double($wn)/[string length $quantity]}] 1267 while {1} { 1268 # figure out a good size for the abbreviated string 1269 set cmax [expr {round(($wNameSpace-$wDots)/$wchar)}] 1270 if {$cmax < 0} {set cmax 0} 1271 set str "[string range $quantity 0 $cmax]..." 1272 if {[font measure $lfont $str] <= $wNameSpace 1273 || $wDots >= $wNameSpace} { 1274 break 1275 } 1276 # we're measuring with average chars, so we may have 1277 # to shave a little off and do this again 1278 set wDots [expr {$wDots+2*$wchar}] 1279 } 1280 $widget.name configure -text $str 1281 set wValueSpace [expr {$wmax-[font measure $lfont $str]}] 1282 } 1283 1284 if {$wv < $wValueSpace} { 1285 $widget.value configure -text " = $newval" 1286 } else { 1287 set wDots [font measure $vfont "..."] 1288 set wEq [font measure $vfont " = "] 1289 set wchar [expr {double($wv)/[string length " = $newval"]}] 1290 while {1} { 1291 # figure out a good size for the abbreviated string 1292 set cmax [expr {round(($wValueSpace-$wDots-$wEq)/$wchar)}] 1293 if {$cmax < 0} {set cmax 0} 1294 set str " = [string range $newval 0 $cmax]..." 1295 if {[font measure $vfont $str] <= $wValueSpace 1296 || $wDots >= $wValueSpace} { 1297 break 1298 } 1299 # we're measuring with average chars, so we may have 1300 # to shave a little off and do this again 1301 set wDots [expr {$wDots+2*$wchar}] 1302 } 1303 $widget.value configure -text $str 1304 } 1305 } 1306 } 1307 1308 # ---------------------------------------------------------------------- 1309 # USAGE: _toggleAll ?<columnName>? 1310 # 1311 # Called automatically whenever the user clicks on an "All" button. 1312 # Toggles the button between its on/off states. In the "on" state, 1313 # all results associated with the current control are sent to the 1314 # result viewer. 1315 # ---------------------------------------------------------------------- 1316 itcl::body Rappture::ResultSet::_toggleAll {{col "current"}} { 1317 if {$col == "current"} { 1318 set col $_active 1319 } 1320 if {![info exists _cntlInfo($this-$col-id)]} { 1321 return 1322 } 1323 set id $_cntlInfo($this-$col-id) 1324 set sbutton $itk_component(dials).all 1325 set current [$sbutton cget -relief] 1326 1327 if {$current == "sunken"} { 1328 $sbutton configure -relief raised \ 1329 -background $itk_option(-activecontrolbackground) \ 1330 -foreground $itk_option(-activecontrolforeground) 1331 set _plotall 0 1332 } else { 1333 $sbutton configure -relief sunken \ 1334 -background $itk_option(-togglebackground) \ 1335 -foreground $itk_option(-toggleforeground) 1336 set _plotall 1 1337 1338 if {$col != $_active} { 1339 # clicked on an inactive "All" button? then activate that column 1340 Activate $col 1341 } 1342 } 1343 $_dispatcher event -idle !settings 1344 } 1345 1346 # ---------------------------------------------------------------------- 1347 # USAGE: _getValues <column> ?<which>? 1348 # 1349 # Called automatically whenever the user hovers a control within 1350 # this widget. Returns the tooltip associated with the control. 1351 # ---------------------------------------------------------------------- 1352 itcl::body Rappture::ResultSet::_getValues {col {which ""}} { 1353 if {$col == "simnum"} { 1354 # load the Simulation # control 1355 set nruns [$_results size] 1356 for {set n 0} {$n < $nruns} {incr n} { 1357 set v [$_results get -format simnum $n] 1358 set label2val($v) $n 1359 } 1360 } else { 1361 set havenums 1 1362 set vlist "" 1363 foreach rec [$_results get -format [list xmlobj $col]] { 1364 set xo [lindex $rec 0] 1365 set v [lindex $rec 1] 1366 1367 if {![info exists label2val($v)]} { 1368 lappend vlist $v 1369 foreach {raw norm} [Rappture::LibraryObj::value $xo $col] break 1370 set label2val($v) $norm 1371 1372 if {$havenums && ![string is double $norm]} { 1373 set havenums 0 1374 } 1375 } 1376 } 1377 1378 if {!$havenums} { 1379 # don't have normalized nums? then sort and create nums 1380 catch {unset label2val} 1381 1382 set n 0 1383 foreach v [lsort $vlist] { 1384 incr n 1385 set label2val($v) $n 1386 } 1387 } 1388 } 1389 1390 switch -- $which { 1391 current { 1392 set curr $_cntlInfo($this-$col-value) 1393 if {[info exists label2val($curr)]} { 1394 return [list $curr $label2val($curr)] 1395 } 1396 return "" 1397 } 1398 all { 1399 return [array get label2val] 1400 } 1401 default { 1402 if {[string is integer $which]} { 1403 if {$col == "simnum"} { 1404 set val [$_results get -format simnum $which] 1405 } else { 1406 # Be careful giving singleton elements as the "columns" 1407 # argument to "Tuples::get". It is expecting a list. 1408 set val [lindex [$_results get -format [list $col] $which] 0] 1409 } 1410 if {[info exists label2val($val)]} { 1411 return [list $val $label2val($val)] 1412 } 1413 return "" 1414 } 1415 error "bad option \"$which\": should be all, current, or an integer index" 1416 } 1417 } 1418 } 1419 1420 # ---------------------------------------------------------------------- 1421 # USAGE: _getTooltip <role> <column> 1422 # 1423 # Called automatically whenever the user hovers a control within 1424 # this widget. Returns the tooltip associated with the control. 1425 # ---------------------------------------------------------------------- 1426 itcl::body Rappture::ResultSet::_getTooltip {role column} { 1427 set label "" 1428 set tip "" 1429 if {$column == "active"} { 1430 set column $_active 1431 } 1432 if {[info exists _cntlInfo($this-$column-label)]} { 1433 set label $_cntlInfo($this-$column-label) 1434 } 1435 if {[info exists _cntlInfo($this-$column-tip)]} { 1436 set tip $_cntlInfo($this-$column-tip) 1437 } 1438 1439 switch -- $role { 1440 label { 1441 if {$column != $_active} { 1442 append tip "\n\nClick to activate this control." 1443 } 1444 } 1445 dial { 1446 append tip "\n\nClick to change the value of this parameter." 1447 } 1448 all { 1449 if {$label == ""} { 1450 set tip "Plot all values for this quantity." 1451 } else { 1452 set tip "Plot all values for $label." 1453 } 1454 if {$_plotall} { 1455 set what "all values" 1456 } else { 1457 set what "one value" 1458 } 1459 append tip "\n\nCurrently, plotting $what. Click to toggle." 1460 } 1461 } 1462 return [string trim $tip] 1463 } 1464 1465 # ---------------------------------------------------------------------- 1466 # USAGE: _getParamDesc <which> ?<index>? 1467 # 1468 # Used internally to build a descripton of parameters for the data 1469 # tuple at the specified <index>. This is passed on to the underlying 1470 # results viewer, so it will know what data is being viewed. 1471 # ---------------------------------------------------------------------- 1472 itcl::body Rappture::ResultSet::_getParamDesc {which {index "current"}} { 1473 if {$index == "current"} { 1474 # search for the result for these settings 1475 set format "" 1476 set tuple "" 1477 foreach col [lrange [$_results column names] 2 end] { 1478 lappend format $col 1479 lappend tuple $_cntlInfo($this-$col-value) 1480 } 1481 set index [$_results find -format $format -- $tuple] 1482 if {"" == $index} { 1483 return "" ;# somethings wrong -- bail out! 1484 } 1485 } 1486 1487 switch -- $which { 1488 active { 1489 if {"" == $_active} { 1490 return "" 1491 } 1492 } 1493 all { 1494 set desc "" 1495 foreach col $_cntlInfo($this-all) { 1496 set quantity $_cntlInfo($this-$col-label) 1497 # Be careful giving singleton elements as the "columns" 1498 # argument to "Tuples::get". It is expecting a list. 1499 set val [lindex [$_results get -format [list $col] $index] 0] 1500 if {$col == "simnum"} { 1501 set irun [lindex [$_results find -format xmlobj $val] 0] 1502 set val [$_results get -format simnum $irun] 1503 } 1504 append desc "$quantity = $val\n" 1505 } 1506 return [string trim $desc] 1507 } 1508 default { 1509 error "bad value \"$which\": should be active or all" 471 error "wrong # args: should be add, get, remove" 472 } 473 } 474 } 475 476 # ---------------------------------------------------------------------- 477 # USAGE: _notifyHandler ?<eventArgs>...? 478 # 479 # Called automatically whenever a !change event is triggered in this 480 # object. Scans through the list of clients that want to receive this 481 # event and executes each of their callbacks. 482 # ---------------------------------------------------------------------- 483 itcl::body Rappture::ResultSet::_notifyHandler {args} { 484 array set data $args 485 set event $data(event) 486 487 foreach caller $_notify(ALL) { 488 if {[info exists _notify($caller-$event)]} { 489 if {[catch {uplevel #0 $_notify($caller-$event) $args} result]} { 490 # anything go wrong? then throw a background error 491 bgerror "$result\n(while dispatching $event to $caller)" 492 } 1510 493 } 1511 494 } … … 1575 558 1576 559 # overwrite the first matching entry 560 # start by freeing the old result 1577 561 set index [lindex $ilist 0] 562 set xo [$tuples get -format xmlobj $index] 563 itcl::delete object $xo 564 565 # put this new result in its place 1578 566 $tuples put -format $cols $index $tuple 567 set simnum [$tuples get -format simnum $index] 1579 568 } else { 1580 569 if {$simnum eq ""} { … … 1586 575 return $simnum 1587 576 } 1588 1589 # ----------------------------------------------------------------------1590 # OPTION: -activecontrolbackground1591 # ----------------------------------------------------------------------1592 itcl::configbody Rappture::ResultSet::activecontrolbackground {1593 $_dispatcher event -idle !layout1594 }1595 1596 # ----------------------------------------------------------------------1597 # OPTION: -activecontrolforeground1598 # ----------------------------------------------------------------------1599 itcl::configbody Rappture::ResultSet::activecontrolforeground {1600 $_dispatcher event -idle !layout1601 }1602 -
branches/blt4/gui/scripts/resultviewer.tcl
r3026 r3029 1 1 2 # ---------------------------------------------------------------------- 2 3 # COMPONENT: ResultViewer - plots a collection of related results … … 297 298 if {![info exists _mode2widget($mode)]} { 298 299 global env 299 switch -- [$dataobj type] {300 switch -- [$dataobj viewer] { 300 301 "unirect2d" { 301 302 if { [info exists env(VTKHEIGHTMAP)] } { … … 327 328 set mode "field3D" 328 329 if {![info exists _mode2widget($mode)]} { 329 switch -- [$dataobj type] {330 switch -- [$dataobj viewer] { 330 331 "vtk" { 331 332 set fmt "vtk" -
branches/blt4/gui/scripts/visviewer.tcl
r3025 r3029 164 164 if { [info exists env(VISRECORDER)] } { 165 165 set _logging 1 166 if { [file exists /tmp/recording.log] } { 167 file delete /tmp/recording.log 168 } 166 169 } 167 170 eval itk_initialize $args -
branches/blt4/gui/scripts/vtkcontourviewer.tcl
r3026 r3029 32 32 vtkvis_server Rappture::VtkContourViewer::SetServerList 33 33 } 34 35 34 itcl::class Rappture::VtkContourViewer { 36 35 inherit Rappture::VisViewer … … 65 64 66 65 protected method Connect {} 67 protected method CurrentDatasets { {what -all}}66 protected method CurrentDatasets { args } 68 67 protected method Disconnect {} 69 68 protected method DoResize {} 70 69 protected method FixLegend {} 71 protected method FixSettings {what {value ""}} 70 protected method InitSettings { args } 71 protected method AdjustSetting {what {value ""}} 72 72 protected method Pan {option x y} 73 73 protected method Pick {x y} … … 75 75 protected method ReceiveDataset { args } 76 76 protected method ReceiveImage { args } 77 protected method DrawLegend { }77 protected method DrawLegend { name } 78 78 protected method ReceiveLegend { colormap title vmin vmax size } 79 79 protected method Rotate {option x y} … … 89 89 # The following methods are only used by this class. 90 90 private method BuildCameraTab {} 91 private method BuildColormap { name colors } 92 private method BuildDownloadPopup { widget command } 91 93 private method BuildViewTab {} 92 private method BuildColormap { colormap dataobj comp } 94 private method ChangeColormap { dataobj comp color } 95 private method ColorsToColormap { color } 96 private method FieldMenu { option } 97 private method EnterLegend { x y } 93 98 private method EventuallyResize { w h } 94 99 private method EventuallyResizeLegend { } 95 private method SetStyles { dataobj comp }96 private method PanCamera {}97 100 private method GetImage { args } 98 101 private method GetVtkData { args } 99 private method BuildDownloadPopup { widget command } 102 private method LeaveLegend {} 103 private method MotionLegend { x y } 104 private method PanCamera {} 105 private method SetColormap { dataobj comp } 106 private method SetLegendTip { x y } 107 private method SetObjectStyle { dataobj comp } 100 108 101 109 private variable _arcball "" … … 113 121 # dataobj-components using the tf. 114 122 123 private variable _style ;# Array of current component styles. 115 124 private variable _click ;# info used for rotate operations 116 125 private variable _limits ;# autoscale min/max for all axes 117 126 private variable _view ;# view params for 3D view 118 private common_settings127 private variable _settings 119 128 # Array of transfer functions in server. If 0 the transfer has been 120 129 # defined but not loaded. If 1 the transfer function has been named … … 132 141 private variable _resizeLegendPending 0 133 142 private variable _outline 143 private variable _title "" 144 private variable _currentField "" 145 private variable _scalarFields {} 146 private variable _fields 147 private variable _afterId -1 134 148 } 135 149 … … 137 151 keep -background -foreground -cursor -font 138 152 keep -plotbackground -plotforeground 153 } 154 itk::usual BltComboButton { 155 keep -background -foreground -cursor -font 139 156 } 140 157 … … 197 214 198 215 array set _settings [subst { 199 $this-axes 1 200 $this-edges 0 201 $this-lighting 1 202 $this-opacity 100 203 $this-volume 1 204 $this-isolines 1 205 $this-wireframe 0 206 $this-legend 1 207 $this-colormap 1 216 axes 1 217 edges 0 218 lighting 1 219 opacity 100 220 volume 1 221 isolines 1 222 wireframe 0 223 legend-visible 1 224 contour-field "" 225 contour-palette BCGYR 226 colormap 1 208 227 }] 209 228 210 229 itk_component add view { 211 230 canvas $itk_component(plotarea).view \ 212 -highlightthickness 0 -borderwidth 0 231 -highlightthickness 0 -borderwidth 0 -background black 213 232 } { 214 233 usual 215 234 ignore -highlightthickness -borderwidth -background 216 235 } 217 236 itk_component add fieldmenu { 237 blt::combomenu $itk_component(plotarea).menu -bg black \ 238 -fg white -relief flat \ 239 -textvariable [itcl::scope _currentField] \ 240 -command [itcl::code $this FieldMenu invoke] 241 } { 242 usual 243 ignore -background -foreground -relief 244 } 218 245 set c $itk_component(view) 219 246 bind $c <Configure> [itcl::code $this EventuallyResize %w %h] … … 275 302 Rappture::Tooltip::for $itk_component(zoomout) "Zoom out" 276 303 277 BuildViewTab 304 if { [catch BuildViewTab errs] != 0 } { 305 puts stderr "errs=$errs" 306 } 278 307 BuildCameraTab 279 308 280 # Legend281 282 309 set _image(legend) [image create picture] 283 itk_component add legend { 284 canvas $itk_component(plotarea).legend -width 50 -highlightthickness 0 285 } { 286 usual 287 ignore -highlightthickness 288 rename -background -plotbackground plotBackground Background 289 } 290 bind $itk_component(legend) <Configure> \ 310 bind $itk_component(plotarea) <Configure> \ 291 311 [itcl::code $this EventuallyResizeLegend] 292 312 … … 297 317 pack forget $itk_component(view) 298 318 blt::table $itk_component(plotarea) \ 299 0,0 $itk_component(view) -fill both -reqwidth $w \ 300 1,0 $itk_component(legend) -fill x 301 blt::table $itk_component(plotarea) \ 302 0,0 $itk_component(view) -fill both -reqwidth $w \ 303 0,1 $itk_component(legend) -fill y 304 blt::table configure $itk_component(plotarea) c1 -resize none 305 306 if 0 { 307 bind $itk_component(view) <Configure> \ 308 [itcl::code $this EventuallyResize %w %h] 309 } 319 0,0 $itk_component(view) -fill both -reqwidth $w 320 310 321 # Bindings for panning via mouse 311 322 bind $itk_component(view) <ButtonPress-2> \ … … 367 378 image delete $_image(legend) 368 379 image delete $_image(download) 369 array unset _settings $this-*380 array unset _settings 370 381 catch { blt::arcball destroy $_arcball} 371 382 } 372 383 373 384 itcl::body Rappture::VtkContourViewer::DoResize {} { 374 if { $_width < 2 } { 375 set _width 500 385 set w [expr $_width - 12] 386 if { $w < 2 } { 387 set w 500 376 388 } 377 389 if { $_height < 2 } { 378 390 set _height 500 379 391 } 380 SendCmd "screen size $ _width$_height"381 if { $_settings( $this-legend) } {382 EventuallyResizeLegend392 SendCmd "screen size $w $_height" 393 if { $_settings(legend-visible) } { 394 FixLegend 383 395 } 384 396 set _resizePending 0 … … 707 719 $_image(plot) configure -data $bytes 708 720 #puts stderr "received image [image width $_image(plot)]x[image height $_image(plot)] image>" 721 #puts stderr "w=[winfo width $itk_component(view)]" 709 722 } elseif { $info(type) == "print" } { 710 723 set tag $this-print-$info(-token) … … 721 734 # ---------------------------------------------------------------------- 722 735 itcl::body Rappture::VtkContourViewer::FixLegend {} { 723 puts stderr "FixLegend _first=$_first" 724 set _resizeLegendPending 0 725 set lineht [font metrics $itk_option(-font) -linespace] 726 set c $itk_component(legend) 727 set w 20 728 set h [expr {[winfo height $itk_component(view)] - 2 * ($lineht+2)}] 729 puts stderr "in fixlegend w=$w h=$h" 736 set font "Arial 8" 737 set lineht [font metrics $font -linespace] 738 set c $itk_component(view) 739 set w 12 740 set h [expr {$_height - 3 * ($lineht + 2)}] 741 if { $h < 1} { 742 return 743 } 730 744 if {$w > 0 && $h > 0 && $_first != "" } { 731 set tag [lindex [CurrentDatasets] 0] 732 puts stderr "tag=$tag [info exists _dataset2style($tag)]" 745 set tag [lindex [CurrentDatasets -all] 0] 746 puts stderr "field=$_settings(contour-field) title=$_currentField" 747 set name $_settings(contour-field) 733 748 if { [info exists _dataset2style($tag)] } { 734 SendCmd "legend $_dataset2style($tag) scalar {} $w $h 0" 735 } 736 } else { 737 #$itk_component(legend) delete all 749 set colormap $_dataset2style($tag) 750 SendCmd "legend $colormap scalar ${name} {} $w $h 0" 751 SendCmd "heightmap colormap $colormap $tag" 752 } 753 foreach dataset [CurrentDatasets -all] { 754 SendCmd "dataset scalar ${name} $dataset" 755 SendCmd "dataset visible on $dataset" 756 SendCmd "dataset outline on $dataset" 757 } 738 758 } 739 759 } … … 745 765 # of the contour plot area. 746 766 # 747 itcl::body Rappture::VtkContourViewer::DrawLegend { } {748 set c $itk_component( legend)767 itcl::body Rappture::VtkContourViewer::DrawLegend { name } { 768 set c $itk_component(view) 749 769 set w [winfo width $c] 750 770 set h [winfo height $c] 751 puts stderr "DrawLegend w=$w h=$h" 771 set font "Arial 8" 772 set lineht [font metrics $font -linespace] 773 if { [info exists _fields($name)] } { 774 foreach { title units } $_fields($name) break 775 if { $units != "" } { 776 set title [format "%s (%s)" $title $units] 777 } 778 } else { 779 set title $name 780 } 781 if { $_settings(legend-visible) } { 782 set x [expr $w - 2] 783 if { [$c find withtag "legend"] == "" } { 784 set y 2 785 $c create text $x $y \ 786 -anchor ne \ 787 -fill $itk_option(-plotforeground) -tags "title legend" \ 788 -font $font 789 incr y $lineht 790 $c create text $x $y \ 791 -anchor ne \ 792 -fill $itk_option(-plotforeground) -tags "vmax legend" \ 793 -font $font 794 incr y $lineht 795 $c create image $x $y \ 796 -anchor ne \ 797 -image $_image(legend) -tags "colormap legend" 798 $c create text $x [expr {$h-2}] \ 799 -anchor se \ 800 -fill $itk_option(-plotforeground) -tags "vmin legend" \ 801 -font $font 802 $c bind colormap <Leave> [itcl::code $this LeaveLegend] 803 $c bind colormap <Motion> [itcl::code $this MotionLegend %x %y] 804 } 805 $c bind title <ButtonPress> [itcl::code $this FieldMenu post] 806 $c bind title <Enter> [itcl::code $this FieldMenu activate] 807 $c bind title <Leave> [itcl::code $this FieldMenu deactivate] 808 # Reset the item coordinates according the current size of the plot. 809 $c itemconfigure title -text $title 810 if { $_limits(vmin) != "" } { 811 $c itemconfigure vmin -text [format %g $_limits(vmin)] 812 } 813 if { $_limits(vmax) != "" } { 814 $c itemconfigure vmax -text [format %g $_limits(vmax)] 815 } 816 set y 2 817 $c coords title $x $y 818 incr y $lineht 819 $c coords vmax $x $y 820 incr y $lineht 821 $c coords colormap $x $y 822 $c coords vmin $x [expr {$h - 2}] 823 } 824 } 825 826 if 0 { 827 # 828 # DrawLegend -- 829 # 830 # Draws the legend in it's own canvas which resides to the right 831 # of the contour plot area. 832 # 833 itcl::body Rappture::VtkContourViewer::DrawLegend {} { 834 set c $itk_component(view) 835 set w [winfo width $c] 836 set h [winfo height $c] 837 #puts stderr "DrawLegend w=$w h=$h" 752 838 set lineht [font metrics $itk_option(-font) -linespace] 753 839 754 if { $_settings( $this-legend) } {840 if { $_settings(legend-visible) } { 755 841 if { [$c find withtag "legend"] == "" } { 756 842 $c create image [expr {$w-2}] [expr {$lineht+2}] -anchor ne \ … … 775 861 } 776 862 } 863 } 777 864 778 865 # ---------------------------------------------------------------------- … … 791 878 } 792 879 $_image(legend) configure -data $bytes 793 puts stderr "read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>" 794 DrawLegend 880 set _limits(vmin) $vmin 881 set _limits(vmax) $vmax 882 #puts stderr "read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>" 883 set _title $title 884 DrawLegend $title 795 885 } 796 886 } … … 810 900 "world" { 811 901 foreach { x y z value tag } [lrange $args 2 end] break 812 puts stderr "world x=$x y=$y z=$z value=$value tag=$tag"902 #puts stderr "world x=$x y=$y z=$z value=$value tag=$tag" 813 903 } 814 904 "pixel" { 815 905 foreach { x y value tag } [lrange $args 2 end] break 816 puts stderr "pixel x=$x y=$y value=$value tag=$tag"906 #puts stderr "pixel x=$x y=$y value=$value tag=$tag" 817 907 } 818 908 } … … 823 913 "world" { 824 914 foreach { x y z vx vy vz tag } [lrange $args 2 end] break 825 puts stderr "world x=$x y=$y z=$z value=$vx $xy $vz tag=$tag"915 #puts stderr "world x=$x y=$y z=$z value=$vx $xy $vz tag=$tag" 826 916 } 827 917 "pixel" { 828 918 foreach { x y vx vy vz tag } [lrange $args 2 end] break 829 puts stderr "pixel x=$x y=$y value=$vx $xy $vz tag=$tag"919 #puts stderr "pixel x=$x y=$y value=$vx $xy $vz tag=$tag" 830 920 } 831 921 } … … 833 923 "names" { 834 924 foreach { name } [lindex $args 1] { 835 puts stderr "Dataset: $name"925 #puts stderr "Dataset: $name" 836 926 } 837 927 } … … 850 940 # ---------------------------------------------------------------------- 851 941 itcl::body Rappture::VtkContourViewer::Rebuild {} { 852 853 942 # Turn on buffering of commands to the server. We don't want to 854 943 # be preempted by a server disconnect/reconnect (which automatically … … 874 963 append _outbuf "dataset add $tag data follows $length\n" 875 964 append _outbuf $bytes 876 append _outbuf "heightmap add numcontours [expr {$style(-levels)+1}] 0 $tag\n" 877 SetStyles $dataobj $comp 965 SetObjectStyle $dataobj $comp 878 966 set _datasets($tag) 1 879 967 foreach {min max} [$dataobj limits v] break … … 902 990 SendCmd "camera zoom $_view(zoom)" 903 991 } 904 FixSettings opacity 905 FixSettings isolines 906 FixSettings colormap 907 FixSettings lighting 908 FixSettings wireframe 909 FixSettings axes 910 FixSettings edges 992 993 InitSettings opacity isolines colormap lighting wireframe axes edges 911 994 912 995 # Nothing to send -- activate the proper ivol 913 foreach tag [CurrentDatasets ] {996 foreach tag [CurrentDatasets -all] { 914 997 SendCmd "dataset visible 0 $tag" 915 998 } … … 925 1008 } 926 1009 } 927 1010 1011 if { $_currentField == "" && $_first != "" } { 1012 $itk_component(fieldmenu) delete all 1013 $itk_component(fieldmenu2) delete all 1014 array unset _fields 1015 set _scalarFields [$_first hints scalars] 1016 foreach { name title units } $_scalarFields { 1017 $itk_component(fieldmenu) add \ 1018 -type radiobutton -text "$title" -value $name \ 1019 -variable [itcl::scope _settings(contour-field)] 1020 $itk_component(fieldmenu2) add \ 1021 -text "$title" -value $name \ 1022 -variable [itcl::scope _settings(contour-field)] 1023 set _fields($name) [list $title $units] 1024 } 1025 set fld [$_first hints default] 1026 if { $fld == "" } { 1027 set fld [lindex $_scalarFields 0] 1028 } 1029 foreach { name title units } $_scalarFields { 1030 if { $fld == $name } { 1031 set _settings(contour-field) $name 1032 set _currentField $title 1033 break 1034 } 1035 } 1036 } 928 1037 FixLegend 929 1038 … … 939 1048 940 1049 # ---------------------------------------------------------------------- 941 # USAGE: CurrentDatasets ?- cutplanes?1050 # USAGE: CurrentDatasets ?-all -visible? ?dataobjs? 942 1051 # 943 1052 # Returns a list of server IDs for the current datasets being displayed. This … … 945 1054 # object has multiple components. 946 1055 # ---------------------------------------------------------------------- 947 itcl::body Rappture::VtkContourViewer::CurrentDatasets {{what -all}} { 1056 itcl::body Rappture::VtkContourViewer::CurrentDatasets {args} { 1057 set flag [lindex $args 0] 1058 switch -- $flag { 1059 "-all" { 1060 if { [llength $args] > 1 } { 1061 error "CurrentDatasets: can't specify dataobj after \"-all\"" 1062 } 1063 set dlist [get -objects] 1064 } 1065 "-visible" { 1066 if { [llength $args] > 1 } { 1067 set dlist {} 1068 set args [lrange $args 1 end] 1069 foreach dataobj $args { 1070 if { [info exists _obj2ovride($dataobj-raise)] } { 1071 lappend dlist $dataobj 1072 } 1073 } 1074 } else { 1075 set dlist [get] 1076 } 1077 } 1078 default { 1079 set dlist $args 1080 } 1081 } 948 1082 set rlist "" 949 if { $_first == "" } { 950 return 951 } 952 foreach comp [$_first components] { 953 set tag $_first-$comp 954 if { [info exists _datasets($tag)] && $_datasets($tag) } { 955 lappend rlist $tag 1083 foreach dataobj $dlist { 1084 foreach comp [$dataobj components] { 1085 set tag $dataobj-$comp 1086 if { [info exists _datasets($tag)] && $_datasets($tag) } { 1087 lappend rlist $tag 1088 } 956 1089 } 957 1090 } … … 1109 1242 } 1110 1243 1111 # ---------------------------------------------------------------------- 1112 # USAGE: FixSettings <what> ?<value>? 1244 1245 # ---------------------------------------------------------------------- 1246 # USAGE: InitSettings <what> ?<value>? 1113 1247 # 1114 1248 # Used internally to update rendering settings whenever parameters … … 1116 1250 # to the back end. 1117 1251 # ---------------------------------------------------------------------- 1118 itcl::body Rappture::VtkContourViewer::FixSettings {what {value ""}} { 1252 itcl::body Rappture::VtkContourViewer::InitSettings { args } { 1253 foreach spec $args { 1254 if { [info exists _settings($_first-$spec)] } { 1255 # Reset global setting with dataobj specific setting 1256 set _settings($spec) $_settings($_first-$spec) 1257 } 1258 AdjustSetting $spec 1259 } 1260 } 1261 1262 # ---------------------------------------------------------------------- 1263 # USAGE: AdjustSetting <what> ?<value>? 1264 # 1265 # Used internally to update rendering settings whenever parameters 1266 # change in the popup settings panel. Sends the new settings off 1267 # to the back end. 1268 # ---------------------------------------------------------------------- 1269 itcl::body Rappture::VtkContourViewer::AdjustSetting {what {value ""}} { 1119 1270 switch -- $what { 1120 1271 "opacity" { 1121 1272 if {[isconnected]} { 1122 set val $_settings( $this-opacity)1273 set val $_settings(opacity) 1123 1274 set sval [expr { 0.01 * double($val) }] 1124 foreach dataset [CurrentDatasets ] {1275 foreach dataset [CurrentDatasets -all] { 1125 1276 SendCmd "heightmap opacity $sval $dataset" 1126 1277 } … … 1129 1280 "wireframe" { 1130 1281 if {[isconnected]} { 1131 set bool $_settings( $this-wireframe)1132 foreach dataset [CurrentDatasets ] {1282 set bool $_settings(wireframe) 1283 foreach dataset [CurrentDatasets -all] { 1133 1284 SendCmd "heightmap wireframe $bool $dataset" 1134 1285 } … … 1137 1288 "colormap" { 1138 1289 if {[isconnected]} { 1139 set bool $_settings( $this-colormap)1140 foreach dataset [CurrentDatasets ] {1290 set bool $_settings(colormap) 1291 foreach dataset [CurrentDatasets -all] { 1141 1292 SendCmd "heightmap surface $bool $dataset" 1142 1293 } … … 1145 1296 "isolines" { 1146 1297 if {[isconnected]} { 1147 set bool $_settings( $this-isolines)1148 foreach dataset [CurrentDatasets ] {1298 set bool $_settings(isolines) 1299 foreach dataset [CurrentDatasets -all] { 1149 1300 SendCmd "heightmap isolines $bool $dataset" 1150 1301 } … … 1153 1304 "edges" { 1154 1305 if {[isconnected]} { 1155 set bool $_settings( $this-edges)1156 foreach dataset [CurrentDatasets ] {1306 set bool $_settings(edges) 1307 foreach dataset [CurrentDatasets -all] { 1157 1308 SendCmd "heightmap edges $bool $dataset" 1158 1309 } … … 1161 1312 "lighting" { 1162 1313 if {[isconnected]} { 1163 set bool $_settings( $this-lighting)1164 foreach dataset [CurrentDatasets ] {1314 set bool $_settings(lighting) 1315 foreach dataset [CurrentDatasets -all] { 1165 1316 SendCmd "heightmap lighting $bool $dataset" 1166 1317 } … … 1169 1320 "axes" { 1170 1321 if { [isconnected] } { 1171 set bool $_settings( $this-axes)1322 set bool $_settings(axes) 1172 1323 SendCmd "axis visible all $bool" 1173 1324 } 1174 1325 } 1175 1326 "legend" { 1176 if { $_settings($this-legend) } { 1177 blt::table $itk_component(plotarea) \ 1178 0,0 $itk_component(view) -fill both \ 1179 0,1 $itk_component(legend) -fill y 1180 blt::table configure $itk_component(plotarea) c1 -resize none 1181 } else { 1182 blt::table forget $itk_component(legend) 1183 } 1327 if { !$_settings(legend-visible) } { 1328 $itk_component(view) delete legend 1329 } 1330 DrawLegend $_settings(contour-field) 1331 } 1332 "contour-palette" { 1333 puts stderr "newpalette is $_settings(contour-palette)" 1334 foreach dataset [CurrentDatasets -visible $_first] { 1335 foreach {dataobj comp} [split $dataset -] break 1336 ChangeColormap $dataobj $comp $_settings(contour-palette) 1337 } 1338 set _legendPending 1 1339 } 1340 "contour-field" { 1341 foreach { name title units } $_scalarFields { 1342 if { $name == $_settings(contour-field) } { 1343 DrawLegend $name 1344 foreach dataset [CurrentDatasets -visible] { 1345 SendCmd "dataset scalar ${name} $dataset" 1346 SendCmd "cutplane colormode scalar ${name} $dataset" 1347 } 1348 set _legendPending 1 1349 break 1350 } 1351 } 1184 1352 } 1185 1353 default { 1186 error "don't know how to fix $what" 1187 } 1188 } 1189 } 1190 1191 1192 # 1193 # SetStyles -- 1194 # 1195 itcl::body Rappture::VtkContourViewer::SetStyles { dataobj comp } { 1196 array set style { 1197 -color rainbow 1198 -levels 6 1199 -opacity 1.0 1200 } 1201 set tag $dataobj-$comp 1202 array set style [lindex [$dataobj components -style $comp] 0] 1203 set colormap "$style(-color):$style(-levels):$style(-opacity)" 1204 if { [info exists _colormaps($colormap)] } { 1205 puts stderr "Colormap $colormap already built" 1206 } 1207 if { ![info exists _dataset2style($tag)] } { 1208 set _dataset2style($tag) $colormap 1209 lappend _style2datasets($colormap) $tag 1210 } 1211 if { ![info exists _colormaps($colormap)] } { 1212 # Build the pseudo colormap if it doesn't exist. 1213 BuildColormap $colormap $dataobj $comp 1214 set _colormaps($colormap) 1 1215 } 1216 #SendCmd "heightmap numcontours $style(-levels) $tag\n" 1217 SendCmd "heightmap colormap $colormap $tag" 1218 return $colormap 1219 } 1220 1221 # 1222 # BuildColormap -- 1223 # 1224 itcl::body Rappture::VtkContourViewer::BuildColormap { colormap dataobj comp } { 1225 puts stderr "BuildColormap $colormap" 1226 array set style { 1227 -color rainbow 1228 -levels 6 1229 -opacity 1.0 1230 } 1231 array set style [lindex [$dataobj components -style $comp] 0] 1232 1233 if {$style(-color) == "rainbow"} { 1234 set style(-color) "white:yellow:green:cyan:blue:magenta" 1235 } 1236 set clist [split $style(-color) :] 1237 set cmap {} 1238 for {set i 0} {$i < [llength $clist]} {incr i} { 1239 set x [expr {double($i)/([llength $clist]-1)}] 1240 set color [lindex $clist $i] 1241 append cmap "$x [Color2RGB $color] " 1242 } 1243 if { [llength $cmap] == 0 } { 1244 set cmap "0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0" 1245 } 1246 set tag $this-$colormap 1247 if { ![info exists _settings($tag-opacity)] } { 1248 set _settings($tag-opacity) $style(-opacity) 1249 } 1250 set max $_settings($tag-opacity) 1251 1252 set wmap "0.0 1.0 1.0 1.0" 1253 SendCmd "colormap add $colormap { $cmap } { $wmap }" 1354 error "unknown setting \"$what\": should be one of [array names _settings]" 1355 } 1356 } 1254 1357 } 1255 1358 … … 1318 1421 checkbutton $inner.axes \ 1319 1422 -text "Axes" \ 1320 -variable [itcl::scope _settings( $this-axes)] \1321 -command [itcl::code $this FixSettingsaxes] \1423 -variable [itcl::scope _settings(axes)] \ 1424 -command [itcl::code $this AdjustSetting axes] \ 1322 1425 -font "Arial 9" 1323 1426 1324 1427 checkbutton $inner.colormap \ 1325 1428 -text "Colormap" \ 1326 -variable [itcl::scope _settings( $this-colormap)] \1327 -command [itcl::code $this FixSettingscolormap] \1429 -variable [itcl::scope _settings(colormap)] \ 1430 -command [itcl::code $this AdjustSetting colormap] \ 1328 1431 -font "Arial 9" 1329 1432 1330 1433 checkbutton $inner.isolines \ 1331 1434 -text "Isolines" \ 1332 -variable [itcl::scope _settings( $this-isolines)] \1333 -command [itcl::code $this FixSettingsisolines] \1435 -variable [itcl::scope _settings(isolines)] \ 1436 -command [itcl::code $this AdjustSetting isolines] \ 1334 1437 -font "Arial 9" 1335 1438 1336 1439 checkbutton $inner.wireframe \ 1337 1440 -text "Wireframe" \ 1338 -variable [itcl::scope _settings( $this-wireframe)] \1339 -command [itcl::code $this FixSettingswireframe] \1441 -variable [itcl::scope _settings(wireframe)] \ 1442 -command [itcl::code $this AdjustSetting wireframe] \ 1340 1443 -font "Arial 9" 1341 1444 1342 1445 checkbutton $inner.lighting \ 1343 1446 -text "Lighting" \ 1344 -variable [itcl::scope _settings( $this-lighting)] \1345 -command [itcl::code $this FixSettingslighting] \1447 -variable [itcl::scope _settings(lighting)] \ 1448 -command [itcl::code $this AdjustSetting lighting] \ 1346 1449 -font "Arial 9" 1347 1450 1348 1451 checkbutton $inner.legend \ 1349 1452 -text "Legend" \ 1350 -variable [itcl::scope _settings( $this-legend)] \1351 -command [itcl::code $this FixSettingslegend] \1453 -variable [itcl::scope _settings(legend-visible)] \ 1454 -command [itcl::code $this AdjustSetting legend] \ 1352 1455 -font "Arial 9" 1353 1456 1354 1457 checkbutton $inner.edges \ 1355 1458 -text "Edges" \ 1356 -variable [itcl::scope _settings( $this-edges)] \1357 -command [itcl::code $this FixSettingsedges] \1459 -variable [itcl::scope _settings(edges)] \ 1460 -command [itcl::code $this AdjustSetting edges] \ 1358 1461 -font "Arial 9" 1359 1462 1360 1463 label $inner.clear -text "Clear" -font "Arial 9" 1361 1464 ::scale $inner.opacity -from 0 -to 100 -orient horizontal \ 1362 -variable [itcl::scope _settings( $this-opacity)] \1465 -variable [itcl::scope _settings(opacity)] \ 1363 1466 -width 10 \ 1364 -showvalue off -command [itcl::code $this FixSettingsopacity]1467 -showvalue off -command [itcl::code $this AdjustSetting opacity] 1365 1468 label $inner.opaque -text "Opaque" -font "Arial 9" 1469 1470 label $inner.field_l -text "Field" -font "Arial 9" 1471 blt::comboentry $inner.field -width 10 \ 1472 -menu $inner.field.menu \ 1473 -textvariable [itcl::scope _currentField] \ 1474 -edit no 1475 itk_component add fieldmenu2 { 1476 blt::combomenu $inner.field.menu \ 1477 -textvariable [itcl::scope _currentField] \ 1478 -command [itcl::code $this FieldMenu invoke] 1479 } { 1480 usual 1481 ignore -background 1482 } 1483 label $inner.palette_l -text "Palette" -font "Arial 9" 1484 blt::comboentry $inner.palette -width 10 \ 1485 -menu $inner.palette.menu \ 1486 -textvariable [itcl::scope _settings(contour-palette)] \ 1487 -edit no 1488 set palettes { 1489 "BCGYR" 1490 "BGYOR" 1491 "blue" 1492 "blue-to-brown" 1493 "blue-to-orange" 1494 "blue-to-grey" 1495 "green-to-magenta" 1496 "greyscale" 1497 "nanohub" 1498 "rainbow" 1499 "spectral" 1500 "ROYGB" 1501 "RYGCB" 1502 "brown-to-blue" 1503 "grey-to-blue" 1504 "orange-to-blue" 1505 } 1506 blt::combomenu $inner.palette.menu \ 1507 -textvariable [itcl::scope _settings(contour-palette)] \ 1508 -command [itcl::code $this AdjustSetting contour-palette] \ 1509 -yscrollbar $inner.palette.menu.ybar \ 1510 -height { 0 1.2i } 1511 1512 blt::tk::scrollbar $inner.palette.menu.ybar 1513 1514 $inner.palette.menu listadd $palettes 1366 1515 1367 1516 blt::table $inner \ … … 1375 1524 7,0 $inner.clear -anchor e -pady 2 \ 1376 1525 7,1 $inner.opacity -columnspan 2 -pady 2 -fill x\ 1377 7,3 $inner.opaque -anchor w -pady 2 1526 7,3 $inner.opaque -anchor w -pady 2 \ 1527 8,0 $inner.field_l -anchor e -pady 2 \ 1528 8,1 $inner.field -cspan 3 -anchor w -pady 2 -fill x \ 1529 9,0 $inner.palette_l -anchor e -pady 2 \ 1530 9,1 $inner.palette -cspan 3 -fill x -pady 2 1378 1531 1379 1532 blt::table configure $inner r* -resize none 1380 blt::table configure $inner r 8-resize expand1533 blt::table configure $inner r10 -resize expand 1381 1534 } 1382 1535 … … 1615 1768 } 1616 1769 1770 1771 1772 # 1773 # EnterLegend -- 1774 # 1775 itcl::body Rappture::VtkContourViewer::EnterLegend { x y } { 1776 SetLegendTip $x $y 1777 } 1778 1779 # 1780 # MotionLegend -- 1781 # 1782 itcl::body Rappture::VtkContourViewer::MotionLegend { x y } { 1783 Rappture::Tooltip::tooltip cancel 1784 set c $itk_component(view) 1785 after cancel $_afterId 1786 set _afterId [after 50 [itcl::code $this SetLegendTip $x $y]] 1787 } 1788 1789 # 1790 # LeaveLegend -- 1791 # 1792 itcl::body Rappture::VtkContourViewer::LeaveLegend { } { 1793 Rappture::Tooltip::tooltip cancel 1794 after cancel $_afterId 1795 .rappturetooltip configure -icon "" 1796 } 1797 1798 # 1799 # SetLegendTip -- 1800 # 1801 itcl::body Rappture::VtkContourViewer::SetLegendTip { x y } { 1802 set c $itk_component(view) 1803 set w [winfo width $c] 1804 set h [winfo height $c] 1805 set font "Arial 8" 1806 set lineht [font metrics $font -linespace] 1807 1808 set imgHeight [image height $_image(legend)] 1809 set coords [$c coords colormap] 1810 set imgX [expr $w - [image width $_image(legend)] - 2] 1811 set imgY [expr $y - 2 * ($lineht + 2)] 1812 1813 set units "" 1814 if { [info exists _fields($_title)] } { 1815 foreach { title units } $_fields($_title) break 1816 } 1817 # Make a swatch of the selected color 1818 if { [catch { $_image(legend) get 10 $imgY } pixel] != 0 } { 1819 puts stderr "out of range: $imgY" 1820 return 1821 } 1822 if { ![info exists _image(swatch)] } { 1823 set _image(swatch) [image create picture -width 24 -height 24] 1824 } 1825 #set color [eval format "\#%02x%02x%02x" $pixel] 1826 $_image(swatch) blank white 1827 $_image(swatch) draw rectangle 3 3 20 20 -color $pixel -shadow 1 1828 $_image(swatch) draw rectangle 3 3 20 20 -color black -linewidth 1 1829 .rappturetooltip configure -icon $_image(swatch) 1830 1831 # Compute the value of the point 1832 if { [info exists _limits(vmax)] && [info exists _limits(vmin)] } { 1833 set t [expr 1.0 - (double($imgY) / double($imgHeight-1))] 1834 set value [expr $t * ($_limits(vmax) - $_limits(vmin)) + $_limits(vmin)] 1835 } else { 1836 set value 0.0 1837 } 1838 set tipx [expr $x + 15] 1839 set tipy [expr $y - 5] 1840 Rappture::Tooltip::text $c "$value$units" 1841 Rappture::Tooltip::tooltip show $c +$tipx,+$tipy 1842 } 1843 1844 1845 1846 # ---------------------------------------------------------------------- 1847 # USAGE: _dropdown post 1848 # USAGE: _dropdown unpost 1849 # USAGE: _dropdown select 1850 # 1851 # Used internally to handle the dropdown list for this combobox. The 1852 # post/unpost options are invoked when the list is posted or unposted 1853 # to manage the relief of the controlling button. The select option 1854 # is invoked whenever there is a selection from the list, to assign 1855 # the value back to the gauge. 1856 # ---------------------------------------------------------------------- 1857 itcl::body Rappture::VtkContourViewer::FieldMenu {option} { 1858 set c $itk_component(view) 1859 set m $itk_component(fieldmenu) 1860 switch -- $option { 1861 post { 1862 foreach { x1 y1 x2 y2 } [$c bbox title] break 1863 set x1 [expr [winfo width $c] - [winfo reqwidth $m]] 1864 set x [expr $x1 + [winfo rootx $c]] 1865 set y [expr $y2 + [winfo rooty $c]] 1866 blt::ComboMenu::popup $m $x $y 1867 } 1868 activate { 1869 $c itemconfigure title -fill red 1870 } 1871 deactivate { 1872 $c itemconfigure title -fill white 1873 } 1874 invoke { 1875 set value [$itk_component(fieldmenu) item cget $_currentField -value] 1876 set _$_settings(contour-field) $value 1877 $itk_component(view) itemconfigure title -text $_currentField 1878 FixLegend 1879 AdjustSetting contour-field 1880 } 1881 default { 1882 error "bad option \"$option\": should be post, unpost, select" 1883 } 1884 } 1885 } 1886 1887 1888 # 1889 # ChangeColormap -- 1890 # 1891 itcl::body Rappture::VtkContourViewer::ChangeColormap {dataobj comp color} { 1892 set tag $dataobj-$comp 1893 if { ![info exist _style($tag)] } { 1894 error "no initial colormap" 1895 } 1896 array set style $_style($tag) 1897 set style(-color) $color 1898 set _style($tag) [array get style] 1899 SetColormap $dataobj $comp 1900 FixLegend 1901 } 1902 1903 # 1904 # SetColormap -- 1905 # 1906 itcl::body Rappture::VtkContourViewer::SetColormap { dataobj comp } { 1907 array set style { 1908 -color BGYOR 1909 -levels 6 1910 -opacity 1.0 1911 } 1912 set tag $dataobj-$comp 1913 if { ![info exists _initialStyle($tag)] } { 1914 # Save the initial component style. 1915 set _initialStyle($tag) [$dataobj style $comp] 1916 } 1917 1918 # Override defaults with initial style defined in xml. 1919 array set style $_initialStyle($tag) 1920 1921 if { ![info exists _style($tag)] } { 1922 set _style($tag) [array get style] 1923 } 1924 # Override initial style with current style. 1925 array set style $_style($tag) 1926 1927 set name "$style(-color):$style(-levels):$style(-opacity)" 1928 if { ![info exists _colormaps($name)] } { 1929 BuildColormap $name [array get style] 1930 set _colormaps($name) 1 1931 } 1932 SendCmd "heightmap colormap $name $tag" 1933 SendCmd "heightmap add numcontours [expr {$style(-levels)+1}] 0 $tag" 1934 if { ![info exists _dataset2style($tag)] || 1935 $_dataset2style($tag) != $name } { 1936 set _dataset2style($tag) $name 1937 } 1938 } 1939 1940 1941 itcl::body Rappture::VtkContourViewer::ColorsToColormap { colors } { 1942 switch -- $colors { 1943 "grey-to-blue" { 1944 return { 1945 0.0 0.200 0.200 0.200 1946 0.14285714285714285 0.400 0.400 0.400 1947 0.2857142857142857 0.600 0.600 0.600 1948 0.42857142857142855 0.900 0.900 0.900 1949 0.5714285714285714 0.800 1.000 1.000 1950 0.7142857142857143 0.600 1.000 1.000 1951 0.8571428571428571 0.400 0.900 1.000 1952 1.0 0.000 0.600 0.800 1953 } 1954 } 1955 "blue-to-grey" { 1956 return { 1957 0.0 0.000 0.600 0.800 1958 0.14285714285714285 0.400 0.900 1.000 1959 0.2857142857142857 0.600 1.000 1.000 1960 0.42857142857142855 0.800 1.000 1.000 1961 0.5714285714285714 0.900 0.900 0.900 1962 0.7142857142857143 0.600 0.600 0.600 1963 0.8571428571428571 0.400 0.400 0.400 1964 1.0 0.200 0.200 0.200 1965 } 1966 } 1967 "blue" { 1968 return { 1969 0.0 0.900 1.000 1.000 1970 0.1111111111111111 0.800 0.983 1.000 1971 0.2222222222222222 0.700 0.950 1.000 1972 0.3333333333333333 0.600 0.900 1.000 1973 0.4444444444444444 0.500 0.833 1.000 1974 0.5555555555555556 0.400 0.750 1.000 1975 0.6666666666666666 0.300 0.650 1.000 1976 0.7777777777777778 0.200 0.533 1.000 1977 0.8888888888888888 0.100 0.400 1.000 1978 1.0 0.000 0.250 1.000 1979 } 1980 } 1981 "brown-to-blue" { 1982 return { 1983 0.0 0.200 0.100 0.000 1984 0.09090909090909091 0.400 0.187 0.000 1985 0.18181818181818182 0.600 0.379 0.210 1986 0.2727272727272727 0.800 0.608 0.480 1987 0.36363636363636365 0.850 0.688 0.595 1988 0.45454545454545453 0.950 0.855 0.808 1989 0.5454545454545454 0.800 0.993 1.000 1990 0.6363636363636364 0.600 0.973 1.000 1991 0.7272727272727273 0.400 0.940 1.000 1992 0.8181818181818182 0.200 0.893 1.000 1993 0.9090909090909091 0.000 0.667 0.800 1994 1.0 0.000 0.480 0.600 1995 } 1996 } 1997 "blue-to-brown" { 1998 return { 1999 0.0 0.000 0.480 0.600 2000 0.09090909090909091 0.000 0.667 0.800 2001 0.18181818181818182 0.200 0.893 1.000 2002 0.2727272727272727 0.400 0.940 1.000 2003 0.36363636363636365 0.600 0.973 1.000 2004 0.45454545454545453 0.800 0.993 1.000 2005 0.5454545454545454 0.950 0.855 0.808 2006 0.6363636363636364 0.850 0.688 0.595 2007 0.7272727272727273 0.800 0.608 0.480 2008 0.8181818181818182 0.600 0.379 0.210 2009 0.9090909090909091 0.400 0.187 0.000 2010 1.0 0.200 0.100 0.000 2011 } 2012 } 2013 "blue-to-orange" { 2014 return { 2015 0.0 0.000 0.167 1.000 2016 0.09090909090909091 0.100 0.400 1.000 2017 0.18181818181818182 0.200 0.600 1.000 2018 0.2727272727272727 0.400 0.800 1.000 2019 0.36363636363636365 0.600 0.933 1.000 2020 0.45454545454545453 0.800 1.000 1.000 2021 0.5454545454545454 1.000 1.000 0.800 2022 0.6363636363636364 1.000 0.933 0.600 2023 0.7272727272727273 1.000 0.800 0.400 2024 0.8181818181818182 1.000 0.600 0.200 2025 0.9090909090909091 1.000 0.400 0.100 2026 1.0 1.000 0.167 0.000 2027 } 2028 } 2029 "orange-to-blue" { 2030 return { 2031 0.0 1.000 0.167 0.000 2032 0.09090909090909091 1.000 0.400 0.100 2033 0.18181818181818182 1.000 0.600 0.200 2034 0.2727272727272727 1.000 0.800 0.400 2035 0.36363636363636365 1.000 0.933 0.600 2036 0.45454545454545453 1.000 1.000 0.800 2037 0.5454545454545454 0.800 1.000 1.000 2038 0.6363636363636364 0.600 0.933 1.000 2039 0.7272727272727273 0.400 0.800 1.000 2040 0.8181818181818182 0.200 0.600 1.000 2041 0.9090909090909091 0.100 0.400 1.000 2042 1.0 0.000 0.167 1.000 2043 } 2044 } 2045 "rainbow" { 2046 set clist { 2047 "#EE82EE" 2048 "#4B0082" 2049 "blue" 2050 "#008000" 2051 "yellow" 2052 "#FFA500" 2053 "red" 2054 } 2055 } 2056 "BGYOR" { 2057 set clist { 2058 "blue" 2059 "#008000" 2060 "yellow" 2061 "#FFA500" 2062 "red" 2063 } 2064 } 2065 "ROYGB" { 2066 set clist { 2067 "red" 2068 "#FFA500" 2069 "yellow" 2070 "#008000" 2071 "blue" 2072 } 2073 } 2074 "RYGCB" { 2075 set clist { 2076 "red" 2077 "yellow" 2078 "green" 2079 "cyan" 2080 "blue" 2081 } 2082 } 2083 "BCGYR" { 2084 set clist { 2085 "blue" 2086 "cyan" 2087 "green" 2088 "yellow" 2089 "red" 2090 } 2091 } 2092 "spectral" { 2093 return { 2094 0.0 0.150 0.300 1.000 2095 0.1 0.250 0.630 1.000 2096 0.2 0.450 0.850 1.000 2097 0.3 0.670 0.970 1.000 2098 0.4 0.880 1.000 1.000 2099 0.5 1.000 1.000 0.750 2100 0.6 1.000 0.880 0.600 2101 0.7 1.000 0.680 0.450 2102 0.8 0.970 0.430 0.370 2103 0.9 0.850 0.150 0.196 2104 1.0 0.650 0.000 0.130 2105 } 2106 } 2107 "green-to-magenta" { 2108 return { 2109 0.0 0.000 0.316 0.000 2110 0.06666666666666667 0.000 0.526 0.000 2111 0.13333333333333333 0.000 0.737 0.000 2112 0.2 0.000 0.947 0.000 2113 0.26666666666666666 0.316 1.000 0.316 2114 0.3333333333333333 0.526 1.000 0.526 2115 0.4 0.737 1.000 0.737 2116 0.4666666666666667 1.000 1.000 1.000 2117 0.5333333333333333 1.000 0.947 1.000 2118 0.6 1.000 0.737 1.000 2119 0.6666666666666666 1.000 0.526 1.000 2120 0.7333333333333333 1.000 0.316 1.000 2121 0.8 0.947 0.000 0.947 2122 0.8666666666666667 0.737 0.000 0.737 2123 0.9333333333333333 0.526 0.000 0.526 2124 1.0 0.316 0.000 0.316 2125 } 2126 } 2127 "greyscale" { 2128 return { 2129 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 2130 } 2131 } 2132 "nanohub" { 2133 set clist "white yellow green cyan blue magenta" 2134 } 2135 default { 2136 set clist $colors 2137 } 2138 } 2139 set cmap {} 2140 for {set i 0} {$i < [llength $clist]} {incr i} { 2141 set x [expr {double($i)/([llength $clist]-1)}] 2142 set color [lindex $clist $i] 2143 append cmap "$x [Color2RGB $color] " 2144 } 2145 return $cmap 2146 } 2147 2148 # 2149 # BuildColormap -- 2150 # 2151 itcl::body Rappture::VtkContourViewer::BuildColormap { name styles } { 2152 array set style $styles 2153 set cmap [ColorsToColormap $style(-color)] 2154 if { [llength $cmap] == 0 } { 2155 set cmap "0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0" 2156 } 2157 if { ![info exists _settings(contour-opacity)] } { 2158 set _settings(contour-opacity) $style(-opacity) 2159 } 2160 set max $_settings(contour-opacity) 2161 2162 set wmap "0.0 1.0 1.0 1.0" 2163 SendCmd "colormap add $name { $cmap } { $wmap }" 2164 } 2165 2166 2167 itcl::body Rappture::VtkContourViewer::SetObjectStyle { dataobj comp } { 2168 # Parse style string. 2169 set tag $dataobj-$comp 2170 set style [$dataobj style $comp] 2171 array set settings { 2172 -color \#808080 2173 -edgecolor black 2174 -edges 0 2175 -lighting 1 2176 -linewidth 1.0 2177 -opacity 0.4 2178 -seedcolor white 2179 -seeds 1 2180 -visible 1 2181 -wireframe 0 2182 } 2183 if { $dataobj != $_first } { 2184 set settings(-opacity) 1 2185 } 2186 array set settings $style 2187 SendCmd "heightmap add numcontours 7 0 $tag" 2188 SendCmd "heightmap linecolor 1. 1. 1. $tag" 2189 SendCmd "heightmap isolinecolor 1. 1. 1. $tag" 2190 SendCmd "heightmap linewidth 1 $tag" 2191 SendCmd "heightmap isolinewidth 2 $tag" 2192 SendCmd "heightmap visible $tag" 2193 SendCmd "heightmap lighting on $tag" 2194 set _settings(contour-wireframe) $settings(-wireframe) 2195 set _settings(contour-opacity) [expr $settings(-opacity) * 100.0] 2196 SetColormap $dataobj $comp 2197 }
Note: See TracChangeset
for help on using the changeset viewer.