First, buggy, attempt at scrolling using a scrollmap. First line seems to disappear...

diff --git a/edit.ml b/edit.ml
index b51ed485b68ed4f0c0feab8bba748719d6c983b3..0e13580b467824551fb055c8759596935d533611 100644 (file)
--- a/edit.ml
+++ b/edit.ml
@@ -1,7 +1,35 @@
 open X11
 
+module View = struct
+  type t = { buf : Buf.t; map : Scrollmap.t }
+
+  let from_buffer buf width height =
+    { buf = buf; map = Scrollmap.make buf width 0 }
+
+  let empty width height =
+    from_buffer (Buf.empty) width height
+
+  let make width height path =
+    from_buffer (Buf.load path) width height
+
+  let resize view width =
+    { view with map = Scrollmap.resize view.map view.buf width }
+
+  let draw view csr =
+    let view = (resize view (Draw.Cursor.max_width csr)) in
+    (*Draw.dark_bkg (csr.width - csr.x) (csr.height - csr.y) csr;*)
+    Draw.buffer csr view.buf (Scrollmap.first view.map);
+    view
+
+  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 }
+end
+
 let tags_buf = ref Buf.empty
-let edit_buf = ref Buf.empty
+let edit_view = ref (View.empty 640 480)
 
 (* Event functions
  ******************************************************************************)
@@ -9,7 +37,14 @@ let onfocus focused = ()
 
 let onkeypress mods rune = ()
 
-let onmousebtn mods btn x y pressed = ()
+let onmousebtn mods btn x y pressed =
+  match btn with
+  | 1 -> ()
+  | 2 -> ()
+  | 3 -> ()
+  | 4 -> (if pressed then edit_view := View.scroll_up !edit_view)
+  | 5 -> (if pressed then edit_view := View.scroll_dn !edit_view)
+  | _ -> ()
 
 let onmousemove mods x y = ()
 
@@ -18,8 +53,7 @@ let onupdate width height =
   Draw.status csr "UNSI> *scratch*";
   Draw.tags csr !tags_buf;
   Draw.scroll csr;
-  Draw.edit csr !edit_buf;
-  let _ = Scrollmap.make !edit_buf width height 0 in ()
+  edit_view := View.draw !edit_view csr
 
 let onshutdown () = ()
 
@@ -41,7 +75,7 @@ let onevent = function
  ******************************************************************************)
 let () =
   if Array.length Sys.argv > 1 then
-    edit_buf := Buf.load Sys.argv.(1);
+    edit_view := View.make 640 480 Sys.argv.(1);
   let win = make_window 640 480 in
   show_window win true;
   event_loop 50 onevent

diff --git a/lib/draw.ml b/lib/draw.ml
index 6cae7e613da3aaa6238ead9149073e2eede833be..8be4d7c6be03ce6e1ded7dae8d8e01d3ff667c7f 100644 (file)
--- a/lib/draw.ml
+++ b/lib/draw.ml
@@ -19,6 +19,9 @@ module Cursor = struct
     { height = height; width = width;
       startx = x; starty = y; x = x; y = y }
 
+  let max_width csr =
+    (csr.width - csr.x)
+
   let restart csr x y =
     let csr = { csr with startx = csr.x + x; starty = csr.y + y } in
     csr.x <- csr.startx;
@@ -82,13 +85,14 @@ let vrule height csr =
   rule_bkg 1 (height - csr.y) csr;
   csr.x <- csr.x + 1
 
-let buffer csr buf =
+let buffer csr buf off =
+  dark_bkg (csr.width - csr.x) (csr.height - csr.y) csr;
   let csr = (restart csr 2 0) in
   let draw_rune c =
     draw_glyph csr c;
     has_next_line csr
   in
-  Buf.iter_from draw_rune buf (Buf.start buf)
+  Buf.iter_from draw_rune buf off
 
 let status csr str =
   dark_bkg csr.width (4 + font_height) csr;
@@ -108,6 +112,6 @@ let scroll csr =
   csr.x <- csr.x + 14;
   vrule csr.height csr
 
