Add display functions...

5 files changed, 116 insertions, 57 deletions

diff --git a/judge/core.ml b/judge/core.ml
index 8b437d3..0f665c2 100644
--- a/judge/core.ml
+++ b/judge/core.ml
@@ -24,11 +24,14 @@ module type GAME = sig
 	type game		(* immutable structure *)
 
 	val name : string	(* ex: Morpion récursif *)
-	val id : string		(* ex: morpion_rec *)
+	val id   : string		(* ex: morpion_rec *)
 
-	val new_game : game * game_status
+	val new_game : game
 
-	val turn : game -> player -> string -> (game * game_status)
+	val turn : game -> player -> string -> game
+	val s    : game -> game_status
+
+	val display_game : game -> (string * string) -> unit
 end
 
 module type CORE = sig
@@ -237,8 +240,8 @@ module Core (G: GAME) : CORE = struct
 			in
 			let p1 = open_c (Hashtbl.find players p1) in
 			let p2 = open_c (Hashtbl.find players p2) in
-			let g, s = G.new_game in
-			let g = { p1; p2; hist = [g]; s } in
+			let g = G.new_game in
+			let g = { p1; p2; hist = [g]; s = G.s g } in
 			r_games := g::(!r_games)
 		in
 		let can_launch, cannot_launch = List.partition
@@ -284,7 +287,8 @@ module Core (G: GAME) : CORE = struct
 					p.s <- StandBy !game_time;
 				| Play act, Thinking (time, beg_r) ->
 					let end_r = Unix.gettimeofday () in
-					let new_g, new_s = G.turn (List.hd g.hist) pi act in
+					let new_g = G.turn (List.hd g.hist) pi act in
+					let new_s = G.s new_g in
 					send_m p OK;
 					send_m op (Play act);
 					g.s <- new_s;
diff --git a/judge/dummy_game.ml b/judge/dummy_game.ml
index 0fac26b..c5be248 100644
--- a/judge/dummy_game.ml
+++ b/judge/dummy_game.ml
@@ -3,16 +3,16 @@ open Main
 
 module Dummy : GAME = struct
 
-  type game = player * int
+  type game = int * (player * string) list * game_status
 
-  let new_game = (P1, 10), TurnOf P1
+  let new_game = (10, [], TurnOf P1)
 
-  let turn (p0, g) p _ =
-    if p <> p0 || g <= 0 then
-      (p0, g), Eliminated p
+  let turn (g, l, s0) p xx =
+    if s0 <> TurnOf p || g <= 0 then
+      (g, l, Eliminated p)
     else
       let op = other_player p in
