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.