-let edit csr buf =
+let edit csr buf off =
   dark_bkg (csr.width - csr.x) (csr.height - csr.y) csr;
-  buffer csr buf
+  buffer csr buf off

diff --git a/lib/draw.mli b/lib/draw.mli
index 11b70b7d839c2d86d3fa6490bb02a400536ed6d7..592a2c3628770ef6df3f3786cf8f141f00cc4799 100644 (file)
--- a/lib/draw.mli
+++ b/lib/draw.mli
@@ -1,6 +1,7 @@
 module Cursor : sig
   type t
   val make : (int * int) -> int -> int -> t
+  val max_width : t -> int
   val restart : t -> int -> int -> t
   val next_line : t -> unit
   val has_next_line : t -> bool
@@ -15,6 +16,8 @@ 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 string : string -> Cursor.t -> unit
 val hrule : int -> Cursor.t -> unit
 val vrule : int -> Cursor.t -> unit
@@ -22,4 +25,4 @@ 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 -> unit
+val edit : Cursor.t -> Buf.t -> int -> unit

diff --git a/lib/scrollmap.ml b/lib/scrollmap.ml
index d81b6a63252867945f125e8f4caaf2d0060df67d..8951c5251aef6d356c68ffa248af586333cf1541 100644 (file)
--- a/lib/scrollmap.ml
+++ b/lib/scrollmap.ml
@@ -1,22 +1,50 @@
 type t = {
+  width : int;
   index : int;
-  map : int array
+  lines : int array
 }
 
-let make buf width height off =
-  print_endline "\nfoo:";
+let make buf width off =
+  let csr = Draw.Cursor.make (width, 0) 0 0 in
   let bol = (Rope.to_bol (Buf.rope buf) off) in
   let lines = ref [bol] in
-  let csr = Draw.Cursor.make (width, 0) 0 0 in
   let process_glyph i c =
     if (Draw.Cursor.next_glyph csr c) then
       lines := i :: !lines;
     ((Rope.is_eol (Buf.rope buf) i) == false)
   in
   Buf.iteri_from process_glyph buf off;
-  List.iter (fun n -> Printf.printf "%d " n) !lines;
-  print_endline "";
-  { index = 0; map = [||] }
+  { width = width; index = 0; lines = (Array.of_list (List.rev !lines)) }
+
+let first map =
+  map.lines.(map.index)
+
+let bopl buf off =
+  let next = ((Rope.to_bol (Buf.rope buf) off) - 1) in
+  Rope.limit_index (Buf.rope buf) next
+
+let bonl buf off =
+  let next = ((Rope.to_eol (Buf.rope buf) off) + 1) in
+  Rope.limit_index (Buf.rope buf) next
+
+let scroll_up map buf =
+  let next = map.index - 1 in
+  if (next >= 0) then
+    { map with index = next }
+  else
+    let map = make buf map.width (bopl buf map.lines.(0)) in
+    { map with index = (Array.length map.lines) - 1 }
+
+let scroll_dn map buf =
+  let next = map.index + 1 in
+  if (next < (Array.length map.lines)) then
+    { map with index = next }
+  else
+    make buf map.width (bonl buf map.lines.((Array.length map.lines) - 1))
+
+let resize map buf width =
+  if map.width == width then map
+  else (make buf width (first map))
 
 (* Unit Tests *****************************************************************)
 

diff --git a/lib/scrollmap.mli b/lib/scrollmap.mli
index 2e8723e2926502750926bfd10bcf2aba706f185a..0344d43b2159aab5877435598e62b311d5dbf094 100644 (file)
--- a/lib/scrollmap.mli
+++ b/lib/scrollmap.mli
@@ -1,3 +1,7 @@
 type t
-val make : Buf.t -> int -> int -> int -> t
+val make : Buf.t -> int -> int -> t
+val first : t -> int
+val scroll_up : t -> Buf.t -> t
+val scroll_dn : t -> Buf.t -> t
+val resize : t -> Buf.t -> int -> t
 val run_unit_tests : unit -> unit