]> git.mdlowis.com Git - archive/tide-ocaml.git/commitdiff
overhauled drawing code to hopefully allow reuse for scrollmap generation
authorMichael D. Lowis <mike.lowis@gentex.com>
Wed, 25 Oct 2017 13:26:38 +0000 (09:26 -0400)
committerMichael D. Lowis <mike.lowis@gentex.com>
Wed, 25 Oct 2017 13:26:38 +0000 (09:26 -0400)
edit.ml
lib/draw.ml
lib/draw.mli

diff --git a/edit.ml b/edit.ml
index 8817801cd773b9f0bfdd06869109cc64de1378a2..3f6ee0fce81e15e8b920b2f0eb9803bb2d2db66d 100644 (file)
--- a/edit.ml
+++ b/edit.ml
@@ -1,79 +1,8 @@
 open X11
 
-let font = Draw.font
-let tabglyph = 0x30
-let tabwidth = 4
-
 let tags_buf = ref Buf.empty
 let edit_buf = ref Buf.empty
 
-(* Drawing functions
- ******************************************************************************)
-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 }
-
-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)
-
-let draw_text text pos =
-  draw_string font Cfg.Color.palette.(5) text (pos.x + 2, pos.y + 2);
-  { pos with y = (pos.y + 4 + font.height) }
-
-let draw_hrule width pos =
-  draw_gray_bkg width 1 pos;
-  { pos with y = pos.y + 1 }
-
-let draw_vrule height pos =
-  draw_gray_bkg 1 (height - pos.y) pos;
-  { pos with x = pos.x + 1 }
-
-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
-
 (* Event functions
  ******************************************************************************)
 let onfocus focused = ()
@@ -90,13 +19,6 @@ let onupdate width height =
   Draw.tags csr !tags_buf;
   Draw.scroll csr;
   Draw.edit csr !edit_buf
-  (*
-  let (pos : drawpos) = { x = 0; y = 0 } in
-  let pos = draw_status pos width "UNSI> *scratch*" in
-  let pos = draw_tags pos width (height / font.height / 4) "Sample tags data" in
-  let pos = draw_scroll pos height in
-  let _   = draw_edit pos width height in ()
-  *)
 
 let onshutdown () = ()
 
index bb9820b6c137ae4eae30819df19535f0cecdf9f4..2e9d5563bbd13a8e5df3a3e1b98b7b57e9c4bab8 100644 (file)
@@ -1,3 +1,9 @@
+(* config settings. eventually move to Cfg module *)
+let font = X11.font_load "Verdana:size=11"
+let font_height = let open X11 in font.height
+let tabglyph = 0x30
+let tabwidth = 4
+
 module Cursor = struct
   type t = {
     height : int;
@@ -12,10 +18,37 @@ module Cursor = struct
     let width, height = dim in
     { height = height; width = width;
       startx = x; starty = y; x = x; y = y }
-end
 
-let font = X11.font_load "Verdana:size=11"
-let font_height = let open X11 in font.height
+  let restart csr x y =
+    let csr = { csr with startx = csr.x + x; starty = csr.y + y } in
+    csr.x <- csr.startx;
+    csr.y <- csr.starty;
+    csr
+
+  let place_glyph csr glyph =
+    let _ = X11.draw_glyph Cfg.Color.palette.(5) glyph (csr.x, csr.y) in ()
+
+  let next_line csr =
+    csr.x <- csr.startx;
+    csr.y <- csr.y + font_height
+
+  let has_next_line csr =
+    ((csr.y + font_height) < csr.height)
+
+  let next_glyph csr c draw =
+    let glyph = (X11.get_glyph font c) in
+    match c with
+    | 0x0A -> next_line csr
+    | 0x0D -> ()
+    | 0x09 ->
+        let tabsz = ((X11.get_glyph font tabglyph).xoff * tabwidth) in
+        csr.x <- (csr.startx + ((csr.x - csr.startx + tabsz) / tabsz * tabsz))
+    | _    -> begin
+        if (csr.x + glyph.xoff) > csr.width then (next_line csr);
+        if draw then place_glyph csr glyph;
+        csr.x <- csr.x + glyph.xoff
+    end
+end
 
 open Cursor
 
@@ -28,8 +61,8 @@ 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
+  X11.draw_string font Cfg.Color.palette.(5) text (csr.x + 2, csr.y);
+  csr.y <- csr.y + 2 + font_height
 
 let hrule width csr =
   rule_bkg width 1 csr;
@@ -39,14 +72,22 @@ let vrule height csr =
   rule_bkg 1 (height - csr.y) csr;
   csr.x <- csr.x + 1
 
+let buffer csr buf =
+  let csr = (restart csr 2 0) in
+  let draw_rune c =
+    next_glyph csr c true;
+    has_next_line csr
+  in
+  Buf.iter_from draw_rune buf (Buf.start buf)
+
 let status csr str =
-  let height = (4 + font_height) in
-  dark_bkg csr.width height csr;
+  dark_bkg csr.width (4 + font_height) csr;
   string str csr;
   hrule csr.width csr
 
 let tags csr buf =
-  let height = (4 + font_height) in
+  let maxlns = (csr.height / font_height / 4) in
+  let height = ((font_height * maxlns) + 4) in
   light_bkg csr.width height csr;
   string "Quit Save Undo Redo Cut Copy Paste | Find " csr;
   hrule csr.width csr
@@ -57,33 +98,6 @@ let scroll csr =
   csr.x <- csr.x + 14;
   vrule csr.height csr
 
-let edit csr buf = ()
-
-(*
-
-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
-*)
+let edit csr buf =
+  dark_bkg (csr.width - csr.x) (csr.height - csr.y) csr;
+  buffer csr buf
index 9a0f7f8382644d192cd1eece11804d8f055d2918..55501d89eb6a5156ab1305c7c6b02d3940de8b5a 100644 (file)
@@ -1,6 +1,11 @@
 module Cursor : sig
   type t
   val make : (int * int) -> int -> int -> t
+  val restart : t -> int -> int -> t
+  val place_glyph : t -> X11.glyph -> unit
+  val next_line : t -> unit
+  val has_next_line : t -> bool
+  val next_glyph : t -> int -> bool -> unit
 end
 
 val font : X11.font