let u = UTF8.from_utf8string

let redraw t screen =
  let screen' =
     Screen.draw t screen
  |> Screen.draw_input t in
  t, screen'

let action f msg (t, screen) = begin
  let t', count = f t in
  let t', screen' = redraw t' screen in
  Screen.status screen' @@ UTF8.from_utf8string (Printf.sprintf msg count);
  t', screen'
end

let f screen = ActionParser.(
  begin match Screen.read_key screen with
  | "\027"      -> ESC
  | "\001\002"  -> DOWN
  | "\001\003"  -> UP
  | "\001\004"  -> LEFT
  | "\001\005"  -> RIGHT
  | "\001\006"  -> HOME
  | "\001\104"  -> END

  | "\001R"     -> NPAGE
  | "\001S"     -> PPAGE

    (* See http://www.ibb.net/~anne/keyboard.html for thoses keycode. *)
  | "\001\074"|"\127" -> DELETE

  | "e"         -> E
  | "u"         -> U
  | "v"         -> V
  | "y"         -> Y
  | "p"         -> P
  | "="         -> EQUAL
  | "/"         -> SEARCH
  | ":"         -> COMMAND

  | "\001\154"  -> RESIZE
  | "\001\153"  ->
    begin match Tools.NCurses.get_mouse_event () with
    | None -> raise Not_found
    | Some (id, ev, (x, y, z)) ->
        if Tools.NCurses.is_event_of_type Tools.NCurses.BUTTON1_CLICKED ev then
          BUTTON1_CLICKED(x, y)
        else if Tools.NCurses.is_event_of_type Tools.NCurses.BUTTON1_PRESSED ev then
          BUTTON1_CLICKED(x, y)
        else if Tools.NCurses.is_event_of_type Tools.NCurses.BUTTON1_RELEASED ev then
          BUTTON1_RELEASED(x, y)
        else
          raise Not_found
    end
  | _ -> raise Not_found
end)

let parser screen = begin
  let get_value () = f screen, Lexing.dummy_pos, Lexing.dummy_pos in
  MenhirLib.Convert.Simplified.traditional2revised ActionParser.normal get_value
end

let rec normal_mode (t, screen) = begin
  match (parser screen) with
  | exception x -> normal_mode (t, screen)

  | Actions.Visual ->
      Screen.status screen @@ u"-- Selection --";
      selection_mode (t, screen)

  | Actions.Move direction ->
      begin match Sheet.move direction t with
      | Some t' -> normal_mode @@ redraw t' screen
      | None -> normal_mode (t, screen)
      end

  | Actions.Resize -> normal_mode (t, Screen.resize t screen)

  | Actions.Delete ->
      let yank_before_delete = fun x -> Sheet.delete (fst (Sheet.yank x)) in
      normal_mode @@ action yank_before_delete "Deleted %d cells" (t, screen)

  | Actions.Yank ->
      normal_mode @@ action Sheet.yank "Yanked %d cells" (t, screen)

  | Actions.Paste ->
      normal_mode @@ action Sheet.paste "Pasted %d cells" (t, screen)

  | Actions.Undo ->
      begin match Sheet.undo t with
      | Some t' -> normal_mode @@ redraw t' screen
      | None -> normal_mode (t, screen)
      end

  (* Edit a content *)
  | Actions.Edit ->
    let position = Selection.extract t.Sheet.selected in
    let expr = Sheet.Raw.get_expr position t.Sheet.data
            |> Expression.show in
    begin match Screen.editor ~position ~init:expr screen with
    | None ->
      (* Restore the previous value *)
      Screen.status screen expr;
      normal_mode (t, screen)
    | Some content ->
      let expr' = Expression.load content in
      let _, t' = Sheet.add expr' t in
      normal_mode @@ redraw t' screen
    end

  (* Insert a new formula, the actual value will be erased *)
  | Actions.InsertFormula ->
    let position = Selection.extract t.Sheet.selected in
    begin match Screen.editor ~position ~init:(u"=") screen with
    | None ->
      (* Restore the previous value *)
      let expr = Sheet.Raw.get_expr position t.Sheet.data
              |> Expression.show in
      Screen.status screen expr;
      normal_mode (t, screen)
    | Some content ->
      let expr = Expression.load content in
      let _, t' = Sheet.add expr t in
      normal_mode @@ redraw t' screen
    end

  | Actions.Search ->
    let expr = Screen.search screen
    |> Expression.load in
    let pattern = Expression.eval expr (fun _ -> ScTypes.Undefined) in
    begin match Sheet.search (`Pattern pattern) t with
    | Some t' -> normal_mode @@ redraw t' screen
    | None -> normal_mode (t, screen)
    end

  | Actions.Button1_clicked coord ->
    begin match Screen.get_cell screen coord with
    | None -> normal_mode (t, screen)
    | Some (x,y) -> begin match Sheet.move (Actions.Absolute (x,y)) t with
        | Some t' -> normal_mode @@ redraw t' screen
        | None -> normal_mode (t, screen)
      end
    end

  | Actions.Button1_released coord ->
    begin match Screen.get_cell screen coord with
    | Some (x,y) when (x,y) <> (Selection.extract t.Sheet.selected) ->
      Screen.status screen @@ u"-- Selection -- ";
      let t' = { t with
        Sheet.selected = Selection.extends (Actions.Absolute (x,y)) t.Sheet.selected
      } in
      let screen' = Screen.draw t' screen in
      selection_mode (t', screen')
    | _ -> normal_mode (t, screen)
    end

  | Actions.Command ->
    begin match Screen.editor ~init:(u":") screen with
    | None ->
      normal_mode (t, screen)
    | Some content ->
        let args = try
          UTF8.to_utf8string content
          |> Tools.String.split ~by:' '
        with Not_found ->
          (UTF8.to_utf8string content, "") in
        command (t, screen) args
    end

  | _ -> normal_mode (t, screen)

end

and selection_mode (t, screen) = begin
  match (parser screen) with
  | exception x -> selection_mode (t, screen)

  | Actions.Resize -> selection_mode (t, Screen.resize t screen)

  | Actions.Delete ->
     let yank_before_delete = fun x -> Sheet.delete (fst (Sheet.yank x)) in
     normal_mode @@ action yank_before_delete "Deleted %d cells" (t, screen)

  | Actions.Yank ->
     normal_mode @@ action Sheet.yank "Yanked %d cells" (t, screen)

  | Actions.Escape ->
     let t' = { t with Sheet.selected = Selection.create (Selection.extract t.Sheet.selected) } in
     let screen' = Screen.draw t' screen
                |> Screen.draw_input t' in
     Screen.status screen UTF8.empty;
     normal_mode (t', screen')

  | Actions.Move m ->
     let t' = { t with Sheet.selected = Selection.extends m t.Sheet.selected } in
     let screen' = Screen.draw t' screen in
     selection_mode (t', screen')

  | Actions.Button1_clicked coord ->
    begin match Screen.get_cell screen coord with
    | None -> normal_mode (t, screen)
    | Some (x,y) -> begin match Sheet.move (Actions.Absolute (x,y)) t with
      | Some t' ->
          Screen.status screen UTF8.empty;
          normal_mode @@ redraw t' screen
      | None -> normal_mode (t, screen)
      end
    end

  | _ -> selection_mode (t, screen)
end

and command (t, screen) action = begin
  match action with
  | (":w", file) -> (* Save the file *)
      Odf.save t.Sheet.data file;
      normal_mode @@ redraw t screen
  | (":enew", _) -> (* Start a new spreadsheet *)
      let sheet = Sheet.Raw.create in
      normal_mode @@ redraw (Sheet.create sheet) screen
  | (":q", _) ->  (* Quit *)
      t
  | _ -> normal_mode @@ redraw t screen
end

let () = begin

  let sheet =
    if Array.length Sys.argv = 1 then
      Sheet.Raw.create
    else
      Odf.load Sys.argv.(1) in

  let window = Screen.init () in
  begin Tools.try_finally
    (fun () ->
      ignore @@ normal_mode @@ redraw (Sheet.create sheet) window)
    (fun () ->
      ignore @@ Screen.close window; )
  end
end