diff options
| -rw-r--r-- | judge/core.ml | 34 | ||||
| -rw-r--r-- | judge/morpion_rec.ml | 10 |
2 files changed, 32 insertions, 12 deletions
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 |