(* ===================================================== *)
(* Apprentissage de la programmation avec OCaml *)
(* Catherine Dubois & Valérie Ménissier-Morain *)
(* Éditions Hermès Sciences *)
(* Mars 2004 *)
(* ===================================================== *)
(* Fichier MLSRC/CC/cc_base.ml *)
(* ===================================================== *)
open Graphics;;
#load "graphics.cma";;
#load "unix.cma";;
type case = Vide | Occupée of int;;
(* Les constantes données *)
let lignes = 4 and colonnes = 6;;
let nb_couleurs = 16;;
let bord_gauche = 1
and bord_droit = 1
and bord_bas = 1
and bord_haut = 1;;
(* Les constantes déduites *)
let débutc = bord_gauche
and finc = bord_gauche+colonnes-1;;
let débutl = bord_bas
and finl = bord_bas+lignes-1;;
let nb_colonnes = bord_gauche+colonnes+bord_droit;;
let nb_lignes = bord_bas+lignes+bord_haut;;
let zone_de_jeu =
Array.make_matrix nb_colonnes nb_lignes Vide;;
(* La zone de jeu *)
let création_tableau_ordonné () =
for j = débutl to finl do
let i = ref débutc in
while !i <= finc do
zone_de_jeu.(!i).(j) <-
Occupée (Random.int nb_couleurs);
zone_de_jeu.(!i+1).(j) <- zone_de_jeu.(!i).(j);
i := !i+2;
done;
done;;
let mélange_couleurs_tableau () =
for i = débutc to finc do
for j = débutl to finl do
let c = i+Random.int (finc-i+1)
and l = j+Random.int (finl-j+1) in
let tmp = zone_de_jeu.(c).(l) in
zone_de_jeu.(c).(l) <- zone_de_jeu.(i).(j);
zone_de_jeu.(i).(j) <- tmp
done;
done;;
let création_zone_de_jeu () =
création_tableau_ordonné ();
mélange_couleurs_tableau ();;
création_zone_de_jeu ();;
(* La détection de circuits *)
let rec interval i j =
if i = j (* Cas d'arrêt de la récursivité *)
then [i]
else if i < j
then i::(interval (i+1) j)
else i::(interval (i-1) j);;
let case_vide (c,l) = zone_de_jeu.(c).(l)=Vide;;
let cases_jointes_segment_vertical (c1,l1) (c2,l2) =
c1 = c2 &&
let (minl, maxl) =
if l1 < l2 then (l1, l2) else (l2, l1) in
(* il n'y a pas de case intermédiaire *)
maxl <= minl+1
|| (* toutes les cases intermédiaires sont vides *)
(List.for_all case_vide
(List.map (function l -> (c1, l))
(interval (minl+1) (maxl-1))));;
let cases_jointes_segment_horizontal (c1,l1) (c2,l2) =
l1 = l2 &&
let (minc, maxc) =
if c1 < c2 then (c1, c2) else (c2, c1) in
(* il n'y a pas de case intermédiaire *)
maxc <= minc+1
|| (* toutes les cases intermédiaires sont vides *)
(List.for_all case_vide
(List.map (function c -> (c, l1))
(interval (minc+1) (maxc-1))));;
let cases_jointes_segment_hv (c1,l1) (c2,l2) =
cases_jointes_segment_vertical (c1,l1) (c2,l2)
|| cases_jointes_segment_horizontal (c1,l1) (c2,l2);;
let interval_sans i j inf sup =
if i = inf
then interval (i+1) sup
else if i = sup
then (interval inf (i-1))
else if i = j
then (interval (i+1) sup)@(interval inf (i-1))
else if i < j
then (interval (i+1) sup)@(interval inf (i-1))
else (interval (i-1) inf)@(interval (i+1) sup);;
let rec cases_jointes_circuit_n_angles (c1,l1) (c2,l2) n =
if n = 0 (* Cas de base de la récursivité *)
then cases_jointes_segment_hv (c1,l1) (c2,l2)
else
List.exists
(function l ->
case_vide (c1,l)
&& cases_jointes_segment_vertical (c1,l1) (c1,l)
&& cases_jointes_circuit_n_angles (c1,l) (c2,l2) (n-1))
(interval_sans l1 l2 0 (nb_lignes-1))
|| List.exists
(function c ->
case_vide (c,l1)
&& cases_jointes_segment_horizontal (c1,l1) (c,l1)
&& cases_jointes_circuit_n_angles (c,l1) (c2,l2) (n-1))
(interval_sans c1 c2 0 (nb_colonnes-1));;
let rec cases_jointes_circuit_au_plus_n_angles (c1,l1) (c2,l2) n =
if n = 0
then cases_jointes_segment_hv (c1,l1) (c2,l2)
else
cases_jointes_circuit_au_plus_n_angles (c1,l1) (c2,l2) (n-1)
|| cases_jointes_circuit_n_angles (c1,l1) (c2,l2) n;;
let suppression_paire_cases (c1,l1) (c2,l2) =
match zone_de_jeu.(c1).(l1), zone_de_jeu.(c2).(l2) with
| Vide, _ | _, Vide -> ()
| Occupée coul1, Occupée coul2 ->
if coul1 = coul2
&& cases_jointes_circuit_au_plus_n_angles (c1,l1) (c2,l2) 2
then
(zone_de_jeu.(c1).(l1) <- Vide;
zone_de_jeu.(c2).(l2) <- Vide);;
let circuit_segment_vertical (c1,l1) (c2,l2) =
if cases_jointes_segment_vertical (c1,l1) (c2,l2)
then
if c1 <> c2 || l1 <> l2
then [(c1,l1); (c2, l2)]
else [(c1,l1)]
else raise Not_found;;
let circuit_segment_horizontal (c1,l1) (c2,l2) =
if cases_jointes_segment_horizontal (c1,l1) (c2,l2)
then
if c1 <> c2 || l1 <> l2
then [(c1,l1);(c2,l2)]
else [(c1,l1)]
else raise Not_found;;
let circuit_segment (c1,l1) (c2,l2) =
if cases_jointes_segment_vertical (c1,l1) (c2,l2)
|| cases_jointes_segment_horizontal (c1,l1) (c2,l2)
then
if c1 <> c2 || l1 <> l2
then [(c1,l1);(c2,l2)]
else [(c1,l1)]
else raise Not_found;;
let rec circuit_n_angles (c1,l1) (c2,l2) n =
if n = 0 (* Cas de base de la récursivité *)
then circuit_segment (c1,l1) (c2,l2)
else
try
let ligne =
List.find
(function l ->
case_vide (c1, l) &&
cases_jointes_segment_vertical (c1,l1) (c1,l) &&
cases_jointes_circuit_n_angles (c1,l) (c2,l2) (n-1))
(interval_sans l1 l2 0 (nb_lignes-1)) in
(c1, l1)::(circuit_n_angles (c1,ligne) (c2,l2) (n-1))
with Not_found ->
let colonne =
List.find
(function c ->
case_vide (c, l1) &&
cases_jointes_segment_horizontal (c1,l1) (c,l1)
&& cases_jointes_circuit_n_angles (c,l1) (c2,l2) (n-1))
(interval_sans c1 c2 0 (nb_colonnes-1)) in
(c1, l1)::(circuit_n_angles (colonne,l1) (c2,l2) (n-1));;
let rec circuit_au_plus_n_angles (c1,l1) (c2,l2) n =
if n = 0
then circuit_segment (c1,l1) (c2,l2)
else
try circuit_au_plus_n_angles (c1,l1) (c2,l2) (n-1)
with Not_found -> circuit_n_angles (c1,l1) (c2,l2) n;;
let circuit_valide (c1,l1) (c2,l2) =
match zone_de_jeu.(c1).(l1), zone_de_jeu.(c2).(l2) with
| Vide, _ | _, Vide -> []
| Occupée coul1, Occupée coul2 ->
if coul1 = coul2
then
try
circuit_au_plus_n_angles (c1,l1) (c2,l2) 2
with Not_found -> []
else [];;
(* L'affichage des pièces *)
let taille_pièce = 30;;
let grey = rgb 175 175 175;;
let dessiner_pièce0 (x, y) fond =
if fond
then set_color white
else set_color grey;
fill_rect x y taille_pièce taille_pièce;
set_color foreground;
draw_rect x y taille_pièce taille_pièce;;
let dessiner_rectangle_bord_arrondi x y w h arrondi =
draw_poly
[|(x,y+arrondi); (x,y+h-arrondi); (x+arrondi,y+h);
(x+w-arrondi,y+h); (x+w,y+h-arrondi); (x+w,y+arrondi);
(x+w-arrondi,y); (x+arrondi,y)|];;
let dessiner_pièce1 (x, y) fond =
dessiner_pièce0 (x, y) fond;
let bord = 5 (* écartement du bord du carré central *)
and arrondi = 2 (* dimension du pan coupé *) in
dessiner_rectangle_bord_arrondi
(x+bord) (y+bord)
(taille_pièce-2*bord) (taille_pièce-2*bord) arrondi;;
let dessiner_pièce2ou3 (x, y) fond orientation =
dessiner_pièce0 (x, y) fond;
let bord = 4 (* écartement du bord du carré central *)
and espace = 6 (* espace entre les deux rectangles *)
and arrondi = 1 in
(* dimension du carré interne dans lequel s'inscrivent
les deux rectangles *)
let dim_interne = taille_pièce-2*bord in
let (w, h) = (* largeur et hauteur des deux rectangles *)
if orientation
then (dim_interne, (dim_interne-espace)/2)
else ((dim_interne-espace)/2, dim_interne) in
dessiner_rectangle_bord_arrondi
(x+bord) (y+bord) w h arrondi;
if orientation
then dessiner_rectangle_bord_arrondi
(x+bord) (y+bord+h+espace) w h arrondi
else dessiner_rectangle_bord_arrondi
(x+bord+w+espace) (y+bord) w h arrondi;;
let dessiner_pièce6 (x, y) fond =
dessiner_pièce0 (x, y) fond;
let bord = 5 (* écartement du bord des carrés centraux *)
and espace = 6 (* espace entre les carrés centraux *)
and arrondi = 1 in
(* côté des carrés centraux *)
let w = (taille_pièce-2*bord-espace)/2 in
dessiner_rectangle_bord_arrondi
(x+bord) (y+bord) w w arrondi;
dessiner_rectangle_bord_arrondi
(x+bord+w+espace) (y+bord) w w arrondi;
dessiner_rectangle_bord_arrondi
(x+bord) (y+bord+w+espace) w w arrondi;
dessiner_rectangle_bord_arrondi
(x+bord+w+espace) (y+bord+w+espace) w w arrondi;;
let dessiner_pièce4ou5 (x, y) fond orientation =
dessiner_pièce0 (x, y) fond;
let bord = 5
and espace = 4 in
if orientation
then
begin
draw_poly
[|(x+bord,y+taille_pièce-bord);
(x+taille_pièce-bord-espace,y+taille_pièce-bord);
(x+bord,y+bord+espace)|];
draw_poly
[|(x+bord+espace,y+bord);
(x+taille_pièce-bord,y+bord);
(x+taille_pièce-bord,y+taille_pièce-bord-espace)|]
end
else
begin
draw_poly
[|(x+bord+espace,y+taille_pièce-bord);
(x+taille_pièce-bord,y+taille_pièce-bord);
(x+taille_pièce-bord,y+bord+espace)|];
draw_poly
[|(x+bord,y+bord);
(x+taille_pièce-bord-espace,y+bord);
(x+bord,y+taille_pièce-bord-espace)|]
end;;
let dessiner_pièce7 (x, y) fond =
dessiner_pièce0 (x, y) fond;
let bord = 4
and espace = 4 in
draw_poly
[|(x+bord,y+bord+espace);
(x+taille_pièce/2-espace,y+taille_pièce/2);
(x+bord,y+taille_pièce-bord-espace)|];
draw_poly
[|(x+taille_pièce-bord,y+bord+espace);
(x+taille_pièce/2+espace,y+taille_pièce/2);
(x+taille_pièce-bord,y+taille_pièce-bord-espace)|];
draw_poly
[|(x+bord+espace,y+bord);
(x+taille_pièce/2,y+taille_pièce/2-espace);
(x+taille_pièce-bord-espace,y+bord)|];
draw_poly
[|(x+bord+espace,y+taille_pièce-bord);
(x+taille_pièce/2,y+taille_pièce/2+espace);
(x+taille_pièce-bord-espace,y+taille_pièce-bord)|];;
let dessiner_pièce (x, y) numéro =
match numéro/2 with
| 0 -> dessiner_pièce0 (x, y) (numéro mod 2 = 0)
| 1 -> dessiner_pièce1 (x, y) (numéro mod 2 = 0)
| 2 -> dessiner_pièce2ou3 (x, y) (numéro mod 2 = 0) true
| 3 -> dessiner_pièce2ou3 (x, y) (numéro mod 2 = 0) false
| 4 -> dessiner_pièce4ou5 (x, y) (numéro mod 2 = 0) true
| 5 -> dessiner_pièce4ou5 (x, y) (numéro mod 2 = 0) false
| 6 -> dessiner_pièce6 (x, y) (numéro mod 2 = 0)
| 7 -> dessiner_pièce7 (x, y) (numéro mod 2 = 0)
| _ -> ();;
(* Le marquage de la sélection du joueur *)
let dessiner_sélection (x,y) =
set_line_width 3;
draw_rect x y taille_pièce taille_pièce;
set_line_width 1;;
let dessiner_désélection (x,y) =
set_color background;
set_line_width 3;
draw_rect x y taille_pièce taille_pièce;
set_line_width 1;
set_color foreground;
draw_rect x y taille_pièce taille_pièce;;
(* L'affichage de la zone de jeu *)
open_graph "";;
set_window_title "Court circuit";;
let espace_pièces = 8;;
let largeur_zone_de_jeu =
colonnes*taille_pièce+(colonnes-1)*espace_pièces
and hauteur_zone_de_jeu =
lignes*taille_pièce+(lignes-1)*espace_pièces;;
let espace_horizontal = (size_x()-largeur_zone_de_jeu)/2
and espace_vertical = (size_y()-hauteur_zone_de_jeu)/2;;
let dessiner_zone_de_jeu () =
let x = ref espace_horizontal
and y = ref espace_vertical in
(* où placer le coin en bas à gauche de la zone de jeu *)
for c = débutc to finc do
for l = débutl to finl do
begin match zone_de_jeu.(c).(l) with
| Vide -> ()
| Occupée couleur -> dessiner_pièce (!x, !y) couleur
end;
y := !y+taille_pièce+espace_pièces;
done;
y := espace_vertical;
x := !x+taille_pièce+espace_pièces
done;;
(* L'affichage de la sélection et des circuits *)
let coordonnées_centre_pièce (c,l) =
(espace_horizontal+(c-1)*taille_pièce+
(c-1)*espace_pièces+taille_pièce/2,
espace_vertical+(l-1)*taille_pièce+
(l-1)*espace_pièces+taille_pièce/2);;
let dessiner_circuit circuit =
match List.map coordonnées_centre_pièce circuit with
| [] -> ()
| (x,y)::circuit' ->
set_line_width 3; moveto x y;
List.iter (function (x,y) -> lineto x y) circuit';
set_line_width 1;;
let coordonnées_pièce (c,l) =
(espace_horizontal+(c-1)*taille_pièce+(c-1)*espace_pièces,
espace_vertical+(l-1)*taille_pièce+(l-1)*espace_pièces);;
let effacer_pièce_sélectionnée (c,l) =
let (x, y) = coordonnées_pièce (c,l) in
set_color background;
fill_rect x y taille_pièce taille_pièce;
dessiner_sélection (x, y);
set_color foreground;;
let effacer_circuit circuit =
set_color background;
dessiner_circuit circuit;
set_color foreground;;
let position_zone_de_jeu (x, y) =
((x-espace_horizontal)/(taille_pièce+espace_pièces)+bord_gauche,
(y-espace_vertical)/(taille_pièce+espace_pièces)+bord_bas);;
let position_pièce_zone_de_jeu_valide (c, l) =
c >= débutc && c <= finc && l >= débutl && l <= finl &&
zone_de_jeu.(c).(l) <> Vide ;;
let sélectionner (c,l) sélection =
sélection := Some (c,l);
dessiner_sélection (coordonnées_pièce (c,l));;
let désélectionner (c,l) sélection =
sélection := None;
dessiner_désélection (coordonnées_pièce (c,l));;
let écrire_pas_de_circuit () =
print_string "pas de circuit entre ces pièces\n";;
let éliminer (c,l) (c',l') sélection =
dessiner_sélection (coordonnées_pièce (c,l));
let circ = circuit_valide (c,l) (c',l') in
if circ = []
then
begin
écrire_pas_de_circuit ();
dessiner_désélection (coordonnées_pièce (c,l))
end
else
begin
dessiner_circuit circ;
Unix.sleep 1;
sélection := None;
(* supprimer le couple de pièces graphiquement *)
effacer_circuit circ;
effacer_pièce_sélectionnée (c,l);
effacer_pièce_sélectionnée (c',l');
(* supprimer le couple de pièces en mémoire *)
zone_de_jeu.(c).(l) <- Vide;
zone_de_jeu.(c').(l') <- Vide;
end;;
(* La réaction aux actions du joueur *)
let coordonnées_clic () =
while not (button_down()) do () done;
while button_down() do () done;
position_zone_de_jeu (mouse_pos());;
exception Non_vide;;
let zone_de_jeu_vide () =
try
for c = débutc to finc do
for l = débutl to finl do
if zone_de_jeu.(c).(l) <> Vide then raise Non_vide;
done;
done; true
with Non_vide -> false;;
let jeu () =
Random.self_init ();
création_zone_de_jeu ();
dessiner_zone_de_jeu ();
let sélection = ref None in
while not (zone_de_jeu_vide ()) do
let (c,l) = coordonnées_clic () in
if position_pièce_zone_de_jeu_valide (c, l)
then
match !sélection with
| None -> sélectionner (c,l) sélection
| Some (c',l') ->
if (c',l') = (c,l)
then désélectionner (c,l) sélection
else éliminer (c,l) (c',l') sélection
done;
exit 0;;
jeu();;
Ce document a été traduit de LATEX par
HEVEA.