From 4e40826add9dc1287b2d250c42c5f7b3b4bb3a5d Mon Sep 17 00:00:00 2001 From: "Michael D. Lowis" Date: Tue, 24 Oct 2017 11:11:46 -0400 Subject: [PATCH] Added scrollmap and remove some unnecessary functions --- Makefile | 4 +- edit.ml | 24 +- lib/buf.ml | 19 +- ...e.sync-conflict-20171023-192447-NVTQWLE.ml | 294 ------------------ lib/scrollmap.ml | 8 + lib/scrollmap.mli | 2 + lib/tide.ml | 8 - lib/tide.mli | 3 - lib/x11_prims.c | 8 +- 9 files changed, 32 insertions(+), 338 deletions(-) delete mode 100644 lib/rope.sync-conflict-20171023-192447-NVTQWLE.ml create mode 100644 lib/scrollmap.ml create mode 100644 lib/scrollmap.mli delete mode 100644 lib/tide.ml delete mode 100644 lib/tide.mli diff --git a/Makefile b/Makefile index 30f86ca..ebe4d59 100644 --- a/Makefile +++ b/Makefile @@ -4,7 +4,7 @@ INCS = -I . -I lib -I /usr/X11R6/include -I /usr/include/freetype2 -I /usr/X11R6 LIBS = -L/usr/X11R6/lib -lX11 -lXft -lfontconfig ifeq ($(NATIVE), 1) - OC = ocamlopt + OC = ocamlopt OCFLAGS = -g MKLIB = ocamlmklib MKLIBFLAGS = -custom @@ -27,11 +27,11 @@ BINS = edit tests LIBOBJS = \ lib/test.$(OBJEXT) \ lib/misc.$(OBJEXT) \ - lib/tide.$(OBJEXT) \ lib/x11.$(OBJEXT) \ lib/cfg.$(OBJEXT) \ lib/rope.$(OBJEXT) \ lib/buf.$(OBJEXT) \ + lib/scrollmap.$(OBJEXT) \ lib/x11_prims.o \ lib/misc_prims.o \ lib/utf8.o diff --git a/edit.ml b/edit.ml index 6b52ece..84dae0b 100644 --- a/edit.ml +++ b/edit.ml @@ -1,8 +1,8 @@ open X11 let font_times = font_load "Times New Roman:size=12" -let font_monaco = font_load "Monaco:size=10::antialias=true:autohint=true" -let font_verdana = font_load "Verdana:size=11:antialias=true:autohint=true" +let font_monaco = font_load "Monaco:size=10" +let font_verdana = font_load "Verdana:size=11" let font = font_verdana let tabglyph = 0x30 @@ -72,13 +72,12 @@ let draw_buffer pos width height = end); ((!y + font.height) < height) in - Buf.iter_from draw_char !edit_buf 0; + Buf.iter_from draw_char !edit_buf !edit_buf.start; pos let draw_edit pos width height = draw_dark_bkg (width - pos.x) (height - pos.y) pos; let pos = { x = pos.x + 2; y = pos.y + 2 } in - Buf.redraw !edit_buf pos.x pos.y width height; draw_buffer pos width height (* Event functions @@ -87,10 +86,11 @@ let onfocus focused = () (*print_endline "onfocus"*) let onkeypress mods rune = - () (*print_endline "onkeypress"*) + print_endline "scroll up" let onmousebtn mods btn x y pressed = - () (*print_endline "onmousebtn"*) + print_endline "scroll down"; + edit_buf := { !edit_buf with start = !edit_buf.start + 1} let onmousemove mods x y = () (*print_endline "onmousemove"*) @@ -127,15 +127,3 @@ let () = let win = make_window 640 480 in show_window win true; event_loop 50 onevent - -(* - let server = Tide.start_server () in - let nargs = Array.length Sys.argv in - for i = 1 to (nargs - 1) do - let arg = Sys.argv.(i) in - if (String.equal "--" arg) then - Tide.start_pty server (Array.sub Sys.argv i (nargs - i)) - else - Tide.edit_file server arg - done; -*) diff --git a/lib/buf.ml b/lib/buf.ml index c45d238..737e951 100644 --- a/lib/buf.ml +++ b/lib/buf.ml @@ -1,27 +1,27 @@ type cursor = { start : int; stop : int } -type buf = { path : string; rope : Rope.t } +type t = { + start : int; + path : string; + rope : Rope.t +} let font = X11.font_load "Verdana:size=11:antialias=true:autohint=true" let empty = - { path = ""; rope = Rope.empty } + { start = 0; path = ""; rope = Rope.empty } let load path = - { path = path; rope = Rope.from_string (Misc.load_file path) } + { start = 0; path = path; rope = Rope.from_string (Misc.load_file path) } -let redraw buf x y width height = - (*let width = (width - x) in*) - let nlines = ((height - y) / font.height) in - () +let rope buf = + buf.rope let iter_from fn buf i = Rope.iter_from fn buf.rope i - - (* let make_cursor buf start stop = @@ -38,6 +38,7 @@ let move_word count csr buf ext = let move_line count csr buf ext = () + *) (* Unit Tests *****************************************************************) diff --git a/lib/rope.sync-conflict-20171023-192447-NVTQWLE.ml b/lib/rope.sync-conflict-20171023-192447-NVTQWLE.ml deleted file mode 100644 index 333da3e..0000000 --- a/lib/rope.sync-conflict-20171023-192447-NVTQWLE.ml +++ /dev/null @@ -1,294 +0,0 @@ -exception Out_of_bounds of string - -type rope = - | Leaf of string * int * int - | Node of rope * rope * int - -type t = rope - -let empty = Leaf ("", 0, 0) - -let length = function - | Leaf (_,_,l) -> l - | Node (_,_,l) -> l - -let from_string s = - Leaf (s, 0, (String.length s)) - -let check_index rope i = - if i < 0 || i >= (length rope) then - raise (Out_of_bounds "Rope.check_index") - -let limit_index rope i = - if i < 0 then 0 - else if i > 0 && i >= (length rope) then - ((length rope) - 1) - else i - -let join left right = - let left_len = (length left) in - let right_len = (length right) in - if left_len == 0 then right - else if right_len == 0 then left - else Node (left, right, (length left) + (length right)) - -let rec split rope i = - if i < 0 || i > (length rope) then - raise (Out_of_bounds "Rope.split"); - match rope with - | Leaf (s,off,len) -> - (Leaf (s, off, i), Leaf (s, (off + i), len - (i))) - | Node (l,r,len) -> - let left_len = (length l) in - if i < left_len then - let (sl,sr) = (split l i) in - (sl, (join sr r)) - else - let (sl,sr) = (split r i) in - ((join l sl), sr) - -let rec getc rope i = - check_index rope i; - match rope with - | Leaf (s,off,_) -> (Char.code s.[off + i]) - | Node (l,r,len) -> - let left_len = (length l) in - if i < left_len then - getc l i - else - getc r (i - left_len) - -let last rope = - limit_index rope ((length rope) - 1) - -let is_bol rope pos = - if pos == 0 then true - else ((getc rope (pos-1)) == 0x0A) - -let is_eol rope pos = - if pos >= (last rope) then true - else let c = (getc rope (pos+1)) in - (c == 0x0A || c == 0x0D) - -let is_bow rope pos = false - -let is_eow rope pos = false - -let rec move_till step testfn rope pos = - if (testfn rope pos) then pos - else (move_till step testfn rope (pos + step)) - -let to_bol rope pos = - move_till (-1) is_bol rope pos - -let to_eol rope pos = - move_till (+1) is_eol rope pos - -let to_bow rope pos = - move_till (-1) is_bow rope pos - -let to_eow rope pos = - move_till (+1) is_eow rope pos - -let rec puts rope s i = - let (left,right) = split rope i in - let middle = from_string s in - (join (join left middle) right) - -let del rope i j = - let (l_left,l_right) = split rope i in - let (r_left,r_right) = split l_right (j - i) in - (join l_left r_right) - -let rec iter_from fn rope pos = - if pos < (length rope) && (fn (getc rope pos)) then - iter_from fn rope (pos + 1) - -let rec iteri_from fn rope pos = - if pos < (length rope) && (fn pos (getc rope pos)) then - iteri_from fn rope (pos + 1) - -let iteri fn rope = - iteri_from (fun i c -> (fn i c); true) rope 0 - -let iter fn rope = - iter_from (fun c -> (fn c); true) rope 0 - -let map fn rope = - let buf = Bytes.create (length rope) in - iteri (fun i c -> Bytes.set buf i (fn c)) rope; - from_string (Bytes.unsafe_to_string buf) - -let mapi fn rope = - let buf = Bytes.create (length rope) in - iteri (fun i c -> Bytes.set buf i (fn i c)) rope; - from_string (Bytes.unsafe_to_string buf) - -let gets rope i j = - let buf = Bytes.create (j - i) in - iteri_from - (fun n c -> - Bytes.set buf (n - i) (Char.chr (getc rope i)); - (n <= j)) - rope i; - Bytes.unsafe_to_string buf - -let to_string rope = - gets rope 0 (length rope) - -(* Unit Tests *****************************************************************) - -let run_unit_tests () = - let open Test in - (* length() tests *) - test "length : 0 for empty string" (fun () -> - let rope = Leaf("", 0, 0) in - assert( length rope == 0 ) - ); - test "length : equal to length of leaf" (fun () -> - let rope = Leaf("a", 0, 1) in - assert( length rope == 1 ) - ); - test "length : equal to sum of leaf lengths" (fun () -> - let rope = (join (Leaf("a", 0, 1)) (Leaf("a", 0, 1))) in - assert( length rope == 2 ) - ); - - (* join() tests *) - test "join : join two leaves into rope" (fun () -> - let left = Leaf("a", 0, 1) in - let right = Leaf("a", 0, 1) in - let rope = (join left right) in - assert( match rope with - | Node (l,r,2) -> (l == left && r == right) - | _ -> false) - ); - test "join : join a rope with a leaf (l to r)" (fun () -> - let left = join (Leaf("a", 0, 1)) (Leaf("a", 0, 1)) in - let right = Leaf("a", 0, 1) in - let rope = (join left right) in - assert( match rope with - | Node (l,r,3) -> (l == left && r == right) - | _ -> false) - ); - test "join : join a rope with a leaf (r to l)" (fun () -> - let left = Leaf("a", 0, 1) in - let right = join (Leaf("a", 0, 1)) (Leaf("a", 0, 1)) in - let rope = (join left right) in - assert( match rope with - | Node (l,r,3) -> (l == left && r == right) - | _ -> false) - ); - - (* getc() tests *) - test "getc : raise Out_of_bounds on negative index" (fun () -> - let rope = Leaf("a", 0, 1) in - try getc rope (-1); assert false - with Out_of_bounds _ -> assert true - ); - test "getc : raise Out_of_bounds on out of bounds index" (fun () -> - let rope = Leaf("a", 0, 1) in - try getc rope (2); assert false - with Out_of_bounds _ -> assert true - ); - test "getc : return index 0 of leaf" (fun () -> - let rope = Leaf("abc", 0, 3) in - assert( (getc rope (0)) == Char.code 'a' ); - ); - test "getc : return index 1 of leaf" (fun () -> - let rope = Leaf("abc", 0, 3) in - assert( (getc rope (1)) == Char.code 'b' ); - ); - test "getc : return index 2 of leaf" (fun () -> - let rope = Leaf("abc", 0, 3) in - assert( (getc rope (2)) == Char.code 'c' ); - ); - test "getc : return index 0 of rope" (fun () -> - let rope = Node((Leaf("a", 0, 1)), (Leaf("b", 0, 1)), 2) in - assert( (getc rope (0)) == Char.code 'a' ); - ); - test "getc : return index 1 of rope" (fun () -> - let rope = Node((Leaf("a", 0, 1)), (Leaf("b", 0, 1)), 2) in - assert( (getc rope (1)) == Char.code 'b' ); - ); - - (* puts() tests *) - test "puts : insert at index 0" (fun () -> - let rope = Leaf("bc", 0, 2) in - let rope = (puts rope "a" 0) in - assert( (length rope) == 3 ); - assert( (getc rope (0)) == Char.code 'a' ); - assert( (getc rope (1)) == Char.code 'b' ); - assert( (getc rope (2)) == Char.code 'c' ); - ); - test "puts : insert at index 1" (fun () -> - let rope = Leaf("ac", 0, 2) in - let rope = (puts rope "b" 1) in - assert( (length rope) == 3 ); - assert( (getc rope (0)) == Char.code 'a' ); - assert( (getc rope (1)) == Char.code 'b' ); - assert( (getc rope (2)) == Char.code 'c' ); - ); - test "puts : insert index at 2" (fun () -> - let rope = Leaf("ab", 0, 2) in - let rope = (puts rope "c" 2) in - assert( (length rope) == 3 ); - assert( (getc rope (0)) == Char.code 'a' ); - assert( (getc rope (1)) == Char.code 'b' ); - assert( (getc rope (2)) == Char.code 'c' ); - ); - - (* is_bol() tests *) - test "is_bol : should return true if pos is 0" (fun () -> - let rope = Leaf("abc", 0, 3) in - assert( is_bol rope 0 ); - ); - test "is_bol : should return true if pos is first char of line" (fun () -> - let rope = Leaf("\nabc", 0, 3) in - assert( is_bol rope 1 ); - ); - test "is_bol : should return false if pos is not first char of line" (fun () -> - let rope = Leaf("\nabc", 0, 3) in - assert( (is_bol rope 2) == false ); - ); - test "is_bol : should return false if previous char is not \n" (fun () -> - let rope = Leaf("\rabc", 0, 3) in - assert( (is_bol rope 1) == false ); - ); - - (* is_eol() tests *) - test "is_eol : should return true if pos is Rope.last" (fun () -> - let rope = Leaf("abc", 0, 3) in - assert( is_eol rope 2 ); - ); - test "is_eol : should return true if pos is last char of line with \n ending" (fun () -> - let rope = Leaf("abc\n", 0, 4) in - assert( is_eol rope 2 ); - ); - test "is_eol : should return true if pos is last char of line with \r\n ending" (fun () -> - let rope = Leaf("abc\r\n", 0, 5) in - assert( is_eol rope 2 ); - ); - test "is_eol : should return false if pos is not last char of line" (fun () -> - let rope = Leaf("abcd\n", 0, 5) in - assert( (is_eol rope 2) == false ); - ); - () - -(* - -size_t buf_lscan(Buf* buf, size_t pos, Rune r); -size_t buf_rscan(Buf* buf, size_t pos, Rune r); -void buf_getword(Buf* buf, bool ( *isword)(Rune), Sel* sel); -void buf_getblock(Buf* buf, Rune beg, Rune end, Sel* sel); -size_t buf_byrune(Buf* buf, size_t pos, int count); -size_t buf_byword(Buf* buf, size_t pos, int count); -size_t buf_byline(Buf* buf, size_t pos, int count); -void buf_find(Buf* buf, int dir, size_t* beg, size_t* end); -void buf_findstr(Buf* buf, int dir, char* str, size_t* beg, size_t* end); -void buf_lastins(Buf* buf, size_t* beg, size_t* end); -size_t buf_setln(Buf* buf, size_t line); -size_t buf_getcol(Buf* buf, size_t pos); -size_t buf_setcol(Buf* buf, size_t pos, size_t col); - -*) diff --git a/lib/scrollmap.ml b/lib/scrollmap.ml new file mode 100644 index 0000000..404b000 --- /dev/null +++ b/lib/scrollmap.ml @@ -0,0 +1,8 @@ +type t = { + index : int; + map : int array +} + +let make buf off = + let bol = (Rope.to_bol (Buf.rope buf) off) in + { index = 0; map = [||] } diff --git a/lib/scrollmap.mli b/lib/scrollmap.mli new file mode 100644 index 0000000..1d37c0a --- /dev/null +++ b/lib/scrollmap.mli @@ -0,0 +1,2 @@ +type t +val make : Buf.t -> int -> t diff --git a/lib/tide.ml b/lib/tide.ml deleted file mode 100644 index cea3bff..0000000 --- a/lib/tide.ml +++ /dev/null @@ -1,8 +0,0 @@ -let start_server () = - 42 - -let start_pty server cmd = - () - -let edit_file server file = - () diff --git a/lib/tide.mli b/lib/tide.mli deleted file mode 100644 index 51191b8..0000000 --- a/lib/tide.mli +++ /dev/null @@ -1,3 +0,0 @@ -val start_server : unit -> int -val start_pty : int -> string array -> unit -val edit_file : int -> string -> unit diff --git a/lib/x11_prims.c b/lib/x11_prims.c index c43193e..3126ccf 100644 --- a/lib/x11_prims.c +++ b/lib/x11_prims.c @@ -126,15 +126,15 @@ CAMLprim value x11_event_loop(value ms, value cbfn) { uint64_t t = getmillis(); while (XPending(X.display)) { XNextEvent(X.display, &e); - printf("%d ", e.type); + //printf("%d ", e.type); if (!XFilterEvent(&e, None) && EventHandlers[e.type]) { event = EventHandlers[e.type](&e); if (event != Val_int(TNone)) caml_callback(cbfn, event); } } - puts(""); - printf("time 1 %lu ", getmillis()-t); + //puts(""); + //printf("time 1 %lu ", getmillis()-t); t = getmillis(); if (X.running) { caml_callback(cbfn, mkvariant(TUpdate, 2, Val_int(X.width), Val_int(X.height))); @@ -148,7 +148,7 @@ CAMLprim value x11_event_loop(value ms, value cbfn) { } XCopyArea(X.display, X.pixmap, X.self, X.gc, 0, 0, X.width, X.height, 0, 0); } - printf("\ntime 2 %lu\n", getmillis()-t); + //printf("\ntime 2 %lu\n", getmillis()-t); XFlush(X.display); } CAMLreturn(Val_unit); -- 2.52.0