Working on judge system

1 files changed, 171 insertions, 0 deletions

diff --git a/judge/main.ml b/judge/main.ml
new file mode 100644
index 0000000..5155e02
--- /dev/null
+++ b/judge/main.ml
@@ -0,0 +1,171 @@
+open Core
+open Graphics
+
+(* ****************** *)
+(* The user interface *)
+(* ****************** *)
+
+exception Exit_judge
+
+module UI (C : CORE) : sig
+
+  val init : unit -> unit
+  val close : unit -> unit
+  val handle_events : unit -> unit
+  val display : unit -> unit
+
+end = struct
+
+  module G = C.G
+
+  (* Graphic helpers *)
+  let grey = rgb 64 64 64
+
+  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)
+                (cx + w + d) (cy + h + d)
+    in cr 20; cr 22;
+    moveto (cx - w) (cy - h);
+    draw_string m
+
+  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 20 c m
+  let text2 l c m =
+    text_l l (size_x()/2 - 20 - tw m) c m
+  let text3 l c m =
+    text_l l (size_x()/2 + 20) c m
+  let text4 l c m =
+    text_l l (size_x() - 20 - tw m) c m
+
+  let hl () =
+    draw_poly_line
+      [| 10, size_y() - 50;
+         size_x() - 10, size_y() - 50 |]
+
+  (* Init/Close *)
+  let init () =
+    open_graph " 800x600";
+    fullscreen_msg "Starting up..."
+
+  let close () =
+    close_graph ()
+
+  (* View types *)
+  type view =
+    | ScoreBoard
+    | MatchList of bool
+    | ViewGame of C.game
+    | Question of string * (unit -> unit) * view
+
+  let rec handle_events () =
+    while key_pressed () do
+      match !curr_view, read_key() with
+      | ScoreBoard, '\t' -> curr_view := MatchList false
+      | MatchList _, '\t' -> curr_view := ScoreBoard
+      | MatchList e, 'f' -> curr_view := MatchList (not e)
+      | Question(_, y, n), 'y' -> y()
+      | Question(_, y, n), 'n' -> curr_view := n
+      | v, 'q' ->
+        curr_view := Question(
+          "Really quit?",
+          (fun () ->
+            fullscreen_msg "Exiting...";
+            raise Exit_judge),
+          v)
+      | _ -> ()
+    done
+
+  and display () =
+    clear_graph ();
+    match !curr_view with
+    | ScoreBoard -> scoreboard_disp ()
+    | MatchList f -> matchlist_disp f
+    | ViewGame g -> game_disp g
+    | Question (q, _, _) -> fullscreen_msg (q ^ " (y/n)")
+
+  and curr_view = ref ScoreBoard
+
+  (* Scoreboard view *)
+  and scoreboard_disp () =
+    text1 2 black "score board";
+    text4 2 grey "match list >";
+    hl();
+    let scores = List.sort
+      (fun (_, sc) (_, sc') -> sc' - sc)
+      (C.scores())
+    in
+    let xx l (n, s) t =
+      text1 l black t;
+      text1 (l+1) black ("  "^n);
+      text2 (l+1) black (string_of_int s)
+    in
+    let scores = match scores with
+    | first::q -> xx 4 first "first place"; q
+    | [] -> []
+    in
+    let scores = match scores with
+    | sec::q -> xx 7 sec "second place"; q
+    | [] -> []
+    in
+    let scores = match scores with
+    | thrd::q -> xx 10 thrd "third place"; q
+    | [] -> []
+    in
+    let show_sc i (n, s) =
+      text3 (i+4) black ((string_of_int (i+3))^". "^n);
+      text4 (i+1) black (string_of_int s)
+    in
+    List.iteri show_sc scores
+
+  (* Match list view *)
+  and matchlist_disp show_only_running =
+    (* TODO *)
+    ()
+
+  (* Game view *)
+  and game_disp g =
+    (* TODO *)
+    ()
+
+end
+
+(* ************* *)
+(* The main loop *)
+(* ************* *)
+
+module Juge (C : CORE) : sig
+
+  val run : unit -> unit
+
+end = struct
+
+  module UI = UI(C)
+
+  let run () =
+    C.init();
+    UI.init();
+    begin try while true do
+      C.handle_events ();
+      UI.handle_events ()
+    done with
+      Exit_judge ->
+        C.finish ();
+        UI.close ()
+    end
+
+end