WJG 2006-05-15: More cheap and cheerful stuff. Creating a
[histogram
] from a simple list. Some output would be useful, obviously to
PS, but perhaps as a windows
WMF.
#---------------
# histogram.tcl
#
# place histogram into canvas
#---------------
# TITLE
# +----------------+
# | V |
# | +---+ |
# | V | | |
# | +---+ | | |
# | | | | | |
# +--+---+--+---+--+
# L L
# SERIES
#---------------
# courtesy of Spephane Arnould
#---------------
proc coordy {cvpath coord} {
incr coord 0; # check integer type
set y [$cvpath cget -height]
return [expr {$y-$coord}]
}
#---------------
# determine canvas centre
#---------------
proc centre {cvpath} {
set cx [$cvpath cget -width]
return [expr {$cx /2}]
}
#---------------
# render histogram
#
# path path of canvas widget into which the chart is rendered
# tag assign a custom tag to all items, it may be useful later
# data the data series to display
# width, height overall width/height of the graphing area
# x, y offsets in the canvas, from the bottom left corner
# t1, t2 top/bottom chart titles
#
#---------------
proc histogram {path tag data width height x y t1 t2} {
# determine how items in the set
set i [expr [llength $data] / 2]
# determine spacing between each bar
set dw [expr $width / $i]
# set bar width as 80% of separation +--|--+
set bw [expr $dw * 4 / 10]
set di [expr $x + 25]
# draw grid
# calculate size of table
set s [expr $i * $dw]
$path create rectangle \
[expr $di - $dw] [coordy $path $y] \
[expr $di + $width] [coordy $path [expr $height + $y]] \
-tags $tag
# determine scale to fit factor
set j 0
foreach {a b} $data {
if {$b > $j} {set j $b}
}
# Patched by paskali, solved division by zero error
#
# make largest item 90% of height, determine scale factor
if {[catch {set sf [expr ($height * 90 /100) /$j]}]} {
set sf 0
}
# initialize block co-ordinates
set cx(1) 0 ; set cy(1) 0
set cx(2) 0 ; set cy(2) 0
foreach {a b} $data {
# bar
set cx(1) [expr $di - $bw]
set cy(1) [coordy $path $y]
set cx(2) [expr $di + $bw]
set cy(2) [coordy $path [expr $y + ($sf * $b)]]
# label
set cy(3) [coordy $path [expr $y -10]]
# value
set cy(4) [coordy $path [expr $y +($sf * $b)+10]]
# sample
$path create text \
$di $cy(3) \
-text $a \
-tags $tag
$path create rectangle \
$cx(1) $cy(1) \
$cx(2) $cy(2) \
-fill yellow \
-outline black \
-tags $tag
# value
$path create text \
$di $cy(4) \
-text $b \
-tags $tag
incr di $dw
}
# add top title
$path create text \
[expr $x + [centre $path]] [coordy $path [expr $height + 30 ]] \
-text $t1 \
-tags $tag
# add bottom title
$path create text \
[expr $x + [centre $path]] [coordy $path [expr $y - 30 ]] \
-text $t2 \
-tags $tag
}
#---------------
# demo block
#---------------
console show
pack [canvas .hist -width 500 -height 400 -bg white] -fill both
set data {ch1 10 ch2 10 ch3 20 ch4 30 ch5 50 ch6 40 ch7 60 ch8 30 ch9 20 ch10 40 ch11 10 ch12 5}
histogram .hist \
sarv \
$data \
500 300 \
50 50 \
{Occurrence of the term 'Sarvajna'} \
{T224 Chapter}