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