ALPHALINUX5/util/ALPHALINUX5/lib/blt2.4/demos/graph1.tcl

   1 #!../src/bltwish
   2
   3 package require BLT
   4
   5 # --------------------------------------------------------------------------
   6 # Starting with Tcl 8.x, the BLT commands are stored in their own
   7 # namespace called "blt".  The idea is to prevent name clashes with
   8 # Tcl commands and variables from other packages, such as a "table"
   9 # command in two different packages.
  10 #
  11 # You can access the BLT commands in a couple of ways.  You can prefix
  12 # all the BLT commands with the namespace qualifier "blt::"
  13 #
  14 #    blt::graph .g
  15 #    blt::table . .g -resize both
  16 #
  17 # or you can import all the command into the global namespace.
  18 #
  19 #    namespace import blt::*
  20 #    graph .g
  21 #    table . .g -resize both
  22 #
  23 # --------------------------------------------------------------------------
  24
  25 if { $tcl_version >= 8.0 } {
  26     namespace import blt::*
  27     namespace import -force blt::tile::*
  28 }
  29
  30 source scripts/demo.tcl
  31
  32 option add *Graph.Tile                  bgTexture
  33 option add *Label.Tile                  bgTexture
  34 option add *Frame.Tile                  bgTexture
  35 option add *Htext.Tile                  bgTexture
  36 option add *TileOffset                  0
  37
  38 option add *HighlightThickness          0
  39 #option add *shadow                     orange2
  40 #option add *titleColor                 orange2
  41
  42
  43 set visual [winfo screenvisual .]
  44 if { $visual != "staticgray" } {
  45     option add *print.background yellow
  46     option add *quit.background red
  47 }
  48
  49 image create photo bgTexture -file ./images/buckskin.gif
  50 set remote {}
  51 set graph .graph
  52
  53 #option add *tile bgTexture
  54 #option add *Postscript.Preview         yes
  55 #option add *Postscript.Landscape       yes
  56 #option add *Postscript.Maxpect         yes
  57 #option add *Postscript.Center          yes
  58
  59 #option add *rotate -45
  60 htext .header -text {\
  61 This is an example of the graph widget.  It displays two-variable data
  62 with assorted line attributes and symbols.  To create a postscript file
  63 "xy.ps", press the %%
  64     button $htext(widget).print -text print -command {
  65         puts stderr [time {.graph postscript output xy.ps}]
  66     }
  67     $htext(widget) append $htext(widget).print
  68 %% button.}
  69
  70 source scripts/graph1.tcl
  71
  72 $graph postscript configure \
  73         -center yes -maxpect yes -landscape no -preview yes
  74 $graph configure -bd 0
  75
  76 htext .footer -text {Hit the %%
  77 button $htext(widget).quit -text quit -command {
  78     catch "send GraphConfig after 1 exit"
  79     exit
  80 }
  81
  82 $htext(widget) append $htext(widget).quit
  83 %% button when you've seen enough.%%
  84 label $htext(widget).logo -bitmap BLT
  85 $htext(widget) append $htext(widget).logo -padx 20
  86 %%}
  87
  88 scrollbar .xbar -command { .graph axis view x } -orient horizontal
  89 scrollbar .ybar -command { .graph axis view y } -orient vertical
  90 .graph axis configure x -scrollcommand { .xbar set } -logscale no -loose no
  91 .graph axis configure y -scrollcommand { .ybar set } -logscale no
  92
  93
  94 $graph element bind all <Enter> {
  95     %W legend activate [%W element get current]
  96 }
  97
  98 $graph element bind all <Leave> {
  99     %W legend deactivate [%W element get current]
 100 }
 101
 102 $graph marker bind Text <B2-Motion> {
 103     set coords [%W invtransform %x %y]
 104     catch { %W marker configure [%W marker get current] -coords $coords }
 105 }
 106
 107 $graph marker bind fred <Enter> {
 108     set marker [%W marker get current]
 109     catch { %W marker configure $marker -outline white -fill red}
 110 }
 111
 112 $graph marker bind fred <Leave> {
 113     set marker [%W marker get current]
 114     catch { %W marker configure $marker -outline black -fill ""}
 115 }
 116
 117 # $graph marker create polygon \
 118 #     -coords { 0 200  1 300  2 200  3 200  4 300  5 200  } \
 119 #     -name xPolygon -linewidth 0 \
 120 #     -fill red -outline  blue
 121
 122 $graph marker create text -bindtags "fred Text all" -name Test\
 123       -text "Move with\nmouse button #2" -coords "3.0 170.0" \
 124         -anchor center  -outline black -fill ""
 125
 126 if 0 {
 127 set printer [printer open [lindex [printer names] 0]]
 128 after 2000 {
 129         .graph print2 $printer
 130 }
 131 }
 132
 133 table . \
 134     0,0 .header -cspan 3 -fill x \
 135     1,0 .graph  -fill both -cspan 3 -rspan 3 \
 136     2,3 .ybar -fill y  -padx 0 -pady 0 \
 137     4,1 .xbar -fill x \
 138     5,0 .footer -cspan 3 -fill x
 139
 140 table configure . c3 r0 r4 r5 -resize none
 141
 142 $graph configure -leftvariable left
 143
 144 trace variable left w "UpdateTable .graph"
 145
 146 proc UpdateTable { graph p1 p2 how } {
 147     table configure . c0 -width [$graph extents leftmargin]
 148     table configure . c2 -width [$graph extents rightmargin]
 149     table configure . r1 -height [$graph extents topmargin]
 150     table configure . r3 -height [$graph extents bottommargin]
 151 }
 152
 153 .graph marker create line -name spot1 -xor yes -dashes 4 -linewidth 2
 154 .graph marker create line -name spot2 -xor yes -dashes 4 -linewidth 2
 155 .graph marker create polygon -name fill
 156
 157 bind .graph <Shift-Motion> {
 158     set x [.graph axis invtransform x %x]
 159     set y [.graph axis invtransform y %y]
 160     if { [.graph element closest %x %y info -interpolate yes -along y -halo 8i line2] } {
 161         .graph marker configure spot1 -coords "$x $y $info(x) $info(y)"
 162     }
 163     if { [.graph element closest %x %y info -interpolate yes -along x -halo 8i line2] } {
 164         .graph marker configure spot2 -coords "$x $y $info(x) $info(y)"
 165     }
 166 }