Tcl - binding

Author

binding

Zulfukar Arslan

2006-03-03, 7:02 pm

Hi everybody,

I have a tcl/tk script which goal is to read a text file and draw the
result in a graph.

Here is the last part of the script: it makes a loop on the points and
draws.

#######################
for {set n 0} {$n < $extobj } {incr n} {

# calcul de leur coordonnees ecran
set x [expr ($xdata($n) - $xmin)*470/($xmax-$xmin)+21]
set y [expr 490-($ydata($n) - $ymin)*470/($ymax-$ymin)]
# calcul de leur couleur
if { $clt($n) != $oldc } {
incr nc
set oldc $clt($n)
}
set textcolor [lindex $plotcolor [expr $nc%[llength $plotcolor]]]
# dessin
#$w create text $x $y -text $clt($n) -fill $textcolor
if { [expr $nc % 4] == 0 } {
$w create rectangle [expr ($x-4)] [expr ($y-4)] [expr ($x+4)] [expr
($y+4)] -fill $textcolor
}
if { [expr $nc % 4] == 1 } {
$w create polygon $x [expr ($y-7)] [expr ($x-6)] [expr ($y+5)] [expr
($x+6)] [expr ($y+5)] -fill $textcolor
}
if { [expr $nc % 4] == 2 } {
$w create oval [expr ($x-4)] [expr ($y-4)] [expr ($x+4)] [expr ($y+4)]
-fill $textcolor
}
if { [expr $nc % 4] == 3 } {
$w create polygon $x [expr ($y+7)] [expr ($x-6)] [expr ($y-5)] [expr
($x+6)] [expr ($y-5)] -fill $textcolor
}
.right.c bind ???????? <Enter> { $w create text $x $y -text $reg($n)
-fill $textcolor }
}
########################

The name of the "canvas" is .right.c. You can find it at the beginning
of the last line.

I would like to replace the "?????????" by what is correct, so I could
get with my mouse the number corresponding to each point on the graph.

For example, it is a 2D graph, filled with squares, and each time I put
the mouse on a square, it appears the number of the square.

Can somebody help me?

slebetman@yahoo.com

2006-03-03, 7:02 pm

Zulfukar Arslan wrote:
> Hi everybody,
>
> I have a tcl/tk script which goal is to read a text file and draw the
> result in a graph.
>
> Here is the last part of the script: it makes a loop on the points and
> draws.
>
> <snip code>
>
> The name of the "canvas" is .right.c. You can find it at the beginning
> of the last line.
>
> I would like to replace the "?????????" by what is correct, so I could
> get with my mouse the number corresponding to each point on the graph.
>
> For example, it is a 2D graph, filled with squares, and each time I put
> the mouse on a square, it appears the number of the square.
>

The short answer is the return value of [.right.c create ...]. The
documentation mentions TagOrId, the return value is the id:

# Changed your if statements to a switch so that we
# only need to calculate the expr once:

