Changeset 2297
- Timestamp:
- Jul 8, 2011, 2:17:46 PM (13 years ago)
- Location:
- branches/blt4/gui/scripts
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/blt4/gui/scripts/curve.tcl
r1786 r2297 139 139 } 140 140 141 blt::vector create tmp zero 141 blt::vector create tmp 142 blt::vector create zero 142 143 foreach comp [array names _comp2xy] { 143 144 set vname [lindex $_comp2xy($comp) $pos] -
branches/blt4/gui/scripts/field.tcl
r2173 r2297 267 267 set max "" 268 268 269 blt::vector create tmp zero 269 blt::vector create tmp 270 blt::vector create zero 270 271 foreach comp [array names _comp2dims] { 271 272 switch -- $_comp2dims($comp) { -
branches/blt4/gui/scripts/histogram.tcl
r2173 r2297 25 25 26 26 public method components {{pattern *}} 27 public method locations {} 28 public method heights {} 29 public method widths {} 27 public method mesh { component } 28 public method values { component } 29 public method widths { component } 30 public method xlabels { component } 30 31 public method limits {which} 31 32 public method xmarkers {} … … 33 34 public method hints {{key ""}} 34 35 35 protected method _build {} 36 protected method Build {} 37 private method Clear {} 38 private method ParseData { comp } 36 39 37 40 private variable _xmlobj "" ;# ref to lib obj with histogram data 38 41 private variable _hist "" ;# lib obj representing this histogram 39 private variable _widths "" ;# vector of bin widths (may be empty string). 40 private variable _heights "" ;# vector of bin heights along y-axis. 41 private variable _locations "" ;# vector of bin locations along x-axis. 42 42 private variable _widths ;# array of vectors of bin widths 43 private variable _yvalues ;# array of vectors of bin heights along 44 ;# y-axis. 45 private variable _xvalues ;# array of vectors of bin locations along 46 ;# x-axis. 47 private variable _xlabels ;# array of labels 43 48 private variable _hints ;# cache of hints stored in XML 44 49 private variable _xmarkers "";# list of {x,label,options} triplets. 45 50 private variable _ymarkers "";# list of {y,label,options} triplets. 46 51 private common _counter 0 ;# counter for unique vector names 52 private variable _comp2hist ;# maps component name => x,y,w,l vectors 47 53 } 48 54 … … 58 64 59 65 # build up vectors for various components of the histogram 60 _build66 Build 61 67 } 62 68 … … 65 71 # ---------------------------------------------------------------------- 66 72 itcl::body Rappture::Histogram::destructor {} { 73 # don't destroy the _xmlobj! we don't own it! 67 74 itcl::delete object $_hist 68 # don't destroy the _xmlobj! we don't own it! 69 if {"" != $_widths} { 70 blt::vector destroy $_widths 71 } 72 if {"" != $_heights} { 73 blt::vector destroy $_heights 74 } 75 if {"" != $_locations} { 76 blt::vector destroy $_locations 77 } 78 } 79 80 # ---------------------------------------------------------------------- 81 # USAGE: locations 75 Clear 76 } 77 78 # ---------------------------------------------------------------------- 79 # USAGE: mesh 82 80 # 83 81 # Returns the vector for the histogram bin locations along the 84 82 # x-axis. 85 83 # ---------------------------------------------------------------------- 86 itcl::body Rappture::Histogram::locations {} { 87 return $_locations 84 itcl::body Rappture::Histogram::mesh { comp } { 85 if { [info exists _xvalues($comp)] } { 86 return $_xvalues($comp) 87 } 88 return "" 88 89 } 89 90 … … 93 94 # Returns the vector for the histogram bin heights along the y-axis. 94 95 # ---------------------------------------------------------------------- 95 itcl::body Rappture::Histogram::heights {} { 96 return $_heights 96 itcl::body Rappture::Histogram::values { comp } { 97 if { [info exists _yvalues($comp)] } { 98 return $_yvalues($comp) 99 } 100 return "" 97 101 } 98 102 … … 104 108 # overall histogram (sum of all components). 105 109 # ---------------------------------------------------------------------- 106 itcl::body Rappture::Histogram::widths {} { 107 return $_widths 110 itcl::body Rappture::Histogram::widths { comp } { 111 if { [info exists _widths($comp)] } { 112 return $_widths($comp) 113 } 114 return "" 115 } 116 117 # ---------------------------------------------------------------------- 118 # USAGE: xlabels 119 # 120 # Returns the vector for the specified histogram component <name>. 121 # If the name is not specified, then it returns the vectors for the 122 # overall histogram (sum of all components). 123 # ---------------------------------------------------------------------- 124 itcl::body Rappture::Histogram::xlabels { comp } { 125 if { [info exists _xlabels($comp)] } { 126 return $_xlabels($comp) 127 } 128 return "" 108 129 } 109 130 … … 116 137 itcl::body Rappture::Histogram::xmarkers {} { 117 138 return $_xmarkers; 139 } 140 141 # ---------------------------------------------------------------------- 142 # USAGE: components ?<pattern>? 143 # 144 # Returns a list of names for the various components of this curve. 145 # If the optional glob-style <pattern> is specified, then it returns 146 # only the component names matching the pattern. 147 # ---------------------------------------------------------------------- 148 itcl::body Rappture::Histogram::components {{pattern *}} { 149 set rlist "" 150 foreach name [array names _comp2hist] { 151 if {[string match $pattern $name]} { 152 lappend rlist $name 153 } 154 } 155 return $rlist 118 156 } 119 157 … … 140 178 set max "" 141 179 switch -- $which { 142 x - xlin { 143 set vname $_locations; 144 set log 0; 145 set axis xaxis 146 } 147 xlog { 148 set vname $_locations; 149 set log 1; 150 set axis xaxis 151 } 152 y - ylin { 153 set vname $_heights; 154 set log 0; 155 set axis yaxis 156 } 157 ylog { 158 set vname $_heights; 159 set log 1; 160 set axis yaxis 161 } 180 x - xlin { set pos 0; set log 0; set axis xaxis } 181 xlog { set pos 0; set log 1; set axis xaxis } 182 y - ylin - v - vlin { set pos 1; set log 0; set axis yaxis } 183 ylog - vlog { set pos 1; set log 1; set axis yaxis } 162 184 default { 163 error "bad option \"$which\": should be x, xlin, xlog, y, ylin, ylog" 164 } 165 } 166 if {"" == $vname} { 167 return {0 1} 168 } 169 $vname dup tmp 170 $vname dup zero 171 if {$log} { 172 # on a log scale, use abs value and ignore 0's 173 zero expr {tmp == 0} ;# find the 0's 174 tmp expr {abs(tmp)} ;# get the abs value 175 tmp expr {tmp + zero*max(tmp)} ;# replace 0's with abs max 176 set vmin [blt::vector expr min(tmp)] 177 set vmax [blt::vector expr max(tmp)] 178 } else { 179 set vmin [blt::vector expr min($vname)] 180 set vmax [blt::vector expr max($vname)] 181 } 182 183 if {"" == $min} { 184 set min $vmin 185 } elseif {$vmin < $min} { 186 set min $vmin 187 } 188 if {"" == $max} { 189 set max $vmax 190 } elseif {$vmax > $max} { 191 set max $vmax 185 error "bad option \"$which\": should be x, xlin, xlog, y, ylin, ylog, v, vlin, vlog" 186 } 187 } 188 189 blt::vector create tmp 190 blt::vector create zero 191 foreach comp [array names _comphist] { 192 set vname [lindex $_comp2hist($comp) $pos] 193 $vname variable vec 194 195 if {$log} { 196 # on a log scale, use abs value and ignore 0's 197 $vname dup tmp 198 $vname dup zero 199 zero expr {tmp == 0} ;# find the 0's 200 tmp expr {abs(tmp)} ;# get the abs value 201 tmp expr {tmp + zero*max(tmp)} ;# replace 0's with abs max 202 set vmin [blt::vector expr min(tmp)] 203 set vmax [blt::vector expr max(tmp)] 204 } else { 205 set vmin $vec(min) 206 set vmax $vec(max) 207 } 208 209 if {"" == $min} { 210 set min $vmin 211 } elseif {$vmin < $min} { 212 set min $vmin 213 } 214 if {"" == $max} { 215 set max $vmax 216 } elseif {$vmax > $max} { 217 set max $vmax 218 } 192 219 } 193 220 blt::vector destroy tmp zero … … 208 235 } 209 236 } 210 211 237 return [list $min $max] 212 238 } … … 271 297 272 298 # ---------------------------------------------------------------------- 273 # USAGE: _build299 # USAGE: Build 274 300 # 275 301 # Used internally to build up the vector representation for the … … 278 304 # from scratch. 279 305 # ---------------------------------------------------------------------- 280 itcl::body Rappture::Histogram:: _build {} {306 itcl::body Rappture::Histogram::Build {} { 281 307 # discard any existing data 282 if { $_locations != "" } { 283 blt::vector destroy $_locations 284 set _locations "" 285 } 286 if { $_widths != "" } { 287 blt::vector destroy $_widths 288 set _widths "" 289 } 290 if { $_heights != "" } { 291 blt::vector destroy $_heights 292 set _heights "" 293 } 294 308 Clear 295 309 # 296 310 # Scan through the components of the histogram and create … … 299 313 # enhancements require more than one component. 300 314 # 301 set xhwdata [$_hist get component.xhw] 302 if {"" != $xhwdata} { 303 set _widths [blt::vector create \#auto] 304 set _heights [blt::vector create \#auto] 305 set _locations [blt::vector create \#auto] 306 307 foreach line [split $xhwdata \n] { 308 set n [scan $line {%s %s %s} x h w] 309 if { $n == 2 } { 310 $_locations append $x 311 $_heights append $h 312 } elseif { $n == 3 } { 313 $_locations append $x 314 $_heights append $h 315 $_widths append $w 316 } 317 } 318 # FIXME: There must be a width specified for each bin location. 319 # If this isn't true, we default to uniform widths 320 # (zero-length _widths vector == uniform). 321 if { [$_locations length] != [$_widths length] } { 322 $_widths set {} 323 } 315 foreach cname [$_hist children -type component] { 316 ParseData $cname 324 317 } 325 318 # Creates lists of x and y marker data. … … 341 334 } 342 335 } 336 337 itcl::body Rappture::Histogram::ParseData { comp } { 338 # Create new vectors or discard any existing data 339 set _xvalues($comp) [blt::vector create \#auto] 340 set _yvalues($comp) [blt::vector create \#auto] 341 set _widths($comp) [blt::vector create \#auto] 342 set _xlabels($comp) {} 343 344 set xydata [$_hist get ${comp}.xy] 345 if { $xydata != "" } { 346 set tmp [blt::vector create \#auto] 347 $tmp set $xydata 348 $tmp split $_xvalues($comp) $_yvalues($comp) 349 blt::vector destroy $tmp 350 $_widths($comp) set {} 351 set _comp2hist($comp) [list $_xvalues($comp) $_yvalues($comp)] 352 return 353 } 354 set xhwdata [$_hist get ${comp}.xhw] 355 if { $xhwdata != "" } { 356 foreach line [split $xhwdata \n] { 357 set n [scan $line {%s %s %s} x h w] 358 if { $n == 2 } { 359 $_xvalues($comp) append $x 360 $_yvalues($comp) append $h 361 } elseif { $n == 3 } { 362 $_xvalues($comp) append $x 363 $_yvalues($comp) append $h 364 $_widths($comp) append $w 365 } 366 } 367 # FIXME: There must be a width specified for each bin location. 368 # If this isn't true, we default to uniform widths 369 # (zero-length _widths vector == uniform). 370 if { [$_xvalues($comp) length] != [$_widths($comp) length] } { 371 $_widths($comp) set {} 372 } 373 set _comp2hist($comp) [list $_xvalues($comp) $_yvalues($comp)] 374 return 375 } 376 set nvdata [$_hist get ${comp}.namevalue] 377 if { $nvdata != "" } { 378 set count 0 379 foreach line [split $nvdata \n] { 380 foreach {name value} $line break 381 $_yvalues($comp) append $value 382 $_xvalues($comp) append $count 383 lappend _xlabels($comp) $name 384 incr count 385 } 386 set _comp2hist($comp) [list $_xvalues($comp) $_yvalues($comp)] 387 return 388 } 389 set xv [$_hist get $comp.xvector] 390 set yv [$_hist get $comp.yvector] 391 if { $xv != "" && $yv != "" } { 392 $_yvalues($comp) set $yv 393 $_xvalues($comp) set $xv 394 } 395 set _comp2hist($comp) [list $xv $yv] 396 } 397 398 itcl::body Rappture::Histogram::Clear {} { 399 foreach name [array names _widths] { 400 blt::vector destroy $_widths($name) 401 } 402 array unset _widths 403 foreach name [array names _yvalues] { 404 blt::vector destroy $_yvalues($name) 405 } 406 array unset _yvalues 407 foreach name [array names _xvalues] { 408 blt::vector destroy $_xvalues($name) 409 } 410 array unset _xvalues 411 array unset _xlabels 412 array unset _comp2hist 413 } 414 -
branches/blt4/gui/scripts/histogramresult.tcl
r2295 r2297 18 18 option add *HistogramResult*Element.borderWidth 1 widgetDefault 19 19 option add *HistogramResult*Element.relief solid widgetDefault 20 option add *HistogramResult*x.loose 1widgetDefault21 option add *HistogramResult*y.loose 1widgetDefault20 option add *HistogramResult*x.loose 0 widgetDefault 21 option add *HistogramResult*y.loose 0 widgetDefault 22 22 option add *HistogramResult*Element.relief solid widgetDefault 23 23 option add *HistogramResult*Element.borderWidth 1 widgetDefault 24 24 # Don't let the step size default to 1.0 (for barcharts) 25 option add *HistogramResult*x.stepSize 0.0 widgetDefault25 option add *HistogramResult*x.stepSize 1.0 widgetDefault 26 26 27 27 option add *HistogramResult.width 3i widgetDefault … … 112 112 protected method _enterMarker { g name x y text } 113 113 protected method _leaveMarker { g name } 114 protected method FormatLabels { g value } 114 115 115 116 private variable _dispatcher "" ;# dispatcher for !events … … 130 131 common _downloadPopup ;# download options from popup 131 132 private variable _markers 133 private variable _xlabels 132 134 } 133 135 … … 362 364 itcl::body Rappture::HistogramResult::get {} { 363 365 # put the dataobj list in order according to -raise options 364 set clist $_dlist 365 foreach obj $clist { 366 set bottom {} 367 set top {} 368 foreach obj $_dlist { 366 369 if {[info exists _dataobj2raise($obj)] && $_dataobj2raise($obj)} { 367 set i [lsearch -exact $clist $obj] 368 if {$i >= 0} { 369 set clist [lreplace $clist $i $i] 370 lappend clist $obj 371 } 372 } 373 } 374 return $clist 370 lappend top $obj 371 } else { 372 lappend bottom $obj 373 } 374 } 375 set _dlist [concat $bottom $top] 376 return $_dlist 375 377 } 376 378 … … 647 649 } 648 650 } 649 651 $g axis configure x 650 652 # 651 653 # All of the extra axes get mapped to the x2/y2 (top/right) … … 683 685 [list ::Rappture::Tooltip::tooltip cancel] 684 686 } 685 687 set invert 0 688 array unset _xlabels 686 689 # 687 690 # Plot all of the dataobjs. … … 691 694 set label [$dataobj hints label] 692 695 foreach {mapx mapy} [_getAxes $dataobj] break 693 694 set xv [$dataobj locations] 695 set yv [$dataobj heights] 696 set zv [$dataobj widths] 697 if {$xv eq "" || $yv eq "" || $zv eq ""} { 698 continue 699 } 700 701 if {[info exists _dataobj2color($dataobj)]} { 702 set color $_dataobj2color($dataobj) 703 } else { 704 set color [$dataobj hints color] 705 if {"" == $color} { 706 set color black 707 } 708 } 709 710 if {[info exists _dataobj2width($dataobj)]} { 711 set lwidth $_dataobj2width($dataobj) 712 } else { 713 set lwidth 2 714 } 715 716 if {[info exists _dataobj2dashes($dataobj)]} { 717 set dashes $_dataobj2dashes($dataobj) 718 } else { 719 set dashes "" 720 } 721 if {([$xv length] <= 1) || ($lwidth == 0)} { 722 set sym square 723 set pixels 2 724 } else { 725 set sym "" 726 set pixels 6 727 } 728 # Compute default bar width for histogram elements. 729 if { [$zv length] == [$xv length] } { 730 foreach x [$xv values] y [$yv values] z [$zv values] { 731 set elem "elem[incr count]" 732 set _elem2dataobj($elem) $dataobj 733 $g element create $elem -x $x -y $y -barwidth $z \ 696 foreach comp [$dataobj components] { 697 set xv [$dataobj mesh $comp] 698 set yv [$dataobj values $comp] 699 set zv [$dataobj widths $comp] 700 if {$xv eq "" || $yv eq "" || $zv eq ""} { 701 continue 702 } 703 if {[info exists _dataobj2color($dataobj)]} { 704 set color $_dataobj2color($dataobj) 705 } else { 706 set color [$dataobj hints color] 707 if {"" == $color} { 708 set color black 709 } 710 } 711 if {[info exists _dataobj2width($dataobj)]} { 712 set lwidth $_dataobj2width($dataobj) 713 } else { 714 set lwidth 2 715 } 716 if {[info exists _dataobj2dashes($dataobj)]} { 717 set dashes $_dataobj2dashes($dataobj) 718 } else { 719 set dashes "" 720 } 721 if {([$xv length] <= 1) || ($lwidth == 0)} { 722 set sym square 723 set pixels 2 724 } else { 725 set sym "" 726 set pixels 6 727 } 728 # Compute default bar width for histogram elements. 729 if { [$zv length] == [$xv length] } { 730 foreach x [$xv values] y [$yv values] z [$zv values] { 731 set elem "elem[incr count]" 732 set _elem2dataobj($elem) $dataobj 733 $g element create $elem -x $x -y $y -barwidth $z \ 734 -label $label -foreground $color \ 735 -mapx $mapx -mapy $mapy 736 } 737 } else { 738 set r [blt::vector expr {max($xv) - min($xv)}] 739 set z [expr {$r / ([$xv length]-1) * 0.8}] 740 set elem "elem[incr count]" 741 set _elem2dataobj($elem) $dataobj 742 $g element create $elem -x $xv -y $yv -barwidth $z \ 734 743 -label $label -foreground $color \ 735 744 -mapx $mapx -mapy $mapy 736 } 737 } else { 738 set r [blt::vector expr {max($xv) - min($xv)}] 739 set z [expr {$r / ([$xv length]-1) * 0.8}] 740 set elem "elem[incr count]" 741 set _elem2dataobj($elem) $dataobj 742 $g element create $elem -x $xv -y $yv -barwidth $z \ 743 -label $label -foreground $color \ 744 -mapx $mapx -mapy $mapy 745 } 745 } 746 set index 0 747 foreach label [$dataobj xlabels $comp] { 748 if { [string length $label] > 3 } { 749 set invert 1 750 } 751 set _xlabels($index) $label 752 incr index 753 } 754 } 746 755 } 747 756 foreach dataobj $_dlist { 748 749 750 751 752 753 757 set xmin -Inf 758 set ymin -Inf 759 set xmax Inf 760 set ymax Inf 761 # 762 # Create text/line markers for each *axis.marker specified. 754 763 # 755 764 foreach m [$dataobj xmarkers] { … … 794 803 } 795 804 } 805 if { [array size _xlabels] > 0 } { 806 set command [itcl::code $this FormatLabels] 807 } else { 808 set command "" 809 } 810 $g axis configure x -command $command 811 $g configure -invertxy $invert 796 812 $itk_component(legend) reset 797 813 } … … 805 821 itcl::body Rappture::HistogramResult::_resetLimits {} { 806 822 set g $itk_component(plot) 807 808 823 # 809 824 # HACK ALERT! … … 1608 1623 return $img 1609 1624 } 1625 1626 itcl::body Rappture::HistogramResult::FormatLabels { w value } { 1627 # Determine the element name from the value 1628 set index [expr round($value)] 1629 if { [info exists _xlabels($index)] } { 1630 return $_xlabels($index) 1631 } 1632 puts stderr "value=$value index=$index" 1633 parray _xlabels 1634 return $value 1635 }
Note: See TracChangeset
for help on using the changeset viewer.