Version 14 of Dragon Curve

Updated 2004-06-07 19:46:49

KPV -- Here's a quick and dirty rendering of the Dragon Curve or Paper Folding fractal. What happens if you repeatedly fold a piece of paper in half numerous times then unfold it once 90 degrees, then again 90 degrees and so on. You get a fractal curve which has several interesting properties. For example, you can combine 4 of these curves and not only will they not overlap but they fill the plane. For more details see http://www.math.okstate.edu/mathdept/dynamics/lecnotes/node17.html

The Penney numerals are closely related.

What does it mean to "unfold it once 90 degrees"? I just can't picture what you mean at all. -- CLN

Try DrawDragons 1, then 2, then 3, and it'll become clear... -jcw

Beware, drawing a Dragon Curve of degree 10 or above can be real slow (the canvas has to render 4 * 2^^degree lines segments).

The following code is available as a starkit on sdarchive.


 ####################################################################
 #
 # dragon.tcl
 #
 # Draws a dragon curve
 # by Keith Vetter
 #
 # Revisions:
 # KPV May 09, 2002 - initial revision
 #
 # http://www.math.okstate.edu/mathdept/dynamics/lecnotes/node17.html
 ####################################################################

 set cw 500 ; set ch 500  ;# canvas size
 array set comp {R L L R}
 array set turn {E,R S E,L N S,R W S,L E W,R N W,L S N,R E N,L W}
 array set fill {E cyan S magenta W blue N yellow}

 proc DoDisplay {} {
     global cw cw2 ch ch2
     canvas .c -width $cw -height $ch -bd 2 -relief ridge
     set cw2 [expr {$cw / 2}]
     set ch2 [expr {$ch / 2}]
     .c config -scrollregion [list -$cw2 -$ch2 $cw2 $ch2]
     .c yview moveto .5
     .c xview moveto .5
     .c create oval -5 -5 5 5 -fill yellow -tag o
     .c create text -$cw2 -$ch2 -anchor nw -font bold -tag lbl
     pack .c -side top

     scale .deg -label Degree -orient horizontal -from 1 -to 12
     .deg config -relief ridge -showvalue 1
     .deg set 4
     bind .deg  <ButtonRelease-1> [list after 1 [list DrawDragons -1]]

     pack .deg -side left
 }

 # DrawDragons -- draw four dragon curve of this degree
 proc DrawDragons {n} {
     .c config -cursor watch
     if {$n == -1} {set n [.deg get]} else {.deg set $n}
     .c delete dragon
     .c itemconfig lbl -text "Dragon Curve: $n"
     DrawDragon $n E ; update
     DrawDragon $n W ; update
     DrawDragon $n S ; update
     DrawDragon $n N ; update
     .c config -cursor {}

 }
 # DrawDragon -- draw one dragon curve of this degree and orientation
 proc DrawDragon {n {dir E}} {
     global cw2 ch2 fill
     set dir [string toupper $dir]

     set tag "dragon_$dir"
     set coords [GetCoords $n $dir]
     set coords [ScaleCoords $coords]
     .c create line $coords -tag [list dragon $tag] -width 2 -fill $fill($dir)

     .c raise o
     .c raise lbl
 }
 # ScaleCoords -- scale the unit coords to fit into the window
 proc ScaleCoords {coords} {
     global cw2 ch2                              ;# Window size

     # Find max coordinate from origin
     set max_x [set max_y [set min_x [set min_y 0]]]
     foreach {x y} $coords {
         if {$x > $max_x} {set max_x $x
         } elseif {$x < $min_x} {set min_x $x}
         if {$y > $max_y} {set max_y $y
         } elseif {$y < $min_y} {set min_y $y}
     }
     set max_x [expr {-$min_x > $max_x ? -$min_x : $max_x}]
     set max_y [expr {-$min_y > $max_y ? -$min_y : $max_y}]
     set max [expr {$max_x > $max_y ? $max_x : $max_y}]

     set sc [expr {($cw2 - 50) / $max}]

     set new {}
     foreach {x y} $coords {
         set nx [expr {$x * $sc}] ; set ny [expr {$y * $sc}]
         lappend new $nx $ny
     }
     return $new
 }
 # GetCoords -- get the unit coordinates for this degree curve
 proc GetCoords {n dir} {
     global turn

     set turns $dir
     foreach leg [MakeDragon $n] {
         set dir $turn($dir,$leg)
         lappend turns $dir
     }

     set x 0 ; set y 0
     set coords [list $x $y]
     foreach leg $turns {
         if {$leg == "E"}       { incr x
         } elseif {$leg == "S"} { incr y
         } elseif {$leg == "W"} { incr x -1
         } elseif {$leg == "N"} { incr y -1 }
         lappend coords $x $y
     }

     return $coords
 }
 # MakeDragon -- gets the turn data for this degree dragon curve
 proc MakeDragon {n} {
     global dragon

     # Do we already have it?
     if {[info exists dragon($n)]} { return $dragon($n) }
     if {$n == 0} { return {}}

     # dragon(n) = dragon(n-1) + "R" + reverse(complement(dragon(n-1)))
     set last [MakeDragon [expr {$n - 1}]]
     set dragon($n) $last
     lappend dragon($n) R

     set idx [llength $last]
     while {[incr idx -1] >= 0} {
         set item [lindex $last $idx]
         lappend dragon($n) $::comp($item)
     }

     return $dragon($n)
 }

 DoDisplay
 DrawDragons 4

More on this subject appears under the title "Fractales, SWIG et performances" [L1 ]. See also Recursive curves.


Pretty cool drawing app. The only thing was when I ran the Dragon Curve with a Degree setting of 12 my computer was nonresponsive for 10 minutes. My processor was running at 100%, and did not allow me to do any other work while it was creating the curve.

KPV Well, there is a warning that at level 12 it must draw 4 * 2^^12 line segments. Fixing this is actually more difficult than it would seem at first blush. The obvious solution would be to throw in some update commands, or better yet, to reorganize the code ala Update considered harmful and Keep a GUI alive during a long calculation. However, that doesn't work because it is not the tcl code taking all the time but in the tk library (written in C) rendering the line: .c create line $coord.... So the only way to make the code more responsive would be to draw the dragon curve in smaller pieces and have some kind of GUI refresh in between segments.


Category Application | Category Graphics