From 12622a51b1591d3ecab970612ade4d912469b456 Mon Sep 17 00:00:00 2001
From: Alex AUVOLAT <alex.auvolat@ens.fr>
Date: Mon, 10 Nov 2014 14:08:04 +0100
Subject: Implement TIME OUT.

---
 judge/core.ml        | 34 +++++++++++++++++++++++++++-------
 judge/morpion_rec.ml | 10 +++++-----
 2 files changed, 32 insertions(+), 12 deletions(-)

(limited to 'judge')

diff --git a/judge/core.ml b/judge/core.ml
index ce542dc..2838732 100644
--- a/judge/core.ml
+++ b/judge/core.ml
@@ -2,6 +2,8 @@ open Unix
 
 open Protocol
 
+let ( |> ) x f = f x
+
 (* Description of data structures *)
 
 exception Eliminated_ex of string
@@ -224,10 +226,10 @@ module Core (G: GAME) : CORE = struct
 
   let handle_events () =
     (* 1. IF NOT ENOUGH MATCHES ARE RUNING, LAUNCH ONE *)
-    let matches_in_progress = List.length
-          (List.filter
-            (fun g -> match g.p1.s, g.p2.s with Dead, Dead -> false | _ -> true)
-            !r_games)
+    let matches_in_progress =
+          !r_games
+        |> List.filter (fun g -> match g.p1.s, g.p2.s with Dead, Dead -> false | _ -> true)
+        |> List.length
     in
     let launch_match p1 p2 =
       Format.printf "Launching match: %s vs. %s@." p1 p2;
@@ -330,17 +332,19 @@ module Core (G: GAME) : CORE = struct
               w.p.score <- w.p.score + !pt_win;
               l.p.score <- l.p.score + !pt_lose;
               true
-            | TurnOf _ -> false
+            | TurnOf _ ->
+              p.s <- StandBy (time -. (end_r -. beg_r));
+              false
             | Eliminated _ -> raise (Eliminated_ex ("invalid move: " ^ act))
           in
           if finished then begin
             p.s <- Saving;
             op.s <- Saving;
-          end else begin
-            p.s <- StandBy (time -. (end_r -. beg_r));
           end
         | FairEnough, Saving ->
           kill p.pid Sys.sigterm;
+        | _, Saving ->
+          ()  (* player may be anywhere in its protocol state, we don't care*)
         | bad_m, _ -> raise (Eliminated_ex ("unexpected message: '" ^ encode bad_m ^ "'"))
         | exception Invalid_message m -> raise (Eliminated_ex ("invalid message: '" ^ m ^"'"))
         | exception _ -> raise (Eliminated_ex "exception when reading message")
@@ -365,6 +369,22 @@ module Core (G: GAME) : CORE = struct
         | _ -> ()
       end
     in List.iter do_fd in_fd;
+    (* Check if somebody has timed out *)
+    let check_timeout g =
+      match g.p1.s, g.p2.s, g.p1, g.p2 with
+      | Thinking(t, st), _, l, w
+      | _, Thinking(t, st), w, l ->
+        if t -. (Unix.gettimeofday() -. st) < 0. then begin
+          send_m w YouWin;
+          send_m l YouLose;
+          Format.printf "%s vs. %s: %s wins! (time out for %s)@." g.p1.p.name g.p2.p.name w.p.name l.p.name;
+          w.p.score <- w.p.score + !pt_win;
+          l.p.score <- l.p.score + !pt_lose;
+          w.s <- Saving;
+          l.s <- Saving
+        end
+      | _ -> ()
+    in List.iter check_timeout !r_games;
     (* Check if somebody has died on us *)
     begin try
       let pid, _ = waitpid [WNOHANG] (-1) in
diff --git a/judge/morpion_rec.ml b/judge/morpion_rec.ml
index 0741742..c7ca480 100644
--- a/judge/morpion_rec.ml
+++ b/judge/morpion_rec.ml
@@ -1,7 +1,6 @@
 open Core
 open Main
 
-let ( |> ) x f = f x
 
 module G = struct
   
@@ -76,21 +75,22 @@ module G = struct
     | l when List.exists ((=) Empty) l -> Empty
     | _ -> T
 
-
   (* setp0 : ('a, 'a, 'a) -> int -> 'a -> ('a, 'a, 'a) *)
   let setp0 (a, b, c) x v = match x with
     | 1 -> (v, b, c)
     | 2 -> (a, v, c)
     | 3 -> (a, b, v)
     | _ -> raise Invalid_pos
+
   (* setp1 : 'a morpion -> loc1 -> 'a -> ('a -> 'c) -> 'a morpion *)
   let setp1 (m, r) (px, py) v rf =
     let k = setp0 m px (setp0 (getp0 m px) py v) in
     (k, if r = Empty then reduce_m rf (k, r) else r)
     (* pourquoi ce if ? parce que si quelqu'un a déjà gagné un petit morpion,
-      alors même si l'adversaire aligne trois pions, le petit morpion lui
-      reste attribué... *)
-  (* setp2 : 'a morpion morpion -> loc2 -> 'a -> 'a morpion morpion *)
+      alors même si l'adversaire aligne trois cases dedans APRES,
+      le petit morpion reste attribué à la même personne. *)
+
+  (* setp : 'a morpion morpion -> loc2 -> 'a -> 'a morpion morpion *)
   let setp m (pg, pp) v =
     let im = setp1 (getp1 m pg) pp v (fun x -> x) in
     let om = setp1 m pg im reduct in
-- 
cgit v1.2.3