ALPHALINUX5/util/ALPHALINUX5/lib/blt2.4/demos/barchart4.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 random {{max 1.0} {min 0.0}} {
  32     global randomSeed
  33
  34     set randomSeed [expr (7141*$randomSeed+54773) % 259200]
  35     set num  [expr $randomSeed/259200.0*($max-$min)+$min]
  36     return $num
  37 }
  38 set randomSeed 14823
  39
  40
  41 set graph .graph
  42
  43 source scripts/stipples.tcl
  44 source scripts/patterns.tcl
  45
  46 option add *Barchart.title              "A Simple Barchart"
  47 option add *Barchart.relief             raised
  48 option add *Barchart.borderWidth        2
  49 option add *Barchart.plotBackground     white
  50 option add *Barchart.baseline           57.299
  51
  52 option add *Element.borderWidth         2
  53 option add *Element.Background          white
  54 option add *Element.Relief              raised
  55
  56 option add *x.Title                     "X Axis"
  57 option add *x.Font                      *Times-Medium-R*10*
  58 option add *y.Title                     "Y Axis"
  59 option add *LineMarker.Foreground       yellow
  60
  61 set visual [winfo screenvisual .]
  62 if { $visual != "staticgray" && $visual != "grayscale" } {
  63     option add *print.background yellow
  64     option add *quit.background red
  65     option add *graph.background palegreen
  66 }
  67
  68 htext .header -text \
  69 {   This is an example of the barchart widget.  The barchart has
  70     many components; x and y axis, legend, crosshairs, elements, etc.
  71     To create a postscript file "bar.ps", press the %%
  72     set w $htext(widget)
  73     button $w.print -text {Print} -command {
  74         $graph postscript output bar.ps
  75     }
  76     $w append $w.print
  77
  78 %% button.
  79 }
  80 barchart $graph
  81 $graph xaxis configure -rotate 90 -stepsize 0
  82
  83 htext .footer -text {    Hit the %%
  84     set im [image create photo -file ./images/stopsign.gif]
  85     button $htext(widget).quit -image $im -command { exit }
  86     $htext(widget) append $htext(widget).quit -pady 2
  87 %% button when you've seen enough. %%
  88     label $htext(widget).logo -bitmap BLT
  89     $htext(widget) append $htext(widget).logo
  90 %%}
  91
  92 set attributes {
  93     red         bdiagonal1
  94     orange      bdiagonal2
  95     yellow      fdiagonal1
  96     green       fdiagonal2
  97     blue        hline1
  98     cyan        hline2
  99     magenta     vline1
 100     violetred   vline2
 101     purple      crossdiag
 102     lightblue   hobbes
 103 }
 104
 105 set count 0
 106 foreach { color stipple } $attributes {
 107     $graph pen create pen$count -fg ${color}1 -bg ${color}4 -stipple $stipple
 108     lappend styles [list pen$count $count $count]
 109     incr count
 110 }
 111
 112 vector x y w
 113
 114 x seq 0 1000
 115 y expr random(x)*90.0
 116 w expr round(y/10.0)%$count
 117 y expr y+10.0
 118
 119 $graph element create data -label {} \
 120     -xdata x -ydata y -weight w -styles $styles
 121
 122 table . \
 123     0,0 .header -fill x  \
 124     1,0 .graph -fill both \
 125     2,0 .footer -fill x
 126
 127 table configure . r0 r2 -resize none
 128
 129 wm min . 0 0
 130
 131 Blt_ZoomStack $graph
 132 Blt_Crosshairs $graph
 133 Blt_ActiveLegend $graph
 134 Blt_ClosestPoint $graph
 135