aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAlex Auvolat <alex.auvolat@ens.fr>2014-11-16 12:44:32 +0100
committerAlex Auvolat <alex.auvolat@ens.fr>2014-11-16 12:44:32 +0100
commit80475db04ef557abc6d7e1cb708a954d501f4f3a (patch)
tree0fc15d06f0f468c1da1d987131e98cedc9e914f4
parent0e83991e3f8739ec00d744f038fdfaea2b60c98e (diff)
downloadCompetIA-master.tar.gz
CompetIA-master.zip
Implement GUI interface for playingHEADmaster
-rw-r--r--judge/core.ml9
-rw-r--r--judge/guiplay.ml155
-rw-r--r--judge/morpion_rec.ml18
-rw-r--r--judge/morpion_rec_guiplay.ml3
4 files changed, 178 insertions, 7 deletions
diff --git a/judge/core.ml b/judge/core.ml
index e08ce17..cb5df75 100644
--- a/judge/core.ml
+++ b/judge/core.ml
@@ -36,6 +36,7 @@ module type GAME = sig
val s : game -> game_status
val display_game : game -> (string * string) -> unit
+ val gui_act_at : game -> (int * int) -> string
end
module type CORE = sig
@@ -121,7 +122,7 @@ module Core (G: GAME) : CORE = struct
let init () =
(* 1. PARSE ARGUMENTS *)
- let game_dir = ref "" in
+ let game_dir = ref "." in
let args = [
"-p", Arg.Set_int par_games, "How many games to run in parallel (2)";
"-s", Arg.Set_float game_time,
@@ -134,11 +135,7 @@ module Core (G: GAME) : CORE = struct
] in
Arg.parse args (fun s -> game_dir := s)
- "Usage: judge [<option> ...] <game_directory>";
- if !game_dir = "" then begin
- Format.eprintf "Error: no game directory specified.@.";
- exit 1
- end;
+ "Usage: judge [<option> ...] [<game_directory>]";
if Filename.is_relative !game_dir then
game_dir := Filename.concat (Unix.getcwd()) !game_dir;
let date =
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
+
+
diff --git a/judge/morpion_rec.ml b/judge/morpion_rec.ml
index a46b7f9..49e6544 100644
--- a/judge/morpion_rec.ml
+++ b/judge/morpion_rec.ml
@@ -195,9 +195,13 @@ module G = struct
List.iter (fun p -> sdf (margin (subpos box p) 6) (getp1 mor p)) all_p1;
disp_l 2 box (reduct mor)
- let display_game (s, mor, q) (pn1, pn2) =
+ let gbox () =
let cx, cy = center() in
let box = cx - 200, cy - 200, cx + 200, cy + 200 in
+ box
+
+ let display_game (s, mor, q) (pn1, pn2) =
+ let box = gbox () in
disp_r (disp_r (disp_l 1)) box mor;
begin match q, s with
| Some p, TurnOf player ->
@@ -207,6 +211,18 @@ module G = struct
| _ -> ()
end
+ let in_box (x1, y1, x2, y2) (x, y) =
+ (x >= x1 && x <= x2 && y >= y1 && y <= y2)
+
+ let gui_act_at g xy =
+ let box = gbox () in
+ try
+ let pg = List.find (fun p -> in_box (subpos box p) xy) all_p1 in
+ let sbox = subpos box pg in
+ let pp = List.find (fun p -> in_box (subpos sbox p) xy) all_p1 in
+ encode (pg, pp)
+ with Not_found -> ""
+
end
diff --git a/judge/morpion_rec_guiplay.ml b/judge/morpion_rec_guiplay.ml
new file mode 100644
index 0000000..ed44a14
--- /dev/null
+++ b/judge/morpion_rec_guiplay.ml
@@ -0,0 +1,3 @@
+module Main = Guiplay.A(Morpion_rec.G)
+
+let () = Main.run ()