Origin: http://wiki.tcl.tk/3349 Author: Keith Vetter
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
Tcl, 135 lines
Download
Copy to clipboard1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 | ####################################################################
#
# 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
|
