util/X86LINUX64/lib/blt2.5/graph.tcl

   1
   2 proc Blt_ActiveLegend { graph } {
   3     $graph legend bind all <Enter> [list blt::ActivateLegend $graph ]
   4     $graph legend bind all <Leave> [list blt::DeactivateLegend $graph]
   5     $graph legend bind all <ButtonPress-1> [list blt::HighlightLegend $graph]
   6 }
   7
   8 proc Blt_Crosshairs { graph } {
   9     blt::Crosshairs $graph
  10 }
  11
  12 proc Blt_ResetCrosshairs { graph {state off}} {
  13     blt::Crosshairs $graph "Any-Motion" $state
  14 }
  15
  16 proc Blt_ZoomStack { graph } {
  17     blt::ZoomStack $graph
  18 }
  19
  20 proc Blt_PrintKey { graph } {
  21     blt::PrintKey $graph
  22 }
  23
  24 proc Blt_ClosestPoint { graph } {
  25     blt::ClosestPoint $graph
  26 }
  27
  28 #
  29 # The following procedures that reside in the "blt" namespace are
  30 # supposed to be private.
  31 #
  32
  33 proc blt::ActivateLegend { graph } {
  34     set elem [$graph legend get current]
  35     $graph legend activate $elem
  36 }
  37 proc blt::DeactivateLegend { graph } {
  38     set elem [$graph legend get current]
  39     $graph legend deactivate $elem
  40 }
  41
  42 proc blt::HighlightLegend { graph } {
  43     set elem [$graph legend get current]
  44     set relief [$graph element cget $elem -labelrelief]
  45     if { $relief == "flat" } {
  46         $graph element configure $elem -labelrelief raised
  47         $graph element activate $elem
  48     } else {
  49         $graph element configure $elem -labelrelief flat
  50         $graph element deactivate $elem
  51     }
  52 }
  53
  54 proc blt::Crosshairs { graph {event "Any-Motion"} {state "on"}} {
  55     $graph crosshairs $state
  56     bind crosshairs-$graph <$event>   {
  57         %W crosshairs configure -position @%x,%y
  58     }
  59     bind crosshairs-$graph <Leave>   {
  60         %W crosshairs off
  61     }
  62     bind crosshairs-$graph <Enter>   {
  63         %W crosshairs on
  64     }
  65     $graph crosshairs configure -color red
  66     if { $state == "on" } {
  67         blt::AddBindTag $graph crosshairs-$graph
  68     } elseif { $state == "off" } {
  69         blt::RemoveBindTag $graph crosshairs-$graph
  70     }
  71 }
  72
  73 proc blt::InitStack { graph } {
  74     global zoomInfo
  75     set zoomInfo($graph,interval) 100
  76     set zoomInfo($graph,afterId) 0
  77     set zoomInfo($graph,A,x) {}
  78     set zoomInfo($graph,A,y) {}
  79     set zoomInfo($graph,B,x) {}
  80     set zoomInfo($graph,B,y) {}
  81     set zoomInfo($graph,stack) {}
  82     set zoomInfo($graph,corner) A
  83 }
  84
  85 proc blt::ZoomStack { graph {start "ButtonPress-1"} {reset "ButtonPress-3"} } {
  86     global zoomInfo zoomMod
  87
  88     blt::InitStack $graph
  89
  90     if { [info exists zoomMod] } {
  91         set modifier $zoomMod
  92     } else {
  93         set modifier ""
  94     }
  95     bind zoom-$graph <${modifier}${start}> { blt::SetZoomPoint %W %x %y }
  96     bind zoom-$graph <${modifier}${reset}> {
  97         if { [%W inside %x %y] } {
  98             blt::ResetZoom %W
  99         }
 100     }
 101     blt::AddBindTag $graph zoom-$graph
 102 }
 103
 104 proc blt::PrintKey { graph {event "Shift-ButtonRelease-3"} } {
 105     bind print-$graph <$event>  { Blt_PostScriptDialog %W }
 106     blt::AddBindTag $graph print-$graph
 107 }
 108
 109 proc blt::ClosestPoint { graph {event "Control-ButtonPress-2"} } {
 110     bind closest-point-$graph <$event>  {
 111         blt::FindElement %W %x %y
 112     }
 113     blt::AddBindTag $graph closest-point-$graph
 114 }
 115
 116 proc blt::AddBindTag { widget tag } {
 117     set oldTagList [bindtags $widget]
 118     if { [lsearch $oldTagList $tag] < 0 } {
 119         bindtags $widget [linsert $oldTagList 0  $tag]
 120     }
 121 }
 122
 123 proc blt::RemoveBindTag { widget tag } {
 124     set oldTagList [bindtags $widget]
 125     set index [lsearch $oldTagList $tag]
 126     if { $index >= 0 } {
 127         bindtags $widget [lreplace $oldTagList $index $index]
 128     }
 129 }
 130
 131 proc blt::FindElement { graph x y } {
 132     if ![$graph element closest $x $y info -interpolate yes] {
 133         beep
 134         return
 135     }
 136     # --------------------------------------------------------------
 137     # find(name)                - element Id
 138     # find(index)               - index of closest point
 139     # find(x) find(y)           - coordinates of closest point
 140     #                             or closest point on line segment.
 141     # find(dist)                - distance from sample coordinate
 142     # --------------------------------------------------------------
 143     set markerName "bltClosest_$info(name)"
 144     catch { $graph marker delete $markerName }
 145     $graph marker create text -coords { $info(x) $info(y) } \
 146         -name $markerName \
 147         -text "$info(name): $info(dist)\nindex $info(index)" \
 148         -font *lucida*-r-*-10-* \
 149         -anchor center -justify left \
 150         -yoffset 0 -bg {}
 151
 152     set coords [$graph invtransform $x $y]
 153     set nx [lindex $coords 0]
 154     set ny [lindex $coords 1]
 155
 156     $graph marker create line -coords "$nx $ny $info(x) $info(y)" \
 157         -name line.$markerName
 158
 159     blt::FlashPoint $graph $info(name) $info(index) 10
 160     blt::FlashPoint $graph $info(name) [expr $info(index) + 1] 10
 161 }
 162
 163 proc blt::FlashPoint { graph name index count } {
 164     if { $count & 1 } {
 165         $graph element deactivate $name
 166     } else {
 167         $graph element activate $name $index
 168     }
 169     incr count -1
 170     if { $count > 0 } {
 171         after 200 blt::FlashPoint $graph $name $index $count
 172         update
 173     } else {
 174         eval $graph marker delete [$graph marker names "bltClosest_*"]
 175     }
 176 }
 177
 178 proc blt::GetCoords { graph x y index } {
 179     global zoomInfo
 180     if { [$graph cget -invertxy] } {
 181         set zoomInfo($graph,$index,x) $y
 182         set zoomInfo($graph,$index,y) $x
 183     } else {
 184         set zoomInfo($graph,$index,x) $x
 185         set zoomInfo($graph,$index,y) $y
 186     }
 187 }
 188
 189 proc blt::MarkPoint { graph index } {
 190     global zoomInfo
 191     set x [$graph xaxis invtransform $zoomInfo($graph,$index,x)]
 192     set y [$graph yaxis invtransform $zoomInfo($graph,$index,y)]
 193     set marker "zoomText_$index"
 194     set text [format "x=%.4g\ny=%.4g" $x $y]
 195
 196     if [$graph marker exists $marker] {
 197         $graph marker configure $marker -coords { $x $y } -text $text
 198     } else {
 199         $graph marker create text -coords { $x $y } -name $marker \
 200             -font *lucida*-r-*-10-* \
 201             -text $text -anchor center -bg {} -justify left
 202     }
 203 }
 204
 205 proc blt::DestroyZoomTitle { graph } {
 206     global zoomInfo
 207
 208     if { $zoomInfo($graph,corner) == "A" } {
 209         catch { $graph marker delete "zoomTitle" }
 210     }
 211 }
 212
 213 proc blt::PopZoom { graph } {
 214     global zoomInfo
 215
 216     set zoomStack $zoomInfo($graph,stack)
 217     if { [llength $zoomStack] > 0 } {
 218         set cmd [lindex $zoomStack 0]
 219         set zoomInfo($graph,stack) [lrange $zoomStack 1 end]
 220         eval $cmd
 221         blt::ZoomTitleLast $graph
 222         busy hold $graph
 223         update
 224         busy release $graph
 225         after 2000 "blt::DestroyZoomTitle $graph"
 226     } else {
 227         catch { $graph marker delete "zoomTitle" }
 228     }
 229 }
 230
 231 # Push the old axis limits on the stack and set the new ones
 232
 233 proc blt::PushZoom { graph } {
 234     global zoomInfo
 235     eval $graph marker delete [$graph marker names "zoom*"]
 236     if { [info exists zoomInfo($graph,afterId)] } {
 237         after cancel $zoomInfo($graph,afterId)
 238     }
 239     set x1 $zoomInfo($graph,A,x)
 240     set y1 $zoomInfo($graph,A,y)
 241     set x2 $zoomInfo($graph,B,x)
 242     set y2 $zoomInfo($graph,B,y)
 243
 244     if { ($x1 == $x2) || ($y1 == $y2) } {
 245         # No delta, revert to start
 246         return
 247     }
 248     set cmd {}
 249     foreach margin { xaxis yaxis x2axis y2axis } {
 250         foreach axis [$graph $margin use] {
 251             set min [$graph axis cget $axis -min]
 252             set max [$graph axis cget $axis -max]
 253             set c [list $graph axis configure $axis -min $min -max $max]
 254             append cmd "$c\n"
 255         }
 256     }
 257     set zoomInfo($graph,stack) [linsert $zoomInfo($graph,stack) 0 $cmd]
 258
 259
 260     foreach margin { xaxis x2axis } {
 261         foreach axis [$graph $margin use] {
 262             set min [$graph axis invtransform $axis $x1]
 263             set max [$graph axis invtransform $axis $x2]
 264             if { $min > $max } {
 265                 $graph axis configure $axis -min $max -max $min
 266             } else {
 267                 $graph axis configure $axis -min $min -max $max
 268             }
 269         }
 270     }
 271     foreach margin { yaxis y2axis } {
 272         foreach axis [$graph $margin use] {
 273             set min [$graph axis invtransform $axis $y1]
 274             set max [$graph axis invtransform $axis $y2]
 275             if { $min > $max } {
 276                 $graph axis configure $axis -min $max -max $min
 277             } else {
 278                 $graph axis configure $axis -min $min -max $max
 279             }
 280         }
 281     }
 282     busy hold $graph
 283     update;                             # This "update" redraws the graph
 284     busy release $graph
 285 }
 286
 287 #
 288 # This routine terminates either an existing zoom, or pops back to
 289 # the previous zoom level (if no zoom is in progress).
 290 #
 291
 292 proc blt::ResetZoom { graph } {
 293     global zoomInfo
 294
 295     if { ![info exists zoomInfo($graph,corner)] } {
 296         blt::InitStack $graph
 297     }
 298     eval $graph marker delete [$graph marker names "zoom*"]
 299
 300     if { $zoomInfo($graph,corner) == "A" } {
 301         # Reset the whole axis
 302         blt::PopZoom $graph
 303     } else {
 304         global zoomMod
 305
 306         if { [info exists zoomMod] } {
 307             set modifier $zoomMod
 308         } else {
 309             set modifier "Any-"
 310         }
 311         set zoomInfo($graph,corner) A
 312         blt::RemoveBindTag $graph select-region-$graph
 313     }
 314 }
 315
 316 option add *zoomTitle.font        -*-helvetica-medium-R-*-*-18-*-*-*-*-*-*-*
 317 option add *zoomTitle.shadow      yellow4
 318 option add *zoomTitle.foreground  yellow1
 319 option add *zoomTitle.coords      "-Inf Inf"
 320
 321 proc blt::ZoomTitleNext { graph } {
 322     global zoomInfo
 323     set level [expr [llength $zoomInfo($graph,stack)] + 1]
 324     if { [$graph cget -invertxy] } {
 325         set coords "-Inf -Inf"
 326     } else {
 327         set coords "-Inf Inf"
 328     }
 329     $graph marker create text -name "zoomTitle" -text "Zoom #$level" \
 330         -coords $coords -bindtags "" -anchor nw
 331 }
 332
 333 proc blt::ZoomTitleLast { graph } {
 334     global zoomInfo
 335
 336     set level [llength $zoomInfo($graph,stack)]
 337     if { $level > 0 } {
 338         $graph marker create text -name "zoomTitle" -anchor nw \
 339             -text "Zoom #$level"
 340     }
 341 }
 342
 343
 344 proc blt::SetZoomPoint { graph x y } {
 345     global zoomInfo zoomMod
 346     if { ![info exists zoomInfo($graph,corner)] } {
 347         blt::InitStack $graph
 348     }
 349     blt::GetCoords $graph $x $y $zoomInfo($graph,corner)
 350     if { [info exists zoomMod] } {
 351         set modifier $zoomMod
 352     } else {
 353         set modifier "Any-"
 354     }
 355     bind select-region-$graph <${modifier}Motion> {
 356         blt::GetCoords %W %x %y B
 357         #blt::MarkPoint $graph B
 358         blt::Box %W
 359     }
 360     if { $zoomInfo($graph,corner) == "A" } {
 361         if { ![$graph inside $x $y] } {
 362             return
 363         }
 364         # First corner selected, start watching motion events
 365
 366         #blt::MarkPoint $graph A
 367         blt::ZoomTitleNext $graph
 368
 369         blt::AddBindTag $graph select-region-$graph
 370         set zoomInfo($graph,corner) B
 371     } else {
 372         # Delete the modal binding
 373         blt::RemoveBindTag $graph select-region-$graph
 374         blt::PushZoom $graph
 375         set zoomInfo($graph,corner) A
 376     }
 377 }
 378
 379 option add *zoomOutline.dashes          4
 380 option add *zoomTitle.anchor            nw
 381 option add *zoomOutline.lineWidth       2
 382 option add *zoomOutline.xor             yes
 383
 384 proc blt::MarchingAnts { graph offset } {
 385     global zoomInfo
 386
 387     incr offset
 388     if { [$graph marker exists zoomOutline] } {
 389         $graph marker configure zoomOutline -dashoffset $offset
 390         set interval $zoomInfo($graph,interval)
 391         set id [after $interval [list blt::MarchingAnts $graph $offset]]
 392         set zoomInfo($graph,afterId) $id
 393     }
 394 }
 395
 396 proc blt::Box { graph } {
 397     global zoomInfo
 398
 399     if { $zoomInfo($graph,A,x) > $zoomInfo($graph,B,x) } {
 400         set x1 [$graph xaxis invtransform $zoomInfo($graph,B,x)]
 401         set y1 [$graph yaxis invtransform $zoomInfo($graph,B,y)]
 402         set x2 [$graph xaxis invtransform $zoomInfo($graph,A,x)]
 403         set y2 [$graph yaxis invtransform $zoomInfo($graph,A,y)]
 404     } else {
 405         set x1 [$graph xaxis invtransform $zoomInfo($graph,A,x)]
 406         set y1 [$graph yaxis invtransform $zoomInfo($graph,A,y)]
 407         set x2 [$graph xaxis invtransform $zoomInfo($graph,B,x)]
 408         set y2 [$graph yaxis invtransform $zoomInfo($graph,B,y)]
 409     }
 410     set coords { $x1 $y1 $x2 $y1 $x2 $y2 $x1 $y2 $x1 $y1 }
 411     if { [$graph marker exists "zoomOutline"] } {
 412         $graph marker configure "zoomOutline" -coords $coords
 413     } else {
 414         set X [lindex [$graph xaxis use] 0]
 415         set Y [lindex [$graph yaxis use] 0]
 416         $graph marker create line -coords $coords -name "zoomOutline" \
 417             -mapx $X -mapy $Y
 418         set interval $zoomInfo($graph,interval)
 419         set id [after $interval [list blt::MarchingAnts $graph 0]]
 420         set zoomInfo($graph,afterId) $id
 421     }
 422 }
 423
 424
 425 proc Blt_PostScriptDialog { graph } {
 426     set top $graph.top
 427     toplevel $top
 428
 429     foreach var { center landscape maxpect preview decorations padx
 430         pady paperwidth paperheight width height colormode } {
 431         global $graph.$var
 432         set $graph.$var [$graph postscript cget -$var]
 433     }
 434     set row 1
 435     set col 0
 436     label $top.title -text "PostScript Options"
 437     blttable $top $top.title -cspan 7
 438     foreach bool { center landscape maxpect preview decorations } {
 439         set w $top.$bool-label
 440         label $w -text "-$bool" -font *courier*-r-*12*
 441         blttable $top $row,$col $w -anchor e -pady { 2 0 } -padx { 0 4 }
 442         set w $top.$bool-yes
 443         global $graph.$bool
 444         radiobutton $w -text "yes" -variable $graph.$bool -value 1
 445         blttable $top $row,$col+1 $w -anchor w
 446         set w $top.$bool-no
 447         radiobutton $w -text "no" -variable $graph.$bool -value 0
 448         blttable $top $row,$col+2 $w -anchor w
 449         incr row
 450     }
 451     label $top.modes -text "-colormode" -font *courier*-r-*12*
 452     blttable $top $row,0 $top.modes -anchor e  -pady { 2 0 } -padx { 0 4 }
 453     set col 1
 454     foreach m { color greyscale } {
 455         set w $top.$m
 456         radiobutton $w -text $m -variable $graph.colormode -value $m
 457         blttable $top $row,$col $w -anchor w
 458         incr col
 459     }
 460     set row 1
 461     frame $top.sep -width 2 -bd 1 -relief sunken
 462     blttable $top $row,3 $top.sep -fill y -rspan 6
 463     set col 4
 464     foreach value { padx pady paperwidth paperheight width height } {
 465         set w $top.$value-label
 466         label $w -text "-$value" -font *courier*-r-*12*
 467         blttable $top $row,$col $w -anchor e  -pady { 2 0 } -padx { 0 4 }
 468         set w $top.$value-entry
 469         global $graph.$value
 470         entry $w -textvariable $graph.$value -width 8
 471         blttable $top $row,$col+1 $w -cspan 2 -anchor w -padx 8
 472         incr row
 473     }
 474     blttable configure $top c3 -width .125i
 475     button $top.cancel -text "Cancel" -command "destroy $top"
 476     blttable $top $row,0 $top.cancel  -width 1i -pady 2 -cspan 3
 477     button $top.reset -text "Reset" -command "destroy $top"
 478     #blttable $top $row,1 $top.reset  -width 1i
 479     button $top.print -text "Print" -command "blt::ResetPostScript $graph"
 480     blttable $top $row,4 $top.print  -width 1i -pady 2 -cspan 2
 481 }
 482
 483 proc blt::ResetPostScript { graph } {
 484     foreach var { center landscape maxpect preview decorations padx
 485         pady paperwidth paperheight width height colormode } {
 486         global $graph.$var
 487         set old [$graph postscript cget -$var]
 488         if { [catch {$graph postscript configure -$var [set $graph.$var]}] != 0 } {
 489             $graph postscript configure -$var $old
 490             set $graph.$var $old
 491         }
 492     }
 493     $graph postscript output "out.ps"
 494     puts stdout "wrote file \"out.ps\"."
 495     flush stdout
 496 }