Version 3 of Recursive curves

Updated 2004-01-19 15:07:55

if 0 {Richard Suchenwirth 2004-01-18 - The C curve is a quite beautiful image created by a simple recursive function, originally described by William Gosper. I met it in the Winston/Horn book on LISP and of course wanted to have it in Tcl/Tk too, and on my PocketPC. Translation wasn't difficult - somehow Tcl is "the LISP of the 21st century".

http://mini.net/files/ccurve.gif http://mini.net/files/dragon.gif

As the code is a bit slow on PocketPC (171 sec for the C curve, 615 sec for the dragon curve!), I chose to update the canvas after every line segment is drawn, for animation. Also, the related but very different dragon curve was added - I think fractals developed from these studies. So here is yet another weekend fun project, which again demonstrates interesting things in few lines of code:

KPV See also Dragon Curve.

}

 proc main {} {
    pack [canvas .c -width 240 -height 280]
    set ::x0 150; set ::y0 190
    set ::pi_4 [expr atan(1)]
 # ETFS configurability: uncomment what you want
    set t [time {ccurve .c 120 0 2}]
    #set t [time {dragon .c 160 0 1 2.4}]
    wm title . "[expr {[lindex $t 0]/1000000.}] sec"
    bind . <Return> {exec wish $argv0 &; exit}
 }

# C curve drawer, translated from Lisp

 proc ccurve {w len angle minlen} {
    if {$len<$minlen} {
       plotline $w $len $angle
    } else {
       set len [expr {$len/sqrt(2)}]
       ccurve $w $len [expr {$angle+$::pi_4}] $minlen
       ccurve $w $len [expr {$angle-$::pi_4}] $minlen
    }
 }

# Dragon curve drawer

 proc dragon {w len angle s minlen} {
    global pi_4
    if {$len<$minlen} {
       plotline $w $len $angle
    } else {
       set len [expr {$len/sqrt(2)}]
       dragon $w $len [expr {$angle+$s*$pi_4}] 1 $minlen
       dragon $w $len [expr {$angle-$s*$pi_4}] -1 $minlen
    }
 }

# Plot a line from last end point in specified direction and length

 proc plotline {w len ang} {
    global x0 y0
    update
    set x [expr {$x0-$len*sin($ang)}]
    set y [expr {$y0-$len*cos($ang)}]
    $w create line $x0 $y0 $x $y
    set x0 $x; set y0 $y
 }

# Let's go!

 main

Arts and crafts of Tcl-Tk programming