From 5900fdb76595b2eb9bf3168cd3ac84d7c52bad0c Mon Sep 17 00:00:00 2001 From: Alex AUVOLAT Date: Mon, 10 Nov 2014 11:35:56 +0100 Subject: Improved navigation and viewing --- judge/main.ml | 20 +++++++++++++------- judge/morpion_rec.ml | 40 ++++++++++++++++++++++++---------------- 2 files changed, 37 insertions(+), 23 deletions(-) diff --git a/judge/main.ml b/judge/main.ml index ac22602..ea7c2ef 100644 --- a/judge/main.ml +++ b/judge/main.ml @@ -53,23 +53,28 @@ end = struct ) | MatchList _, 'v' when C.games () <> [] -> curr_view := ViewLastGame | MatchList _, 'n' when C.games () <> [] -> - curr_view := NavGame ((List.hd (C.games())), 0) - | NavGame (g, n), 'b' when n > 0 -> - curr_view := NavGame (g, n-1) - | NavGame (g, n), 'f' when n < List.length (C.hist g) - 1 -> - curr_view := NavGame (g, n+1) + let g = List.hd (C.games()) in + curr_view := NavGame (g, -1) | NavGame (g, _), 'n' -> let rec dx = function - | gg::pg::_ when pg == g -> curr_view := NavGame (gg, 0) + | gg::pg::_ when pg == g -> curr_view := NavGame (gg, -1) | _::l -> dx l | [] -> () in dx (C.games()) | NavGame (g, _), 'p' -> let rec dx = function - | pg::gg::_ when pg == g -> curr_view := NavGame (gg, 0) + | pg::gg::_ when pg == g -> curr_view := NavGame (gg, -1) | _::l -> dx l | [] -> () in dx (C.games()) + | NavGame (g, n), 'b' when n > 0 -> + curr_view := NavGame (g, n-1) + | NavGame (g, n), 'b' when n = -1 -> + curr_view := NavGame (g, List.length (C.hist g) - 1) + | NavGame (g, n), 'f' when n < List.length (C.hist g) - 1 && n <> -1 -> + curr_view := NavGame (g, n+1) + | NavGame (g, n), 'f' when n = List.length (C.hist g) - 1 -> + curr_view := NavGame (g, -1) | ViewLastGame, '\t' | NavGame _, '\t' -> curr_view := MatchList false | Question(_, y, n), 'y' -> y() | Question(_, y, n), 'n' -> curr_view := n @@ -169,6 +174,7 @@ end = struct text2 1 p2c p2n; text4 1 grey "match list >"; hl(); + let n = if n = -1 then List.length (C.hist g) -1 else n in let put_st i g = let cx = 10 * i + 30 in let cy = size_y () - 60 in diff --git a/judge/morpion_rec.ml b/judge/morpion_rec.ml index 05d1d3e..19b1623 100644 --- a/judge/morpion_rec.ml +++ b/judge/morpion_rec.ml @@ -148,46 +148,54 @@ module G = struct let subpos (x1, y1, x2, y2) (l, c) = let dx, dy = (x2 - x1) / 3, (y2 - y1) / 3 in x1 + (l-1) * dx, y1 + (c-1) * dy, x1 + l * dx, y1 + c * dy + let margin (x1, y1, x2, y2) m = + (x1+m, y1+m, x2-m, y2-m) - let disp_l lw (x1, y1, x2, y2) = - let m = 4 in + let disp_l lw pos = + let x1, y1, x2, y2 = pos in function | X -> set_line_width lw; set_color p1c; draw_segments - [| x1+m, y1+m, x2-m, y2-m; - x1+m, y2-m, x2-m, y1+m |]; + [| x1, y1, x2, y2; + x1, y2, x2, y1 |]; set_line_width 1 | O -> set_line_width lw; set_color p2c; - draw_circle ((x1+x2)/2) ((y1+y2)/2) (min (x2-x1) (y2-y1) / 2 - m); + draw_circle ((x1+x2)/2) ((y1+y2)/2) (min (x2-x1) (y2-y1) / 2); set_line_width 1 | _ -> () - let disp_r rf sdf ((x1, y1, x2, y2) as box) mor = - let m = 4 in + let disp_r rf sdf box mor = + let x1, y1, x2, y2 = box in let dx, dy = (x2 - x1) / 3, (y2 - y1) / 3 in let x12, x23 = x1 + dx, x1 + 2 * dx in let y12, y23 = y1 + dy, y1 + 2 * dy in set_color black; draw_segments - [| x12, y1+m, x12, y2-m; - x23, y1+m, x23, y2-m; - x1+m, y12, x2-m, y12; - x1+m, y23, x2-m, y23 |]; - List.iter (fun p -> sdf (subpos box p) (getp1 mor p)) all_p1; + [| x12, y1, x12, y2; + x23, y1, x23, y2; + x1, y12, x2, y12; + x1, y23, x2, y23 |]; + List.iter (fun p -> sdf (margin (subpos box p) 6) (getp1 mor p)) all_p1; disp_l 2 box (rf mor) - let display_game (s, m, q) (pn1, pn2) = + let display_game (s, mor, q) (pn1, pn2) = let cx, cy = center() in + let box = cx - 200, cy - 200, cx + 200, cy + 200 in disp_r (reduce_m (reduce_m (fun x -> x))) (disp_r (reduce_m (fun x -> x)) (disp_l 1)) - (cx - 200, cy - 200, cx + 200, cy + 200) - m - (* TODO *) + box mor; + begin match q, s with + | Some p, TurnOf player -> + let x1, y1, x2, y2 = margin (subpos box p) 3 in + set_color (pc player); + draw_rect x1 y1 (x2-x1) (y2-y1) + | _ -> () + end end -- cgit v1.2.3