Ensemble de Mandelbrot

 

GS (090807) L'ensemble de Mandelbrot est certainement l'une des courbes Fractales les plus connues. Voici un petit programme qui se contente de la dessiner dans un canvas. Le plus-produit étant simplement une variété de gradients bicolores.

 package require Tk
 bind all <Escape> {exit}

 set xmin -2.2; set xmax 0.8; set ymin -1.1; set ymax 1.1
 set width 400; set height $width
 set itermax 32
 set lclr [list red orange yellow green lightgreen darkblue blue lightblue white black]
 set N [llength $lclr]
 set stop 1
 set l {defaut bleu_noir bleu_vert bleu_rouge bleu_jaune bleu_orange bleu_blanc \
        vert_noir vert_rouge vert_jaune vert_orange vert_blanc \
        rouge_noir rouge_vert rouge_jaune rouge_orange rouge_blanc}

 canvas .c -width $width -height $height
 spinbox .sb -values $l -command "ColorTable %s"
 button .bfin -text Démarrer -width 8 -command {Mandelbrot [expr {$width/2}]}
 button .bstop -text Stopper -width 8 -command {set stop 1}
 button .bquit -text Quitter -width 8 -bg darkgrey -command exit
 pack .c
 pack .sb .bfin .bstop .bquit -side left -expand yes -fill x

 # Références KPV - http://wiki.tcl.tk/16283
 proc Gradient {n clr1 clr2} {
  foreach {r1 g1 b1} [winfo rgb . $clr1] {r2 g2 b2} [winfo rgb . $clr2] break
  set n [expr {$n <= 1 ? 1 : double($n - 1)}]
  set gradient {}
  for {set i 0} {$i <= $n} {incr i} {
     set r [expr {int(($r2 - $r1) * $i / $n + $r1) * 255 / 65535}]
     set g [expr {int(($g2 - $g1) * $i / $n + $g1) * 255 / 65535}]
     set b [expr {int(($b2 - $b1) * $i / $n + $b1) * 255 / 65535}]
     lappend gradient [format "#%.2x%.2x%.2x" $r $g $b]
  }
  return $gradient
 }

 proc ColorTable {c} {
     global lclr N
  if {$c == "defaut"} then {
    set lclr [list red orange yellow green lightgreen darkblue blue lightblue white black]
  } else {
    set tclr {bleu blue rouge red vert green jaune yellow orange orange noir black blanc white}
    foreach {c1 c2} [split $c "_"] {set c1 [string map $tclr $c1]; set c2 [string map $tclr $c2]}
    set lclr [Gradient $N $c1 $c2]
  }
 }

 proc Mandelbrot {a} {
  global stop lclr color N
  global ymin xmin ymax xmax width height
  global tag tag1 itermax

   set dx [expr {($xmax-$xmin)/$a}]
   set dy [expr {($ymax-$ymin)/$a}]
   set bwidth  [expr {$width/$a}]
   set bheight [expr {$height/$a}]
   set stop 0
   .c delete all
   for {set j 0} {$j < $a} {incr j} {
     if $stop break
     set y [expr {$ymin+$dy*$j}]
     for {set i 0} {$i < $a} {incr i} {
       set x [expr {$xmin+$dx*$i}]
       set iter 0; set color 0
       set zr 0; set zi 0
       while {$zr*$zr+$zi*$zi < 4} {
         if {[incr iter] > $itermax} {
           set color [expr {$N-1}]
           break
         }
         incr color
         set old [expr {$zr*$zr-$zi*$zi+$x}]
         set zi  [expr {2*$zr*$zi+$y}]
         set zr  $old
       }
       .c create rect [expr {$i*$bwidth}] [expr {$j*$bwidth}] \
          [expr {($i+1)*$bwidth}] [expr {($j+1)*$bheight}] \
          -fill [lindex $lclr [expr {$color % $N}]] -outline ""
       update
     }
   }
   set stop 1
 }

Pour des explications, voir la page Fractales de David Cobac.


Catégorie Mathématiques