(* to run : $ ocaml graphics.cma fractale.ml  *)
open Graphics;;
let dX = 400;;
let dY = 400;;
let echelle=100.;;
let maxI=125;; (*le nombre maximal d'iterations*)
(*fait "comme" une boucle for, mais en recursif et en tail-rec*)
let rec each from toend fonction =
    if from = toend then ()
    else (fonction from; each (from+1) toend fonction);;
open Complex;;
let c= {re=0.-.0.727; im=0.1888};; (*parametre*)
(*calcule le nombre d'iterations*)
let rec complexe2int n z =
    if (norm z) < 4. & n < maxI
        then complexe2int (n+1) (add (mul z z) c)
        else n
(*renvoie la couleur a partir du nombre complexe*)
let fonction_complexe_to_color z =
    let n = (complexe2int 0 z) in
    rgb (255*(maxI+1)/(n+1)) (255*(n+1)/(maxI+1)) 0;;
(*paint le point (x, y)*)
let paintPoint x y=
    let z= {re=(float_of_int (x-dX/2)) /. echelle; im=(float_of_int (y-dY/2)) /. echelle}
    in set_color ( fonction_complexe_to_color(z) ); plot x y;;
(*main-like*)
let () =
    let height, width = dX, dY in
        open_graph (Printf.sprintf " %ix%i" height width) ;
        each 0 dX (fun x -> each 0 dY (fun y -> paintPoint x y));
let rec main_loop () = main_loop () in main_loop ();;

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
}