edit field editsdune build -w ./boot_js.bc.js
This commit is contained in:
cqc
42
boot_js.ml
42
boot_js.ml
@ -86,9 +86,48 @@ let _ =
|
||||
let webgl_ctx = webgl_initialize canvas in
|
||||
let vg = graphv_initialize webgl_ctx in
|
||||
let open Js_of_ocaml_lwt.Lwt_js_events in
|
||||
let edit_me = Lwd.var ("edit me?", 0) in
|
||||
let root =
|
||||
Lwd_utils.pack Nottui.Ui.pack_y
|
||||
[
|
||||
(* Lwd_utils.pack Nottui.Ui.pack_x
|
||||
[
|
||||
Lwd.pure @@ Nottui_widgets.string "hello daddy";
|
||||
Lwd.pure
|
||||
@@ Nottui_widgets.string
|
||||
"What is going to be displayed here?";
|
||||
];
|
||||
Lwd_utils.pack Nottui.Ui.pack_x
|
||||
[ Lwd.pure @@ Nottui_widgets.string "hello daddy" ]
|
||||
[
|
||||
Lwd.pure @@ Nottui_widgets.string "hello daddy";
|
||||
Lwd.pure
|
||||
@@ Nottui_widgets.string
|
||||
"What is going to be displayed here?";
|
||||
];
|
||||
Lwd_utils.pack Nottui.Ui.pack_x
|
||||
[
|
||||
Lwd.pure @@ Nottui_widgets.string "hello";
|
||||
Lwd.pure @@ Nottui_widgets.string "hello";
|
||||
Lwd.pure @@ Nottui_widgets.string "hello";
|
||||
Lwd.pure @@ Nottui_widgets.string "hello";
|
||||
Lwd.pure @@ Nottui_widgets.string "hello";
|
||||
];
|
||||
Lwd_utils.pack Nottui.Ui.pack_x
|
||||
[
|
||||
Lwd.pure @@ Nottui_widgets.string "it ";
|
||||
Lwd.pure @@ Nottui_widgets.string "want ";
|
||||
Lwd.pure @@ Nottui_widgets.string "you ";
|
||||
Lwd.pure @@ Nottui_widgets.string "do ";
|
||||
Lwd.pure @@ Nottui_widgets.string "when ";
|
||||
];
|
||||
Lwd.pure @@ Nottui_widgets.string "when when when when";
|
||||
Lwd.pure @@ Nottui_widgets.string "when when when when";*)
|
||||
Nottui_widgets.edit_field (Lwd.get edit_me)
|
||||
~on_change:(fun ((text, pos) as state) ->
|
||||
Log.debug (fun m -> m "--- on_change (%s,%d)" text pos);
|
||||
Lwd.set edit_me state)
|
||||
~on_submit:ignore;
|
||||
]
|
||||
in
|
||||
|
||||
let events, push_event = Lwt_stream.create () in
|
||||
@ -102,7 +141,6 @@ let _ =
|
||||
(fun vg ?(time = 0.) p i ->
|
||||
Log.debug (fun m ->
|
||||
m "Drawing image: p=%a n=%a" Gg.V2.pp p I.Draw.pp i);
|
||||
|
||||
let p' = I.Draw.node vg A.dark p i in
|
||||
Logs.debug (fun m ->
|
||||
m "Drawing finished: p'=%a" Gg.V2.pp p'))
|
||||
|
||||
135
human.ml
135
human.ml
@ -564,8 +564,8 @@ module NVG = struct
|
||||
let none = Color.transparent
|
||||
let rgbf = Color.rgbf
|
||||
let gray a = rgbf ~r:a ~g:a ~b:a
|
||||
let light = gray 0.2
|
||||
let dark = gray 0.8
|
||||
let light = gray 0.8
|
||||
let dark = gray 0.2
|
||||
|
||||
let black = gray 0.
|
||||
and red = rgbf ~r:1. ~g:0. ~b:0.
|
||||
@ -643,20 +643,8 @@ module Style = struct
|
||||
underline = `None;
|
||||
}
|
||||
|
||||
let default =
|
||||
ref
|
||||
{
|
||||
size = Some 20.;
|
||||
font = `Sans;
|
||||
weight = `Regular;
|
||||
italic = `None;
|
||||
underline = `None;
|
||||
}
|
||||
|
||||
let size { size; _ } =
|
||||
match (size, !default.size) with
|
||||
| None, None -> 20.
|
||||
| None, Some s | Some s, _ -> s
|
||||
let underline = { empty with underline = `Underline }
|
||||
let size { size; _ } = match size with None -> 20. | Some s -> s
|
||||
|
||||
let merge a b =
|
||||
{
|
||||
@ -724,8 +712,9 @@ module Style = struct
|
||||
bg = Color.lerp a1.bg a2.bg ~a:0.5;
|
||||
}
|
||||
|
||||
let fg c = { empty with fg = c }
|
||||
let bg c = { empty with bg = c }
|
||||
let fg ?(t = empty) c = { t with fg = c }
|
||||
let bg ?(t = empty) c = { t with bg = c }
|
||||
let font ?(t = empty) c = { t with font = c }
|
||||
|
||||
let merge a b =
|
||||
{
|
||||
@ -858,11 +847,11 @@ module I = struct
|
||||
| Hcompose (t1, t2) ->
|
||||
let p1 = size vg p t1 in
|
||||
let p2 = size vg V2.(p + v (x p1) 0.) t2 in
|
||||
p2_max p1 p2
|
||||
V2.(v (x p1 +. x p2) (Float.max (y p1) (y p2)))
|
||||
| Vcompose (t1, t2) ->
|
||||
let p1 = size vg p t1 in
|
||||
let p2 = size vg V2.(p + v 0. (y p1)) t2 in
|
||||
p2_max p1 p2
|
||||
V2.(v (Float.max (x p1) (x p2)) (y p1 +. y p2))
|
||||
| Zcompose (t1, t2) -> p2_max (size vg p t1) (size vg p t2)
|
||||
| Hcrop (t, left, right) ->
|
||||
V2.(size vg (p - v left 0.) t - v right 0.)
|
||||
@ -1069,18 +1058,15 @@ module I = struct
|
||||
|
||||
let rec segment vg p : Text.t -> P2.t = function
|
||||
| String s ->
|
||||
Log.debug (fun m -> m "I.Draw.segment p=%a %s" Gg.V2.pp p s);
|
||||
(* Log.debug (fun m -> m "I.Draw.segment p=%a %s" Gg.V2.pp p s); *)
|
||||
let metrics = NVG.Text.metrics vg in
|
||||
let twidth =
|
||||
NVG.Text.text_w vg ~x:(V2.x p)
|
||||
NVG.Text.text vg ~x:(V2.x p)
|
||||
~y:(V2.y p +. metrics.ascender)
|
||||
s
|
||||
s;
|
||||
let NVG.Bounds.{ xmin; ymin; xmax; ymax } =
|
||||
(NVG.Text.bounds vg ~x:(V2.x p) ~y:(V2.y p) s).box
|
||||
in
|
||||
V2.(
|
||||
p
|
||||
+ v twidth
|
||||
(P2.y p +. metrics.ascender +. metrics.descender
|
||||
+. metrics.line_height))
|
||||
V2.v (xmax -. xmin) (ymax -. ymin)
|
||||
|
||||
and node vg attr p n : p2 =
|
||||
let b' =
|
||||
@ -1088,21 +1074,17 @@ module I = struct
|
||||
| Empty | Void _ -> p
|
||||
| Segment text -> segment vg p text
|
||||
| Attr (i, a0) ->
|
||||
let p1 = node vg A.(attr ++ a0) p i in
|
||||
(* TODO need to set that weird "draw under" thing here *)
|
||||
if Style.(attr.fg) != a0.fg then
|
||||
NVG.set_stroke_color vg ~color:Style.(attr.fg);
|
||||
if Style.(attr.bg) != a0.bg then
|
||||
NVG.set_fill_color vg ~color:Style.(attr.bg);
|
||||
p1
|
||||
NVG.set_fill_color vg ~color:Style.(attr.fg);
|
||||
node vg A.(attr ++ a0) p i
|
||||
| Hcompose (i1, i2) ->
|
||||
let p1 = node vg attr p i1 in
|
||||
let p2 = node vg attr V2.(p + v (V2.x p1) 0.) i2 in
|
||||
p2_max p1 p2
|
||||
V2.(v (x p1 +. x p2) (Float.max (y p1) (y p2)))
|
||||
| Vcompose (i1, i2) ->
|
||||
let p1 = node vg attr p i1 in
|
||||
let p2 = node vg attr V2.(p + v 0. (V2.y p1)) i2 in
|
||||
p2_max p1 p2
|
||||
V2.(v (Float.max (x p1) (x p2)) (y p1 +. y p2))
|
||||
| Zcompose (i1, i2) ->
|
||||
let p1 = node vg attr p i1 in
|
||||
let p2 = node vg attr p i2 in
|
||||
@ -1282,10 +1264,7 @@ module Nottui = struct
|
||||
[ `Next | `Prev | `Left | `Right | `Up | `Down ] ]
|
||||
|
||||
type key =
|
||||
[ Input.special
|
||||
| `Uchar of Uchar.t
|
||||
| `ASCII of char
|
||||
| semantic_key ]
|
||||
[ Input.special | `Uchar of Uchar.t | semantic_key ]
|
||||
* Input.mods
|
||||
|
||||
type mouse = Input.mouse
|
||||
@ -1497,10 +1476,7 @@ module Nottui = struct
|
||||
let has_focus t = Focus.has_focus t.focus
|
||||
|
||||
let rec pp ppf t =
|
||||
Format.fprintf ppf
|
||||
"@[<hov>{@ w = %f;@ h = %f;@ sw = %f;@ sh = %f;@ desc = \
|
||||
@[%a@];@ }@]"
|
||||
t.w t.h t.sw t.sh pp_desc t.desc
|
||||
Format.fprintf ppf "@[<hov>@[%a@]@]" pp_desc t.desc
|
||||
|
||||
and pp_desc ppf = function
|
||||
| Atom _ -> Format.fprintf ppf "Atom _"
|
||||
@ -1883,6 +1859,7 @@ module Nottui = struct
|
||||
|
||||
let image vg { size; view; _ } =
|
||||
let w, h = V2.to_tuple size in
|
||||
Log.debug (fun m -> m "Renderer.image view=%a" Ui.pp view);
|
||||
(render_node vg 0. 0. w h w h view).image
|
||||
|
||||
let dispatch_raw_key st key =
|
||||
@ -1900,6 +1877,7 @@ module Nottui = struct
|
||||
in
|
||||
iter st'
|
||||
| Focus_area (t, f) -> (
|
||||
Log.debug (fun m -> m "dispatch_raw_key Focus_area");
|
||||
match iter [ t ] with
|
||||
| `Handled -> `Handled
|
||||
| `Unhandled -> (
|
||||
@ -1948,10 +1926,18 @@ module Nottui = struct
|
||||
| Event_filter (t, _) ->
|
||||
dispatch_focus t dir
|
||||
| Focus_area (t', _) ->
|
||||
if Focus.has_focus t'.focus then
|
||||
dispatch_focus t' dir || grab_focus t
|
||||
else if Focus.has_focus t.focus then false
|
||||
else grab_focus t
|
||||
if Focus.has_focus t'.focus then (
|
||||
Log.debug (fun m ->
|
||||
m "dispatch_focus: Focus.has_focus t'.focus");
|
||||
dispatch_focus t' dir || grab_focus t)
|
||||
else if
|
||||
Log.debug (fun m ->
|
||||
m "dispatch_focus: Focus.has_focus t.focus");
|
||||
Focus.has_focus t.focus
|
||||
then false
|
||||
else (
|
||||
Log.debug (fun m -> m "dispatch_focus: grab_focus");
|
||||
grab_focus t)
|
||||
| X (a, b) -> (
|
||||
if Focus.has_focus a.focus then
|
||||
dispatch_focus a dir
|
||||
@ -1997,7 +1983,7 @@ module Nottui = struct
|
||||
let rec dispatch_key st key =
|
||||
match (dispatch_raw_key st key, key) with
|
||||
| `Handled, _ -> `Handled
|
||||
| `Unhandled, (`Arrow dir, [ `Meta ]) ->
|
||||
| `Unhandled, (`Arrow dir, []) ->
|
||||
let dir : [ `Down | `Left | `Right | `Up ] :>
|
||||
[ `Down | `Left | `Right | `Up | `Next | `Prev ] =
|
||||
dir
|
||||
@ -2070,13 +2056,22 @@ module Nottui_lwt = struct
|
||||
push (Some (Renderer.image vg renderer))
|
||||
in
|
||||
refresh ();
|
||||
let process_event = function
|
||||
| `Key (`ASCII 'q', [ `Meta ]) as event -> (
|
||||
let process_event e =
|
||||
Log.debug (fun m -> m "Nottui_lwt.render= process_event");
|
||||
match e with
|
||||
| `Key (`Uchar c, [ `Meta ]) as event
|
||||
when Uchar.(equal c (of_char 'q')) -> (
|
||||
match do_quit with
|
||||
| Some u -> Lwt.wakeup u ()
|
||||
| None -> ignore (Renderer.dispatch_event renderer event))
|
||||
| #Ui.event as event ->
|
||||
ignore (Renderer.dispatch_event renderer event)
|
||||
| #Ui.event as event -> (
|
||||
match Renderer.dispatch_event renderer event with
|
||||
| `Handled -> refresh ()
|
||||
| `Unhandled ->
|
||||
Log.warn (fun m ->
|
||||
m
|
||||
"Nottui_lwt.render process_event #Ui.event -> \
|
||||
`Unhandled"))
|
||||
| `Resize size' ->
|
||||
size := size';
|
||||
refresh ()
|
||||
@ -2118,7 +2113,7 @@ module Nottui_widgets = struct
|
||||
|
||||
let attr_menu_main = A.(bg Color.green ++ fg Color.black)
|
||||
let attr_menu_sub = A.(bg Color.lightgreen ++ fg Color.black)
|
||||
let attr_clickable = A.(bg Color.lightblue)
|
||||
let attr_clickable = A.(fg Color.lightblue)
|
||||
|
||||
type window_manager = {
|
||||
overlays : ui Lwd.t Lwd_table.t;
|
||||
@ -2307,7 +2302,7 @@ module Nottui_widgets = struct
|
||||
Lwd.map2 t (Lwd.get offset) ~f:(fun t (s_x, s_y) ->
|
||||
t |> Ui.shift_area s_x s_y
|
||||
|> Ui.mouse_area scroll_handler
|
||||
|> Ui.keyboard_area focus_handler)
|
||||
|> keyboard_area focus_handler)
|
||||
|
||||
let main_menu_item wm text f =
|
||||
let text = string ~attr:attr_menu_main (" " ^ text ^ " ") in
|
||||
@ -2450,6 +2445,7 @@ module Nottui_widgets = struct
|
||||
ui
|
||||
in
|
||||
Lwd.map2 ~f:render (Lwd.get state_var) (Lwd.pair top bot)
|
||||
*)
|
||||
|
||||
let sub' str p l =
|
||||
if p = 0 && l = String.length str then str else String.sub str p l
|
||||
@ -2464,30 +2460,33 @@ module Nottui_widgets = struct
|
||||
if Focus.has_focus focus then
|
||||
let attr = attr_clickable in
|
||||
let len = String.length text in
|
||||
(if pos >= len then [ I.string attr text ]
|
||||
else [ I.string attr (sub' text 0 pos) ])
|
||||
(if pos >= len then [ I.string ~attr text ]
|
||||
else [ I.string ~attr (sub' text 0 pos) ])
|
||||
@
|
||||
if pos < String.length text then
|
||||
[
|
||||
I.string A.(bg lightred) (sub' text pos 1);
|
||||
I.string attr (sub' text (pos + 1) (len - pos - 1));
|
||||
I.string ~attr:A.(bg Color.lightred) (sub' text pos 1);
|
||||
I.string ~attr (sub' text (pos + 1) (len - pos - 1));
|
||||
]
|
||||
else [ I.string A.(bg lightred) " " ]
|
||||
else [ I.string ~attr:A.(bg Color.lightred) " " ]
|
||||
else
|
||||
[
|
||||
I.string
|
||||
A.(st underline)
|
||||
~attr:A.(font Font.underline)
|
||||
(if text = "" then " " else text);
|
||||
]
|
||||
in
|
||||
let handler = function
|
||||
| `ASCII 'U', [ `Ctrl ] ->
|
||||
let handler k =
|
||||
Log.debug (fun m -> m "edit_field keyboard_area handler");
|
||||
match k with
|
||||
| `Uchar c, [ `Ctrl ] when Uchar.(equal c (of_char 'U')) ->
|
||||
on_change ("", 0);
|
||||
`Handled (* clear *)
|
||||
| `Escape, [] ->
|
||||
Focus.release focus_h;
|
||||
`Handled
|
||||
| `ASCII k, _ ->
|
||||
| `Uchar k, _ ->
|
||||
let k = Uchar.unsafe_to_char k in
|
||||
let text =
|
||||
if pos < String.length text then
|
||||
String.sub text 0 pos ^ String.make 1 k
|
||||
@ -2532,7 +2531,8 @@ module Nottui_widgets = struct
|
||||
let node =
|
||||
Lwd.map2 ~f:(update focus) (Focus.status focus) state
|
||||
in
|
||||
let mouse_grab (text, pos) ~x ~y:_ = function
|
||||
node
|
||||
(* let mouse_grab (text, pos) ~x ~y:_ = function
|
||||
| `Left ->
|
||||
if x <> pos then on_change (text, x);
|
||||
Nottui.Focus.request focus;
|
||||
@ -2540,8 +2540,9 @@ module Nottui_widgets = struct
|
||||
| _ -> `Unhandled
|
||||
in
|
||||
Lwd.map2 state node ~f:(fun state content ->
|
||||
Ui.mouse_area (mouse_grab state) content)
|
||||
Ui.mouse_area (mouse_grab state) content *)
|
||||
|
||||
(*
|
||||
(** Tab view, where exactly one element of [l] is shown at a time. *)
|
||||
let tabs (tabs : (string * (unit -> Ui.t Lwd.t)) list) : Ui.t Lwd.t
|
||||
=
|
||||
|
||||
Reference in New Issue
Block a user