-      (op, g-1), (
+      (g-1, l@[p, xx], 
         if g - 1 = 0 then
           if Random.int 100 = 0 then Eliminated p
           else if Random.int 2 = 0 then Won p
@@ -22,6 +22,26 @@ module Dummy : GAME = struct
           TurnOf op
       )
 
+  let s (_, _, s) = s
+
+  let display_game (cr, cs, t) (p1n, p2n) =
+    let open Graphics in
+    let open G_util in
+    let pt = function P1 -> p1n | P2 -> p2n in
+    List.iteri
+      (fun i (p, x) ->
+        text2 (i+4) black (string_of_int i);
+        text3 (i+4) (pc p) x)
+      cs;
+    text2 (List.length cs + 4) black ("... " ^ string_of_int cr);
+    let c, t = match t with
+        | TurnOf x -> pc x, "... " ^ pt x
+        | Won x -> pc x, pt x ^ " WON"
+        | Tie -> black, "TIE"
+        | Eliminated x -> pc x, pt x ^ " ELIM"
+    in
+    text3 (List.length cs + 4) c t
+
   let id = "dummy_game"
   let name = "Dummy game for testing purposes"
 
diff --git a/judge/dummy_player.ml b/judge/dummy_player.ml
index fe19b48..09b13aa 100644
--- a/judge/dummy_player.ml
+++ b/judge/dummy_player.ml
@@ -1,5 +1,16 @@
 
 
+let words = [|
+      "banane"; "hippopotame"; "povrion";
+      "pourquoi???"; "un ange passe"; "television";
+      "ceci n'est pas..."; "environ 12"; "septante";
+      "Philipp Glass"; "nyaaa"; "tu crois ?"; "hallo";
+      "mange ton muesli"; "va te coucher"; "MAMAAAAN!!";
+      "meme pas peur"; "python FTW"; "savanne!";
+      "le lion mange le lion"; "canard"; "tennis";
+      "sauve qui peut!"; "bref..."; "j'approuve.";
+  |]
+
 let expect mgs =
   let l = read_line () in
   begin try
@@ -24,7 +35,8 @@ let rec turn _ =
     "Your turn",
       (fun _ ->
         if Random.int 2 = 0 then Unix.sleep 1;
-        print_string "Play this_is_a_word\n";
+        Format.printf "Play %s@."
+          words.(Random.int (Array.length words));
         expect [ "OK", turn ]);
     "Play ", turn;
     "Tie", finished;
diff --git a/judge/g_util.ml b/judge/g_util.ml
new file mode 100644
index 0000000..95bfcba
--- /dev/null
+++ b/judge/g_util.ml
@@ -0,0 +1,49 @@
+open Graphics
+open Core
+
+(* Graphic helpers *)
+let grey = rgb 112 112 112
+let red = rgb 200 0 0
+let green = rgb 0 150 0
+
+let p1c = blue
+let p2c = red
+
+let pc = function P1 -> p1c | P2 -> p2c
+
+let center () = size_x () / 2, size_y () / 2
+
+let fullscreen_msg m =
+  clear_graph();
+  let tx, ty = text_size m in
+  let cx, cy = center () in
+  let w, h = tx/2, ty/2 in
+  set_color black;
+  let cr d =
+    draw_rect (cx - w - d) (cy - h - d)
+              (2 * (w + d)) (2 * (h + d))
+  in cr 20; cr 22;
+  moveto (cx - w) (cy - h);
+  draw_string m;
+  synchronize ()
+
+let tw m = fst (text_size m)
+
+let text_l l x c m =
+  set_color c;
+  moveto x (size_y() - ((l+1) * 20));
+  draw_string m
+
+let text1 l c m =
+  text_l l 30 c m
+let text2 l c m =
+  text_l l (size_x()/2 - 30 - tw m) c m
+let text3 l c m =
+  text_l l (size_x()/2 + 30) c m
+let text4 l c m =
+  text_l l (size_x() - 30 - tw m) c m
+
+let hl () =
+  draw_poly_line
+    [| 10, size_y() - 50;
+       size_x() - 10, size_y() - 50 |]
diff --git a/judge/main.ml b/judge/main.ml
index 6a42ff8..ef73ec5 100644
--- a/judge/main.ml
+++ b/judge/main.ml
@@ -18,47 +18,7 @@ end = struct
 
   module G = C.G
 
-  (* Graphic helpers *)
-  let grey = rgb 112 112 112
-  let red = rgb 200 0 0
-  let green = rgb 0 150 0
-
-  let center () = size_x () / 2, size_y () / 2
-
-  let fullscreen_msg m =
-    clear_graph();
-    let tx, ty = text_size m in
-    let cx, cy = center () in
-    let w, h = tx/2, ty/2 in
-    set_color black;
-    let cr d =
-      draw_rect (cx - w - d) (cy - h - d)
-                (2 * (w + d)) (2 * (h + d))
-    in cr 20; cr 22;
-    moveto (cx - w) (cy - h);
-    draw_string m;
-    synchronize ()
-
-  let tw m = fst (text_size m)
-
-  let text_l l x c m =
-    set_color c;
-    moveto x (size_y() - ((l+1) * 20));
-    draw_string m
-
-  let text1 l c m =
-    text_l l 30 c m
-  let text2 l c m =
-    text_l l (size_x()/2 - 30 - tw m) c m
-  let text3 l c m =
-    text_l l (size_x()/2 + 30) c m
-  let text4 l c m =
-    text_l l (size_x() - 30 - tw m) c m
-
-  let hl () =
-    draw_poly_line
-      [| 10, size_y() - 50;
-         size_x() - 10, size_y() - 50 |]
+  open G_util
 
   (* Init/Close *)
   let init () =
@@ -76,7 +36,8 @@ end = struct
   type view =
     | ScoreBoard
     | MatchList of bool
-    | ViewGame of C.game
+    | ViewLastGame
+    | NavGame of C.game * int
     | Question of string * (unit -> unit) * view
 
   let rec handle_events () =
@@ -90,6 +51,8 @@ end = struct
           (fun () -> C.add_rounds(); curr_view := MatchList false),
           !curr_view
         )
+      | MatchList _, 'v' -> curr_view := ViewLastGame
+      | ViewLastGame, '\t' -> curr_view := MatchList false
       | Question(_, y, n), 'y' -> y()
       | Question(_, y, n), 'n' -> curr_view := n
       | v, 'q' ->
@@ -107,7 +70,8 @@ end = struct
     begin match !curr_view with
     | ScoreBoard -> scoreboard_disp ()
     | MatchList f -> matchlist_disp f
-    | ViewGame g -> game_disp g
+    | ViewLastGame -> last_game_disp ()
+    | NavGame (g, n) -> nav_game_disp g n
     | Question (q, _, _) -> fullscreen_msg (q ^ " (y/n)")
     end;
     synchronize ()
@@ -171,7 +135,17 @@ end = struct
     List.iteri print_g games
 
   (* Game view *)
-  and game_disp g =
+  and last_game_disp () =
+    match C.games () with
+    | g::_ ->
+      let p1n, p2n = C.pn g in
+      text1 1 p1c p1n;
+      text2 1 p2c p2n;
+      text4 1 grey "match list >";
+      hl();
+      G.display_game (C.g g) (p1n, p2n)
+    | _ -> ()
+  and nav_game_disp g n =
     (* TODO *)
     ()