Fractale de mandelbrot
Contenu du snippet
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 512; set height $width
set itermax 32
set lclr [list red orange yellow green lightgreen darkblue blue lightblue white black]
set N [llength $lclr]
set tag 1
set tag1 1
set stop 1
canvas .c -width $width -height $height
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 .bfin .bstop .bquit -side left -expand yes -fill x
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 tag0 $tag1
set stop 0
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
}
if {$tag <= $tag0} {.c delete $tag}
incr tag
set tag1 [.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
}
Compatibilité : Tcl
Disponible dans d'autres langages :
A voir également
- Fractale de mandelbrot
- Fractale flocon - Forum Visual Basic
- Compression fractale - Forum Java
- Fractale - Forum ASP / ASP3
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.