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)