set dotType [expr $nc % 4]
switch -exact $dotType {
0 {
set id [$w create rectangle \
[expr ($x-4)] [expr ($y-4)] [expr ($x+4)] \
[expr ($y+4)] -fill $textcolor]
}
1 {
set id [$w create polygon \
$x [expr ($y-7)] [expr ($x-6)] [expr ($y+5)] \
[expr ($x+6)] [expr ($y+5)] -fill $textcolor]
}
2 {
set id [$w create oval [expr ($x-4)] \
[expr ($y-4)] [expr ($x+4)] [expr ($y+4)] \
-fill $textcolor]
}
3 {
set id [$w create polygon $x [expr ($y+7)] \
[expr ($x-6)] [expr ($y-5)] [expr ($x+6)] \
[expr ($y-5)] -fill $textcolor
}

# Also changed the quoting to using a list command
# your original code won't work since a curly brace
# will not be substituted and you'll get errors like
# invalid command name $w or can't read w, no such
# variable. You could also use the double quote which
# is substituted but that will give you problems with
# the string in $reg($n) which probably contains
# whitespace

.right.c bind $id <Enter> [list $w create text \
$x $y -text $reg($n) -fill $textcolor]
}

Bryan Oakley

2006-03-03, 9:57 pm

slebetman@yahoo.com wrote:
>
> The short answer is the return value of [.right.c create ...]. The
> documentation mentions TagOrId, the return value is the id:
>
> # Changed your if statements to a switch so that we
> # only need to calculate the expr once:
>
> set dotType [expr $nc % 4]

you should get in the habit of bracing your expressions -- they run
faster that way:

set dotType [expr {$nc % 4}]

--
Bryan Oakley
http://www.tclscripting.com

Zulfukar Arslan

2006-03-06, 3:57 am

Great! This is what I want. But there are two problems:

1. The number which appears on the square is hidden by the color of the
square because it appears behind it.
2. The number does not disappear when the mouse goes elsewhere.

The second one is not really important. But the first problem needs to
be checked because I can't see anything. Do you have a solution which
enables me to see that number. Perhaps to make the number appear near
the square and not on the square...

Thanks for your help.

slebetman@yahoo.com wrote:
> Zulfukar Arslan wrote:
>
>
>
> The short answer is the return value of [.right.c create ...]. The
> documentation mentions TagOrId, the return value is the id:
>
> # Changed your if statements to a switch so that we
> # only need to calculate the expr once:
>
> set dotType [expr $nc % 4]
> switch -exact $dotType {
> 0 {
> set id [$w create rectangle \
> [expr ($x-4)] [expr ($y-4)] [expr ($x+4)] \
> [expr ($y+4)] -fill $textcolor]
> }
> 1 {
> set id [$w create polygon \
> $x [expr ($y-7)] [expr ($x-6)] [expr ($y+5)] \
> [expr ($x+6)] [expr ($y+5)] -fill $textcolor]
> }
> 2 {
> set id [$w create oval [expr ($x-4)] \
> [expr ($y-4)] [expr ($x+4)] [expr ($y+4)] \
> -fill $textcolor]
> }
> 3 {
> set id [$w create polygon $x [expr ($y+7)] \
> [expr ($x-6)] [expr ($y-5)] [expr ($x+6)] \
> [expr ($y-5)] -fill $textcolor
> }
>
> # Also changed the quoting to using a list command
> # your original code won't work since a curly brace
> # will not be substituted and you'll get errors like
> # invalid command name $w or can't read w, no such
> # variable. You could also use the double quote which
> # is substituted but that will give you problems with
> # the string in $reg($n) which probably contains
> # whitespace
>
> .right.c bind $id <Enter> [list $w create text \
> $x $y -text $reg($n) -fill $textcolor]
> }
>

slebetman@yahoo.com

2006-03-06, 7:57 am

Zulfukar Arslan wrote:
> slebetman@yahoo.com wrote:
> Great! This is what I want. But there are two problems:
>
> 1. The number which appears on the square is hidden by the color of the
> square because it appears behind it.

That's funny, newer objects on the canvas should be created above older
objects. If you really do have this problem then you can use the canvas
raise command to make sure the text label is on top. To do that you
need to modify your code:

.right.c bind $id <Enter> [list showNumber \
$id $x $y $reg($n) $textcolor]

Then outside of your graph-creating loop, write the proc showNumber:

proc showNumber {id x y txt color} {
# Create the label with an offset of 5 pixels on both
# axis so that it doesn't overlap the dot. Tune the
# offset to your taste:
set label_id [.right.c create text \
[expr {$x+5}] [expr {$y+5}] -text $txt \
-fill $color -anchor nw]

# Raise the label to be above everything else:
.right.c raise $label_id
}

> 2. The number does not disappear when the mouse goes elsewhere.

If you want this feature bind the <Leave> event in your showNumber
proc:

proc showNumber {id x y txt color} {
# Create the label with an offset of 5 pixels on both
# axis so that it doesn't overlap the dot:
set label_id [.right.c create text \
[expr {$x+5}] [expr {$y+5}] -text $txt \
-fill $color -anchor nw]

# Raise the label to be above everything else:
.right.c raise $label_id

# Destroy the label if the mouse is not on the dot:
.right.c bind $id <Leave> [list .right.c delete $label_id]
}

slebetman@yahoo.com

2006-03-06, 7:57 am

Bryan Oakley wrote:
> slebetman@yahoo.com wrote:
>
> you should get in the habit of bracing your expressions -- they run
> faster that way:
>
> set dotType [expr {$nc % 4}]

I know, I know. But I've been writing tcl code before the bytecode
compiler was written and old habbits die hard - especially when writing
short snippets of code for usenet. In my production code I do brace
stuff which are calculated in loops or are calculated more than once.
For exprs which are calculated only once per program I still prefer not
to brace them. Somehow bracing looks ugly to me ;-)

Bryan Oakley

2006-03-06, 7:00 pm

slebetman@yahoo.com wrote:
> Bryan Oakley wrote:
>
>
> I know, I know. But I've been writing tcl code before the bytecode
> compiler was written and old habbits die hard - especially when writing
> short snippets of code for usenet. In my production code I do brace
> stuff which are calculated in loops or are calculated more than once.
> For exprs which are calculated only once per program I still prefer not
> to brace them. Somehow bracing looks ugly to me ;-)
>

It does look ugly. I still recommend it. Not for seasoned professionals
since, obviously, you know what you're doing. For beginning programmers
though, I think we should set a good example lest they get the wrong
impression that Tcl is slower than it really is.

