path: root/judge/main.ml

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 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 |]

  (* Init/Close *)
  let init () =
    open_graph " 800x600";
    set_font "-misc-fixed-bold-r-normal--15-120-90--c-90-iso8859-1";
    auto_synchronize false;
    display_mode false;
    remember_mode true;
    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)
      | MatchList _, 'r' -> curr_view := Question(
          "Launch new round?",
          (fun () -> C.add_rounds(); curr_view := MatchList false),
          !curr_view
        )
      | 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 ();
    begin match !curr_view with
    | ScoreBoard -> scoreboard_disp ()
    | MatchList f -> matchlist_disp f
    | ViewGame g -> game_disp g
    | Question (q, _, _) -> fullscreen_msg (q ^ " (y/n)")
    end;
    synchronize ()

  and curr_view = ref ScoreBoard

  (* Scoreboard view *)
  and scoreboard_disp () =
    text1 1 black "score board";
    text4 1 grey "match list >";
    hl();
    let scores = List.sort
      (fun (_, sc) (_, sc') -> sc' - sc)
      (C.scores())
    in
    let show_sc i (n, s) =
      text2 (i+4) black (string_of_int (i+1)^". ");
      text3 (i+4) black n;
      text4 (i+4) black (string_of_int s)
    in
    List.iteri show_sc scores

  (* Match list view *)
  and matchlist_disp show_only_running =
    text1 1 black "match list";
    text2 1 black "queued matches:";
    text3 1 black (string_of_int (C.ql ()));
    text4 1 grey "score board >";
    hl();
    let games =
      if show_only_running then
        List.filter
          (fun g -> match C.p1 g, C.p2 g with Dead, Dead -> false | _ -> true)
          (C.games())
      else C.games()
    in
    let time = Unix.gettimeofday() in
    let print_g i g =
      let cp1, cp2 = match C.s g with
      | TurnOf _ -> black, black
      | Won P1 -> green, red
      | Won P2 -> red, green
      | Tie -> grey, grey
      | Eliminated P1 -> red, grey
      | Eliminated P2 -> grey, red
      in
      let mp = function
        | Loading -> grey, ">>>"
        | Saving -> grey, "<<<"
        | Dead -> black, ""
        | StandBy t -> grey, Format.sprintf "%.2f" t
        | Thinking (t, tb) -> black,
          Format.sprintf "[ %.2f ]" (t -. (time -. tb))
      in
      let p1n, p2n = C.pn g in
      let c, m = mp (C.p1 g) in text1 (i+4) c m;
      text2 (i+4) cp1 p1n;
      text3 (i+4) cp2 p2n;
      let c, m = mp (C.p2 g) in text4 (i+4) c m
    in
    List.iteri print_g games

  (* 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 ();
      UI.display ()
    done with
      Exit_judge ->
        C.finish ();
        UI.close ()
    end

end