HP/util/HP/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
  66 option add *Axis.tickFont               -*-helvetica-medium-r-*-*-12-*-*
  67 option add *Axis.titleFont              -*-helvetica-bold-r-*-*-12-*-*
  68 option add *x.Command                   FormatXTicks
  69 option add *x.Title                     "Simulator"
  70 option add *y.Title                     "Time (hrs)"
  71
  72 option add *activeBar.Foreground        pink
  73 option add *activeBar.stipple           dot3
  74 option add *Element.Background          red
  75 option add *Element.Relief              raised
  76
  77 option add *Grid.dashes                 { 2 4 }
  78 option add *Grid.hide                   no
  79 option add *Grid.mapX                   ""
  80
  81 option add *Legend.Font                 "-*-helvetica*-bold-r-*-*-12-*-*"
  82 option add *Legend.activeBorderWidth    2
  83 option add *Legend.activeRelief         raised
  84 option add *Legend.anchor               ne
  85 option add *Legend.borderWidth          0
  86 option add *Legend.position             right
  87
  88 option add *TextMarker.Font             *Helvetica-Bold-R*14*
  89
  90 set visual [winfo screenvisual .]
  91 if { $visual != "staticgray" && $visual != "grayscale" } {
  92     option add *print.background        yellow
  93     option add *quit.background         red
  94     option add *quit.activeBackground   red2
  95 }
  96
  97 htext .title -text {
  98     Data points with like x-coordinates, can have their bar segments displayed
  99     in one of the following modes (using the -barmode option):
 100 }
 101 htext .header -text {
 102     %%
 103         radiobutton .header.stacked -text stacked -variable barMode \
 104             -anchor w -value "stacked" -selectcolor red -command {
 105             .graph configure -barmode $barMode
 106         }
 107         .header append .header.stacked -width 1.5i -anchor w
 108     %%      Bars are stacked on top of each other. The overall height is the
 109                                                    sum of the y-coordinates.
 110     %%
 111         radiobutton .header.aligned -text aligned -variable barMode \
 112           -anchor w -value "aligned" -selectcolor yellow -command {
 113             .graph configure -barmode $barMode
 114         }
 115         .header append .header.aligned -width 1.5i -fill x
 116     %%      Bars are drawn side-by-side at a fraction of their normal width.
 117     %%
 118         radiobutton .header.overlap -text "overlap" -variable barMode \
 119             -anchor w -value "overlap" -selectcolor green -command {
 120             .graph configure -barmode $barMode
 121         }
 122         .header append .header.overlap -width 1.5i -fill x
 123     %%      Bars overlap slightly.
 124     %%
 125         radiobutton .header.normal -text "normal" -variable barMode \
 126             -anchor w -value "normal" -selectcolor blue -command {
 127             .graph configure -barmode $barMode
 128         }
 129         .header append .header.normal -width 1.5i -fill x
 130     %%      Bars are overlayed one on top of the next.
 131 }
 132
 133 htext .footer -text {    Hit the %%
 134     set im [image create photo -file ./images/stopsign.gif]
 135     button $htext(widget).quit -image $im -command { exit }
 136     $htext(widget) append $htext(widget).quit -pady 2
 137 %% button when you've seen enough. %%
 138     label $htext(widget).logo -bitmap BLT
 139     $htext(widget) append $htext(widget).logo
 140 %%}
 141
 142 barchart .graph -tile bgTexture
 143
 144 vector X Y0 Y1 Y2 Y3 Y4
 145
 146 X set { 1 2 3 4 5 6 7 8 9 }
 147 Y0 set {
 148     0.729111111  0.002250000  0.09108333  0.006416667  0.026509167
 149     0.007027778  0.1628611    0.06405278  0.08786667
 150 }
 151 Y1 set {
 152     0.003120278  0.004638889  0.01113889  0.048888889  0.001814722
 153     0.291388889  0.0503500    0.13876389  0.04513333
 154 }
 155 Y2 set {
 156     11.534444444 3.879722222  4.54444444  4.460277778  2.334055556
 157     1.262194444  1.8009444    4.12194444  3.24527778
 158 }
 159 Y3 set {
 160     1.015750000  0.462888889  0.49394444  0.429166667  1.053694444
 161     0.466111111  1.4152500    2.17538889  2.55294444
 162 }
 163 Y4 set {
 164     0.022018611  0.516333333  0.54772222  0.177638889  0.021703889
 165     0.134305556  0.5189278    0.07957222  0.41155556
 166 }
 167
 168
 169 #
 170 # Element attributes:
 171 #
 172 #    Label      yData   Color           Stipple Pattern
 173 set attributes {
 174     "Setup"     Y1      lightyellow     fdiagonal1
 175     "Read In"   Y0      lightgoldenrod  bdiagonal1
 176     "Other"     Y4      lightpink       fdiagonal1
 177     "Solve"     Y3      cyan            bdiagonal1
 178     "Load"      Y2      lightblue       fdiagonal1
 179 }
 180
 181 foreach {label yData color stipple} $attributes {
 182     .graph element create $yData -label $label -bd 1 \
 183         -ydata $yData -xdata X -fg ${color}3 -bg ${color}1 -stipple $stipple
 184 }
 185
 186 .header.stacked invoke
 187
 188 table . \
 189     0,0 .title -fill x \
 190     1,0 .header -fill x  \
 191     2,0 .graph -fill both \
 192     3,0 .footer -fill x
 193
 194 table configure . r0 r1 r3 -resize none
 195
 196 Blt_ZoomStack .graph
 197 Blt_Crosshairs .graph
 198 Blt_ActiveLegend .graph
 199 Blt_ClosestPoint .graph
 200
 201 .graph marker bind all <B2-Motion> {
 202     set coords [%W invtransform %x %y]
 203     catch { %W marker configure [%W marker get current] -coords $coords }
 204 }
 205
 206 .graph marker bind all <Enter> {
 207     set marker [%W marker get current]
 208     catch { %W marker configure $marker -bg green}
 209 }
 210
 211 .graph marker bind all <Leave> {
 212     set marker [%W marker get current]
 213     catch { %W marker configure $marker -bg ""}
 214 }
 215