--
Bryan Oakley
http://www.tclscripting.com

slebetman@yahoo.com

2006-03-06, 9:57 pm

slebetman@yahoo.com wrote:
> Zulfukar Arslan wrote:
>
> That's funny, newer objects on the canvas should be created above older
> objects. If you really do have this problem then you can use the canvas
> raise command to make sure the text label is on top. To do that you
> need to modify your code:
>
> .right.c bind $id <Enter> [list showNumber \
> $id $x $y $reg($n) $textcolor]
>
> Then outside of your graph-creating loop, write the proc showNumber:
>
> proc showNumber {id x y txt color} {
> # Create the label with an offset of 5 pixels on both
> # axis so that it doesn't overlap the dot. Tune the
> # offset to your taste:
> set label_id [.right.c create text \
> [expr {$x+5}] [expr {$y+5}] -text $txt \
> -fill $color -anchor nw]
>
> # Raise the label to be above everything else:
> .right.c raise $label_id
> }
>
>
> If you want this feature bind the <Leave> event in your showNumber
> proc:
>
> proc showNumber {id x y txt color} {
> # Create the label with an offset of 5 pixels on both
> # axis so that it doesn't overlap the dot:
> set label_id [.right.c create text \
> [expr {$x+5}] [expr {$y+5}] -text $txt \
> -fill $color -anchor nw]
>
> # Raise the label to be above everything else:
> .right.c raise $label_id
>
> # Destroy the label if the mouse is not on the dot:
> .right.c bind $id <Leave> [list .right.c delete $label_id]
> }

Zulfukar sent me a private email saying that my code caused his app to
hang. After a little investigation I found that at least on windows you
need to do an 'update' after deleting a canvas item before binding
another canvas item. This is interesting since common wisdom is that
updates are considered harmful. Well, in this case NOT updating IS
harmful. The corrected code which doesn't hang:

proc showNumber {id x y txt color} {
# Create the label with an offset of 5 pixels on both
# axis so that it doesn't overlap the dot:
set label_id [.c create text \
[expr {$x+5}] [expr {$y-5}] -text $txt \
-fill $color -anchor sw -tags textlabel]

# Create background rect so that our textlabel is
# not obscured by items of the same color:
.c create rectangle [.c bbox $label_id] \
-fill white -tags textlabel

# Raise the label to be above the rectangle
.c raise $label_id

# Destroy the label if the mouse is not on the dot:
.c bind $id <Leave> {
.c delete textlabel
# Without this update the app will hang:
update
}
}

Zulfukar Arslan

2006-03-07, 3:57 am

Wonderful! You were right, just an update and it works. For the private
email, sorry, I didn't see.

Bye.

slebetman@yahoo.com wrote:
> slebetman@yahoo.com wrote:
>
>
>
> Zulfukar sent me a private email saying that my code caused his app to
> hang. After a little investigation I found that at least on windows you
> need to do an 'update' after deleting a canvas item before binding
> another canvas item. This is interesting since common wisdom is that
> updates are considered harmful. Well, in this case NOT updating IS
> harmful. The corrected code which doesn't hang:
>
> proc showNumber {id x y txt color} {
> # Create the label with an offset of 5 pixels on both
> # axis so that it doesn't overlap the dot:
> set label_id [.c create text \
> [expr {$x+5}] [expr {$y-5}] -text $txt \
> -fill $color -anchor sw -tags textlabel]
>
> # Create background rect so that our textlabel is
> # not obscured by items of the same color:
> .c create rectangle [.c bbox $label_id] \
> -fill white -tags textlabel
>
> # Raise the label to be above the rectangle
> .c raise $label_id
>
> # Destroy the label if the mouse is not on the dot:
> .c bind $id <Leave> {
> .c delete textlabel
> # Without this update the app will hang:
> update
> }
> }
>

Erik Leunissen

2006-03-30, 8:02 am

slebetman@yahoo.com wrote:
> slebetman@yahoo.com wrote:

[snip]

> ... After a little investigation I found that at least on windows you
> need to do an 'update' after deleting a canvas item before binding
> another canvas item. This is interesting since common wisdom is that
> updates are considered harmful. Well, in this case NOT updating IS
> harmful....

[snip]

Chances that [update] does do harm are much greater than [update
idletasks]. The former updates *all* events in the event loop, the
latter is restricted to *idle* events.

If the issue of the OP is a case of merely updating the display of a
widget, then we have an idle event, in which case [update idletasks]
will do the trick also, evading a lot of harm that [update] might cause
otherwise.

Erik Leunissen
--
leunissen@ nl | Merge the left part of these two lines into one,
e. hccnet. | respecting a character's position in a line.

Sponsored Links