(** Curses submodules *)
module Attrs = Curses.A
module Color = Curses.Color

module T2 = Tools.Tuple2

let cell_size = 10

let u = UTF8.from_utf8string

type t = Sheet.t

type screen = {
  window: Curses.window;    (* the main window *)
  sheet: Curses.window;     (* the spreadsheet *)
  input: Curses.window;     (* the input window *)
  status: Curses.window;    (* status bar *)
  start: (int * int);       (* Left corner *)
  left_margin: int;         (* Reserved margin for rows name *)

  mutable size: int * int;  (* Terminal size *)
}

let get_cell screen (x, y) = begin

  let x' = (fst screen.start) + (x - screen.left_margin) / cell_size
  and y' = (snd screen.start) + y - 3 in

  if (x' < 1 || y' < 1) then
    None
  else
    Some (x', y')
end

let center data screen height width = begin
  let height' = height - 3
  and width'  = (width - screen.left_margin) / cell_size in
  let end_x = (fst screen.start) + width' -1 in
  let end_y = (snd screen.start) + height' -2 in

  let selected = Selection.extract data.Sheet.selected in

  let center_axis f replace max_limit shift screen = begin
    let selected_axis = f selected in
    match (selected_axis >= f screen.start), (selected_axis > max_limit) with
    | true, false  -> screen
    | _ -> { screen with  start = replace (max 1 (selected_axis - shift)) screen.start }
  end in
    center_axis T2.fst T2.replace1 end_x (width' / 2) screen
 |> center_axis T2.snd T2.replace2 end_y (height' / 2)
end

let status screen msg = begin
  let height, width = screen.size in
  let encoded = UTF8.encode msg in
  let status = Bytes.make (width -1) ' ' in
  Bytes.blit encoded 0 status 0 (String.length encoded);
  Curses.werase screen.status;
  if not (
    Curses.mvwaddstr screen.status 0 0 encoded
    && Curses.wrefresh screen.status
  ) then
    raise (Failure "Status update")
end

(** Draw the spreadsheet *)
let draw data screen = begin

  let selected = Selection.extract data.Sheet.selected in

  let referenced =
       Sheet.Raw.get_expr selected data.Sheet.data
    |> Expression.collect_sources

  and sink = Sheet.Raw.get_sink selected data.Sheet.data in

  let height, width = screen.size in
  let screen = center data screen height width in

  for y = 1 to (height-2) do
    let pos_y = (y + (snd screen.start) - 1) in
    if (Curses.has_colors ()) then begin
      if Selection.is_selected (Selection.Vertical pos_y) data.Sheet.selected then
        Curses.wattrset screen.sheet (Attrs.color_pair 2 )
      else
        Curses.wattrset screen.sheet (Attrs.color_pair 1 )
      end;
    ignore
    @@ Curses.mvwaddstr screen.sheet y 0
    @@ Printf.sprintf "%-*d" screen.left_margin pos_y
  done;
  Curses.wattrset screen.sheet Attrs.normal;

  for x = 0 to ((width - cell_size - screen.left_margin) / cell_size) do
    let pos_x = x + (fst screen.start) in
    if (Curses.has_colors ()) then begin
      if Selection.is_selected (Selection.Horizontal pos_x) data.Sheet.selected then
        Curses.wattrset screen.sheet (Attrs.color_pair 2 )
      else
        Curses.wattrset screen.sheet (Attrs.color_pair 1 )
      end;
    ignore
    @@ Curses.mvwaddstr screen.sheet 0 (x * cell_size + screen.left_margin)
    @@ Printf.sprintf "%-*s" cell_size (UTF8.encode @@ Cell.to_hname pos_x);
    Curses.wattrset screen.sheet Attrs.normal;
    for y = 1 to (height-2) do

      let pos_y = y + (snd screen.start) - 1 in

      if (Curses.has_colors ()) then begin
        if Selection.is_selected (Selection.Cell (pos_x, pos_y)) data.Sheet.selected then
          Curses.wattrset screen.sheet (Attrs.color_pair 3 )
        else if Cell.Set.mem (pos_x, pos_y) referenced then
          Curses.wattrset screen.sheet (Attrs.color_pair 4 )
        else if Cell.Set.mem (pos_x, pos_y) sink then
          Curses.wattrset screen.sheet (Attrs.color_pair 5 )
        else
          Curses.wattrset screen.sheet Attrs.normal;
      end;

      let content = Sheet.Raw.get_value (pos_x, pos_y) data.Sheet.data
               |> ScTypes.Result.show
               |> UTF8.split ~sep:(u"\n") in

      let value = UTF8.encode content
      and length = UTF8.length content in
      let strlength = String.length value in
      let blank = cell_size - length in
      let padding = if blank > 0
        then String.make blank ' '
        else "" in

      ignore
      @@ Curses.mvwaddnstr screen.sheet y (x * cell_size + screen.left_margin)
         (Printf.sprintf "%s%s" value padding)
         0 (blank + strlength)
    done
  done;
  ignore @@ Curses.wrefresh screen.sheet;
  screen

end

let init () = begin
  (* Do not set delay after ESC keycode *)
  begin try ignore @@ Unix.getenv "ESCDELAY" with
  | Not_found -> Unix.putenv "ESCDELAY" "25" end;

  let window = Curses.initscr () in
  let height, width = Curses.getmaxyx window in

  Tools.NCurses.set_mouse_event (Tools.NCurses.BUTTON1_CLICKED::[]);

  let init = Curses.keypad window true
  && Curses.noecho ()
  && Curses.start_color ()
  && Curses.use_default_colors ()

  (* Build the color map *)
  && Curses.init_pair 1 Color.white Color.blue  (* Titles *)
  && Curses.init_pair 2 Color.blue Color.white  (* Selected titles *)
  && Curses.init_pair 3 Color.black Color.white (* Selected cell *)
  && Curses.init_pair 4 Color.black Color.red   (* referenced cell *)
  && Curses.init_pair 5 Color.black Color.green (* sink cell *)
  && Curses.curs_set 0

  in
  if not init then
    raise (Failure "Initialisation")
  else
    {
      window = window;
      input = Curses.subwin window 2 width 0 0;
      sheet = Curses.subwin window (height - 3) width 2 0;
      status = Curses.subwin window 1 width (height - 1) 0;
      start = 1, 1;
      left_margin = 4;
      size = height, width;
    }
end

let close {window} = begin
  ignore @@ (Curses.keypad window false && Curses.echo ());
  Curses.endwin()
end

let draw_input t screen = begin

    let height, width = screen.size in

    let expr = Sheet.Raw.get_expr (Selection.extract t.Sheet.selected) t.Sheet.data
            |> Expression.show in

    (* Compute the difference between number of bytes in the string, and the
       number of character printed : Printf.sprintf format use the bytes number
       in the string, while Curses print the characters in the user encoding *)
    let result = Sheet.Raw.get_value (Selection.extract t.Sheet.selected) t.Sheet.data
    |> ScTypes.Result.show in
    let encoded_result = UTF8.encode result in
    let result_length_delta = (UTF8.length result) - (String.length encoded_result) in

    ignore (
       encoded_result
    |> Printf.sprintf "%-*s" (width - 11 - result_length_delta)
    |> Curses.mvwaddstr screen.input 0 10

    && Curses.wrefresh screen.input);
    status screen expr;
    screen
end

(** Wait for an event and return the key pressed
    The signal is always followed by NULL character (0x00)
    If the key code contains more than one char, they are both returned
 *)
let read_key {window} = begin
  let buff = Buffer.create 2 in
  let int_val = Curses.wgetch window in
  if int_val > 255 then
    Buffer.add_string buff @@ Tools.String.string_of_ints int_val
  else
    Buffer.add_char buff @@ char_of_int int_val;
  (** Check for a second key code *)
  ignore @@ Curses.nodelay window true;
  begin match Curses.wgetch window with
  | -1 -> ()
  | x ->  Buffer.add_char buff @@ char_of_int x;
  end;
  ignore @@ Curses.nodelay window false;
  let content = Buffer.contents buff in
  content
end

let resize data t = begin
  let size = Curses.getmaxyx t.window in
  if (size <> t.size) then (
    let height, width = size in
    t.size <- size;
    ignore (
       Curses.wresize t.input 2 width

    && Curses.wresize t.sheet (height - 3) width

    (* The status window *)
    && Curses.wresize t.status 1 width
    && Curses.mvwin t.status (height - 1) 0);
    Curses.wclear t.status;
    ignore @@ Curses.wrefresh t.status;
    draw data t
  ) else t
end

let editor ?position ?(prefix=UTF8.empty) ?(init=UTF8.empty) t = begin
  let encodedPrefix = UTF8.encode prefix
  and encodedInit = UTF8.encode init in
  let with_refs, position = match position with
  | None -> false, (1, 1)
  | Some x -> true, x in
  Curses.werase t.status;
  ignore @@ Curses.mvwaddstr t.status 0 0 (encodedPrefix^encodedInit);
  ignore @@ Curses.wrefresh t.status;

  (** Rewrite all the text after the cursor *)
  let rewrite_after = begin function
  | [] -> ()
  | elems -> ( (* Rewrite each char after the cursor *)
    let y, x = Curses.getyx t.status in
    List.iter (fun x -> ignore @@ Curses.waddstr t.status (UTF8.encode x)) elems;
    ignore @@ Curses.wmove t.status y x )
  end

  (** Delete the previous text (or block of text) *)
  and delete_previous hd = begin
    let y, x = Curses.getyx t.status in
    let length = UTF8.length hd in
    for position = 1 to length do
      ignore @@ Curses.wmove t.status y (x - position);
      ignore @@ Curses.wdelch t.status
    done;
  end in

  let rec _edit (before:UTF8.t list) after = begin function
  (* [before] contains all the caracters inserted before the cursor (reverse
     ordered), while [after] contains all the caracters after the cursor.
   *)
  | "\027" -> (* Escape, cancel the modifications *)
    None
  | "\010" -> (* Enter, validate the input *)
    Some (UTF8.implode @@ (UTF8.rev_implode before)::after)

  | "\001\004" -> (* Left *)
    begin match before with
    | [] -> _edit before after @@ read_key t
    | hd::tl ->
      let y, x = Curses.getyx t.status
      and length = UTF8.length hd in
      ignore @@ Curses.wmove t.status y (x - length);
      ignore @@ Curses.wrefresh t.status;
      _edit tl (hd::after) @@ read_key t
    end

  | "\001\005" -> (* Right *)
    begin match after with
    | [] -> _edit before after @@ read_key t
    | hd::tl ->
      let y, x = Curses.getyx t.status
      and length = UTF8.length hd in
      ignore @@ Curses.wmove t.status y (x + length);
      ignore @@ Curses.wrefresh t.status;
      _edit (hd::before) tl @@ read_key t
    end

  | "\001\007" ->   (* Backspace *)
    begin match before with
    | [] -> _edit before after @@ read_key t
    | hd::tl ->
      delete_previous hd;
      ignore @@ Curses.wrefresh t.status;
      _edit tl after @@ read_key t
    end

  | "\001\006" ->   (* Home *)
    begin match before with
    | [] -> _edit before after @@ read_key t
    | elems ->
        let to_left (size, after) elem = begin
          let size' = size + UTF8.length elem in
          size', elem::after
        end in
        let chars, after' = List.fold_left to_left (0, after) elems in
        let y, x = Curses.getyx t.status in
        ignore @@ Curses.wmove t.status y (x - chars);
        ignore @@ Curses.wrefresh t.status;
        _edit [] after' @@ read_key t
    end

  | "\001\104" ->   (* End *)
    begin match after with
    | [] -> _edit before after @@ read_key t
    | elems ->
        let to_rigth (size, before) elem = begin
          let size' = size + UTF8.length elem in
          size', elem::before
        end in
        let chars, before' = List.fold_left to_rigth (0, before) elems in
        let y, x = Curses.getyx t.status in
        ignore @@ Curses.wmove t.status y (x + chars);
        ignore @@ Curses.wrefresh t.status;
        _edit before' [] @@ read_key t
    end
  | "\001\074"
  | "\127" ->       (* Del *)
    begin match after with
    | [] ->  _edit before after @@ read_key t
    | hd::tl ->
      let y, x = Curses.getyx t.status in
      ignore @@ Curses.wmove t.status y (x + 1);
      delete_previous hd;
      ignore @@ Curses.wrefresh t.status;
      _edit before tl @@ read_key t
    end

  | ("\001\002" as key)     (* Down *)
  | ("\001\003" as key)     (* Up *)
  | ("\001\153" as key) ->  (* click *)
    if with_refs then
      select_content position (UTF8.empty) before after key
    else
      _edit before after @@ read_key t

  | any ->
    ignore @@ Curses.waddstr t.status any;
    rewrite_after after;
    ignore @@ Curses.wrefresh t.status;
    _edit (UTF8.decode any::before) after @@ read_key t
  end

  (* Selection mode, Left and Right keys allow to select a cell, and not to
     move inside the edition *)
  and select_content (x, y) name before after = begin
  function
  | "\001\002" -> (* Down *) insert_cell_name (x, y + 1) name before after
  | "\001\005" -> (* Right *) insert_cell_name (x + 1, y) name before after

  | "\001\003" -> (* Up *)
    if y > 1 then
      insert_cell_name (x, y - 1) name before after
    else select_content (x, y) name before after @@ read_key t

  | "\001\004" -> (* Left *)
    if x > 1 then
      insert_cell_name (x - 1, y) name before after
    else select_content (x, y) name before after @@ read_key t

  | "\001\153" -> (* click *)
    let position =
    begin match Tools.NCurses.get_mouse_event () with
    | None -> None
    | Some (id, ev, (x, y, z)) ->
        if Tools.NCurses.is_event_of_type Tools.NCurses.BUTTON1_CLICKED ev
        || Tools.NCurses.is_event_of_type Tools.NCurses.BUTTON1_PRESSED ev then
          get_cell t (x,y)
        else
          None
    end in
    begin match position with
    | None -> select_content (x, y) name before after @@ read_key t
    | Some (x, y) -> insert_cell_name (x, y) name before after
    end

  | key ->
    _edit (UTF8.fold List.cons name before) after key
  end

  and insert_cell_name position name before after = begin
    let cell_name = Cell.to_string @@ (position, (false, false)) in
    ignore @@ delete_previous name;
    ignore @@ Curses.waddstr t.status (UTF8.encode cell_name);
    rewrite_after after;
    ignore @@ Curses.wrefresh t.status;
    select_content position cell_name before after @@ read_key t
  end
  in

  ignore @@ Curses.curs_set 1;
  let mode = if with_refs then
    select_content position (UTF8.empty)
  else
    _edit in
  let res = mode (UTF8.rev_explode init) [] @@ read_key t in
  ignore @@ Curses.curs_set 0;
  res


end

let search screen = begin
  let result = editor ~prefix:(u"/") screen in
  begin match result with
  | Some content -> content
  | None -> UTF8.empty
  end
end

let read_input position screen = begin
  let result = editor ~position ~init:(u"=") screen in
  begin match result with
  | Some content -> content
  | None -> UTF8.empty
  end
end