[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