From: Michael D. Lowis <mike.lowis@gentex.com>
Date: Tue, 24 Oct 2017 20:04:35 +0000 (-0400)
Subject: Added draw module and functions for common drawing operations
X-Git-Url: https://git.mdlowis.com/?a=commitdiff_plain;h=526362bfec66005e546817b6cd864fc11ca1435d;p=archive%2Ftide-ocaml.git

Added draw module and functions for common drawing operations
---

diff --git a/Makefile b/Makefile
index ebe4d59..68f86da 100644
--- a/Makefile
+++ b/Makefile
@@ -29,6 +29,7 @@ LIBOBJS = \
     lib/misc.$(OBJEXT) \
     lib/x11.$(OBJEXT) \
     lib/cfg.$(OBJEXT) \
+    lib/draw.$(OBJEXT) \
     lib/rope.$(OBJEXT) \
     lib/buf.$(OBJEXT) \
     lib/scrollmap.$(OBJEXT) \
diff --git a/edit.ml b/edit.ml
index 3403e0c..541e111 100644
--- a/edit.ml
+++ b/edit.ml
@@ -1,10 +1,6 @@
 open X11
 
-let font_times = font_load "Times New Roman:size=12"
-let font_monaco = font_load "Monaco:size=10"
-let font_verdana = font_load "Verdana:size=11"
-
-let font = font_verdana
+let font = Draw.font
 let tabglyph = 0x30
 let tabwidth = 4
 
@@ -18,7 +14,6 @@ type drawpos = { x: int; y: int }
 let draw_bkg color width height pos =
   draw_rect { x = pos.x; y = pos.y; w = width; h = height; c = color }
 
-(* curried helpers *)
 let draw_dark_bkg = draw_bkg Cfg.Color.palette.(0)
 let draw_light_bkg = draw_bkg Cfg.Color.palette.(1)
 let draw_gray_bkg = draw_bkg Cfg.Color.palette.(3)
@@ -81,17 +76,13 @@ let draw_edit pos width height =
 
 (* Event functions
  ******************************************************************************)
-let onfocus focused =
-  () (*print_endline "onfocus"*)
+let onfocus focused = ()
 
-let onkeypress mods rune =
-  ()
+let onkeypress mods rune = ()
 
-let onmousebtn mods btn x y pressed =
-  ()
+let onmousebtn mods btn x y pressed = ()
 
-let onmousemove mods x y =
-  () (*print_endline "onmousemove"*)
+let onmousemove mods x y = ()
 
 let onupdate width height =
   let (pos : drawpos) = { x = 0; y = 0 } in
@@ -100,8 +91,7 @@ let onupdate width height =
   let pos = draw_scroll pos height in
   let _   = draw_edit pos width height in ()
 
-let onshutdown () =
-  print_endline "onshutdown"
+let onshutdown () = ()
 
 let onevent = function
   | Focus state      -> onfocus state
diff --git a/lib/draw.ml b/lib/draw.ml
new file mode 100644
index 0000000..26484ef
--- /dev/null
+++ b/lib/draw.ml
@@ -0,0 +1,87 @@
+module Cursor = struct
+  type t = {
+    height : int;
+    width : int;
+    startx : int;
+    starty : int;
+    mutable x: int;
+    mutable y: int
+  }
+
+  let make dim x y =
+    let height, width = dim in
+    { height = height; width = width;
+      startx = x; starty = y; x = x; y = y }
+end
+
+open Cursor
+
+let font = X11.font_load "Verdana:size=11"
+
+let rectangle color width height csr =
+  X11.draw_rect (X11.make_rect csr.x csr.y width height color)
+
+(* curried helpers *)
+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 string text csr =
+  X11.draw_string font Cfg.Color.palette.(5) text (csr.x + 2, csr.y + 2);
+  csr.y <- csr.y + 4 + font.height
+
+let hrule width csr =
+  rule_bkg width 1 csr;
+  csr.y <- csr.y + 1
+
+let vrule height csr =
+  rule_bkg 1 (height - csr.y) csr;
+  csr.x <- csr.x + 1
+
+(*
+type drawpos = { x: int; y: int }
+
+let draw_status pos width text =
+  let height = (4 + font.height) in
+  draw_dark_bkg width height pos;
+  let pos = draw_text text pos in
+  draw_hrule width pos
+
+let draw_tags pos width maxlns text =
+  let bkgheight = ((font.height * maxlns) + 4) in
+  draw_light_bkg width bkgheight pos;
+  let pos = draw_text text pos in
+  draw_hrule width pos
+
+let draw_scroll pos height =
+  let rulepos = { pos with x = 14 } in
+  draw_gray_bkg rulepos.x height pos;
+  draw_dark_bkg rulepos.x (height/2) pos;
+  draw_vrule height rulepos
+
+let draw_buffer pos width height =
+  let x = ref pos.x and y = ref pos.y in
+  let newline () = x := pos.x; y := !y + font.height in
+  let draw_char c =
+    let glyph = (X11.get_glyph font c) in
+    (match c with
+    | 0x0A -> newline ()
+    | 0x0D -> ()
+    | 0x09 ->
+        let tabsz = ((X11.get_glyph font tabglyph).xoff * tabwidth) in
+        x := pos.x + (((!x - pos.x) + tabsz) / tabsz * tabsz)
+    | _    -> begin
+        if (!x + glyph.xoff) > width then (newline ());
+        let off = X11.draw_glyph Cfg.Color.palette.(5) glyph (!x, !y) in
+        x := !x + off
+    end);
+    ((!y + font.height) < height)
+  in
+  Buf.iter_from draw_char !edit_buf (Buf.start !edit_buf);
+  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
+  draw_buffer pos width height
+*)
diff --git a/lib/draw.mli b/lib/draw.mli
new file mode 100644
index 0000000..028d186
--- /dev/null
+++ b/lib/draw.mli
@@ -0,0 +1,15 @@
+module Cursor : sig
+  type t
+  val make : (int * int) -> int -> int -> t
+end
+
+val font : X11.font
+
+val rectangle : int -> int -> int -> Cursor.t -> unit
+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 string : string -> Cursor.t -> unit
+val hrule : int -> Cursor.t -> unit
+val vrule : int -> Cursor.t -> unit
diff --git a/lib/x11.ml b/lib/x11.ml
index 35f4b22..f7c4281 100644
--- a/lib/x11.ml
+++ b/lib/x11.ml
@@ -141,6 +141,9 @@ let rec draw_stringi font color str coord index =
 let draw_string font color str coord =
   draw_stringi font color str coord 0
 
+let make_rect x y w h c =
+  { x = x; y = y; w = w; h = h; c = c }
+
 (* Automatically connect and disconnect to the display server *)
 let () =
   connect ();