(*ocamlmktop -custom -o myocaml graphics.cma -cclib -lgraphics -cclib -lX11 *) open Graphics;; open_graph "";; let dessine_piquet i nb_disques= set_color black; moveto (-180+200*i) 100; lineto (-20+200*i) 100; moveto (200*i-100) 100; lineto (200*i-100) (110+30*nb_disques); moveto (200*i-100) 85; set_text_size 12; draw_string ([|"A";"B";"C"|].(i-1));; (* val dessine_piquet : int -> int -> unit = *) let arc_en_ciel h n= [|black;red;green;blue;yellow;cyan;magenta|].(h mod 7);; (*val arc_en_ciel : int -> 'a -> Graphics.color = *) let dessine_rondelle tour hauteur largeur n= let px=(-100)+200*tour and py=110+30*(hauteur-1) and dx=(largeur*80)/n in set_color (arc_en_ciel largeur n); fill_rect (px-dx) py (2*dx) 20;; (*val dessine_rondelle : int -> int -> int -> int -> unit = *) let dessine_etat etat_piquets n= clear_graph (); set_color black; moveto 300 30; set_text_size 100; draw_string ("Hanoļ "^(string_of_int n)); for i=1 to 3 do dessine_piquet i n done; for i=1 to 3 do for k=1 to etat_piquets.(i-1).(0) do dessine_rondelle i k etat_piquets.(i-1).(k) n done done;; (*val dessine_etat : int array array -> int -> unit = *) let mouvement origine destination etat_piquets nb_disques= let t1=etat_piquets.(origine-1).(0) and t2=etat_piquets.(destination-1).(0) in etat_piquets.(destination-1).(t2+1)<-etat_piquets.(origine-1).(t1); etat_piquets.(origine-1).(0)<-t1-1; etat_piquets.(destination-1).(0)<-t2+1; dessine_etat etat_piquets nb_disques; for i=1 to 3000000/nb_disques do () done;; (* val mouvement : int -> int -> int array array -> int -> unit = *) let init_etats nb_disques= let etats=Array.make_matrix 3 (nb_disques+1) 0 in etats.(0).(0)<- nb_disques; for i=1 to nb_disques do etats.(0).(i)<-(nb_disques+1-i) done; dessine_etat etats nb_disques; for i=1 to 900000 do () done; etats;; (*val init_etats : int -> int array array = *) let hanoi nb_disques= let etat_piquets=init_etats nb_disques in let rec hanoi_aux n origine intermediaire destination = match n with | 1 -> mouvement origine destination etat_piquets nb_disques | _ -> begin hanoi_aux (n-1) origine destination intermediaire; mouvement origine destination etat_piquets nb_disques; hanoi_aux (n-1) intermediaire origine destination; end; in hanoi_aux nb_disques 1 2 3;; (*val hanoi : int -> unit = *) hanoi 4;; while not(key_pressed()) do () done;; hanoi 8;; while not(key_pressed()) do () done;;