util/X86LINUX64/lib/blt2.5/demos/barchart1.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 set graph .bc
  32
  33 proc random {{max 1.0} {min 0.0}} {
  34     global randomSeed
  35
  36     set randomSeed [expr (7141*$randomSeed+54773) % 259200]
  37     set num  [expr $randomSeed/259200.0*($max-$min)+$min]
  38     return $num
  39 }
  40 set randomSeed 148230
  41
  42 proc FormatLabel { w value } {
  43
  44     # Determine the element name from the value
  45
  46     set names [$w element show]
  47     set index [expr round($value)]
  48     if { $index != $value } {
  49         return $value
  50     }
  51     global elemLabels
  52     if { [info exists elemLabels($index)] } {
  53         return $elemLabels($index)
  54     }
  55     return $value
  56 }
  57
  58 source scripts/stipples.tcl
  59
  60 image create photo bgTexture -file ./images/rain.gif
  61
  62 option add *tile                        bgTexture
  63
  64 option add *Button.tile                 ""
  65
  66 option add *Htext.tileOffset            no
  67 option add *Htext.font                  { Times 12 }
  68
  69 option add *Barchart.title              "A Simple Barchart"
  70
  71 option add *Axis.tickFont               { Courier 10 }
  72 option add *Axis.titleFont              { Helvetica 12 bold }
  73
  74 option add *x.Title                     "X Axis Label"
  75 option add *x.Rotate                    90
  76 option add *x.Command                   FormatLabel
  77 option add *y.Title                     "Y Axis Label"
  78
  79 option add *Element.Background          white
  80 option add *Element.Relief              solid
  81 option add *Element.BorderWidth         1
  82
  83 option add *Legend.hide                 yes
  84
  85 option add *Grid.hide                   no
  86 option add *Grid.dashes                 { 2 4 }
  87 option add *Grid.mapX                   ""
  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 *graph.background palegreen
  94 }
  95
  96 htext .header -text {
  97     The barchart has several components: coordinate axes, data
  98     elements, legend, crosshairs, grid,  postscript, and markers.
  99     They each control various aspects of the barchart.  For example,
 100     the postscript component lets you generate PostScript output.
 101     Pressing the %%
 102
 103     set w $htext(widget)
 104     button $w.print -text {Print} -command {
 105         .bc postscript output bar.ps
 106     }
 107     $w append $w.print
 108
 109 %% button will create a file "bar.ps"
 110 }
 111
 112 htext .footer -text {
 113     Hit the %%
 114
 115     set w $htext(widget)
 116     button $w.quit -text quit -command exit
 117     $w append $w.quit
 118
 119 %% button when you've seen enough.%%
 120
 121     label $w.logo -bitmap BLT
 122     $w append $w.logo -padx 20
 123
 124 %% }
 125
 126 barchart .bc
 127
 128 #
 129 # Element attributes:
 130 #
 131 #    Label      Foreground      Background      Stipple Pattern
 132
 133 source scripts/stipples.tcl
 134
 135 set bitmaps {
 136     bdiagonal1 bdiagonal2 checker2 checker3 cross1 cross2 cross3 crossdiag
 137     dot1 dot2 dot3 dot4 fdiagonal1 fdiagonal2 hline1 hline2 lbottom ltop
 138     rbottom rtop vline1 vline2
 139 }
 140 set count 1
 141 foreach stipple $bitmaps {
 142     set label [file tail $stipple]
 143     set label [file root $label]
 144     set y [random -2 10]
 145     set yhigh [expr $y + 0.5]
 146     set ylow [expr $y - 0.5]
 147     .bc element create $label -y $y -x $count \
 148         -fg brown -bg orange -stipple $stipple -yhigh $yhigh -ylow $ylow
 149     set elemLabels($count) $label
 150     incr count
 151 }
 152
 153 table . \
 154     0,0 .header -fill x \
 155     1,0 .bc -fill both \
 156     2,0 .footer -fill x
 157
 158 table configure . r0 r2 -resize none
 159
 160 Blt_ZoomStack .bc
 161 Blt_Crosshairs .bc
 162 Blt_ActiveLegend .bc
 163 Blt_ClosestPoint .bc
 164
 165 if 0 {
 166 set printer [printer open [lindex [printer names] 0]]
 167 printer getattr $printer attrs
 168 set attrs(Orientation) Portrait
 169 printer setattr $printer attrs
 170 after 2000 {
 171         $graph print2 $printer
 172         printer close $printer
 173 }
 174 }
 175
 176 .bc axis bind x <Enter> {
 177     set axis [%W axis get current]
 178     %W axis configure $axis -color blue3 -titlecolor blue3
 179 }
 180 .bc axis bind x <Leave> {
 181     set axis [%W axis get current]
 182     %W axis configure $axis -color black -titlecolor black
 183 }
 184
 185