I686LINUX/util/I686LINUX/lib/blt2.4/demos/barchart2.tcl

   1 #!../src/bltwish
   2
   3 package require BLT
   4 # --------------------------------------------------------------------------
   5 # Starting with Tcl 8.x, the BLT commands are stored in their own
   6 # namespace called "blt".  The idea is to prevent name clashes with
   7 # Tcl commands and variables from other packages, such as a "table"
   8 # command in two different packages.
   9 #
  10 # You can access the BLT commands in a couple of ways.  You can prefix
  11 # all the BLT commands with the namespace qualifier "blt::"
  12 #
  13 #    blt::graph .g
  14 #    blt::table . .g -resize both
  15 #
  16 # or you can import all the command into the global namespace.
  17 #
  18 #    namespace import blt::*
  19 #    graph .g
  20 #    table . .g -resize both
  21 #
  22 # --------------------------------------------------------------------------
  23
  24 if { $tcl_version >= 8.0 } {
  25     namespace import blt::*
  26     namespace import -force blt::tile::*
  27 }
  28
  29 source scripts/demo.tcl
  30
  31 proc FormatXTicks { w value } {
  32
  33     # Determine the element name from the value
  34
  35     set index [expr round($value)]
  36     if { $index != $value } {
  37         return $value
  38     }
  39     incr index -1
  40
  41     set name [lindex { A1 B1 A2 B2 C1 D1 C2 A3 E1 } $index]
  42     return $name
  43 }
  44
  45 source scripts/stipples.tcl
  46
  47 #image create photo bgTexture -file ./images/chalk.gif
  48 image create photo bgTexture -file ./images/rain.gif
  49
  50 option add *Button.padX                 5
  51
  52 option add *tile                        bgTexture
  53
  54 option add *Radiobutton.font            -*-courier*-medium-r-*-*-14-*-*
  55 option add *Radiobutton.relief          flat
  56 option add *Radiobutton.borderWidth     2
  57 option add *Radiobutton.highlightThickness 0
  58
  59 option add *Htext.font                  -*-times*-bold-r-*-*-14-*-*
  60 option add *Htext.tileOffset            no
  61 option add *header.font                 -*-times*-medium-r-*-*-14-*-*
  62
  63 option add *Barchart.font                -*-helvetica-bold-r-*-*-14-*-*
  64 option add *Barchart.title              "Comparison of Simulators"
  65 option add *Axis.tickFont               -*-helvetica-medium-r-*-*-12-*-*
  66 option add *Axis.titleFont              -*-helvetica-bold-r-*-*-12-*-*
  67 option add *x.Command                   FormatXTicks
  68 option add *x.Title                     "Simulator"
  69 option add *y.Title                     "Time (hrs)"
  70
  71 option add *activeBar.Foreground        pink
  72 option add *activeBar.stipple           dot3
  73 option add *Element.Background          red
  74 option add *Element.Relief              solid
  75
  76 option add *Grid.dashes                 { 2 4 }
  77 option add *Grid.hide                   no
  78 option add *Grid.mapX                   ""
  79
  80 option add *Legend.Font                 "-*-helvetica*-bold-r-*-*-12-*-*"
  81 option add *Legend.activeBorderWidth    2
  82 option add *Legend.activeRelief         raised
  83 option add *Legend.anchor               ne
  84 option add *Legend.borderWidth          0
  85 option add *Legend.position             right
  86
  87 option add *TextMarker.Font             *Helvetica-Bold-R*14*
  88
  89 set visual [winfo screenvisual .]
  90 if { $visual != "staticgray" && $visual != "grayscale" } {
  91     option add *print.background        yellow
  92     option add *quit.background         red
  93     option add *quit.activeBackground   red2
  94 }
  95
  96 htext .title -text {
  97     Data points with like x-coordinates, can have their bar segments displayed
  98     in one of the following modes (using the -barmode option):
  99 }
 100 htext .header -text {
 101     %%
 102         radiobutton .header.stacked -text stacked -variable barMode \
 103             -anchor w -value "stacked" -selectcolor red -command {
 104             .graph configure -barmode $barMode
 105         }
 106         .header append .header.stacked -width 1.5i -anchor w
 107     %%      Bars are stacked on top of each other. The overall height is the
 108                                                    sum of the y-coordinates.
 109     %%
 110         radiobutton .header.aligned -text aligned -variable barMode \
 111           -anchor w -value "aligned" -selectcolor yellow -command {
 112             .graph configure -barmode $barMode
 113         }
 114         .header append .header.aligned -width 1.5i -fill x
 115     %%      Bars are drawn side-by-side at a fraction of their normal width.
 116     %%
 117         radiobutton .header.overlap -text "overlap" -variable barMode \
 118             -anchor w -value "overlap" -selectcolor green -command {
 119             .graph configure -barmode $barMode
 120         }
 121         .header append .header.overlap -width 1.5i -fill x
 122     %%      Bars overlap slightly.
 123     %%
 124         radiobutton .header.normal -text "normal" -variable barMode \
 125             -anchor w -value "normal" -selectcolor blue -command {
 126             .graph configure -barmode $barMode
 127         }
 128         .header append .header.normal -width 1.5i -fill x
 129     %%      Bars are overlayed one on top of the next.
 130 }
 131
 132 htext .footer -text {    Hit the %%
 133     set im [image create photo -file ./images/stopsign.gif]
 134     button $htext(widget).quit -image $im -command { exit }
 135     $htext(widget) append $htext(widget).quit -pady 2
 136 %% button when you've seen enough. %%
 137     label $htext(widget).logo -bitmap BLT
 138     $htext(widget) append $htext(widget).logo
 139 %%}
 140
 141 barchart .graph -tile bgTexture
 142
 143 vector X Y0 Y1 Y2 Y3 Y4
 144
 145 X set { 1 2 3 4 5 6 7 8 9 }
 146 Y0 set {
 147     0.729111111  0.002250000  0.09108333  0.006416667  0.026509167
 148     0.007027778  0.1628611    0.06405278  0.08786667
 149 }
 150 Y1 set {
 151     0.003120278  0.004638889  0.01113889  0.048888889  0.001814722
 152     0.291388889  0.0503500    0.13876389  0.04513333
 153 }
 154 Y2 set {
 155     11.534444444 3.879722222  4.54444444  4.460277778  2.334055556
 156     1.262194444  1.8009444    4.12194444  3.24527778
 157 }
 158 Y3 set {
 159     1.015750000  0.462888889  0.49394444  0.429166667  1.053694444
 160     0.466111111  1.4152500    2.17538889  2.55294444
 161 }
 162 Y4 set {
 163     0.022018611  0.516333333  0.54772222  0.177638889  0.021703889
 164     0.134305556  0.5189278    0.07957222  0.41155556
 165 }
 166
 167
 168 #
 169 # Element attributes:
 170 #
 171 #    Label     yData    Foreground      Background      Stipple     Borderwidth
 172 set attributes {
 173     "Setup"     Y1      lightyellow3    lightyellow1    fdiagonal1      1
 174     "Read In"   Y0      lightgoldenrod3 lightgoldenrod1 bdiagonal1      1
 175     "Other"     Y4      lightpink3      lightpink1      fdiagonal1      1
 176     "Solve"     Y3      cyan3           cyan1           bdiagonal1      1
 177     "Load"      Y2      lightblue3      ""              fdiagonal1      1
 178 }
 179
 180 foreach {label yData fg bg stipple bd} $attributes {
 181     .graph element create $yData -label $label -bd $bd \
 182         -y $yData -x X -fg "" -bg $bg -stipple $stipple
 183 }
 184 .header.stacked invoke
 185
 186 table . \
 187     0,0 .title -fill x \
 188     1,0 .header -fill x  \
 189     2,0 .graph -fill both \
 190     3,0 .footer -fill x
 191
 192 table configure . r0 r1 r3 -resize none
 193
 194 Blt_ZoomStack .graph
 195 Blt_Crosshairs .graph
 196 Blt_ActiveLegend .graph
 197 Blt_ClosestPoint .graph
 198
 199 .graph marker bind all <B2-Motion> {
 200     set coords [%W invtransform %x %y]
 201     catch { %W marker configure [%W marker get current] -coords $coords }
 202 }
 203
 204 .graph marker bind all <Enter> {
 205     set marker [%W marker get current]
 206     catch { %W marker configure $marker -bg green}
 207 }
 208
 209 .graph marker bind all <Leave> {
 210     set marker [%W marker get current]
 211     catch { %W marker configure $marker -bg ""}
 212 }
 213
 214 .graph element bind all <Enter> {
 215     .graph element closest %x %y info
 216     puts stderr "$info(x) $info(y)"
 217 }