# drawtable.tcl --
# Script to draw a table in a canvas
#
namespace eval ::DrawTable {
variable tableCmd
variable table
variable defaults
# Possibly need to take care of Windows/Linux/UNIX differences
# in font sizes
#
set defaults {
-columnwidths {20 20}
-headerfont "Helvetica 14 bold"
-headerforeground black
-headerbackground white
-textfont "Helvetica 12"
-textforeground black
-textbackground white
-numberfont fixed
-numberforeground black
-numberbackground white
-evenrowbackground white
-oddrowbackground white
-oddcolumnbackground white
-evencolumnbackground white
-corner {10 10}
-tablewidth {}
}
set tableCmd(headers) Headers
set tableCmd(addrow) Addrow
set tableCmd(colconfigure) ColumnConfigure
set tableCmd(rowconfigure) RowConfigure
set tableCmd(cellconfigure) CellConfigure
set tableCmd(cellcontent) CellContent
set tableCmd(frame) DrawFrame
set tableCmd(hline) DrawHLine
namespace export drawntable
}
# drawntable --
# Create a command to draw and manipulate a table
#
# Arguments:
# canvas Canvas to be used
# args Options for the table (key-value pairs)
#
proc ::DrawTable::drawntable {canvas args} {
InitialiseTable $canvas $args
return [interp alias {} table$canvas {} ::DrawTable::TableCmd $canvas]
}
# TableCmd --
# Call the procedure for the given subcommand
#
# Arguments:
# canvas Canvas to be used
# subcmd Subcommand to run
# options Options to the subcommand
#
proc ::DrawTable::TableCmd {canvas subcmd {options {}}} {
variable tableCmd
if { [info exists tableCmd($subcmd)] } {
$tableCmd($subcmd) $canvas $options
} else {
return -code error "DrawnTable: unknown subcommand - $subcmd"
}
}
# InitialiseTable --
# Initialise the array "table" for a new drawn table
#
# Arguments:
# canvas Canvas to be used
# options Options for the table
#
proc ::DrawTable::InitialiseTable {canvas options} {
variable defaults
variable table
foreach {keyw value} $defaults {
set table($canvas,$keyw) $value
}
foreach {keyw value} $options {
set table($canvas,$keyw) $value
}
if { $table($canvas,-tablewidth) == {} } {
set table($canvas,-tablewidth) [$canvas cget -width]
}
set tablewidth $table($canvas,-tablewidth)
set columns $table($canvas,-columnwidths)
set xpos [lindex $table($canvas,-corner) 0]
set ypos [lindex $table($canvas,-corner) 1]
set item [$canvas create text 0 0 -text "MWijk" -font $table($canvas,-textfont)]
set bbox [$canvas bbox $item]
set charwidth [expr {([lindex $bbox 2]-[lindex $bbox 0])/5.0}]
set rowheight [expr {[lindex $bbox 3]-[lindex $bbox 1]}]
$canvas delete $item
set item [$canvas create text 0 0 -text "MWijk" -font $table($canvas,-headerfont)]
set bbox [$canvas bbox $item]
set headerheight [expr {[lindex $bbox 3]-[lindex $bbox 1]}]
$canvas delete $item
set pos $xpos
set colpos [list $pos]
set headerpos [list]
foreach col $columns {
set hpos [expr {$pos + 0.5*$col*$charwidth}]
set pos [expr {$pos + $col*$charwidth}]
lappend colpos $pos
lappend headerpos $hpos
}
set table($canvas,colpos) $colpos
set table($canvas,headerpos) $headerpos
set table($canvas,charwidth) $charwidth
set table($canvas,rowheight) $rowheight
set table($canvas,headerheight) $headerheight
set table($canvas,header) 0
set table($canvas,yheader) [expr {$ypos+0.5*$headerheight}]
set table($canvas,ypos) [expr {$ypos+$headerheight+0.5*$rowheight}]
set table($canvas,rowidx) 0
return [interp alias {} table$canvas {} TableCmd $canvas]
}
# Headers --
# Draw the headers to the table
#
# Arguments:
# canvas Canvas to be used
# headers Headers for the table
#
proc ::DrawTable::Headers {canvas headers} {
variable table
if { $table($canvas,header) == 0 } {
set table($canvas,header) 1
set yheader $table($canvas,yheader)
set idx 0
foreach col $table($canvas,headerpos) text $headers {
if { $col == {} } {
break
}
$canvas create text $col $yheader -text $text \
-anchor center \
-font $table($canvas,-headerfont) \
-fill $table($canvas,-headerforeground) \
-tags [list header_$idx]
incr idx
}
} else {
set idx 0
foreach col $table($canvas,headerpos) text $headers {
if { $col == {} } {
break
}
set item [$canvas gettags "header_$idx"]
$canvas itemconfigure -text $text
incr idx
}
}
}
# Addrow --
# Add a new row to the table
#
# Arguments:
# canvas Canvas to be used
# values values for the columns in the table
#
proc ::DrawTable::Addrow {canvas values} {
variable table
set ypos $table($canvas,ypos)
set rowidx $table($canvas,rowidx)
set colidx 0
set rowtype [expr {$rowidx%2==0? "even" : "odd"}]
foreach txtcol [lrange $table($canvas,colpos) 0 end-1] \
numcol [lrange $table($canvas,colpos) 1 end] \
text $values {
set coltype [expr {$colidx%2==0? "even" : "odd"}]
if { $txtcol == {} } {
break
}
if { ! [string is double $text] } {
$canvas create text $txtcol $ypos -text " $text" \
-anchor w \
-font $table($canvas,-textfont) \
-fill $table($canvas,-textforeground) \
-tags [list cell_${rowidx}_$colidx row$rowtype col$coltype]
incr colidx
} else {
$canvas create text $numcol $ypos -text "$text " \
-anchor e \
-font $table($canvas,-numberfont) \
-fill $table($canvas,-numberforeground) \
-tags [list cell_${rowidx}_$colidx row$rowtype col$coltype]
incr colidx
}
}
incr table($canvas,rowidx)
set table($canvas,ypos) [expr {$table($canvas,ypos)+$table($canvas,rowheight)}]
}
# DrawHLine --
# Draw a horizontal line
#
# Arguments:
# canvas Canvas to be used
# dummy Dummy argument
#
proc ::DrawTable::DrawHLine {canvas dummy} {
variable table
set ypos [expr {$table($canvas,ypos)-0.5*$table($canvas,rowheight)}]
set xbgn [lindex $table($canvas,colpos) 0]
set xend [lindex $table($canvas,colpos) end]
$canvas create line $xbgn $ypos $xend $ypos -fill black
}
# DrawFrame --
# Draw a frame around the table
#
# Arguments:
# canvas Canvas to be used
# which Which columns to delimit with a vertical line
# (either "first" or "all")
#
proc ::DrawTable::DrawFrame {canvas which} {
variable table
set ybgn [expr {$table($canvas,yheader)-0.5*$table($canvas,headerheight)}]
set yend [expr {$table($canvas,ypos) -0.5*$table($canvas,rowheight)}]
set xbgn [lindex $table($canvas,colpos) 0]
set xend [lindex $table($canvas,colpos) end]
$canvas create line $xbgn $ybgn $xend $ybgn $xend $yend $xbgn $yend \
$xbgn $ybgn -fill black
if { $which == "first" } {
set xcol [lindex $table($canvas,colpos) 1]
$canvas create line $xcol $ybgn $xcol $yend -fill black
} else {
foreach xcol [lrange $table($canvas,colpos) 1 end-1] {
$canvas create line $xcol $ybgn $xcol $yend -fill black
}
}
}
# main --
# Test the code
#
pack [canvas .c -width 600 -bg white]
set table [::DrawTable::drawntable .c -headerforeground green -columnwidths {20 20 10 10} \
-numberforeground blue]
$table headers {Name Country Size #}
$table hline
$table addrow {London Britain "Very big" 1}
$table addrow {Paris France "Very big" 2}
$table addrow {Amsterdam Holland "Big" 3}
$table addrow {Brussels Belgium "Very big" 4}
$table addrow {Schokland Holland "Tiny" 5}
#$table frame first
$table frame allArjen Markus One of the things a canvas can do is draw text in any font or colour or position. It can also write a PostScript file so that you can print what you see ...Here is a small script that displays a table by drawing it on a canvas, it is merely a humble beginning. (Of course, it may stay in its present state, if I think of something else to play with ;))I have not implemented all the options I wrote down yet, nor all the commands. But you can see what it could become, I guess.
gold added pix
Page contents
Getting started
Home • Recent changes • Help • Create new page • Search • Add comments
• Edit