diff options
Diffstat (limited to 'src/main.ml')
-rwxr-xr-x | src/main.ml | 241 |
1 files changed, 241 insertions, 0 deletions
diff --git a/src/main.ml b/src/main.ml new file mode 100755 index 0000000..3b83e85 --- /dev/null +++ b/src/main.ml @@ -0,0 +1,241 @@ +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 ~prefix:(u"-> ") ~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.Refs.Single None) in + begin match Sheet.search (`Pattern (Some 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 ~prefix:(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 + | ("repr", file) -> (* Save the file *) + let out_gv = open_out_bin file in + let form = Format.formatter_of_out_channel out_gv in + Evaluator.repr form (Evaluator.get_catalog ()); + close_out out_gv; + normal_mode @@ redraw t screen + | ("enew", _) -> (* Start a new spreadsheet *) + normal_mode @@ redraw (Sheet.create Sheet.Raw.empty) screen + | ("q", _) -> (* Quit *) + t + | _ -> normal_mode @@ redraw t screen +end + +let () = begin + + let sheet = + if Array.length Sys.argv = 1 then + Sheet.Raw.empty + else + Odf.load Sys.argv.(1) in + + Screen.run (fun window -> + ignore @@ normal_mode @@ redraw (Sheet.create sheet) window) +end |