GWM This is an example of creating a derived widget - in this case for drawing a graph. The main differences are:
- lines to be drawn are defined in 'user coordinates' not pixels - the coordinates use normal graph directions (canvas pixels are defined as 0 at top, large at bottom of screen). - the pen colour is an option.
The code is a simplification of Overloading widgets and shows how to add an option to a derived widget. I do not like my use of globals here to store the widget's options. Any improvements/suggestions sought.
15/05/.05 - corrected initialisation of graph ranges (xmin, xmax...).
proc grapharea {w args} { ;# a graph plotter canvas derived thing.
set dx 400
set dy 400
global $w.pencolour $w.xmin $w.xmax $w.ymin $w.ymax
set $w.pencolour black
set $w.xmin -1; set $w.xmax 1
set $w.ymin -1; set $w.ymax 1
array set options {{-colour} red}
# split off the custom options:
set textArgs [list]
foreach {opt val} $args {
switch -- $opt {
{-pencolour} {set options($opt) $val}
default {lappend textArgs $opt $val}
}
}
eval canvas $w $textArgs
interp hide {} $w
# Install the alias:
interp alias {} $w {} graphareaCmd $w
foreach opt [array names options] {
$w configure $opt $options($opt)
}
return $w ;# the original canvas
}
proc graphareaCmd {self cmd args} {
switch -- $cmd {
configure {eval graphareaConfigure $self $cmd $args}
cget {eval graphareaCget $self $args}
showgrid { ;# draw a grid of lines on the graph
set x0 [$self cget xmin]
set x1 [$self cget xmax]
set y0 [$self cget ymin]
set y1 [$self cget ymax]
set dx [lindex $args 0]
set x [expr int($x0/$dx)*$dx] ;# choose lines s.t. zero is a line.
while {$x<$x1} {
$self addline $x $y0 $x $y1
set x [expr $x+$dx]
}
set dy [lindex $args 1]
set y [expr int($y0/$dy)*$dy]
while {$y<$y1} {
$self addline $x0 $y $x1 $y
set y [expr $y+$dy]
}
}
addline {
set args [eval concat $args] ;# this removes a level of curlies if necessary from the list.
set penc [$self cget pencolour];# get "local" pen colour name
set x0 [$self cget xmin]
set x1 [$self cget xmax]
set y0 [$self cget ymin]
set y1 [$self cget ymax]
set wid [$self cget -width]
set ht [$self cget -height]
foreach {x y} $args { ;# scale to canvas pixels
lappend xylist [expr $wid*double($x-$x0)/($x1-$x0)]
lappend xylist [expr $ht*double($y-$y1)/($y0-$y1)]
}
interp invokehidden {} $self create line $xylist -fill $penc
}
createcanvasoption { ;# add text (eg) positioned at scaled position
set args [eval concat $args] ;# this removes a level of curlies if necessary from the list.
set penc [$self cget pencolour];# get "local" pen colour name
set x0 [$self cget xmin]
set x1 [$self cget xmax]
set y0 [$self cget ymin]
set y1 [$self cget ymax]
set wid [$self cget -width]
set ht [$self cget -height]
lset args 1 [expr int($wid*double([lindex $args 1]-$x0)/($x1-$x0))]
lset args 2 [expr int($ht*double([lindex $args 2]-$y1)/($y0-$y1))]
switch [lindex $args 0] {
{text} {
interp invokehidden {} $self create text [lindex $args 1] [lindex $args 2] -fill $penc -text "[lindex $args 3]"
}
}
}
}
}
proc graphareaConfigure {self cmd args} {
# 3 scenarios:
#
# $args is empty -> return all options with their values
# $args is one element -> return current values
# $args is 2+ elements -> configure the options
switch [llength $args] {
0 { ;# return argument values
set result [ option get $self -pencolour ""]
# default options:
lappend result [interp invokehidden {} $self configure ]
# lappend result [uplevel 1 $self cconfigure]
return $result
}
1 {
switch -- $args {
{-pencolour} {return [uplevel 1 [list interp invokehidden {} $self configure -pencolour]]}
default {return [uplevel 1 interp invokehidden {} $self configure $args]}
}
}
default { ;# >1 arg - an option and its value
# go through each option:
foreach {option value} $args {
switch -- $option {
{-xmin} -
{-xmax} -
{-ymin} -
{-ymax} -
{-pencolour} {
if {1==0} {This is the part I dont like - I create a global variable for each added option.
}
global $self.[string range $option 1 end]
set $self.[string range $option 1 end] $value
}
default {puts " default $option, $value for $self";$self configure $option $value}
;#$self configure $option $value
}
}
return {}
}
}
}
proc graphareaCget {self args} {
# cget defaults done by the canvas cget command
#puts "In graphareaCget option $self $args"
if {[info exists ::$self.$args]} {upvar #0 $self.$args val; return $val}
switch -- $args {
{-pencolour} {return [uplevel 1 [list interp invokehidden {} $self cget pencolour]]}
default {return [uplevel 1 [list interp invokehidden {} $self cget $args]]}
}
}
catch {destroy .fib}
set dr2 [grapharea .fib -width 400 -height 400 -pencolour red]
# points are drawn with the canvas area scaled to these values:
$dr2 configure -xmin -2 -xmax 22 -ymin -1.02 -ymax 1.02
pack $dr2
$dr2 showgrid 5 1
$dr2 configure -pencolour blue ;# this value persist for all lines from here
set xold 0
set yold [expr sin(0)]
for {set x 0} {$x<20} {set x [expr $x+.25]} {
set y [expr sin($x)*exp(-0.1*$x)]
$dr2 addline $xold $yold $x $y
set xold $x
set yold $y
}
$dr2 configure -pencolour orange
set xold 0
set yold [expr cos(0)]
for {set x 0} {$x<20} {set x [expr $x+.25]} {
set y [expr cos($x)*exp(-0.1*$x)]
$dr2 addline $xold $yold $x $y
set xold $x
set yold $y
}
$dr2 configure -pencolour green
# a simple rectangle drawn as a line with 5 coordinates (10 values, last repeats first)
$dr2 addline 0 1 20 1 20 -1 0 -1 0 1
# you can also add canvas options to the grapharea:
interp invokehidden {} $dr2 create rectangle 20 20 390 390
interp invokehidden {} $dr2 create text 120 30 -fill black -text "Graph Area"
# or you can use the
$dr2 createcanvasoption text 10.0 0.9 {{Positioned Label}}
# creating a long line of coordiantes
set xys ""
for {set x 0} {$x<20} {set x [expr $x+.25]} {
set y [expr cos(2*$x)*sin(0.3*$x)]
lappend xys $x $y
}
#puts "Length [llength $xys] [$dr2 cget pencolour] [$dr2 cget xmin] [$dr2 cget xmax]"
$dr2 addline $xys