lib/graphFeature.wish

   1
   2 set bindings(dummy) {}
   3
   4 proc bltResetBindings { graph type } {
   5     global bindings
   6
   7     set all [array names bindings]
   8     set cmds {}
   9     foreach i $all {
  10                 if [string match "$type,$graph,*" $i] {
  11                     lappend cmds $bindings($i)
  12                 }
  13     }
  14     bind $graph $type [join $cmds \n]
  15 }
  16
  17 proc bltActivateLegend { graph name } {
  18     global lastActive
  19
  20     set last $lastActive($graph)
  21     if { $name != $last } {
  22         if { $last != "" } {
  23             $graph legend deactivate $last
  24             $graph element deactivate $last
  25         }
  26         if { $name != "" } {
  27             $graph legend activate $name
  28             $graph element activate $name
  29         }
  30         set lastActive($graph) $name
  31     }
  32 }
  33
  34 proc SetActiveLegend { graph } {
  35     global lastActive bindings
  36
  37     set lastActive($graph) {}
  38     set bindings(<Motion>,$graph,activeLegend) {
  39         set info [%W legend get @%x,%y]
  40         bltActivateLegend %W $info
  41     }
  42     bltResetBindings $graph <Motion>
  43 }
  44
  45
  46 proc SetCrosshairs { graph } {
  47     global bindings
  48
  49     $graph crosshairs on
  50     set bindings(<Motion>,$graph,crosshairs) {
  51         %W crosshairs configure -position @%x,%y
  52     }
  53     bltResetBindings $graph <Motion>
  54 }
  55
  56
  57 proc bltFindElement { graph x y } {
  58     set info [$graph element closest $x $y ]
  59     if { $info == "" } {
  60         blt_bell
  61         return
  62     }
  63     set name [lindex $info 0]
  64     set points [lrange $info 2 3]
  65     set index [lindex $info 1]
  66     global tagId
  67     catch { $graph tag delete $tagId($graph,$name,$index) }
  68     set tagId($graph,$name,$index) \
  69         [$graph tag create text $points -text " $name \[$index\] " -anchor s \
  70          -yoffset -10 -fg black -bg {}]
  71     bltFlashPoint $graph $name $index 10
  72 }
  73
  74 proc bltFlashPoint { graph name index count } {
  75     if { $count & 1 } {
  76         $graph element deactivate $name
  77     } else {
  78         $graph element activate $name $index
  79     }
  80     incr count -1
  81     if { $count > 0 } {
  82         after 200 bltFlashPoint $graph $name $index $count
  83         update
  84     } else {
  85         global tagId
  86         catch { $graph tag delete $tagId($graph,$name,$index) }
  87     }
  88 }
  89
  90 proc SetClosestPoint { graph } {
  91     global bindings
  92
  93     global tagId
  94     set tagId(dummy) {}
  95     set bindings(<ButtonPress-3>,$graph,closestPoint) {
  96         bltFindElement %W  %x %y
  97     }
  98     bltResetBindings $graph <ButtonPress-3>
  99 }
 100
 101
 102 proc bltGetCoords { graph winX winY var index } {
 103     scan [$graph invtransform $winX $winY] "%s %s" x y
 104     scan [$graph xaxis limits] "%s %s" xmin xmax
 105     scan [$graph yaxis limits] "%s %s" ymin ymax
 106
 107     if { $x > $xmax } {
 108         set x $xmax
 109     } elseif { $x < $xmin } {
 110         set x $xmin
 111     }
 112
 113     if { $y > $ymax } {
 114         set y $ymax
 115     } elseif { $y < $ymin } {
 116         set y $ymin
 117     }
 118     upvar $var arr
 119     set arr($index,x) $x
 120     set arr($index,y) $y
 121 }
 122
 123
 124 proc bltGetAnchor { graph x y } {
 125     global pos bindings
 126
 127     set pos(B,x) {}
 128     set pos(B,y) {}
 129     bltGetCoords $graph $x $y pos A
 130     set bindings(<B1-Motion>,$graph,zoom) {
 131                 bltScan %W %x %y
 132     }
 133     set bindings(<ButtonRelease-1>,$graph,zoom) {
 134                 bltZoom %W %x %y
 135     }
 136     bltResetBindings $graph <ButtonRelease-1>
 137     bltResetBindings $graph <B1-Motion>
 138 }
 139
 140 proc bltGetAnchorX { graph x y } {
 141     global pos bindings
 142
 143     set pos(B,x) {}
 144     set pos(B,y) {}
 145     bltGetCoords $graph $x $y pos A
 146     set bindings(<B1-Motion>,$graph,zoomx) {
 147                 bltScanX %W %x %y
 148     }
 149     set bindings(<ButtonRelease-1>,$graph,zoomx) {
 150                 bltZoomX %W %x %y
 151     }
 152     bltResetBindings $graph <ButtonRelease-1>
 153     bltResetBindings $graph <B1-Motion>
 154 }
 155
 156
 157 proc bltBox { graph x1 y1 x2 y2 } {
 158     global tagId
 159
 160     set text [format "%.4g,%.4g" $x1 $y1]
 161     if { $tagId($graph,text1) == "" } then {
 162         set tagId($graph,text1) \
 163             [$graph tag create text {$x1 $y1} -text $text ]
 164     } else {
 165         $graph tag configure $tagId($graph,text1) -text $text
 166         $graph tag coords $tagId($graph,text1) "$x1 $y1"
 167     }
 168     set text [format "%.4g,%.4g" $x2 $y2]
 169     if { $tagId($graph,text2) == "" } then {
 170         set tagId($graph,text2) \
 171             [$graph tag create text {$x2 $y2} -text $text ]
 172     } else {
 173         $graph tag configure $tagId($graph,text2) -text $text
 174         $graph tag coords $tagId($graph,text2) "$x2 $y2"
 175     }
 176     set coords {
 177         $x1 $y1 $x1 $y2 $x1 $y1 $x2 $y1 $x2 $y1 $x2 $y2 $x1 $y2 $x2 $y2
 178     }
 179     if { $tagId($graph,outline) == "" } then {
 180         set tagId($graph,outline) [$graph tag create line $coords]
 181     } else {
 182         $graph tag coords $tagId($graph,outline) $coords
 183     }
 184 }
 185
 186 proc bltBoxX { graph x1 y1 x2 y2 } {
 187     global tagId
 188
 189     set text [format "%.4g" $x1]
 190     if { $tagId($graph,text1) == "" } then {
 191         set tagId($graph,text1) \
 192             [$graph tag create text {$x1 $y1} -text $text ]
 193     } else {
 194         $graph tag configure $tagId($graph,text1) -text $text
 195         $graph tag coords $tagId($graph,text1) "$x1 $y1"
 196     }
 197     set text [format "%.4g" $x2]
 198     if { $tagId($graph,text2) == "" } then {
 199         set tagId($graph,text2) \
 200             [$graph tag create text {$x2 $y2} -text $text ]
 201     } else {
 202         $graph tag configure $tagId($graph,text2) -text $text
 203         $graph tag coords $tagId($graph,text2) "$x2 $y2"
 204     }
 205     set coords {
 206         $x1 $y1 $x1 $y2 $x1 $y1 $x2 $y1 $x2 $y1 $x2 $y2 $x1 $y2 $x2 $y2
 207     }
 208     if { $tagId($graph,outline) == "" } then {
 209         set tagId($graph,outline) [$graph tag create line $coords]
 210     } else {
 211         $graph tag coords $tagId($graph,outline) $coords
 212     }
 213 }
 214
 215 set pos(last,x) 0
 216 set pos(last,y) 0
 217
 218 proc bltScan { graph x y } {
 219     global pos
 220
 221     set deltaX [expr abs($pos(last,x)-$x)]
 222     set deltaY [expr abs($pos(last,y)-$y)]
 223     if { ($deltaX < 5) && ($deltaY < 5) } {
 224         return
 225     }
 226     set pos(last,x) $x
 227     set pos(last,y) $y
 228
 229     bltGetCoords $graph $x $y pos B
 230     if { $pos(A,x) > $pos(B,x) } {
 231         bltBox $graph $pos(B,x) $pos(B,y) $pos(A,x) $pos(A,y)
 232     } else {
 233         bltBox $graph $pos(A,x) $pos(A,y) $pos(B,x) $pos(B,y)
 234     }
 235 }
 236
 237 proc bltScanX { graph x y } {
 238     global pos
 239
 240     set deltaX [expr abs($pos(last,x)-$x)]
 241     set deltaY [expr abs($pos(last,y)-$y)]
 242     if { ($deltaX < 5) && ($deltaY < 5) } {
 243                 return
 244     }
 245     set pos(last,x) $x
 246     set pos(last,y) $y
 247
 248     bltGetCoords $graph $x $y pos B
 249     if { $pos(A,x) > $pos(B,x) } {
 250                 bltBox $graph $pos(B,x) $pos(B,y) $pos(A,x) $pos(A,y)
 251     } else {
 252                 bltBox $graph $pos(A,x) $pos(A,y) $pos(B,x) $pos(B,y)
 253     }
 254 }
 255
 256 proc bltZoom { graph x y } {
 257     global bindings pos tagId
 258
 259     # Go back to original bindings
 260     set bindings(<ButtonPress-1>,$graph,zoom) {
 261         bltGetAnchor %W %x %y
 262     }
 263     set bindings(<B1-Motion>,$graph,zoom) {}
 264
 265     catch {$graph tag delete $tagId($graph,text1) $tagId($graph,text2)}
 266     set tagId($graph,text1) {}
 267     set tagId($graph,text2) {}
 268
 269     bltResetBindings $graph <B1-Motion>
 270     bltResetBindings $graph <ButtonPress-1>
 271
 272     if { $pos(B,x) == "" } then {
 273         catch {$graph tag delete $tagId($graph,outline)}
 274         set tagId($graph,outline) {}
 275         $graph xaxis configure -min {} -max {}
 276         $graph yaxis configure -min {} -max {}
 277         return
 278     }
 279     if { $pos(A,x) > $pos(B,x) } {
 280         $graph xaxis configure -min $pos(B,x) -max $pos(A,x)
 281     } else {
 282         if { $pos(A,x) < $pos(B,x) } {
 283             $graph xaxis configure -min $pos(A,x) -max $pos(B,x)
 284         }
 285     }
 286     if { $pos(A,y) > $pos(B,y) } {
 287         $graph yaxis configure -min $pos(B,y) -max $pos(A,y)
 288     } else {
 289         if { $pos(A,y) < $pos(B,y) } {
 290             $graph yaxis configure -min $pos(A,y) -max $pos(B,y)
 291         }
 292     }
 293 #    $graph configure -cursor crosshair
 294     catch {$graph tag delete $tagId($graph,outline)}
 295     set tagId($graph,outline) {}
 296     blt_busy hold $graph
 297     update
 298     blt_busy release $graph
 299 }
 300
 301 proc bltZoomX { graph x y } {
 302     global bindings pos tagId
 303
 304     # Go back to original bindings
 305     set bindings(<ButtonPress-1>,$graph,zoomx) {
 306                 bltGetAnchorX %W %x %y
 307     }
 308     set bindings(<B1-Motion>,$graph,zoomx) {}
 309
 310     catch {$graph tag delete $tagId($graph,text1) $tagId($graph,text2)}
 311     set tagId($graph,text1) {}
 312     set tagId($graph,text2) {}
 313
 314     bltResetBindings $graph <B1-Motion>
 315     bltResetBindings $graph <ButtonPress-1>
 316
 317     if { $pos(B,x) == "" } then {
 318                 catch {$graph tag delete $tagId($graph,outline)}
 319                 set tagId($graph,outline) {}
 320                 $graph xaxis configure -min {} -max {}
 321                 $graph yaxis configure -min {} -max {}
 322                 return
 323     }
 324     if { $pos(A,x) > $pos(B,x) } {
 325                 $graph xaxis configure -min $pos(B,x) -max $pos(A,x)
 326     } else {
 327                 if { $pos(A,x) < $pos(B,x) } {
 328                     $graph xaxis configure -min $pos(A,x) -max $pos(B,x)
 329                 }
 330     }
 331 #    $graph configure -cursor crosshair
 332     catch {$graph tag delete $tagId($graph,outline)}
 333     set tagId($graph,outline) {}
 334     blt_busy hold $graph
 335     update
 336     blt_busy release $graph
 337 }
 338
 339
 340 proc SetZoom { graph } {
 341     global bindings tagId
 342
 343     set tagId($graph,text1) {}
 344     set tagId($graph,text2) {}
 345     set tagId($graph,outline) {}
 346     set bindings(<ButtonRelease-2>,$graph,zoom) {
 347         catch {%W tag delete $tagId(outline) }
 348         set tagId(outline) {}
 349         %W yaxis configure -min {} -max {}
 350         %W xaxis configure -min {} -max {}
 351         blt_busy hold %W
 352         update
 353         blt_busy release %W
 354     }
 355     set bindings(<ButtonPress-1>,$graph,zoom) {
 356 #       %W configure -cursor {crosshair red black}
 357         bltGetAnchor %W %x %y
 358         bltScan %W %x %y
 359     }
 360     bltResetBindings $graph <ButtonPress-1>
 361     bltResetBindings $graph <ButtonRelease-2>
 362 }
 363
 364 proc SetZoomX { graph } {
 365     global bindings tagId
 366
 367     set tagId($graph,text1) {}
 368     set tagId($graph,text2) {}
 369     set tagId($graph,outline) {}
 370     set bindings(<ButtonRelease-2>,$graph,zoomx) {
 371                 catch {%W tag delete $tagId(outline) }
 372                 set tagId(outline) {}
 373                 %W yaxis configure -min {} -max {}
 374                 %W xaxis configure -min {} -max {}
 375                 blt_busy hold %W
 376                 update
 377                 blt_busy release %W
 378     }
 379     set bindings(<ButtonPress-1>,$graph,zoomx) {
 380 #       %W configure -cursor {crosshair red black}
 381                 bltGetAnchorX %W %x %y
 382                 bltScanX %W %x %y
 383     }
 384     bltResetBindings $graph <ButtonPress-1>
 385     bltResetBindings $graph <ButtonRelease-2>
 386 }
 387
 388 proc SetPrint { graph } {
 389     global bindings
 390     set bindings(<Shift-ButtonRelease-3>,$graph,print) {
 391                 puts stdout "creating file \"out.ps\... " nonewline
 392                 flush stdout
 393                 %W postscript "out.ps" -pagewidth 6.5i -pageheight 8.5i -landscape true
 394                 puts stdout "done."
 395                 flush stdout
 396     }
 397     bltResetBindings $graph <Shift-ButtonRelease-3>
 398 }