proc main {} {
set ::tcl_precision 17
wm geom . 200x200
pack [canvas .c]
.c config -scrollregion {-100 -100 100 100}
set s [.c create line [spiral 1 0] -width 3]
every 40 [list rotate .c $s 0 0 .1]
}The spiral routine produces an x y x y.. list of coordinates, that can be specified for a canvas line: proc spiral {x y {max 500}} {
set res [list $x $y]
while {[llength $res]<=$max} {
set r [expr {hypot($x,$y)+0.2}]
set a [expr {atan2($y,$x)+0.2}]
set x [expr {$r*cos($a)}]
set y [expr {$r*sin($a)}]
lappend res $x $y
}
set res
}The generic rotation takes a canvas pathname, the ID of one canvas object, coordinates of rotation center, and finally the radians to rotate the thing: proc rotate {w id x0 y0 da} {
set coords {}
foreach {x y} [$w coords $id] {
set r [expr {hypot($y-$y0,$x-$x0)}]
set a [expr {atan2($y-$y0,$x-$x0)+$da}]
set x [expr {$x0+$r*cos($a)}]
set y [expr {$y0+$r*sin($a)}]
lappend coords $x $y
}
$w coords $id $coords
}
# This repeating timer comes handy [every] now and then:
proc every {ms body} {
eval $body; after $ms [info level 0]
}
# Ready.. Set.. Go!
mainEKB This is, I think, a cleaner way to do the rotations:
proc rotate {w id x0 y0 da} {
set rot1 [expr cos($da)]
set rot2 [expr -sin($da)]
set coords {}
foreach {x y} [$w coords $id] {
set deltax [expr $x - $x0]
set deltay [expr $y - $y0]
set x [expr $x0 + $deltax * $rot1 + $deltay * $rot2]
set y [expr $x0 - $deltax * $rot2 + $deltay * $rot1]
lappend coords $x $y
}
$w coords $id $coords
}It uses a rotation matrix to rotate each point. I didn't time it, but suspect that it will be faster, since the cos/sin are only calculated once for all points.Also, here is an alternative to generating the spiral itself: proc spiral {x0 y0 {max 500}} {
set res [list $x0 $y0]
set a 0
while {[llength $res]<=$max} {
set x [expr {$a *cos($a)} + $x0]
set y [expr {$a *sin($a)} + $y0]
set a [expr $a + 0.2]
lappend res $x $y
}
set res
}It sets the radius of the spiral equal to the angle (a), and then shifts the center of the spiral to x0, y0. I suspect it's faster, but again I didn't time it...And, finally, to avoid any cos & sin calculations in the body of the loop for the spiral, either, the rotation matrix can be used there, too: proc spiral {x0 y0 {max 500}} {
set res [list $x0 $y0]
set a 0
set cosa 1
set sina 0
set rot1 [expr cos(0.2)]
set rot2 [expr -sin(0.2)]
while {[llength $res]<=$max} {
set x [expr $a * $cosa + $x0]
set y [expr $a * $sina + $y0]
set a [expr $a + 0.2]
set oldcosa $cosa
set cosa [expr $cosa * $rot1 + $sina * $rot2]
set sina [expr -$oldcosa * $rot2 + $sina * $rot1]
lappend res $x $y
}
set res
}In this version, the new cos(a) and sin(a) are generated from the old values by applying a rotation.EKB In an e-mail, RS pointed out to me, "It looks as if your code is indeed more efficient - provided that sin() and cos() are really costly, and not just table lookups (not sure about that). Your code is a bit longer, and uses more variables, which prompts me to still stick to my "simpler" version, which implements exactly the rotation transform from the book.Also, not bracing the arguments to expr may cost more runtime than you save by juggling cos, cosa, sin, sina..."Sure enough, profiling the routines showed that mine ran much more slowly. I was led astray by my experience from C and Fortran, that an algebraic solution is in general preferable to call to a function, if you can find one. (On reflection I can see why it is different with Tcl, but it didn't occur to me at the time.)Bracing arguments to expr makes an enormous amount of difference. In fact, after bracing the arguments to expr, my version runs slightly faster than RS's original. Here's the braced version:
proc main {} {
set ::tcl_precision 17
wm geom . 200x200
pack [canvas .c]
.c config -scrollregion {-100 -100 100 100}
set s [.c create line [spiral 1 0] -width 3]
every 40 [list rotate .c $s 0 0 .1]
}
proc spiral {x0 y0 {max 500}} {
set res [list $x0 $y0]
set a 0
set cosa 1
set sina 0
set rot1 [expr cos(0.2)]
set rot2 [expr -sin(0.2)]
while {[llength $res]<=$max} {
set x [expr {$a * $cosa + $x0}]
set y [expr {$a * $sina + $y0}]
set a [expr {$a + 0.2}]
set oldcosa $cosa
set cosa [expr {$cosa * $rot1 + $sina * $rot2}]
set sina [expr {-$oldcosa * $rot2 + $sina * $rot1}]
lappend res $x $y
}
set res
}
proc rotate {w id x0 y0 da} {
set rot1 [expr cos($da)]
set rot2 [expr -sin($da)]
set coords {}
foreach {x y} [$w coords $id] {
set deltax [expr {$x - $x0}]
set deltay [expr {$y - $y0}]
set x [expr {$x0 + $deltax * $rot1 + $deltay * $rot2}]
set y [expr {$x0 - $deltax * $rot2 + $deltay * $rot1}]
lappend coords $x $y
}
$w coords $id $coords
}
proc every {ms body} {
eval $body; after $ms [info level 0]
}
main 