From: Michael D. Lowis <mike@mdlowis.com>
Date: Wed, 11 Oct 2017 02:26:11 +0000 (-0400)
Subject: replaced imperative iterator with more idiomatic iter_from function
X-Git-Url: https://git.mdlowis.com/?a=commitdiff_plain;h=e71716efb78d2437ed14dd442ef13e8cf6fed779;p=archive%2Ftide-ocaml.git

replaced imperative iterator with more idiomatic iter_from function
---

diff --git a/edit.ml b/edit.ml
index 848d7e2..d1215f9 100644
--- a/edit.ml
+++ b/edit.ml
@@ -2,6 +2,8 @@ open X11
 
 (*let font = font_load "Times New Roman:pixelsize=14"*)
 let font = font_load "Monospace:size=10"
+let tags_buf = ref Buf.create
+let edit_buf = ref Buf.create
 
 (* Drawing functions
  ******************************************************************************)
@@ -91,6 +93,8 @@ let onevent = function
 (* Main Routine
  ******************************************************************************)
 let () =
+  if Array.length Sys.argv > 1 then
+    edit_buf := Buf.load Sys.argv.(1);
   let win = make_window 640 480 in
   show_window win true;
   event_loop 50 onevent
diff --git a/lib/buf.ml b/lib/buf.ml
index bb811be..cb0c025 100644
--- a/lib/buf.ml
+++ b/lib/buf.ml
@@ -23,6 +23,9 @@ type buf = {
   redo : bufstate list;
 }
 
+let iter_from fn buf i =
+  Rope.iter_from fn buf i
+
 let create =
   let state = { nlines = 0; outpoint = 0; rope = Rope.empty }
   and info  = { path = ""; modtime = 0; charset = Utf8; crlf = Unix } in
diff --git a/lib/rope.ml b/lib/rope.ml
index 128adc5..f072b3e 100644
--- a/lib/rope.ml
+++ b/lib/rope.ml
@@ -45,7 +45,7 @@ let rec getc rope i =
   check_index rope i;
   match rope with
   | Leaf (s,off,_) -> s.[off + i]
-  | Node (l,r,len)   ->
+  | Node (l,r,len) ->
       let left_len = (length l) in
       if i < left_len then
         getc l i
@@ -62,43 +62,19 @@ let del rope i j =
   let (r_left,r_right) = split l_right (j - i) in
   (join l_left r_right)
 
-module Iter = struct
-  type t = {
-    rope: rope;
-    length: int;
-    mutable pos: int;
-  }
-
-  let make rope index =
-    check_index rope index;
-    { rope = rope; length = (length rope); pos = index }
-
-  let pos itr = itr.pos
-
-  let incr itr = itr.pos <- (itr.pos + 1)
-
-  let decr itr = itr.pos <- (itr.pos - 1)
-
-  let goto itr pos= itr.pos <- pos
-
-  let move itr off = itr.pos <- (itr.pos + off)
-
-  let get itr = getc itr.rope itr.pos
-
-  let has_next itr = (itr.pos + 1) <= itr.length
+let rec iter_from fn rope pos =
+  if pos < (length rope) && (fn (getc rope pos)) then
+    iter_from fn rope (pos + 1)
 
-  let has_prev itr = (itr.pos - 1) > 0
-end
+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 =
-  let it = Iter.make rope 0 in
-  while (Iter.has_next it) do
-    fn (Iter.pos it) (Iter.get it);
-    Iter.incr it
-  done
+  iteri_from (fun i c -> (fn i c); true) rope 0
 
 let iter fn rope =
-  iteri (fun i c -> (fn c)) rope
+  iter_from (fun c -> (fn c); true) rope 0
 
 let map fn rope =
   let buf = Bytes.create (length rope) in
@@ -111,12 +87,12 @@ let mapi fn rope =
   from_string (Bytes.unsafe_to_string buf)
 
 let gets rope i j =
-  let buf = Bytes.create (j - i)
-  and it  = Iter.make rope 0 in
-  while (Iter.has_next it) && ((Iter.pos it) <= j) do
-    Bytes.set buf ((Iter.pos it) - i) (Iter.get it);
-    Iter.incr it;
-  done;
+  let buf = Bytes.create (j - i) in
+  iteri_from
+    (fun n c ->
+      Bytes.set buf (n - i) (getc rope i);
+      (n <= j))
+    rope i;
   Bytes.unsafe_to_string buf
 
 let to_string rope =
diff --git a/lib/x11_prims.c b/lib/x11_prims.c
index 0b22879..5daf87a 100644
--- a/lib/x11_prims.c
+++ b/lib/x11_prims.c
@@ -261,13 +261,13 @@ CAMLprim value x11_draw_glyph(value color, value glyph, value coord) {
         .x     = intfield(coord,0) + intfield(glyph,4),
         .y     = intfield(coord,1) + font->ascent
     };
-    printf("c: '%c' w: %d x: %d y: %d xoff: %d yoff: %d\n",
-        intfield(glyph,2),
-        intfield(glyph,3),
-        intfield(glyph,4),
-        intfield(glyph,5),
-        intfield(glyph,6),
-        intfield(glyph,7));
+//    printf("c: '%c' w: %d x: %d y: %d xoff: %d yoff: %d\n",
+//        intfield(glyph,2),
+//        intfield(glyph,3),
+//        intfield(glyph,4),
+//        intfield(glyph,5),
+//        intfield(glyph,6),
+//        intfield(glyph,7));
     XftColor fgc;
     xftcolor(&fgc, Int_val(color));
     XftDrawGlyphFontSpec(X.xft, &fgc, &spec, 1);