From: Michael D. Lowis <mike@mdlowis.com>
Date: Wed, 20 Dec 2017 02:59:36 +0000 (-0500)
Subject: Added logic to draw cursor
X-Git-Url: https://git.mdlowis.com/?a=commitdiff_plain;h=84e3b94cab43e7036daf97472da35a725ba7a9f4;p=archive%2Ftide-ocaml.git

Added logic to draw cursor
---

diff --git a/edit.ml b/edit.ml
index 01bcb08..bd5eae8 100644
--- a/edit.ml
+++ b/edit.ml
@@ -17,8 +17,7 @@ let scroll_dn () =
  ******************************************************************************)
 let onfocus focused = ()
 
-let onkeypress mods rune =
-  edit_view := View.scroll_up !edit_view
+let onkeypress mods rune = ()
 
 let onmousebtn mods btn x y pressed =
   if pressed then match btn with
diff --git a/lib/buf.ml b/lib/buf.ml
index dfeba1c..a3e48f1 100644
--- a/lib/buf.ml
+++ b/lib/buf.ml
@@ -1,7 +1,13 @@
+type cursor = {
+  mutable start : int;
+  mutable stop : int
+}
+
 type buf = {
   lexfn : Colormap.ctx -> Lexing.lexbuf -> unit;
   path : string;
-  rope : Rope.t
+  rope : Rope.t;
+  cursor : cursor
 }
 
 type t = buf
@@ -35,6 +41,48 @@ let filetypes = [
   }
 ]
 
+module Cursor = struct
+  type csr = cursor
+  type t = csr
+
+  let swap csr =
+    if csr.stop < csr.start then
+      { start = csr.stop; stop = csr.start }
+    else
+      csr
+
+  let initial =
+    { start = 0; stop = 0 }
+
+  let make buf idx =
+    { start = 0; stop = (Rope.limit_index buf.rope idx) }
+
+  let move_to dest buf csr =
+    csr.stop <- (match dest with
+      | StartOfLine -> Rope.to_bol buf.rope csr.stop
+      | EndOfLine   -> Rope.to_eol buf.rope csr.stop
+      | NextChar    -> Rope.nextc buf.rope csr.stop
+      | PrevChar    -> Rope.prevc buf.rope csr.stop
+      | NextLine    -> Rope.nextln buf.rope csr.stop
+      | PrevLine    -> Rope.prevln buf.rope csr.stop
+    );
+    csr.stop
+
+  let stop csr =
+    csr.stop
+
+  let selected csr pos =
+    let csr = swap csr in
+    (pos >= csr.start && pos <= csr.stop)
+end
+
+let move_to dest buf i =
+  Cursor.move_to dest buf (Cursor.make buf i)
+let nextln = move_to NextLine
+let prevln = move_to PrevLine
+let bol = move_to StartOfLine
+
+
 let pick_syntax path =
   let name = Filename.basename path in
   let ext = Filename.extension path in
@@ -48,12 +96,14 @@ let pick_syntax path =
 let empty =
   { lexfn = Lex_text.scan;
     path = "";
-    rope = Rope.empty }
+    rope = Rope.empty;
+    cursor = Cursor.initial }
 
 let load path =
   { lexfn = pick_syntax path;
     path = path;
-    rope = Rope.from_string (Misc.load_file path) }
+    rope = Rope.from_string (Misc.load_file path);
+    cursor = Cursor.initial }
 
 let path buf =
   buf.path
@@ -67,6 +117,9 @@ let iteri fn buf i =
 let iter fn buf i =
   iteri (fun i c -> (fn c)) buf i
 
+let cursor buf =
+  buf.cursor
+
 let make_lexer buf =
   let pos = ref 0 in
   Colormap.({
@@ -81,27 +134,6 @@ let make_lexer buf =
       !count)
   })
 
-module Cursor = struct
-  type csr = {
-    mutable start : int;
-    mutable stop : int
-  }
-
-  type t = csr
-
-  let make buf idx =
-    { start = 0; stop = (Rope.limit_index buf.rope idx) }
-
-  let move_to dest buf csr =
-    csr.stop <- (match dest with
-      | StartOfLine -> Rope.to_bol buf.rope csr.stop
-      | EndOfLine   -> Rope.to_eol buf.rope csr.stop
-      | NextChar    -> Rope.nextc buf.rope csr.stop
-      | PrevChar    -> Rope.prevc buf.rope csr.stop
-      | NextLine    -> Rope.nextln buf.rope csr.stop
-      | PrevLine    -> Rope.prevln buf.rope csr.stop
-    );
-    csr.stop
 (*
   let clone csr =
     { start = csr.start; stop = csr.stop }
@@ -133,16 +165,7 @@ module Cursor = struct
 
   let is_bol = is_at StartOfLine
   let is_eol = is_at EndOfLine
-*)
-end
 
