diff options
| -rw-r--r-- | judge/core.ml | 9 | ||||
| -rw-r--r-- | judge/guiplay.ml | 155 | ||||
| -rw-r--r-- | judge/morpion_rec.ml | 18 | ||||
| -rw-r--r-- | judge/morpion_rec_guiplay.ml | 3 |
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 () |