sreemannarayan... This is the square fractal generation program
proc programit { level } {
global tagcount
set tagcount 1
set noofiter [expr {pow(8,[expr $level - 1])}]
set noofiter [expr {int($noofiter)}]
set count 1
while { $count <= $noofiter } {
divideem $level $count
incr count
}
incr level
if { $level < 6 } {
after 1000 programit $level
} else {
tk_messageBox -title "EXIT MESSAGE" -message "PROGRAM COMPLETED";
after 5000 exit
}
}
proc divideem { level count } {
global tagcount
foreach { x0 y0 x1 y1 } [.c coords sq$level$count] {}
set maxsize [expr $x1 - $x0]
set x $x0
set count 1
while { $x < [expr $x1 - 1] } {
set y $y0
while { $y < [expr $y1 - 1] } {
if { $count == 5 } {set colo white; set tg dummy} else {set colo black; set tg sq[expr $level + 1]$tagcount; incr tagcount;}
.c create rect $x $y [expr $x + $maxsize / 3.0] [expr $y + $maxsize / 3.0] \
-fill $colo -outline $colo -tag $tg
set y [expr $y + $maxsize / 3.0]
incr count
}
set x [expr $x + $maxsize / 3.0]
}
}
canvas .c -width 990 -height 990 -bg black
.c create rect 0 0 990.0 990.0 -fill white -tag sq11
programit 1
pack .cKeith Vetter 2003-12-01 : This image of a Black Spleenwort fern is often called the Barnsley's Fern after Michael Barnsley. It is one of the best known of the Iterated Function System (IFS) fractals. Actually, while everyone calls it a fractal technically it's not--it's not self-similar but self-affine.
An IFS takes a point and performs an affine transformation--translation, rotation and contraction--on it, then repeats. For the fern, there are four affine transformation that are used with certain probabilities.
See also IFS for a page with more general IFS fractals.
DKF: Oooh! I like it!
##+##########################################################################
#
# Fern.tcl - description
# by Keith Vetter -- November 30, 2003
#
# This image of a Black Spleenwort fern is often called the Barnsley's
# Fern after Michael Barnsley. It is one of the best known of the
# Iterated Function System (IFS) fractals (technically it's not a
# fractal but everyone calls it one). An IFS takes a point and
# performs an affine transformation--translation, rotation and
# contraction--on it, then repeats. For the fern, there are four
# affine transformation that are used with certain probabilities.
# Define our affine transformations
# (x,y) <== (rx(cos(A)) - sy(sin(B)) + h, rx(sin(A)) + sy(cos(B)) + k)
# (x,y) <== (ax + by + h, cx + dy + k)
array set TRANS {
- {P a b h c d k}
0 {0.02 0.0 0.0 0.5 0.0 0.27 0}
1 {0.15 -.139 0.263 0.57 0.246 0.224 -.036}
2 {0.13 0.17 -.215 0.408 0.222 0.176 0.0893}
3 {0.70 0.781 0.034 0.1075 -.032 0.739 0.27}
}
array set S {title "Fern Fractal" W 500 H 500 color green}
proc OnePixel {} {
global S xx yy TRANS
# Pick which transformation to use
set rand [expr {rand()}]
for {set i 0} {$i < 3} {incr i} {
set p [lindex $TRANS($i) 0]
if {$rand < $p} break
set rand [expr {$rand - $p}]
}
# (x,y) <== (ax + by + h, cx + dy + k)
foreach {p a b h c d k} $TRANS($i) break
foreach xx [expr {$a*$xx + $b*$yy + $h}] \
yy [expr {$c*$xx + $d*$yy + $k}] break
set sx [expr {$S(W) * $xx}] ;# Map to screen coordinates
set sy [expr {$S(H) - ($S(H) * $yy)}] ;# Make fern grow upwards
.c create rect $sx $sy $sx $sy -fill $S(color) -outline {}
return
}
proc Run {} {
foreach id [after info] {after cancel $id} ;# Be safe
if {$::S(go)} {
OnePixel
after 1 Run
}
}
proc tracer {var1 var2 op} {
if {$::S(go)} {
.start config -state disabled
.stop config -state normal
Run
} else {
.start config -state normal
.stop config -state disabled
}
}
proc Resize {W h w} {
foreach ::S(H) $h ::S(W) $w break
Reset
}
proc Reset {} {
.c delete all
set ::xx [expr {rand()}]
set ::yy [expr {rand()}]
}
proc DoDisplay {} {
global S
wm title . $S(title)
pack [frame .ctrl -relief ridge -bd 2 -padx 5 -pady 5] \
-side right -fill both -ipady 5
pack [frame .top -relief ridge -bd 2] -side top -fill x
pack [frame .screen -bd 2 -relief raised] -side top -fill both -expand 1
canvas .c -relief raised -bd 2 -height $S(H) -width $S(W) -bg black
pack .c -side top -in .screen -fill both -expand 1
set colors {red orange yellow green blue cyan purple violet white black}
foreach color $colors {
radiobutton .top.b$color -width 1 -padx 0 -pady 0 -bg $color \
-variable S(color) -value $color
bind .top.b$color <3> [list .c config -bg $color]
}
eval pack [winfo children .top] -side left -fill y
DoCtrlFrame
bind all <Key-F2> {console show}
bind .c <Configure> {Resize %W %h %w}
trace variable S(go) w tracer
update
}
proc DoCtrlFrame {} {
option add *Button.borderWidth 4
button .start -text "Start" -command {set S(go) 1}
.start configure -font "[font actual [.start cget -font]] -weight bold"
option add *Button.font [.start cget -font]
button .stop -text "Stop" -command {set S(go) 0}
button .reset -text "Reset" -command Reset
button .about -text About -command [list tk_messageBox -title $::S(title) \
-message "$::S(title)\nby Keith Vetter, November 2003"]
grid .start -in .ctrl -row 1 -sticky ew
grid .stop -in .ctrl -row 2 -sticky ew
grid .reset -in .ctrl -row 3 -sticky ew -pady 10
grid rowconfigure .ctrl 50 -weight 1
grid .about -in .ctrl -row 100 -sticky ew
}
DoDisplay
set S(go) 1