Version 6 of spiral

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):

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.

Arts and crafts of Tcl-Tk programming

Category Application Category Animation