From: Michael D. Lowis Date: Fri, 10 Nov 2017 02:47:10 +0000 (-0500) Subject: updated drawing code to draw scrollbar thumb based on visible part of the file X-Git-Url: https://git.mdlowis.com/?a=commitdiff_plain;h=72a6a15e57e691a1fe8c7ed617bcbbdd87b67c0d;p=archive%2Ftide-ocaml.git updated drawing code to draw scrollbar thumb based on visible part of the file --- diff --git a/docs/Buf.html b/docs/Buf.html index e7943e7..f2246c7 100644 --- a/docs/Buf.html +++ b/docs/Buf.html @@ -99,6 +99,7 @@ 
val empty : buf
val load : string -> buf
+
val length : buf -> int
val iteri : (int -> Rope.rune -> bool) -> buf -> int -> unit
val iter : (Rope.rune -> bool) -> buf -> int -> unit
module Cursor: sig .. end
diff --git a/docs/Draw.Cursor.html b/docs/Draw.Cursor.html index d2fe5f0..20875f9 100644 --- a/docs/Draw.Cursor.html +++ b/docs/Draw.Cursor.html @@ -73,6 +73,8 @@ 
val make : int * int -> int -> int -> t
+
val clone : t -> t
+
val move_x : t -> int -> unit
val max_width : t -> int
val restart : t -> int -> int -> t
val next_line : t -> unit
diff --git a/docs/Draw.html b/docs/Draw.html index 0bfe7fa..867004a 100644 --- a/docs/Draw.html +++ b/docs/Draw.html @@ -42,8 +42,8 @@ 
val string : string -> Cursor.t -> unit
val hrule : int -> Cursor.t -> unit
val vrule : int -> Cursor.t -> unit
-
val buffer : Cursor.t -> Buf.t -> int -> unit
+
val buffer : Cursor.t -> Buf.t -> int -> int
val status : Cursor.t -> string -> unit
val tags : Cursor.t -> 'a -> unit
-
val scroll : Cursor.t -> unit
-
val edit : Cursor.t -> Buf.t -> int -> unit
\ No newline at end of file +
val scroll : Cursor.t -> float -> unit
+
val edit : Cursor.t -> Buf.t -> int -> int
\ No newline at end of file diff --git a/docs/Rope.html b/docs/Rope.html index 56ebad4..cd7d93a 100644 --- a/docs/Rope.html +++ b/docs/Rope.html @@ -62,7 +62,6 @@ 
val length : t -> int
val height : t -> int
val is_leaf : t -> bool
-
val is_leaf : t -> bool
val limit_index : t -> int -> int
val last : t -> int
val check_index : t -> int -> unit
diff --git a/docs/index_values.html b/docs/index_values.html index 05bcc0c..8e33641 100644 --- a/docs/index_values.html +++ b/docs/index_values.html @@ -41,6 +41,8 @@ check_index [Rope] +clone [Draw.Cursor] + clone [Buf.Cursor] clrvar [Cfg] @@ -200,6 +202,8 @@
L last [Rope] +length [Buf] + length [Rope] light_bkg [Draw] @@ -237,6 +241,8 @@ move_to [Buf] +move_x [Draw.Cursor] +
N next_glyph [Draw.Cursor] diff --git a/docs/type_Draw.Cursor.html b/docs/type_Draw.Cursor.html index 060e514..c98866d 100644 --- a/docs/type_Draw.Cursor.html +++ b/docs/type_Draw.Cursor.html @@ -26,6 +26,8 @@     mutable y : int;
  }
  val make : int * int -> int -> int -> Draw.Cursor.t
+  val clone : Draw.Cursor.t -> Draw.Cursor.t
+  val move_x : Draw.Cursor.t -> int -> unit
  val max_width : Draw.Cursor.t -> int
  val restart : Draw.Cursor.t -> int -> int -> Draw.Cursor.t
  val next_line : Draw.Cursor.t -> unit
