Version 8 of spiral

Updated 2005-07-11 10:40:37

if 0 {Richard Suchenwirth 2004-07-04 - Another sunny Sunday, another balcony fun project. What have I never coded in Tcl before? Umm ... A spiral on a canvas? And have it rotate for yet another animation effect? Here's what I came up with (quite a CPU burner on a 200 MHz iPaq):

http://mini.net/files/spiral.jpg

A spiral is a long line, consisting of many points. The center (for simplicity at 0 0.. move the thing if you want it elsewhere) is not part of the line, but the first point is closest to it. Every other point can be computed from its predecessor, by converting it to polar coordinates, adding a little bit to both radius (so the line moves slowly out) and angle (so it runs in quasi-circles), and reconverting to Cartesian (canvas) coordinates. Simple enough.. after some less simple experiments.. In a tidy fashion, let's start with a main routine: }

 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]
 }

if 0 {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
 }

if 0 {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!

 main

EKB 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 

Arts and crafts of Tcl-Tk programming

Category Application Category Animation