Browse Source

document, complete tyxml interface

pre-release
Frédéric Bour 2 months ago
parent
commit
fa091a3d1f
8 changed files with 176 additions and 12 deletions
  1. +7
    -0
      lib/nottui-lwt/nottui_lwt.mli
  2. +3
    -3
      lib/nottui-pretty/nottui_pretty.ml
  3. +8
    -8
      lib/nottui-widgets/nottui_widgets.ml
  4. +93
    -0
      lib/nottui-widgets/nottui_widgets.mli
  5. +1
    -1
      lib/nottui/nottui.ml
  6. +1
    -0
      lib/tyxml-lwd/dune
  7. +31
    -0
      lib/tyxml-lwd/lwdom.ml
  8. +32
    -0
      lib/tyxml-lwd/lwdom.mli

+ 7
- 0
lib/nottui-lwt/nottui_lwt.mli View File

@@ -7,7 +7,14 @@ type event = [
| `Paste of Unescape.paste
| `Resize of int * int
]
(** FIXME: Refactor to use [Nottui.Ui.event]? *)

val render : ?quit:unit Lwt.t -> size:int * int -> event Lwt_stream.t -> ui Lwd.t -> image Lwt_stream.t
(** Turn a stream of events into a stream of images. *)

val run : (*?term:Term.t ->*) ?quit:unit Lwt.t -> ui Lwd.t -> unit Lwt.t
(** Run mainloop in [Lwt], until the [quit] promise is fulfilled.

The ui is a normal [Lwd.t] value, but events are free to spawn asynchronous
[Lwt] threads.
*)

+ 3
- 3
lib/nottui-pretty/nottui_pretty.ml View File

@@ -194,11 +194,11 @@ open Nottui
(* Some intermediate UI *)

let blank_ui =
let space = Ui.atom (Notty.I.void 1 0) in
let space = Ui.space 1 0 in
function
| 0 -> Ui.empty
| 1 -> space
| n -> Ui.atom (Notty.I.void n 0)
| n -> Ui.space n 0

let flat_hardline =
Flat_span { prefix = Ui.empty; body = Ui.empty; suffix = Ui.empty; }
@@ -207,7 +207,7 @@ let mk_body body1 suffix prefix body2 =
Ui.join_y body1 (Ui.join_y (Ui.join_x suffix prefix) body2)

let mk_pad indent body suffix =
let pad = Ui.void indent 0 in
let pad = Ui.space indent 0 in
(Ui.join_x pad body, Ui.join_x pad suffix)

(* Flat renderer *)


+ 8
- 8
lib/nottui-widgets/nottui_widgets.ml View File

@@ -50,7 +50,7 @@ let attr_menu_sub = A.(bg lightgreen ++ fg black)
let menu_overlay ?dx ?dy handler t =
ignore (dx, dy, handler, t);
assert false
(*let placeholder = Lwd.return (Ui.atom (I.void 1 0)) in
(*let placeholder = Lwd.return (Ui.space 1 0) in
let body = Lwd_utils.pack Ui.pack_x [placeholder; t; placeholder] in
let bg = Lwd.map' body @@ fun t ->
let {Ui. w; h; _} = Ui.layout_spec t in
@@ -95,7 +95,7 @@ let vscroll_area ~state ~change t =
in
Lwd.map2' t state @@ fun t state ->
t
|> Ui.scroll_area 0 state.position
|> Ui.shift_area 0 state.position
|> Ui.resize ~h:0 ~sh:1
|> Ui.size_sensor (fun ~w:_ ~h ->
let tchange =
@@ -140,7 +140,7 @@ let scroll_area ?(offset=0,0) t =
in
Lwd.map2' t (Lwd.get offset) @@ fun t (s_x, s_y) ->
t
|> Ui.scroll_area s_x s_y
|> Ui.shift_area s_x s_y
|> Ui.mouse_area scroll_handler
|> Ui.keyboard_area focus_handler

@@ -556,7 +556,7 @@ let rec iterate n f x =
@param bg attribute for controlling background style
@param h_space horizontal space between each cell in a row
@param v_space vertical space between each row
@param fill used to control filling of cells
@param pad used to control padding of cells
@param crop used to control cropping of cells
TODO: control padding/alignment, vertically and horizontally
TODO: control align left/right in cells
@@ -564,7 +564,7 @@ let rec iterate n f x =
TODO: headers *)
let grid
?max_h ?max_w
?fill ?crop ?bg
?pad ?crop ?bg
?(h_space=0)
?(v_space=0)
?(headers:Ui.t Lwd.t list option)
@@ -597,10 +597,10 @@ let grid
(* now render, with some padding *)
let pack_pad_x =
if h_space<=0 then (Ui.empty, Ui.join_x)
else (Ui.empty, (fun x y -> Ui.hcat [x; Ui.void h_space 0; y]))
else (Ui.empty, (fun x y -> Ui.hcat [x; Ui.space h_space 0; y]))
and pack_pad_y =
if v_space =0 then (Ui.empty, Ui.join_y)
else (Ui.empty, (fun x y -> Ui.vcat [x; Ui.void v_space 0; y]))
else (Ui.empty, (fun x y -> Ui.vcat [x; Ui.space v_space 0; y]))
in
let rows =
List.map
@@ -615,7 +615,7 @@ let grid
let row =
List.mapi
(fun i c ->
Ui.resize ~w:col_widths.(i) ~h:row_h ?crop ?fill ?bg c)
Ui.resize ~w:col_widths.(i) ~h:row_h ?crop ?pad ?bg c)
row
in
Lwd_utils.reduce pack_pad_x row)