diff --git a/edit.ml b/edit.ml index 1b3b4cc..b53ba94 100644 --- a/edit.ml +++ b/edit.ml @@ -1,10 +1,14 @@ open X11 module View = struct - type t = { buf : Buf.t; map : Scrollmap.t } + type t = { + num : int; + buf : Buf.t; + map : Scrollmap.t + } let from_buffer buf width height = - { buf = buf; map = Scrollmap.make buf width 0 } + { num = 0; buf = buf; map = Scrollmap.make buf width 0 } let empty width height = from_buffer (Buf.empty) width height @@ -17,14 +21,18 @@ module View = struct let draw view csr = let view = (resize view (Draw.Cursor.max_width csr)) in - Draw.buffer csr view.buf (Scrollmap.first view.map); - view + let num = Draw.buffer csr view.buf (Scrollmap.first view.map) in + { view with num = num } let scroll_up view = { view with map = Scrollmap.scroll_up view.map view.buf } let scroll_dn view = { view with map = Scrollmap.scroll_dn view.map view.buf } + + let visible view = + (float_of_int view.num) /. (float_of_int (Buf.length view.buf)) + end let tags_buf = ref Buf.empty @@ -52,8 +60,10 @@ let onupdate width height = let csr = Draw.Cursor.make (width, height) 0 0 in Draw.status csr "UNSI> *scratch*"; Draw.tags csr !tags_buf; - Draw.scroll csr; - edit_view := View.draw !edit_view csr + let scrollcsr = (Draw.Cursor.clone csr) in + Draw.Cursor.move_x csr 15; + edit_view := View.draw !edit_view csr; + Draw.scroll scrollcsr (View.visible !edit_view) let onshutdown () = () diff --git a/lib/buf.ml b/lib/buf.ml index 94a6fbb..ef6f37a 100644 --- a/lib/buf.ml +++ b/lib/buf.ml @@ -16,6 +16,9 @@ let empty = let load path = { path = path; rope = Rope.from_string (Misc.load_file path) } +let length buf = + Rope.length buf.rope + let iteri fn buf i = Rope.iteri fn buf.rope i diff --git a/lib/buf.mli b/lib/buf.mli index 496882d..57f6304 100644 --- a/lib/buf.mli +++ b/lib/buf.mli @@ -36,6 +36,7 @@ end val empty : t val load : string -> t +val length : t -> int val iter : (int -> bool) -> t -> int -> unit val iteri : (int -> int -> bool) -> t -> int -> unit diff --git a/lib/draw.ml b/lib/draw.ml index 8cafd26..9cbf0c3 100644 --- a/lib/draw.ml +++ b/lib/draw.ml @@ -22,6 +22,14 @@ module Cursor = struct { height = height; width = width; startx = x; starty = y; x = x; y = y } + let clone csr = + { height = csr.height; width = csr.width; + startx = csr.startx; starty = csr.starty; + x = csr.x; y = csr.y } + + let move_x csr n = + csr.x <- csr.x + n + let max_width csr = (csr.width - csr.x) @@ -92,12 +100,14 @@ let vrule height csr = let buffer csr buf off = dark_bkg (csr.width - csr.x) (csr.height - csr.y) csr; - let csr = (restart csr 2 0) in + let num = ref 0 and csr = (restart csr 2 0) in let draw_rune c = draw_glyph csr c; + num := !num + 1; has_next_line csr in - Buf.iter draw_rune buf off + Buf.iter draw_rune buf off; + !num let status csr str = dark_bkg csr.width (4 + font_height) csr; @@ -111,9 +121,10 @@ let tags csr buf = string "Quit Save Undo Redo Cut Copy Paste | Find " csr; hrule csr.width csr -let scroll csr = +let scroll csr pct = + let thumbsz = int_of_float ((float_of_int csr.height) *. pct) in rule_bkg 14 csr.height csr; - dark_bkg 14 (csr.height / 2) csr; + dark_bkg 14 thumbsz csr; csr.x <- csr.x + 14; vrule csr.height csr diff --git a/lib/draw.mli b/lib/draw.mli index 592a2c3..c71bf5f 100644 --- a/lib/draw.mli +++ b/lib/draw.mli @@ -1,6 +1,8 @@ module Cursor : sig type t val make : (int * int) -> int -> int -> t + val clone : t -> t + val move_x : t -> int -> unit val max_width : t -> int val restart : t -> int -> int -> t val next_line : t -> unit @@ -16,7 +18,7 @@ val dark_bkg : int -> int -> Cursor.t -> unit val light_bkg : int -> int -> Cursor.t -> unit val rule_bkg : int -> int -> Cursor.t -> unit -val buffer : Cursor.t -> Buf.t -> int -> unit +val buffer : Cursor.t -> Buf.t -> int -> int val string : string -> Cursor.t -> unit val hrule : int -> Cursor.t -> unit @@ -24,5 +26,5 @@ val vrule : int -> Cursor.t -> unit val status : Cursor.t -> string -> unit val tags : Cursor.t -> Buf.t -> unit -val scroll : Cursor.t -> unit -val edit : Cursor.t -> Buf.t -> int -> unit +val scroll : Cursor.t -> float -> unit +val edit : Cursor.t -> Buf.t -> int -> int diff --git a/lib/rope.ml b/lib/rope.ml index d8211a2..d975940 100644 --- a/lib/rope.ml +++ b/lib/rope.ml @@ -26,10 +26,6 @@ let is_leaf = function | Leaf _ -> true | _ -> false -let is_leaf = function - | Leaf _ -> true - | _ -> false - let limit_index rope i = if i < 0 then 0 else if i > 0 && i >= (length rope) then @@ -79,7 +75,7 @@ let rec getc rope i = (* inefficient form of iteri *) let rec iteri fn rope pos = - if pos < (length rope) && (fn pos (getc rope pos)) then + if pos < (length rope) && (fn pos (Char.code (getb rope pos))) then iteri fn rope (pos + 1) (* More efficient form of iteri? @@ -113,6 +109,53 @@ let gets rope i j = (******************************************************************************) +(* Rebalancing: + +* Height of leaf is 0 +* Height of a node is (1 + max(left,right)) +* Rope balanced if (length >= Fib(n) + 2) + + +The rebalancing operation maintains an ordered sequence of (empty or) balanced +ropes, one for each length interval [Fn, Fn+1), for n $2. + +We traverse the rope from left to right, inserting each leaf into the +appropriate sequence position, depending on its length. + +The concatenation of the sequence of ropes in order of decreasing length is +equivalent to the prefix of the rope we have traversed so far. + +Each new leaf x is inserted into the appropriate entry of the sequence. + +Assume that x's length is in the interval [Fib(n), Fib(n+1)], and thus it should be put +in slot n (which also corresponds to maximum depth n - 2). + +If all lower and equal numbered levels are empty, then this can be done directly. + +If not, then we concatenate ropes in slots 2,. . .,(n - 1) (concatenating onto +the left), and concatenate x to the right of the result. + +We then continue to concatenate ropes from the sequence in increasing order to +the left of this result, until the result fits into an empty slot in the sequence. + +The concatenation we form in this manner is guaranteed to be balanced. + +The concatenations formed before the addition of x each have depth at most one more +than is warranted by their length. + +If slot n - 1 is empty then the concatenation of shorter ropes has depth at most +n - 3, so the concatenation with x has depth n - 2, and is thus balanced. + +If slot n - 1 is full, then the final depth after adding x may be n - 1, but the +resulting length is guaranteed to be at least Fn+1, again guaranteeing +balance. + +Subsequent concatenations (if any) involve concatenating two balanced ropes with +lengths at least Fm and Fm-1 and producing a rope of depth m - 1, which must +again be balanced. + +*) + let flatten rope = let s = (gets rope 0 (length rope)) in Leaf (s,0,(String.length s)) diff --git a/lib/x11_prims.c b/lib/x11_prims.c index c43193e..2e03ef0 100644 --- a/lib/x11_prims.c +++ b/lib/x11_prims.c @@ -126,14 +126,12 @@ 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); 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); t = getmillis(); if (X.running) {