aboutsummaryrefslogtreecommitdiff
path: root/judge
diff options
context:
space:
mode:
Diffstat (limited to 'judge')
-rw-r--r--judge/main.ml20
-rw-r--r--judge/morpion_rec.ml40
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