MG Jan 25th 2005 - Tested on Windows XP. The majority of the lines do move for me; the two rectangles at the right, along with the shapes inside them all move, and the two lines to the left which disect the square move (the square itself does not). The red/green/blue lines in the top left and the star at the bottom left are static, though.
MM Thank you for testing it! Yes, some of the lines are static to test different patterns: only the ones that are created from [main] as scripts for [after 0] are meant to be marching ants, the others (the little square, the star, and the three lines in the upper left corner of the canvas) are static.
PWQ On my Linux box, wish hangs and does not ever update. I changed one of the after 50, to after 60 and the display appeared and all the ant's march. There must be some weirdness in tcl's event processing that pushed the idle callback for the display to the back of the list.
MM Yes: the updating of the widgets is queued, at the C language level, with a call to Tcl_DoWhenIdle(). I am also on GNU+Linux (1.3 GHz processor), and see no delay, so I do not know what to tell. I do not know the internals of the canvas widget, but I think that drawing lines that way results in many events appended to the idle queue and maybe this slows down the app, especially if one has a busy CPU.
PWQ For me the critical issue is , should tcl defer an idle call back forever infavour of later posted after events?. Some of the calls were 'after 0' which seems to have heighest priority, but even changing them to after idle, we still don't see tcl even displaying the toplevel, let alone processing the canvas events.
MM You can start by inserting [tkwait visibility .] before putting the lines on the canvas: that way the window will be drawn; then you can invoke [update] to force the queued events to be processed. On this Wiki there are many pages dealing with the usage of [update].
# canvas_dashed_lines.tcl --
#
# Part of: Useless Widgets Package
# Contents: test script for dashed lines and marching ants
# Date: Sun Jan 23, 2005
#
# Abstract
#
# This does not use the "-dashoffset" canvas option, so it should
# work even on MS Windows(tm) where the option appears to have
# limitations; the author has not tested this, though: anyone?.
#
# Drawing a line with a pattern is straightforward with no offset
# in the pattern: we just draw a sequence of segments and jumps
# taking the lengths from the pattern; while doing it: we cumpute
# the length of the line drawn so far and when it exceeds the
# requested length just stop, cutting a segment if required.
#
# Example of pattern: { 10 3 5 2 },
#
# 10 3 5 2
# |---------- ----- |
# ... ..
#
# |...pattern length...| 10+3+5+2=20
#
# the pattern starts with a segment, not a jump.
#
# The approach used to implement the offset in the pattern is to
# split the line in two: a "preline", that represents the fraction
# of the pattern that is requested; the "subline" that is a common
# line with no offset.
#
# The preline is shorter in length than the pattern: to draw it
# we build a new special pattern whose length equals the length of
# the preline, with all the right segments in place, then we draw
# a common line with no offset but we use the special pattern.
#
# Exmaple of special pattern: if the offset is 7 in the pattern
# { 10 3 5 2 }, the preline pattern is { 3 3 5 2 }; if the offset
# is 12, the preline pattern is { 1 5 2 }.
#
# Copyright (c) 2005 Marco Maggi
#
# The author hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose,
# provided that existing copyright notices are retained in all copies
# and that this notice is included verbatim in any distributions. No
# written agreement, license, or royalty fee is required for any of the
# authorized uses. Modifications to this software may be copyrighted by
# their authors and need not follow the licensing terms described here,
# provided that the new terms are clearly indicated on the first page of
# each file where they apply.
#
# IN NO EVENT SHALL THE AUTHOR OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHOR HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHOR AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND
# NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS,
# AND THE AUTHOR AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE
# MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#
#
#page
## ------------------------------------------------------------
## Setup.
## ------------------------------------------------------------
package require Tcl 8.4
package require Tk 8.4
#page
## ------------------------------------------------------------
## Widget options.
## ------------------------------------------------------------
option add *borderWidth 1
#page
## ------------------------------------------------------------
## Main.
## ------------------------------------------------------------
proc main {} {
global exit_trigger
wm title . "Canvas Pattern Lines and Marching Ants"
wm geometry . +200+100
canvas .c -width 500 -height 300 -background white
grid .c -sticky news
uwp_canvas_pattern_line .c {10 10 290 50} {10 5} { LineOne }
uwp_canvas_pattern_line .c {10 20 290 60} {10 2 2 2} { LineTwo }
uwp_canvas_pattern_line .c {10 30 290 70} {20 3 15 3 10 3 5 3} { LineThree }
put_star
uwp_canvas_pattern_poly .c {100 100 150 100 150 150 100 150} {10 5} { PolyTen }
after 0 marching_ants_in_line_forward
after 0 marching_ants_in_line_backward
after 0 marching_ants_in_poly_forward
after 0 marching_ants_in_poly_backward
foreach {x y} [polygon_star_coords 50.0 70.0 8] {
lappend coords [expr {$x+400.0}] [expr {$y+150.0}]
}
foreach {x y} [polygon_star_coords 30.0 40.0 5] {
lappend coords [expr {$x+400.0}] [expr {$y+150.0}]
}
after 0 [list marching_ants_in_poly_star $coords]
.c itemconfigure LineOne -fill red
.c itemconfigure LineTwo -fill blue
.c itemconfigure LineThree -fill green
.c itemconfigure PolyTen -fill black
grid [button .quit -text Exit -command main_exit]
focus .quit
bind .quit <Return> main_exit
bind . <Escape> main_exit
interp alias {} main_exit {} set exit_trigger 1
vwait exit_trigger
exit
}
#page
proc put_star {} {
for {set i 0} {$i < 16.0} {incr i} {
set yaw [expr {double($i)*6.28318530718/16.0}]
set coords [list 150.0 230.0 \
[expr {150.0+70.0*cos(double($yaw))}] \
[expr {230.0+70.0*sin(double($yaw))}]]
uwp_canvas_pattern_line .c $coords {10 3 7 3 4 3} { Circle }
}
}
proc marching_ants_in_line_forward { {offset 0.0} } {
after 50 [list marching_ants_in_line_forward [expr {$offset+2.0}]]
.c delete LineFour
uwp_canvas_pattern_line .c {10 100 290 140} \
{50 5 40 5 30 5 20 5 10 5} { LineFour } $offset
.c itemconfigure LineFour -fill magenta
.c itemconfigure UWPPatternLinePreline -fill green
}
proc marching_ants_in_line_backward { {offset 0.0} } {
after 50 [list marching_ants_in_line_backward [expr {$offset-2.0}]]
.c delete LineFive
uwp_canvas_pattern_line .c {10 110 290 150} \
{50 5 40 5 30 5 20 5 10 5} { LineFive } $offset
.c itemconfigure LineFive -fill magenta
.c itemconfigure UWPPatternLinePreline -fill green
}
proc marching_ants_in_poly_forward { {offset 0.0} } {
after 50 [list marching_ants_in_poly_forward [expr {$offset+2.0}]]
.c delete PolyOne
uwp_canvas_pattern_poly .c {310 20 480 20 480 280 310 280} \
{20 3} { PolyOne } $offset
.c itemconfigure PolyOne -fill black
# .c itemconfigure UWPPatternLinePreline -fill green
}
proc marching_ants_in_poly_backward { {offset 0.0} } {
after 50 [list marching_ants_in_poly_backward [expr {$offset-2.0}]]
.c delete PolyTwo
uwp_canvas_pattern_poly .c {320 30 470 30 470 270 320 270} \
{20 3} { PolyTwo } $offset
.c itemconfigure PolyTwo -fill black
}
#page
proc marching_ants_in_poly_star { coords {offset 0.0} } {
after 50 [list marching_ants_in_poly_star $coords [expr {$offset+2.0}]]
.c delete PolyStar
uwp_canvas_pattern_poly .c $coords {20 3} { PolyStar } $offset
.c itemconfigure PolyStar -fill black
}
proc polygon_regular_coords { num radius {fraction 1.0} } {
for {set i 0} {$i < $num} {incr i} {
set angle [expr {6.28318530718/double($fraction)+
(6.28318530718*double($i)/double($num))}]
lappend coords \
[expr {double($radius)*cos($angle)}] [expr {double($radius)*sin($angle)}]
}
return $coords
}
proc polygon_star_coords { in_radius out_radius num } {
set fraction [expr {double($num)*2.0}]
foreach {x1 y1} [polygon_regular_coords $num $in_radius] \
{x2 y2} [polygon_regular_coords $num $out_radius $fraction] {
lappend result $x1 $y1 $x2 $y2
}
return $result
}
#page
proc uwp_canvas_pattern_line {
widget line_coords pattern tags {pattern_offset 0.0} {invert 0}
} {
# If you need a full line do not call this procedure, please.
if { ! [llength $pattern] } {return}
# We try to force the conversion to double so that in the code below
# we can omit the "double" operator: this increases the readability
# of the code. For some reason I cannot figure out, but that TCL
# figures perfectly, I cannot use [expr {double($num)}] to convert
# to double; using [format %f $num] appears to solve the problems I
# had with [expr].
set pattern_offset [format %f $pattern_offset]
for {set i 0} {$i < [llength $pattern]} {incr i} {
lset pattern $i [format %f [lindex $pattern $i]]
if { [lindex $pattern $i] < 0.0 } {
return -code error "negative pattern lengths are not allowed"
}
}
for {set i 0} {$i < [llength $line_coords]} {incr i} {
lset line_coords $i [format %f [lindex $line_coords $i]]
}
# We compute the lengths of the projections of the segments on the X
# and Y axis because they are used again and again in the loop at
# the end. While we are looping: we compute the total pattern
# length, even if it is used only when the offset not null.
set yaw [uwp_yaw_angle_from_line_coords $line_coords]
set cos [expr {cos($yaw)}]
set sin [expr {sin($yaw)}]
set pattern_length 0.0
foreach segment_length $pattern {
lappend delta_segment \
[expr {$segment_length*cos($yaw)}] [expr {$segment_length*sin($yaw)}]
set pattern_length [expr {$pattern_length+$segment_length}]
}
#page
# We draw the preline only if there is an offset, else we go
# directly to the normal line drawing code.
if { $pattern_offset != 0.0 } {
# Normalise the offset so that it is not greater than the total
# pattern length. The preline is meant to be only a fraction of
# the pattern length: "whole" patterns are drawn by the normal
# line code below.
while { $pattern_offset > $pattern_length } {
set pattern_offset [expr {$pattern_offset-$pattern_length}]
}
while { $pattern_offset < -($pattern_length) } {
set pattern_offset [expr {$pattern_offset+$pattern_length}]
}
# Convert a negative offset to the equivalent positive offset.
# It is easy to do this when the offset has already been
# normalised; not so immediate before the normalisation.
if {$pattern_offset < 0.0} {
set pattern_offset [expr {$pattern_length+$pattern_offset}]
}
# virtual
# pattern whole line begin = preline end =
# begin preline begin subline begin
# v v v
# |-------------|-----------------------|---------------|------------
# (x,y)
#
# |.............|pattern_offset (after normalisation, that is >0)
#
# |.. [lindex $pattern $i] .......|
#
# |.....current_pattern_length..........|
#
# |.first_segment_length..|
#
# |....................pattern_length...................|
#
# Find the index of the segment that is cut by the offset.
set current_pattern_length 0.0
for {set i 0} {$i < [llength $pattern]} {incr i} {
set current_pattern_length \
[expr {$current_pattern_length+[lindex $pattern $i]}]
# Moving this condition inside the [if] clause is not so
# immediate: by doing the test here we have incremented the
# "current_pattern_length", but not incremented the "i"
# counter yet. This makes easy to code the two statements
# just outside of the loop.
if {$current_pattern_length > $pattern_offset} {break}
}
# Build the special pattern for the preline: the first segment
# is the ending portion of the one cut by the offset; the other
# segments are the ones that are part of the line.
set prepattern \
[concat [expr {$current_pattern_length-$pattern_offset}] \
[lrange $pattern [incr i] end]]
# If the index of the first segment is even: it must be drawn,
# it is not a jump; if the index is odd: it is a jump. The code
# that draws the subline/common line assumes that the first
# segment is not a jump, if the "invert" parameter is false.
set preline_invert [expr { ($i % 2)? 0 : 1 }]
# Compute the coordinates of the end of the preline: this point
# is one with the beginning of the normal line. The internal
# subtraction is computed twice: I think that this is faster
# than invoking [expr] and setting a variable.
set x [expr {[lindex $line_coords 0]+($pattern_length-$pattern_offset)*$cos}]
set y [expr {[lindex $line_coords 1]+($pattern_length-$pattern_offset)*$sin}]
# Draw the preline: the starting point is the one requested by
# the caller as starting point of the whole line; the ending
# point has been computed in the code above.
#
# The tag "UWPPatternLinePreline" is here only for debugging
# purposes: to configure the preline with a color different from
# the rest of the line makes it visible.
uwp_canvas_pattern_line $widget \
[lreplace $line_coords 2 3 $x $y] $prepattern \
[concat $tags UWPPatternLinePreline] 0.0 $preline_invert
# Replace the original starting point of the whole line so that
# the code below will draw the subline.
lset line_coords 0 $x
lset line_coords 1 $y
}
#page
# These are used to compute the fraction of the pattern that is cut
# at the end of the line: it is required to draw a polygon (and
# especially the marching ants).
#
# "restX" and "restY" represent the projection on the X and Y axis
# of the portion of the segment that is cut out at the end of the
# line.
set restX 0.0
set restY 0.0
# Select the procedure to use to test line end and to compute the
# rest and the last fraction of segment to draw. By splitting all
# the possible cases into simple procedures simplifies the code and
# may also make it more efficient; the end of line test is performed
# again and again in the loop below.
set x_forward [expr { [lindex $line_coords 0] <= [lindex $line_coords 2] }]
set y_forward [expr { [lindex $line_coords 1] <= [lindex $line_coords 3] }]
if { $x_forward && $y_forward } {
set line_end_cmd uwp_p_canvas_pattern_line_ff
set rest_x_cmd uwp_p_canvas_pattern_line_rest_x_forward
set rest_y_cmd uwp_p_canvas_pattern_line_rest_y_forward
} elseif { $x_forward } {
set line_end_cmd uwp_p_canvas_pattern_line_fb
set rest_x_cmd uwp_p_canvas_pattern_line_rest_x_forward
set rest_y_cmd uwp_p_canvas_pattern_line_rest_y_backward
} elseif { $y_forward } {
set line_end_cmd uwp_p_canvas_pattern_line_bf
set rest_x_cmd uwp_p_canvas_pattern_line_rest_x_backward
set rest_y_cmd uwp_p_canvas_pattern_line_rest_y_forward
} else {
set line_end_cmd uwp_p_canvas_pattern_line_bb
set rest_x_cmd uwp_p_canvas_pattern_line_rest_x_backward
set rest_y_cmd uwp_p_canvas_pattern_line_rest_y_backward
}
#page
# Example for the pattern: { 10 3 5 3 5 3 }
#
# |......pattern_length......|......pattern_length.........|
#
# starting point end point
# v v
# O-------- ----- ----- ---------- --O-- ----- |
# 10 3 5 3 5 3 , 10 3 ^ ^
# | |
# this segment this segment
# is cut in two is completely
# by the end of left out
# the line
#
# |.............|
# this is the "rest": the portion of
# pattern that's cut out of the line
# Build the list that will hold the coordinates of the segment to
# draw or the jump to skip.
set segment_coords \
[list [expr {[lindex $line_coords 0]}] [expr {[lindex $line_coords 1]}] {} {}]
while { 1 } {
# "blank" is a boolean that controls whether the segment is a
# line or a jump: if it is false we draw a line, else we
# skip. The default is to start with a line.
set blank $invert
# We need this counter only to keep track of which segment we
# are drawing in the "pattern" list. We use it only at the end
# of the line to know which segments are cut out at the end.
set i 0
foreach {deltaX deltaY} $delta_segment {
lset segment_coords 2 [expr {[lindex $segment_coords 0]+$deltaX}]
lset segment_coords 3 [expr {[lindex $segment_coords 1]+$deltaY}]
if { ! [$line_end_cmd] } {
$rest_x_cmd
$rest_y_cmd
} else {
# Init the rest with the length of the fraction of
# segment that is cut out. "restX" and "restY" may be
# zero. Thank You, Pitagora.
set rest_offset [expr {sqrt(pow($restX,2.0)+pow($restY,2.0))}]
# Add the length of all the segments that are completely
# left out.
for {} {$i < [llength $pattern]} {incr i} {
set rest_offset [expr {$rest_offset+[lindex $pattern $i]}]
}
# Return the rest so that the caller can use it.
return $rest_offset
}
incr i
if { ! $blank } { $widget create line $segment_coords -tags $tags }
# Invert the skip flag.
set blank [expr {!$blank}]
# Now: the end point of this segment-or-jump becomes the
# starting point of the next segment-or-jump.
lset segment_coords 0 [lindex $segment_coords 2]
lset segment_coords 1 [lindex $segment_coords 3]
}
}
}
#page
proc uwp_p_canvas_pattern_line_ff {} {
upvar line_coords line_coords segment_coords segment_coords
expr { ([lindex $segment_coords 0] >= [lindex $line_coords 2]) &&
([lindex $segment_coords 1] >= [lindex $line_coords 3]) }
}
proc uwp_p_canvas_pattern_line_bb {} {
upvar line_coords line_coords segment_coords segment_coords
expr { ([lindex $segment_coords 0] <= [lindex $line_coords 2]) &&
([lindex $segment_coords 1] <= [lindex $line_coords 3]) }
}
proc uwp_p_canvas_pattern_line_fb {} {
upvar line_coords line_coords segment_coords segment_coords
expr { ([lindex $segment_coords 0] >= [lindex $line_coords 2]) &&
([lindex $segment_coords 1] <= [lindex $line_coords 3]) }
}
proc uwp_p_canvas_pattern_line_bf {} {
upvar line_coords line_coords segment_coords segment_coords
expr { ([lindex $segment_coords 0] <= [lindex $line_coords 2]) &&
([lindex $segment_coords 1] >= [lindex $line_coords 3]) }
}
#page
proc uwp_p_canvas_pattern_line_rest_x_forward {} {
upvar line_coords line_coords segment_coords segment_coords restX restX
if { [lindex $segment_coords 2] > [lindex $line_coords 2] } {
set restX [expr {[lindex $segment_coords 2]-[lindex $line_coords 2]}]
lset segment_coords 2 [lindex $line_coords 2]
}
}
proc uwp_p_canvas_pattern_line_rest_x_backward {} {
upvar line_coords line_coords segment_coords segment_coords restX restX
if { [lindex $segment_coords 2] < [lindex $line_coords 2] } {
set restX [expr {[lindex $line_coords 2]-[lindex $segment_coords 2]}]
lset segment_coords 2 [lindex $line_coords 2]
}
}
proc uwp_p_canvas_pattern_line_rest_y_forward {} {
upvar line_coords line_coords segment_coords segment_coords restY restY
if { [lindex $segment_coords 3] > [lindex $line_coords 3] } {
set restY [expr {[lindex $segment_coords 3]-[lindex $line_coords 3]}]
lset segment_coords 3 [lindex $line_coords 3]
}
}
proc uwp_p_canvas_pattern_line_rest_y_backward {} {
upvar line_coords line_coords segment_coords segment_coords restY restY
if { [lindex $segment_coords 3] < [lindex $line_coords 3] } {
set restY [expr {[lindex $line_coords 3]-[lindex $segment_coords 3]}]
lset segment_coords 3 [lindex $line_coords 3]
}
}
#page
proc uwp_yaw_angle_from_line_coords { coords } {
expr {atan2(double([lindex $coords 3])-double([lindex $coords 1]),
double([lindex $coords 2])-double([lindex $coords 0]))}
}
#page
proc uwp_canvas_pattern_poly { widget coords pattern tags {offset 0.0} } {
set line_coords [list [lindex $coords 0] [lindex $coords 1] {} {}]
for {set i 2} {$i < [llength $coords]} {incr i} {
lset line_coords 2 [lindex $coords $i]
lset line_coords 3 [lindex $coords [incr i]]
set offset [expr {-([uwp_canvas_pattern_line \
$widget $line_coords $pattern $tags $offset])}]
lset line_coords 0 [lindex $line_coords 2]
lset line_coords 1 [lindex $line_coords 3]
}
lset line_coords 2 [lindex $coords 0]
lset line_coords 3 [lindex $coords 1]
uwp_canvas_pattern_line $widget $line_coords $pattern $tags $offset
}
#page
## ------------------------------------------------------------
## Let's go.
## ------------------------------------------------------------
main
### end of file
# Local Variables:
# mode: tcl
# End:See also Canvas selection with marching ants.