From 1b065f371f7f8051e2a39c30f125337240fd441e Mon Sep 17 00:00:00 2001 From: "Michael D. Lowis" Date: Wed, 25 Oct 2017 09:26:38 -0400 Subject: [PATCH] overhauled drawing code to hopefully allow reuse for scrollmap generation --- edit.ml | 78 --------------------------------------------- lib/draw.ml | 90 ++++++++++++++++++++++++++++++---------------------- lib/draw.mli | 5 +++ 3 files changed, 57 insertions(+), 116 deletions(-) diff --git a/edit.ml b/edit.ml index 8817801..3f6ee0f 100644 --- 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 () = () diff --git a/lib/draw.ml b/lib/draw.ml index bb9820b..2e9d556 100644 --- a/lib/draw.ml +++ b/lib/draw.ml @@ -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 diff --git a/lib/draw.mli b/lib/draw.mli index 9a0f7f8..55501d8 100644 --- a/lib/draw.mli +++ b/lib/draw.mli @@ -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 -- 2.49.0