+ 93
- 0
lib/nottui-widgets/nottui_widgets.mli View File

@@ -0,0 +1,93 @@
open Notty
open Nottui

val empty_lwd : ui Lwd.t

(* Primitive printing *)

val string : ?attr:attr -> string -> ui
val int : ?attr:attr -> int -> ui
val bool : ?attr:attr -> bool -> ui
val float_ : ?attr:attr -> float -> ui

(* Printf support *)
val printf : ?attr:attr -> ('a, unit, string, ui) format4 -> 'a
val kprintf : (ui -> 'a) -> ?attr:attr -> ('b, unit, string, 'a) format4 -> 'b

val fmt : ?attr:attr -> ('a, Format.formatter, unit, ui) format4 -> 'a
val kfmt : (ui -> 'a) -> ?attr:attr -> ('b, Format.formatter, unit, 'a) format4 -> 'b

(* FIXME Menu *)
(*val menu_overlay : ?dx:'a -> ?dy:'b -> 'c -> 'd -> 'e*)
val main_menu_item : string -> (unit -> 'a) -> ui Lwd.t
val sub_menu_item : string -> (unit -> 'a) -> ui Lwd.t
val sub_entry : string -> (unit -> unit) -> ui

(* FIXME Explain how scrolling works *)
val scroll_step : int
type scroll_state = { position : int; bound : int; visible : int; total : int }
val default_scroll_state : scroll_state
val vscroll_area :
state:scroll_state Lwd.t ->
change:([> `Action | `Content ] -> scroll_state -> unit) ->
ui Lwd.t -> ui Lwd.t

val scroll_area :
?offset:int * int -> ui Lwd.t -> ui Lwd.t

(* FIXME Explain panes *)
val v_pane : ui Lwd.t -> ui Lwd.t -> ui Lwd.t
val h_pane : ui Lwd.t -> ui Lwd.t -> ui Lwd.t

(* FIXME Edit field *)

val edit_field :
?focus:Focus.handle ->
(string * int) Lwd.t ->
on_change:(string * int -> unit) ->
on_submit:(string * int -> unit) -> ui Lwd.t

(* FIXME Tabs *)

val tabs : (string * (unit -> ui Lwd.t)) list -> ui Lwd.t

(* FIXME Flex box *)

val flex_box : ?w:int Lwd.t -> ui Lwd.t list -> ui Lwd.t

(* FIXME Unfoldable *)

val unfoldable :
?folded_by_default:bool ->
ui Lwd.t -> (unit -> ui Lwd.t) -> ui Lwd.t

(* FIXME Boxes *)
val hbox : ui Lwd.t list -> ui Lwd.t
val vbox : ui Lwd.t list -> ui Lwd.t
val zbox : ui Lwd.t list -> ui Lwd.t

(* FIXME List *)
val vlist : ?bullet:string -> ui Lwd.t list -> ui Lwd.t

val vlist_with :
?bullet:string ->
?filter:('a -> bool) Lwd.t ->
('a -> ui Lwd.t) -> 'a list Lwd.t -> ui Lwd.t

val grid :
?max_h:int -> ?max_w:int ->
?pad:gravity -> ?crop:gravity -> ?bg:attr ->
?h_space:int -> ?v_space:int ->
?headers:ui Lwd.t list ->
ui Lwd.t list list -> ui Lwd.t

val button : ?attr:attr -> string -> (unit -> unit) -> ui

val file_select :
?abs:bool ->
?filter:(String.t -> bool) ->
on_select:(string -> unit) -> unit -> ui Lwd.t

val toggle : ?init:bool -> string Lwd.t -> (bool -> unit) -> ui Lwd.t

val toggle' : string Lwd.t -> bool Lwd.var -> ui Lwd.t

+ 1
- 1
lib/nottui/nottui.ml View File

@@ -246,7 +246,7 @@ struct
desc = Atom img;
sensor_cache = None; cache; }

let void x y = atom (I.void x y)
let space x y = atom (I.void x y)

let mouse_area f t : t =
{ t with desc = Mouse_handler (t, f) }


+ 1
- 0
lib/tyxml-lwd/dune View File

@@ -1,5 +1,6 @@
(library
(name tyxml_lwd)
(wrapped false)
(public_name tyxml-lwd)
(modes byte)
(preprocess (pps js_of_ocaml-ppx))


+ 31
- 0
lib/tyxml-lwd/lwdom.ml View File

@@ -0,0 +1,31 @@
module Xml = Tyxml_lwd.Xml
module Svg = Svg_f.Make(Tyxml_lwd.Xml)
module Html = Html_f.Make(Tyxml_lwd.Xml)(Svg)

type 'a t = 'a Xml.Elt.t
type 'a attr = 'a Xml.Attr.t

let elt x = Lwd.pure (Lwd_seq.element x)
let attr x : _ Xml.Attr.t = Lwd.pure (Some x)
let lwd_attr x : _ Xml.Attr.t = Lwd.map (fun x -> Some x) x

let dom_nodes x =
let rec fold x acc = match Lwd_seq.view x with
| Lwd_seq.Empty -> acc
| Lwd_seq.Element x -> x :: acc
| Lwd_seq.Concat (l, r) -> fold l (fold r acc)
in
fold x []

let children = function
| [] -> Xml.Child.nil ()
| [x] -> x
| [x; y] -> Lwd.map2 Lwd_seq.concat x y
| xs -> Lwd_utils.reduce Lwd_seq.lwd_monoid xs

let children_array = function
| [||] -> Xml.Child.nil ()
| [|x|] -> x
| [|x; y|] -> Lwd.map2 Lwd_seq.concat x y
| xs ->
Lwd_seq.bind (Lwd_seq.lift (Lwd.pure (Lwd_seq.of_array xs))) (fun x -> x)

+ 32
- 0
lib/tyxml-lwd/lwdom.mli View File

@@ -0,0 +1,32 @@
open Js_of_ocaml
open Tyxml_lwd

module Xml = Xml
module Svg : Svg_sigs.Make(Xml).T
module Html : Html_sigs.Make(Xml)(Svg).T

(** FIXME
- Explain that in this DOM binding, element is a monoid.
- Explain how to manage roots, connect to Browser document *)

type 'a t = 'a Xml.Elt.t
type 'a attr = 'a Xml.Attr.t

val elt : 'a -> 'a t
(** Create an element from a value *)

val children : 'a t list -> 'a t
(** Flatten a list of elements *)

val children_array : 'a t array -> 'a t
(** Flatten an array of elements *)

val attr : 'a -> 'a attr
(** Make a constant attribute *)

val lwd_attr : 'a Lwd.t -> 'a attr
(** Make a reactive attribute *)

(** FIXME: Expose higher-level interface, especially for managing roots and
connecting to the document *)
val dom_nodes : 'a Html.data Lwd_seq.t -> Dom.node Js.t list

Loading…
Cancel
Save