1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
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
|