-let move_to dest buf i =
-  Cursor.move_to dest buf (Cursor.make buf i)
-let nextln = move_to NextLine
-let prevln = move_to PrevLine
-let bol = move_to StartOfLine
-
-(*
 let nextc = move_to NextChar
 let prevc = move_to PrevChar
 let eol = move_to EndOfLine
diff --git a/lib/buf.mli b/lib/buf.mli
index 8462596..ced60f4 100644
--- a/lib/buf.mli
+++ b/lib/buf.mli
@@ -5,36 +5,13 @@ type dest =
   | NextChar | PrevChar
   | NextLine | PrevLine
 
-(*
 module Cursor : sig
   type t
-
   val make : buf -> int -> t
-  val clone : t -> t
-  val iter : (t -> int -> bool) -> buf -> t -> unit
-  val offset : t -> int
-  val goto : buf -> t -> int -> unit
-
-  val getc : buf -> t -> int
-( *
-  val putc : buf -> t -> int -> unit
-  val gets : buf -> t -> string
-  val puts : buf -> t -> string -> unit
-* )
-
   val move_to : dest -> buf -> t -> int
-  val nextc : buf -> t -> int
-  val prevc : buf -> t -> int
-  val nextln : buf -> t -> int
-  val prevln : buf -> t -> int
-  val bol : buf -> t -> int
-  val eol : buf -> t -> int
-
-  val is_at : dest -> buf -> t -> bool
-  val is_bol : buf -> t -> bool
-  val is_eol : buf -> t -> bool
+  val stop : t -> int
+  val selected : t -> int -> bool
 end
-*)
 
 val empty : t
 val load : string -> t
@@ -42,22 +19,8 @@ val path : t -> string
 val length : t -> int
 val iteri : (int -> int -> bool) -> t -> int -> unit
 val iter : (int -> bool) -> t -> int -> unit
+val cursor : t -> Cursor.t
 val make_lexer : t -> Colormap.lexer
-
 val nextln : t -> int -> int
 val prevln : t -> int -> int
 val bol : t -> int -> int
-
-(*
-val move_to : dest -> t -> int -> int
-val nextc : t -> int -> int
-val prevc : t -> int -> int
-
-val eol : t -> int -> int
-
-val is_at : dest -> t -> int -> bool
-val is_bol : t -> int -> bool
-val is_eol : t -> int -> bool
-*)
-
-
diff --git a/lib/cfg.ml b/lib/cfg.ml
index 1f5a30c..a107b57 100644
--- a/lib/cfg.ml
+++ b/lib/cfg.ml
@@ -27,7 +27,7 @@ let cmd_tags = strvar "tide.ui.font"
     "Quit Undo Redo Cut Copy Paste | Send Find "
 
 (* font settings *)
-let font = strvar "tide.ui.tags.edit" "Verdana:size=10"
+let font = strvar "tide.ui.tags.edit" "Verdana:size=11"
 let line_spacing = intvar "tide.ui.line_spacing" 1
 
 (* user interface related options *)
diff --git a/lib/draw.ml b/lib/draw.ml
index 66c245e..f5d6ea3 100644
--- a/lib/draw.ml
+++ b/lib/draw.ml
@@ -84,6 +84,7 @@ let rectangle color width height csr =
 let dark_bkg = rectangle Cfg.Color.palette.(0)
 let light_bkg = rectangle Cfg.Color.palette.(1)
 let rule_bkg = rectangle Cfg.Color.palette.(3)
+let draw_cursor = rectangle Cfg.Color.palette.(6) 1 font_height
 
 let string text csr =
   X11.draw_string font Cfg.Color.palette.(5) text (csr.x + 2, csr.y);
@@ -99,9 +100,13 @@ let vrule height csr =
 
 let buffer csr buf clr off =
   dark_bkg (csr.width - csr.x) (csr.height - csr.y) csr;
+  csr.y <- csr.y + 2;
   let num = ref 0 and csr = (restart csr 2 0) in
   let draw_rune c =
-    draw_glyph csr c (Colormap.find (off + !num) clr);
+    let pos = off + !num in
+    if pos == (Buf.Cursor.stop (Buf.cursor buf)) then
+      draw_cursor csr;
+    draw_glyph csr c (Colormap.find pos clr);
     num := !num + 1;
     has_next_line csr
   in
diff --git a/tests/rope_tests.ml b/tests/rope_tests.ml
index 0ec914f..612e4f5 100644
--- a/tests/rope_tests.ml
+++ b/tests/rope_tests.ml
@@ -1,6 +1,6 @@
 open Test
 open Rope
-(*
+
 let () = (* empty tests *)
   test "empty : should be an empty rope" (fun () ->
     let rope = Rope.empty in
@@ -239,7 +239,6 @@ let () = (* to_eol() tests *)
     assert( (to_eol rope 1) == 4 );
   );
   ()
-*)
 
 let () = (* getc() tests *)
   test "getc : " (fun () ->