Changeset 46
- Timestamp:
- Aug 21, 2005 10:24:48 PM (19 years ago)
- Location:
- trunk/gui/scripts
- Files:
-
- 4 added
- 2 edited
-
balloon.tcl (added)
-
images/dismiss.xbm (added)
-
images/finddn.gif (added)
-
images/findup.gif (added)
-
textresult.tcl (modified) (5 diffs)
-
xyresult.tcl (modified) (10 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/gui/scripts/textresult.tcl
r23 r46 14 14 option add *TextResult.width 4i widgetDefault 15 15 option add *TextResult.height 4i widgetDefault 16 option add *TextResult.textBackground white widgetDefault 16 17 option add *TextResult.font \ 18 -*-helvetica-medium-r-normal-*-*-120-* widgetDefault 19 option add *TextResult.textFont \ 17 20 -*-courier-medium-r-normal-*-*-120-* widgetDefault 18 21 … … 27 30 public method scale {args} 28 31 32 public method select {option args} 33 public method find {option} 34 29 35 set _dataobj "" ;# data object currently being displayed 36 37 private common icons 38 set dir [file dirname [info script]] 39 set icons(up) [image create photo -file [file join $dir images findup.gif]] 40 set icons(down) [image create photo -file [file join $dir images finddn.gif]] 30 41 } 31 42 … … 41 52 pack propagate $itk_component(hull) no 42 53 54 # 55 # CONTROL BAR with find/select functions 56 # 57 itk_component add controls { 58 frame $itk_interior.cntls 59 } 60 pack $itk_component(controls) -side bottom -fill x -pady {4 0} 61 62 itk_component add selectall { 63 button $itk_component(controls).selall -text "Select All" \ 64 -command [itcl::code $this select all] 65 } 66 pack $itk_component(selectall) -side right -fill y 67 68 itk_component add findl { 69 label $itk_component(controls).findl -text "Find:" 70 } 71 pack $itk_component(findl) -side left 72 73 itk_component add find { 74 entry $itk_component(controls).find -width 20 75 } 76 pack $itk_component(find) -side left 77 78 itk_component add finddown { 79 button $itk_component(controls).finddown -image $icons(down) \ 80 -relief flat -overrelief raised \ 81 -command [itcl::code $this find down] 82 } { 83 usual 84 ignore -relief 85 } 86 pack $itk_component(finddown) -side left 87 88 itk_component add findup { 89 button $itk_component(controls).findup -image $icons(up) \ 90 -relief flat -overrelief raised \ 91 -command [itcl::code $this find up] 92 } { 93 usual 94 ignore -relief 95 } 96 pack $itk_component(findup) -side left 97 98 itk_component add findstatus { 99 label $itk_component(controls).finds -width 10 -anchor w 100 } 101 pack $itk_component(findstatus) -side left -expand yes -fill x 102 103 # shortcut for Return in search field 104 bind $itk_component(find) <KeyPress-Return> " 105 $itk_component(finddown) configure -relief sunken 106 update idletasks 107 after 200 108 $itk_component(finddown) configure -relief flat 109 $itk_component(finddown) invoke 110 " 111 bind $itk_component(find) <KeyPress> \ 112 [itcl::code $this find reset] 113 114 # 115 # TEXT AREA 116 # 43 117 itk_component add scroller { 44 118 Rappture::Scroller $itk_interior.scroller \ … … 49 123 itk_component add text { 50 124 text $itk_component(scroller).text -width 1 -height 1 -wrap none 125 } { 126 usual 127 rename -background -textbackground textBackground Background 128 rename -font -textfont textFont Font 51 129 } 52 130 $itk_component(scroller) contents $itk_component(text) … … 161 239 # nothing to do for text 162 240 } 241 242 # ---------------------------------------------------------------------- 243 # USAGE: select all 244 # 245 # Handles various selection operations within the text. 246 # ---------------------------------------------------------------------- 247 itcl::body Rappture::TextResult::select {option args} { 248 switch -- $option { 249 all { 250 $itk_component(text) tag add sel 1.0 end 251 } 252 default { 253 error "bad option \"$option\": should be all" 254 } 255 } 256 } 257 258 # ---------------------------------------------------------------------- 259 # USAGE: find up 260 # USAGE: find down 261 # USAGE: find reset 262 # 263 # Handles various find operations within the text. These find a 264 # bit of text and highlight it within the widget. The find operation 265 # starts from the end of the currently highlighted text, or from the 266 # beginning if there is no highlight. 267 # ---------------------------------------------------------------------- 268 itcl::body Rappture::TextResult::find {option} { 269 # handle the reset case... 270 $itk_component(find) configure \ 271 -background $itk_option(-background) \ 272 -foreground $itk_option(-foreground) 273 $itk_component(findstatus) configure -text "" 274 275 if {$option == "reset"} { 276 return 277 } 278 279 # handle the up/down cases... 280 set t $itk_component(text) 281 set pattern [string trim [$itk_component(find) get]] 282 283 if {"" == $pattern} { 284 $itk_component(find) configure -background red -foreground white 285 $itk_component(findstatus) configure -text "<< Enter a search string" 286 return 287 } 288 289 # find the starting point for the search 290 set seln [$t tag nextrange sel 1.0] 291 if {$seln == ""} { 292 set t0 1.0 293 set t1 end 294 } else { 295 foreach {t0 t1} $seln break 296 } 297 $t tag remove sel 1.0 end 298 299 # search up or down 300 switch -- $option { 301 up { 302 set start [$t index $t0-1char] 303 set next [$t search -backwards -nocase -- $pattern $start] 304 } 305 down { 306 set start [$t index $t1+1char] 307 set next [$t search -forwards -nocase -- $pattern $start] 308 } 309 } 310 311 if {"" != $next} { 312 set len [string length $pattern] 313 $t tag add sel $next $next+${len}chars 314 $t see $next 315 set lnum [lindex [split $next .] 0] 316 set lines [lindex [split [$t index end] .] 0] 317 set percent [expr {round(100.0*$lnum/$lines)}] 318 set status "line $lnum --$percent%--" 319 } else { 320 set status "Not found" 321 $itk_component(find) configure -background red -foreground white 322 } 323 $itk_component(findstatus) configure -text $status 324 } -
trunk/gui/scripts/xyresult.tcl
r43 r46 16 16 option add *XyResult.height 4i widgetDefault 17 17 option add *XyResult.gridColor #d9d9d9 widgetDefault 18 option add *XyResult.activeColor blue widgetDefault 18 19 option add *XyResult.controlBackground gray widgetDefault 19 20 option add *XyResult.font \ 20 21 -*-helvetica-medium-r-normal-*-*-120-* widgetDefault 21 22 22 blt::bitmap define ContourResult-reset { 23 option add *XyResult*Balloon*Entry.background white widgetDefault 24 25 blt::bitmap define XyResult-reset { 23 26 #define reset_width 12 24 27 #define reset_height 12 … … 28 31 } 29 32 33 blt::bitmap define XyResult-dismiss { 34 #define dismiss_width 10 35 #define dismiss_height 8 36 static unsigned char dismiss_bits[] = { 37 0x87, 0x03, 0xce, 0x01, 0xfc, 0x00, 0x78, 0x00, 0x78, 0x00, 0xfc, 0x00, 38 0xce, 0x01, 0x87, 0x03}; 39 } 40 41 30 42 itcl::class Rappture::XyResult { 31 43 inherit itk::Widget 32 44 33 45 itk_option define -gridcolor gridColor GridColor "" 46 itk_option define -activecolor activeColor ActiveColor "" 34 47 35 48 constructor {args} { # defined below } … … 45 58 protected method _zoom {option args} 46 59 protected method _hilite {state x y} 60 protected method _axis {option args} 47 61 48 62 private variable _clist "" ;# list of curve objects … … 57 71 private variable _vmax "" ;# autoscale max for y-axis 58 72 private variable _hilite ;# info from last _hilite operation 73 private variable _axis ;# info for axis being edited 59 74 } 60 75 … … 81 96 button $itk_component(controls).reset \ 82 97 -borderwidth 1 -padx 1 -pady 1 \ 83 -bitmap ContourResult-reset \98 -bitmap XyResult-reset \ 84 99 -command [itcl::code $this _zoom reset] 85 100 } { … … 101 116 pack $itk_component(plot) -expand yes -fill both 102 117 103 # special pen for highlighting active traces 104 #$itk_component(plot) element bind all <Enter> \ 105 # [itcl::code $this _hilite on %x %y] 106 #$itk_component(plot) element bind all <Leave> \ 107 # [itcl::code $this _hilite off %x %y] 118 # 119 # Add bindings so you can mouse over points to see values: 120 # 108 121 array set _hilite { 109 122 elem "" … … 115 128 [itcl::code $this _hilite off %x %y] 116 129 130 # 131 # Add support for editing axes: 132 # 133 Rappture::Balloon $itk_component(hull).axes 134 set inner [$itk_component(hull).axes component inner] 135 set inner [frame $inner.bd -borderwidth 4 -relief flat] 136 pack $inner -expand yes -fill both 137 138 button $inner.dismiss -bitmap XyResult-dismiss \ 139 -relief flat -overrelief raised -command " 140 Rappture::Tooltip::cue hide 141 [list $itk_component(hull).axes deactivate] 142 " 143 grid $inner.dismiss -row 0 -column 1 -sticky e 144 145 label $inner.minl -text "Minimum:" 146 entry $inner.min -width 15 -highlightbackground $itk_option(-background) 147 grid $inner.minl -row 1 -column 0 -sticky e 148 grid $inner.min -row 1 -column 1 -sticky ew -pady 4 149 150 label $inner.maxl -text "Maximum:" 151 entry $inner.max -width 15 -highlightbackground $itk_option(-background) 152 grid $inner.maxl -row 2 -column 0 -sticky e 153 grid $inner.max -row 2 -column 1 -sticky ew -pady 4 154 155 # 156 # The grab imposed by this combobox messes up the grab for the 157 # balloon panel. Skip this for now. 158 # 159 #label $inner.formatl -text "Format:" 160 #Rappture::Combobox $inner.format -width 15 -editable no 161 #$inner.format choices insert end \ 162 # "%.3g" "Auto" \ 163 # "%.1f" "X.X" \ 164 # "%.2f" "X.XX" \ 165 # "%.3f" "X.XXX" \ 166 # "%.6f" "X.XXXXXX" \ 167 # "%.1e" "X.Xe+XX" \ 168 # "%.2e" "X.XXe+XX" \ 169 # "%.3e" "X.XXXe+XX" \ 170 # "%.6e" "X.XXXXXXe+XX" 171 #grid $inner.formatl -row 3 -column 0 -sticky e 172 #grid $inner.format -row 3 -column 1 -sticky ew -pady 4 173 174 label $inner.scalel -text "Scale:" 175 frame $inner.scales 176 radiobutton $inner.scales.linear -text "Linear" \ 177 -variable [itcl::scope _axis(scale)] -value "linear" 178 pack $inner.scales.linear -side left 179 radiobutton $inner.scales.log -text "Logarithmic" \ 180 -variable [itcl::scope _axis(scale)] -value "log" 181 pack $inner.scales.log -side left 182 grid $inner.scalel -row 4 -column 0 -sticky e 183 grid $inner.scales -row 4 -column 1 -sticky ew -pady 4 184 185 foreach axis {x y} { 186 $itk_component(plot) axis bind $axis <Enter> \ 187 [itcl::code $this _axis hilite $axis on] 188 $itk_component(plot) axis bind $axis <Leave> \ 189 [itcl::code $this _axis hilite $axis off] 190 $itk_component(plot) axis bind $axis <ButtonPress> \ 191 [itcl::code $this _axis edit $axis] 192 } 193 194 set _axis(format-x) "%.3g" 195 set _axis(format-y) "%.3g" 196 _axis scale x linear 197 _axis scale y linear 198 199 # quick-and-dirty zoom functionality, for now... 117 200 Blt_ZoomStack $itk_component(plot) 118 201 $itk_component(plot) legend configure -hide yes … … 280 363 # first clear out the widget 281 364 eval $g element delete [$g element names] 282 $g axis configure x -min "" -max "" -logscale 0 283 $g axis configure y -min "" -max "" -logscale 0 365 366 $g axis configure x -min "" -max "" 367 _axis scale x linear 368 369 $g axis configure y -min "" -max "" 370 _axis scale y linear 284 371 285 372 # extract axis information from the first curve … … 363 450 364 451 if {[info exists hints(xscale)] && $hints(xscale) == "log"} { 365 $g xaxis configure -logscale 1452 _axis scale x log 366 453 } 367 454 if {[info exists hints(yscale)] && $hints(yscale) == "log"} { 368 $g yaxis configure -logscale 1455 _axis scale x log 369 456 } 370 457 … … 538 625 539 626 # ---------------------------------------------------------------------- 627 # USAGE: _axis hilite <axis> <state> 628 # USAGE: _axis edit <axis> 629 # USAGE: _axis changed <axis> <what> 630 # USAGE: _axis format <axis> <widget> <value> 631 # USAGE: _axis scale <axis> linear|log 632 # 633 # Used internally to handle editing of the x/y axes. The hilite 634 # operation causes the axis to light up. The edit operation pops 635 # up a panel with editing options. The changed operation applies 636 # changes from the panel. 637 # ---------------------------------------------------------------------- 638 itcl::body Rappture::XyResult::_axis {option args} { 639 set inner [$itk_component(hull).axes component inner].bd 640 641 switch -- $option { 642 hilite { 643 if {[llength $args] != 2} { 644 error "wrong # args: should be \"_axis hilite axis state\"" 645 } 646 set axis [lindex $args 0] 647 set state [lindex $args 1] 648 649 if {$state} { 650 $itk_component(plot) axis configure $axis \ 651 -color $itk_option(-activecolor) \ 652 -titlecolor $itk_option(-activecolor) 653 } else { 654 $itk_component(plot) axis configure $axis \ 655 -color $itk_option(-foreground) \ 656 -titlecolor $itk_option(-foreground) 657 } 658 } 659 edit { 660 if {[llength $args] != 1} { 661 error "wrong # args: should be \"_axis edit axis\"" 662 } 663 set axis [lindex $args 0] 664 set _axis(current) $axis 665 666 # fix min/max controls... 667 foreach {min max} [$itk_component(plot) axis limits $axis] break 668 $inner.min delete 0 end 669 $inner.min insert end $min 670 bind $inner.min <KeyPress-Return> \ 671 [itcl::code $this _axis changed $axis min] 672 bind $inner.min <FocusOut> \ 673 [itcl::code $this _axis changed $axis min] 674 675 $inner.max delete 0 end 676 $inner.max insert end $max 677 bind $inner.max <KeyPress-Return> \ 678 [itcl::code $this _axis changed $axis max] 679 bind $inner.max <FocusOut> \ 680 [itcl::code $this _axis changed $axis max] 681 682 # fix format control... 683 #set fmts [$inner.format choices get -value] 684 #set i [lsearch -exact $fmts $_axis(format-$axis)] 685 #if {$i < 0} { set i 0 } ;# use Auto choice 686 #$inner.format value [$inner.format choices get -label $i] 687 # 688 #bind $inner.format <<Value>> \ 689 # [itcl::code $this _axis changed $axis format] 690 691 # fix scale control... 692 if {[$itk_component(plot) axis cget $axis -logscale]} { 693 set _axis(scale) "log" 694 } else { 695 set _axis(scale) "linear" 696 } 697 $inner.scales.linear configure \ 698 -command [itcl::code $this _axis changed $axis scale] 699 $inner.scales.log configure \ 700 -command [itcl::code $this _axis changed $axis scale] 701 702 # 703 # Figure out where the window should pop up. 704 # 705 set x [winfo rootx $itk_component(plot)] 706 set y [winfo rooty $itk_component(plot)] 707 set w [winfo width $itk_component(plot)] 708 set h [winfo height $itk_component(plot)] 709 foreach {x0 y0 pw ph} [$itk_component(plot) extents plotarea] break 710 switch -- $axis { 711 x { 712 set x [expr {round($x + $x0+0.5*$pw)}] 713 set y [expr {round($y + $y0+$ph + 0.5*($h-$y0-$ph))}] 714 set dir "above" 715 } 716 y { 717 set x [expr {round($x + 0.5*$x0)}] 718 set y [expr {round($y + $y0+0.5*$ph)}] 719 set dir "right" 720 } 721 } 722 $itk_component(hull).axes activate @$x,$y $dir 723 } 724 changed { 725 if {[llength $args] != 2} { 726 error "wrong # args: should be \"_axis changed axis what\"" 727 } 728 set axis [lindex $args 0] 729 set what [lindex $args 1] 730 731 switch -- $what { 732 min { 733 set val [$inner.min get] 734 if {![string is double -strict $val]} { 735 Rappture::Tooltip::cue $inner.min "Must be a number" 736 bell 737 return 738 } 739 740 set max [lindex [$itk_component(plot) axis limits $axis] 1] 741 if {$val >= $max} { 742 Rappture::Tooltip::cue $inner.min "Must be <= max ($max)" 743 bell 744 return 745 } 746 catch { 747 # can fail in log mode 748 $itk_component(plot) axis configure $axis -min $val 749 } 750 foreach {min max} [$itk_component(plot) axis limits $axis] break 751 $inner.min delete 0 end 752 $inner.min insert end $min 753 } 754 max { 755 set val [$inner.max get] 756 if {![string is double -strict $val]} { 757 Rappture::Tooltip::cue $inner.max "Should be a number" 758 bell 759 return 760 } 761 762 set min [lindex [$itk_component(plot) axis limits $axis] 0] 763 if {$val <= $min} { 764 Rappture::Tooltip::cue $inner.max "Must be >= min ($min)" 765 bell 766 return 767 } 768 catch { 769 # can fail in log mode 770 $itk_component(plot) axis configure $axis -max $val 771 } 772 foreach {min max} [$itk_component(plot) axis limits $axis] break 773 $inner.max delete 0 end 774 $inner.max insert end $max 775 } 776 format { 777 # set fmt [$inner.format translate [$inner.format value]] 778 # set _axis(format-$axis) $fmt 779 # 780 # # force a refresh 781 # $itk_component(plot) axis configure $axis -min \ 782 # [$itk_component(plot) axis cget $axis -min] 783 } 784 scale { 785 _axis scale $axis $_axis(scale) 786 787 foreach {min max} [$itk_component(plot) axis limits $axis] break 788 $inner.min delete 0 end 789 $inner.min insert end $min 790 $inner.max delete 0 end 791 $inner.max insert end $max 792 } 793 } 794 } 795 format { 796 if {[llength $args] != 3} { 797 error "wrong # args: should be \"_axis format axis widget value\"" 798 } 799 set axis [lindex $args 0] 800 set value [lindex $args 2] 801 return [format $_axis(format-$axis) $value] 802 } 803 scale { 804 if {[llength $args] != 2} { 805 error "wrong # args: should be \"_axis scale axis type\"" 806 } 807 set axis [lindex $args 0] 808 set type [lindex $args 1] 809 810 if {$type == "log"} { 811 catch {$itk_component(plot) axis configure $axis -logscale 1} 812 # leave format alone in log mode 813 $itk_component(plot) axis configure x -command "" 814 $itk_component(plot) axis configure y -command "" 815 } else { 816 catch {$itk_component(plot) axis configure $axis -logscale 0} 817 # use special formatting for linear mode 818 $itk_component(plot) axis configure x -command \ 819 [itcl::code $this _axis format x] 820 $itk_component(plot) axis configure y -command \ 821 [itcl::code $this _axis format y] 822 } 823 } 824 default { 825 error "bad option \"$option\": should be changed, edit, hilite, or format" 826 } 827 } 828 } 829 830 # ---------------------------------------------------------------------- 540 831 # CONFIGURATION OPTION: -gridcolor 541 832 # ----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
