From 74b18ff8b3dc8ea4fff2cb6edd37396fa12c6a72 Mon Sep 17 00:00:00 2001 From: "Michael D. Lowis" Date: Sun, 18 Feb 2018 15:08:54 -0500 Subject: [PATCH] eliminated status region in favor of acme dual-region approach --- deftags | 1 + edit.ml | 10 ++++++---- lib/draw.ml | 44 ++++++++++++++++---------------------------- lib/draw.mli | 22 ++++++---------------- lib/view.ml | 6 +++--- 5 files changed, 32 insertions(+), 51 deletions(-) create mode 100644 deftags diff --git a/deftags b/deftags new file mode 100644 index 0000000..5488f64 --- /dev/null +++ b/deftags @@ -0,0 +1 @@ +UNSI>* edit.ml | Quit Save Undo Redo Cut Copy Paste | Find diff --git a/edit.ml b/edit.ml index a95045b..d7e0e84 100644 --- a/edit.ml +++ b/edit.ml @@ -1,7 +1,7 @@ open X11 -let tags_buf = ref Buf.empty let edit_view = ref (View.empty 640 480) +let tags_view = ref (View.empty 640 480) let scroll_up () = for i = 1 to 4 do @@ -58,12 +58,13 @@ let onmousemove mods x y = let onupdate width height = let csr = Draw.Cursor.make (width, height) 0 0 in - Draw.status csr (View.path !edit_view); - Draw.tags csr !tags_buf; + tags_view := View.draw !tags_view csr; + Draw.hrule csr.width csr; let scrollcsr = (Draw.Cursor.clone csr) in Draw.Cursor.move_x csr 15; edit_view := View.draw !edit_view csr; - Draw.scroll scrollcsr (View.scroll_params !edit_view) + Draw.scroll scrollcsr (View.scroll_params !edit_view); + () let onshutdown () = shutdown () @@ -91,6 +92,7 @@ let onevent evnt = ******************************************************************************) let () = Printexc.record_backtrace true; + tags_view := View.make 640 480 "deftags"; if Array.length Sys.argv > 1 then edit_view := View.make 640 480 Sys.argv.(1); let win = make_window 640 480 in diff --git a/lib/draw.ml b/lib/draw.ml index 5d80ed2..f61ea0a 100644 --- a/lib/draw.ml +++ b/lib/draw.ml @@ -8,10 +8,10 @@ let glyph_width g = X11.(g.xoff) module Cursor = struct type t = { - height : int; - width : int; - startx : int; - starty : int; + mutable height : int; + mutable width : int; + mutable startx : int; + mutable starty : int; mutable x: int; mutable y: int } @@ -39,11 +39,19 @@ module Cursor = struct (csr.width - csr.x) let restart csr x y = - let csr = { csr with startx = csr.x + x; starty = csr.y + y } in + csr.startx <- csr.x + x; + csr.starty <- csr.y + y; csr.x <- csr.startx; csr.y <- csr.starty; csr + let reanchor csr xoff yoff = + csr.x <- csr.x + xoff; + csr.y <- csr.y + yoff; + csr.startx <- csr.x + xoff; + csr.starty <- csr.y + yoff; + () + let next_line csr = csr.x <- csr.startx; csr.y <- csr.y + font_height @@ -108,10 +116,6 @@ 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); - csr.y <- csr.y + 2 + font_height - let hrule width csr = rule_bkg width 1 csr; csr.y <- csr.y + 1 @@ -123,12 +127,12 @@ let vrule height csr = let make_line_array lines nlines = let lines = (Array.of_list (List.rev !lines)) in let line_ary = (Array.make nlines (-1)) in - Array.blit lines 0 line_ary 0; + Array.blit lines 0 line_ary 0 (Array.length lines); lines let buffer csr buf clr off = let height = (csr.height - csr.y) in - dark_bkg (csr.width - csr.x) height csr; + (if csr.y == 0 then light_bkg else dark_bkg) (csr.width - csr.x) height csr; csr.y <- csr.y + 2; let nlines = ((height -2) / font_height) in let num = ref 0 and csr = (restart csr 2 0) @@ -145,20 +149,9 @@ let buffer csr buf clr off = in Buf.iter draw_rune buf off; List.iter X11.draw_rect !boxes; (* draw selection boxes *) + reanchor csr (-2) 2; (!num, (make_line_array lines nlines)) -let status csr str = - dark_bkg csr.width (4 + font_height) csr; - string str csr; - hrule csr.width csr - -let tags csr buf = - 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 - let scroll csr params = let start, pct = params and height = float_of_int (csr.height - csr.y) in let thumbsz = (height *. pct) and thumboff = (height *. start) in @@ -168,8 +161,3 @@ let scroll csr params = dark_bkg 14 (int_of_float (max thumbsz 5.0)) mcsr; csr.x <- csr.x + 14; vrule csr.height csr - -let edit csr buf clr = - dark_bkg (csr.width - csr.x) (csr.height - csr.y) csr; - let nchars = buffer csr buf clr in - nchars diff --git a/lib/draw.mli b/lib/draw.mli index ff613ca..1041bc6 100644 --- a/lib/draw.mli +++ b/lib/draw.mli @@ -1,24 +1,19 @@ module Cursor : sig type t = { - height : int; - width : int; - startx : int; - starty : int; + mutable height : int; + mutable width : int; + mutable startx : int; + mutable starty : int; mutable x: int; mutable y: int } + val make : (int * int) -> int -> int -> t val clone : t -> t val pos : t -> (int * int) val dim : t -> (int * int) val move_x : t -> int -> unit val max_width : t -> int -(* - val restart : t -> int -> int -> t - val next_line : t -> unit - val has_next_line : t -> bool - val draw_glyph : t -> int -> int -> unit -*) val next_glyph : t -> int -> bool end @@ -30,12 +25,7 @@ val light_bkg : int -> int -> Cursor.t -> unit val rule_bkg : int -> int -> Cursor.t -> unit val buffer : Cursor.t -> Buf.t -> Colormap.t -> int -> (int * int array) +val scroll : Cursor.t -> (float * float) -> unit -val string : string -> Cursor.t -> unit val hrule : int -> Cursor.t -> unit val vrule : int -> Cursor.t -> unit - -val status : Cursor.t -> string -> unit -val tags : Cursor.t -> Buf.t -> unit -val scroll : Cursor.t -> (float * float) -> unit -val edit : Cursor.t -> Buf.t -> Colormap.t -> int -> (int * int array) diff --git a/lib/view.ml b/lib/view.ml index 6dad1dc..2dcbdfb 100644 --- a/lib/view.ml +++ b/lib/view.ml @@ -76,12 +76,12 @@ let resize view width = let draw view csr = let view = (resize view (Draw.Cursor.max_width csr)) in let newcsr = (Draw.Cursor.clone csr) in - let num, lines = Draw.buffer newcsr view.buf view.clr (Scrollmap.first view.map) in + let num, lines = Draw.buffer csr view.buf view.clr (Scrollmap.first view.map) in { view with num = num; lines = lines; - pos = Draw.Cursor.pos csr; - dim = Draw.Cursor.dim csr } + pos = Draw.Cursor.pos newcsr; + dim = Draw.Cursor.dim newcsr } let scroll_up view = { view with map = Scrollmap.scroll_up view.map view.buf } -- 2.51.0