aboutsummaryrefslogtreecommitdiff
path: root/judge/core.ml
diff options
context:
space:
mode:
Diffstat (limited to 'judge/core.ml')
-rw-r--r--judge/core.ml17
1 files changed, 12 insertions, 5 deletions
diff --git a/judge/core.ml b/judge/core.ml
index 1c8ad05..4f4ba0d 100644
--- a/judge/core.ml
+++ b/judge/core.ml
@@ -57,7 +57,7 @@ module type CORE = sig
val init : unit -> unit
val finish : unit -> unit
- val handle_events : unit -> unit (* is anything happening ? *)
+ val handle_events : unit -> bool (* is anything happening ? *)
val add_rounds : unit -> unit (* adds one game of everyone against everyone *)
@@ -233,6 +233,7 @@ module Core (G: GAME) : CORE = struct
end
let handle_events () =
+ let usefull = ref false in
(* 1. IF NOT ENOUGH MATCHES ARE RUNING, LAUNCH ONE *)
let matches_in_progress =
!r_games
@@ -269,7 +270,8 @@ module Core (G: GAME) : CORE = struct
let p2 = open_c (Hashtbl.find players p2) in
let g = G.new_game in
let g = { p1; p2; hist = [g]; gs = G.s g } in
- r_games := g::(!r_games)
+ r_games := g::(!r_games);
+ usefull := true
in
let can_launch, cannot_launch = List.partition
(fun (p1, p2) ->
@@ -370,7 +372,8 @@ module Core (G: GAME) : CORE = struct
send_m p (YourTurn t);
p.s <- Thinking (t, Unix.gettimeofday());
| _ -> ()
- end
+ end;
+ usefull := true
in List.iter do_fd in_fd;
(* Check if somebody has timed out *)
let check_timeout g =
@@ -384,7 +387,8 @@ module Core (G: GAME) : CORE = struct
w.p.score <- w.p.score + !pt_win;
l.p.score <- l.p.score + !pt_lose;
w.s <- Saving;
- if l.s <> Dead then l.s <- Saving
+ if l.s <> Dead then l.s <- Saving;
+ usefull := true
end
| _ -> ()
in List.iter check_timeout !r_games;
@@ -412,7 +416,10 @@ module Core (G: GAME) : CORE = struct
p.s <- Dead;
p.p.running <- None;
List.iter close p.cfd;
+ usefull := true
end
- with _ -> () end
+ with _ -> () end;
+ (* return value *)
+ !usefull
end