Bon c'est tout pourri et complètement inachevé, mais c'est pour montrer à Pollux à quoi ça ressemble (ce fut fait en une ou deux soirées je crois) :[nosmile]
type couleur = Blanc | Noir | Aucun
let autre_couleur = function Blanc -> Noir | Noir -> Blanc | _ -> invalid_arg "autre_couleur"
module Plateau : sig
type case
type direction
type t
val cree : unit -> t
val clone : t -> t
val directions : direction list
val neg_dir : direction -> direction
val avance_dir : case -> direction -> case
val mult_dir : int -> direction -> direction
val contenu_case : plateau: t -> case: case -> couleur
val set_contenu_case : plateau: t -> case: case -> couleur: couleur -> unit
val iter_cases : (case: case -> unit) -> unit
type event = Case of case | Clic | Quit
val init_dessin : unit -> unit
val redessine : case: case -> couleur: couleur -> unit
val attend_clic : unit -> event
end = struct
type case = int * int
type direction = int * int
type t = couleur array array
let cree () =
let plateau = Array.make_matrix 8 8 Aucun
in plateau.(0).(0) <- Blanc; plateau.(7).(7) <- Noir;
plateau.(7).(0) <- Noir; plateau.(0).(7) <- Blanc; plateau
let clone plateau = Array.map Array.copy plateau
let directions = [0, 1 ; 1, 0 ; 1, 1; 1, -1]
let neg_dir (a, b) = -a, -b
let mult_dir i (a, b) = i * a, i * b
let reduit (x, y) = (if y land 8 = 0 then x else lnot x) land 7, y land 7
let avance_dir (a, b) (c, d) = reduit (a + c, b + d)
let contenu_case ~plateau ~case:(x, y) = plateau.(x).(y)
let set_contenu_case ~plateau ~case:(x, y) ~couleur = plateau.(x).(y) <- couleur
let iter_cases f = for x = 0 to 7 do for y = 0 to 7 do f ~case:(x,y) done done
open Graphics
type event = Case of case | Clic | Quit
let redessine ~case:(x, y) ~couleur =
(match couleur with
Blanc -> set_color white
| Noir -> set_color black
| _ -> set_color red);
fill_circle (x * 22 + 11) (y * 22 + 11) 9;
fill_circle (x * 22 + 189) (y * 22 + 11) 9;
fill_circle ((7 - x) * 22 + 11) (y * 22 + 189) 9;
fill_circle ((7 - x) * 22 + 189) (y * 22 + 189) 9
let init_dessin () =
open_graph " 355x355+20+20"; (* " 363x382+20+20" pour win2k *)
set_window_title "Othello en bouteille de Klein";
set_color (rgb 0 128 64);
fill_rect 0 0 354 354;
set_color black;
let quadrille i =
moveto i 0;
lineto i 355;
moveto 0 i;
lineto 355 i;
in for i = 0 to 8 do
quadrille (i * 22);
quadrille (178 + i * 22)
done;
quadrille 177;
redessine ~case:(0,0) ~couleur:Blanc;
redessine ~case:(0,7) ~couleur:Blanc;
redessine ~case:(7,0) ~couleur:Noir;
redessine ~case:(7,7) ~couleur:Noir
exception Rien
let rec attend_clic () =
let status = wait_next_event [Button_down; Key_pressed] in
if status.key = 'q' then Quit
else if status.button = true then
let reduit coord =
if coord < 0 || coord > 354 then raise Rien
else if coord < 176 then coord / 22, false
else if coord < 178 then raise Rien
else (coord - 178) / 22, true in
try
let y, neg = reduit status.mouse_y
in let x, _ = reduit status.mouse_x
in Case (if neg then (7 - x, y) else (x,y))
with Rien -> Clic
else attend_clic ()
end
let (+:) = Plateau.avance_dir
let ( *: ) = Plateau.mult_dir
module Coups : sig
type coup
val case : coup -> Plateau.case
val trouve : couleur: couleur -> plateau: Plateau.t -> coup list
val joue : coup: coup -> couleur: couleur -> plateau: Plateau.t -> unit
end = struct
type ligne = Simple | Double | Non
type coup = Plateau.case * (Plateau.direction * int) list
let case = fst
let trouve_ligne case_depart ~direction ~couleur ~plateau =
let case = case_depart +: direction in
if Plateau.contenu_case ~plateau ~case <> autre_couleur couleur then Non, 0
else
let rec continue i nombre =
let case = case_depart +: i *: direction in
if case = case_depart then Double, nombre
else
let pion = Plateau.contenu_case ~plateau ~case in
if pion = couleur then Simple, nombre
else if pion = Aucun then Non, 0
else continue (i + 1) (nombre + 1)
in continue 2 1
let trouve_coup ~case ~couleur ~plateau =
let directions_trouvees = ref [] in
let cherche_lignes direction =
let (ligne, nombre) = trouve_ligne case ~direction ~couleur ~plateau in
if ligne <> Non then
directions_trouvees := (direction, nombre) :: !directions_trouvees;
if ligne <> Double then
let dir = Plateau.neg_dir direction in
let (ligne, nombre) = trouve_ligne case ~direction:dir ~couleur ~plateau in
if ligne <> Non then
directions_trouvees := (dir, nombre) :: !directions_trouvees;
in List.iter cherche_lignes Plateau.directions; match !directions_trouvees with
[] -> None
| directions -> Some (case, directions)
let trouve ~couleur ~plateau =
let resultat = ref [] in
let ajoute_coup ~case =
if Plateau.contenu_case ~case ~plateau = Aucun then
match trouve_coup ~case ~couleur ~plateau with
Some coup -> resultat := coup :: !resultat
| _ -> ()
in Plateau.iter_cases ajoute_coup; !resultat
let joue ~coup:(case, directions) ~couleur ~plateau =
Plateau.set_contenu_case ~case ~couleur ~plateau;
let retourne (direction, nombre) =
for i = 1 to nombre do
Plateau.set_contenu_case ~case:(case +: (i *: direction)) ~couleur ~plateau
done
in List.iter retourne directions
end
let compte_tout plateau =
let noirs = ref 0 and blancs = ref 0 in
let compte ~case = match Plateau.contenu_case ~plateau ~case with
Blanc -> incr blancs
| Noir -> incr noirs
| _ -> ()
in Plateau.iter_cases compte;
if !blancs > !noirs then print_endline "Blanc gagne."
else if !noirs > !blancs then print_endline "Noir gagne."
else print_endline "Partie nulle.";
ignore (Plateau.attend_clic ())
let attend_coup couleur coups_possibles plateau =
let rec boucle () =
match Plateau.attend_clic () with
Plateau.Quit -> exit 0
| Plateau.Case case ->
(try Coups.joue ~couleur ~plateau
~coup:(List.find (fun coup -> Coups.case coup = case) coups_possibles)
with Not_found -> boucle ())
| _ -> boucle ()
in boucle ()
let _ =
Random.self_init ();
let plateau = Plateau.cree () in
Plateau.init_dessin();
let rec boucle couleur coups_possibles =
if couleur = Blanc then (
let n = List.length coups_possibles in
let coup = List.nth coups_possibles (Random.int n) in
Plateau.redessine ~case:(Coups.case coup) ~couleur:Aucun;
Plateau.attend_clic ();
Coups.joue ~couleur ~plateau ~coup)
else attend_coup couleur coups_possibles plateau;
let redessine_cqui_faut ~case =
if Plateau.contenu_case ~plateau ~case = couleur
then Plateau.redessine ~case ~couleur
in Plateau.iter_cases redessine_cqui_faut;
let coul = autre_couleur couleur in
let possibles = Coups.trouve ~couleur:coul ~plateau in
if possibles = [] then (
let re_possibles = Coups.trouve ~couleur ~plateau in
if re_possibles = [] then compte_tout plateau else (
print_endline ("Le joueur " ^ (match couleur with
Blanc -> "Noir "
| Noir -> "Blanc "
| _ -> "") ^ "passe son tour");
boucle couleur re_possibles))
else boucle coul possibles
in boucle Noir (Coups.trouve ~couleur:Noir ~plateau)