path: root/judge/guiplay.ml

open Core
open Graphics
open Unix
open Protocol

module A (G : GAME) : sig

  val run : unit -> unit

end = struct

  exception Unexpected of msg

  open G_util

  (* Init/Close *)
  let gui_init () =
    open_graph " 800x600";
    set_font "-misc-fixed-bold-r-normal--15-120-90--c-90-iso8859-1";
    auto_synchronize false;
    display_mode false;
    remember_mode true;
    fullscreen_msg "Starting up..."

  let gui_close () =
    close_graph ()

  (* The functions *)

  let dg t g pnx =
    clear_graph();
    text3 1 black t;
    hl();
    G.display_game g pnx;
    synchronize()

  let display_result r (p1n, p2n) = 
    let s = match r with
      | Won P1 -> p1n ^ " won"
      | Won P2 -> p2n ^ " won"
      | Tie -> "Tie"
      | Eliminated P1 -> p1n ^ " eliminated"
      | Eliminated P2 -> p2n ^ " eliminated"
      | _ -> assert false
    in
    fullscreen_msg (s ^ ". Press a key to exit.");
    ignore @@ read_key()

  let fwd ff g (send, recv) (p1n, p2n) =
    match G.s g with
    | TurnOf _ -> ff g (send, recv) (p1n, p2n)
    | s ->
      display_result s (p1n, p2n);
      send (match s with
        | Tie -> Tie
        | Won P1 when p1n = "AI" -> YouWin
        | Won P2 when p2n = "AI" -> YouWin
        | Won _ ->  YouLose
        | _ -> Eliminated);
      match (recv ()) with
        | FairEnough -> ()
        | x -> raise (Unexpected x)

  let rec human_turn g (send, recv) pnx =
    dg "Your turn !" g pnx;
    let rec x pmc =
      let st = wait_next_event [Button_down; Button_up; Mouse_motion; Key_pressed] in
      let act = G.gui_act_at g (st.mouse_x, st.mouse_y) in
      let g', ok = try G.play g act, true with _ -> g, false in
      let ok = ok && (match G.s g' with Eliminated _ -> false | _ -> true) in
      dg "Your turn !" (if ok then g' else g) pnx;
      if st.keypressed && st.key = 'q' then begin
        send (YouWin);
        fullscreen_msg "You abandon! Coward!"
      end else
        if pmc && not st.button && ok then begin
          send (Play act);
          fwd ai_turn g' (send, recv) pnx
        end else
          x st.button
    in x false
    
  and ai_turn g (send, recv) pnx =
    dg "AI's turn..." g pnx;
    send (YourTurn 30.0);
    match recv() with
      | Play x ->
        let g' = G.play g x in
        send OK;
        fwd human_turn g' (send, recv) pnx
      | x -> raise (Unexpected x)

  (* Arg parsing && Initialization *)

  let human_begin = ref false

  let start_proc player_dir =
    let b = Filename.concat player_dir "player" in
    let st = Unix.stat b in
    if not ((st.st_kind = S_REG || st.st_kind = S_LNK)
            && (st.st_perm land 0o100 <> 0)) then
    begin
      Format.eprintf "Could not find player binary in %s@." player_dir;
      exit 1
    end;
    let (ff_i, o) = pipe () in
    let (i, ff_o) = pipe () in
    let pid = fork() in
    if pid = 0 then begin
      chdir player_dir;
      dup2 ff_i stdin;
      dup2 ff_o stdout;
      execvp b [| b |];
    end;
    Format.eprintf "Started IA process, pid %d@." pid;
    i, o, pid


  let run () =
    let player_dir = ref "." in
    let args = [
      "-h", Arg.Set human_begin, "Human begins (default: AI begins";
    ] in
    Arg.parse args (fun s -> player_dir := s)
      "Usage: xx_guiplay [<option> ...] [<player directory>]";
    let player_dir =
      if Filename.is_relative !player_dir
        then Filename.concat (Unix.getcwd()) !player_dir
        else !player_dir
    in
    gui_init();
    let i, o, pid = start_proc player_dir in
    let ic = in_channel_of_descr i in
    let oc = out_channel_of_descr o in
    let send m = output_string oc (encode m ^ "\n"); flush oc in
    let recv () = decode (input_line ic) in
    send (Hello G.id);
    let pnc = if !human_begin then ("human", "AI") else ("AI", "human") in
    begin try
        match recv () with
        | Hello x when x = G.id ->
          if !human_begin
            then human_turn G.new_game (send, recv) pnc
            else ai_turn G.new_game (send, recv) pnc
        | x -> raise (Unexpected x)
      with
        | Unexpected x ->
          Format.eprintf "Unexpected message: %s@." (encode x)
    end;
    Unix.kill pid Sys.sigterm;
    gui_close()

end