home *** CD-ROM | disk | FTP | other *** search
/ Il CD di internet / CD.iso / SOURCE / TCL / BLT / BLT1.7L1 / BLT1 / blt-1.7 / applications / extloader / demos / blt / graph.tcl < prev    next >
Encoding:
Text File  |  1994-04-22  |  5.9 KB  |  251 lines
  1. set bindings(dummy) {}
  2.  
  3. proc bltResetBindings { graph type } {
  4.     global bindings
  5.  
  6.     set all [array names bindings] 
  7.     set cmds {}
  8.     foreach i $all {
  9.     if [string match "$type,$graph,*" $i] {
  10.         lappend cmds $bindings($i)
  11.     }
  12.     }
  13.     bind $graph $type [join $cmds \n]
  14. }
  15.  
  16. proc bltActivateLegend { graph name } {
  17.     global lastActive
  18.  
  19.     set last $lastActive($graph)
  20.     if { $name != $last } {
  21.     if { $last != "" } {
  22.         $graph legend deactivate $last
  23.         $graph element deactivate $last
  24.     }
  25.     if { $name != "" } {
  26.         $graph legend activate $name
  27.         $graph element activate $name 
  28.     }
  29.     set lastActive($graph) $name
  30.     }
  31. }
  32.  
  33. proc SetActiveLegend { graph } {
  34.     global lastActive bindings
  35.  
  36.     set lastActive($graph) {}
  37.     set bindings(<Motion>,$graph,activeLegend) {
  38.     set info [%W legend get @%x,%y]
  39.     bltActivateLegend %W $info
  40.     }    
  41.     bltResetBindings $graph <Motion>
  42. }
  43.  
  44.  
  45. proc SetCrosshairs { graph } {
  46.     global bindings
  47.     
  48.     $graph crosshairs set on 
  49.     set bindings(<Motion>,$graph,crosshairs) {
  50.     %W crosshairs configure -position @%x,%y
  51.     }
  52.     bltResetBindings $graph <Motion>
  53. }
  54.  
  55.  
  56. proc bltFindElement { graph x y } {
  57.     set info [$graph element closest $x $y ]
  58.     if { $info == "" } {
  59.     blt_bell
  60.     return
  61.     }
  62.     set name [lindex $info 0]
  63.     set points [lrange $info 2 3]
  64.     set index [lindex $info 1]
  65.     global tagId
  66.     set tagId($graph,$name,$index) \
  67.     [$graph tag create text $points -text " $name " -anchor s \
  68.      -yoffset -10 -fg white -bg red]
  69.     bltFlashPoint $graph $name $index 10
  70. }
  71.  
  72. proc bltFlashPoint { graph name index count } {
  73.     if { $count & 1 } {
  74.         $graph element deactivate $name
  75.     } else {
  76.         $graph element activate $name $index
  77.     }
  78.     incr count -1
  79.     if { $count > 0 } {
  80.     after 200 bltFlashPoint $graph $name $index $count
  81.     } else {
  82.     global tagId
  83.     catch { $graph tag delete $tagId($graph,$name,$index) }
  84.     }
  85. }
  86.  
  87. proc SetClosestPoint { graph } {
  88.     global bindings
  89.  
  90.     set bindings(<ButtonPress-3>,$graph,closestPoint) {
  91.     bltFindElement %W  %x %y
  92.     }
  93.     bltResetBindings $graph <ButtonPress-3>
  94. }
  95.  
  96.  
  97. proc bltGetCoords { graph winX winY var index } {
  98.     scan [$graph invtransform $winX $winY] "%s %s" x y 
  99.     scan [$graph xaxis limits] "%s %s" xmin xmax
  100.     scan [$graph yaxis limits] "%s %s" ymin ymax
  101.  
  102.     if { $x > $xmax } { 
  103.     set x $xmax 
  104.     } elseif { $x < $xmin } { 
  105.     set x $xmin 
  106.     }
  107.  
  108.     if { $y > $ymax } { 
  109.     set y $ymax 
  110.     } elseif { $y < $ymin } { 
  111.     set y $ymin 
  112.     }
  113.     upvar $var arr
  114.     set arr($index,x) $x
  115.     set arr($index,y) $y
  116. }
  117.  
  118.  
  119. proc bltGetAnchor { graph x y } {
  120.     global pos bindings
  121.  
  122.     set pos(B,x) {}
  123.     set pos(B,y) {}
  124.     bltGetCoords $graph $x $y pos A
  125.     set bindings(<B1-Motion>,$graph,zoom) { 
  126.     bltScan %W %x %y 
  127.     }
  128.     set bindings(<ButtonRelease-1>,$graph,zoom) { 
  129.     bltZoom %W %x %y 
  130.     }
  131.     bltResetBindings $graph <ButtonRelease-1>
  132.     bltResetBindings $graph <B1-Motion>
  133. }
  134.  
  135.  
  136. proc bltBox { graph x1 y1 x2 y2 } {
  137.     global tagId 
  138.  
  139.     set text [format "%.4g,%.4g" $x1 $y1] 
  140.     if { $tagId($graph,text1) == "" } then {
  141.     set tagId($graph,text1) \
  142.         [$graph tag create text {$x1 $y1} -text $text ] 
  143.     } else {
  144.     $graph tag configure $tagId($graph,text1) -text $text 
  145.     $graph tag coords $tagId($graph,text1) "$x1 $y1"
  146.     }
  147.     set text [format "%.4g,%.4g" $x2 $y2] 
  148.     if { $tagId($graph,text2) == "" } then {
  149.     set tagId($graph,text2) \
  150.         [$graph tag create text {$x2 $y2} -text $text ] 
  151.     } else {
  152.     $graph tag configure $tagId($graph,text2) -text $text 
  153.     $graph tag coords $tagId($graph,text2) "$x2 $y2"
  154.     }
  155.     set coords {
  156.     $x1 $y1 $x1 $y2 $x1 $y1 $x2 $y1 $x2 $y1 $x2 $y2 $x1 $y2 $x2 $y2 
  157.     }
  158.     if { $tagId($graph,outline) == "" } then {
  159.     set tagId($graph,outline) [$graph tag create line $coords]
  160.     } else {
  161.     $graph tag coords $tagId($graph,outline) $coords
  162.     }
  163. }
  164.  
  165. set pos(last,x) 0
  166. set pos(last,y) 0
  167.  
  168. proc bltScan { graph x y } {
  169.     global pos
  170.  
  171.     set deltaX [expr abs($pos(last,x)-$x)]
  172.     set deltaY [expr abs($pos(last,y)-$y)]
  173.     if { ($deltaX < 5) && ($deltaY < 5) } {
  174.     return
  175.     }    
  176.     set pos(last,x) $x
  177.     set pos(last,y) $y
  178.  
  179.     bltGetCoords $graph $x $y pos B
  180.     if { $pos(A,x) > $pos(B,x) } { 
  181.     bltBox $graph $pos(B,x) $pos(B,y) $pos(A,x) $pos(A,y)
  182.     } else {
  183.     bltBox $graph $pos(A,x) $pos(A,y) $pos(B,x) $pos(B,y)
  184.     }
  185. }
  186.  
  187. proc bltZoom { graph x y } {
  188.     global bindings pos tagId
  189.  
  190.     # Go back to original bindings
  191.     set bindings(<ButtonPress-1>,$graph,zoom) { 
  192.     bltGetAnchor %W %x %y 
  193.     }
  194.     set bindings(<B1-Motion>,$graph,zoom) {}
  195.  
  196.     catch {$graph tag delete $tagId($graph,text1) $tagId($graph,text2)}
  197.     set tagId($graph,text1) {}
  198.     set tagId($graph,text2) {}
  199.  
  200.     bltResetBindings $graph <B1-Motion>
  201.     bltResetBindings $graph <ButtonPress-1>
  202.  
  203.     if { $pos(B,x) == "" } then {
  204.     catch {$graph tag delete $tagId($graph,outline)}
  205.     set tagId($graph,outline) {} 
  206.     $graph xaxis configure -min {} -max {} 
  207.     $graph yaxis configure -min {} -max {}
  208.     return
  209.     }
  210.     if { $pos(A,x) > $pos(B,x) } { 
  211.     $graph xaxis configure -min $pos(B,x) -max $pos(A,x) 
  212.     } else { 
  213.     if { $pos(A,x) < $pos(B,x) } {
  214.         $graph xaxis configure -min $pos(A,x) -max $pos(B,x) 
  215.     }
  216.     }
  217.     if { $pos(A,y) > $pos(B,y) } { 
  218.     $graph yaxis configure -min $pos(B,y) -max $pos(A,y)
  219.     } else {
  220.     if { $pos(A,y) < $pos(B,y) } {
  221.         $graph yaxis configure -min $pos(A,y) -max $pos(B,y)
  222.     }
  223.     }
  224.     $graph configure -cursor crosshair 
  225.     $graph tag delete $tagId($graph,outline)
  226.     set tagId($graph,outline) {}
  227. }
  228.  
  229.  
  230. proc SetZoom { graph } {
  231.     global bindings tagId
  232.  
  233.     set tagId($graph,text1) {}
  234.     set tagId($graph,text2) {}
  235.     set tagId($graph,outline) {}
  236.     set bindings(<ButtonRelease-2>,$graph,zoom) {
  237.     catch {%W tag delete $tagId(outline) }
  238.     set tagId(outline) {} 
  239.     %W yaxis configure -min {} -max {} 
  240.     %W xaxis configure -min {} -max {}
  241.     }
  242.     set bindings(<ButtonPress-1>,$graph,zoom) { 
  243.     %W configure -cursor {crosshair red black}
  244.     bltGetAnchor %W %x %y 
  245.     bltScan %W %x %y 
  246.     }
  247.     bltResetBindings $graph <ButtonPress-1>
  248.     bltResetBindings $graph <ButtonRelease-2>
  249. }
  250.  
  251.