diff options
Diffstat (limited to 'judge')
| -rw-r--r-- | judge/core.ml | 16 | ||||
| -rw-r--r-- | judge/dummy_game.ml | 32 | ||||
| -rw-r--r-- | judge/dummy_player.ml | 14 | ||||
| -rw-r--r-- | judge/g_util.ml | 49 | ||||
| -rw-r--r-- | judge/main.ml | 62 |
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 *) () |