Implement GUI interface for playingHEADmaster

1 files changed, 155 insertions, 0 deletions

diff --git a/judge/guiplay.ml b/judge/guiplay.ml
new file mode 100644
index 0000000..50add3c
--- /dev/null
+++ b/judge/guiplay.ml
@@ -0,0 +1,155 @@
+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
+
+