A simple Mandelbrot tclet

Source:

#!/usr/bin/wish
# this is a simple attempt to draw a Mandelbrot fractal in tcl/tk

set xmin -2.2
set xmax 0.8
set ymin -1.1
set ymax 1.1
set blocks 64
set width 400.0
set height $width
set maxiter 50
canvas .c -width $width -height $height

# pick colors
set colors [list red magenta blue cyan green yellow white]
# alternative for a greyscale image:
# for {set ncolors 1} {$ncolors<50} {incr ncolors} {
#     lappend colors grey[expr $ncolors*2]
# }

# make a black center
lappend colors black
set ncolors [llength $colors]

button .quit -text quit -command exit -activeforeground red

button .finer -text "finer" -activeforeground red -command {
  set blocks [expr $blocks*2]
  drawit
}

button .coarser -text "coarser" -activeforeground red -command {
  set blocks [expr $blocks/2.0]
  drawit
}

button .brk -text break -activeforeground red -command {
    set breakflag 1
}

pack .c 
pack .quit .coarser .finer .brk -side left -expand yes -fill x
set breakflag 1

# to keep track of deletable objects
set lastp 1
set p 1 

proc drawit {} {
  global breakflag colors currentcolor ncolors
  global blocks ymin xmin ymax xmax width height
  global p lastp maxiter
  set dx [expr ($xmax-$xmin)/$blocks]
  set dy [expr ($ymax-$ymin)/$blocks]
  set bwidth [expr $width/$blocks]
  set bheight [expr $height/$blocks]
  set firstp $lastp
  set breakflag 0

  for {set j 0} {$j<$blocks} {incr j} {
    update
    if $breakflag break
    set y [expr $ymin+$dy*$j]
    for {set i 0} {$i<$blocks} {incr i} {
      set x [expr $xmin+$dx*$i]
      set iteration 0
      set currentcolor 0
      set zr 0
      set zi 0
      while {$zr*$zr+$zi*$zi<4} {
        if {[incr iteration]>$maxiter} {
          set currentcolor [expr $ncolors-1]
          break
        }
        incr currentcolor
        set temp [expr $zr*$zr-$zi*$zi+$x]
        set zi [expr 2*$zr*$zi+$y]
        set zr $temp
      }
# a feeble attempt to remove unused stuff
      if {$p <= $firstp} {.c delete $p}
      set p [expr $p + 1]

# draw the new rectangle 
      set lastp [.c create rect [expr $i*$bwidth] [expr $j*$bwidth]\
                     [expr ($i+1)*$bwidth] [expr ($j+1)*$bheight]\
         -fill [lindex $colors [expr $currentcolor % $ncolors]] -outline "" ]
    }
  }
  set breakflag 1
}

drawit