Compare commits

...

14 Commits

Author SHA1 Message Date
Frédéric Bour fa091a3d1f document, complete tyxml interface 1 year ago
Frédéric Bour 7b03af8a2d document nottui 1 year ago
Frédéric Bour a9095faa6f updating doc 1 year ago
Frédéric Bour 1067a65207 some Lwd_seq combinators 1 year ago
Frédéric Bour addb56401d tyxml: unify element and element list 1 year ago
Frédéric Bour da494a2613 lwd_seq: optimize pure case 1 year ago
Frédéric Bour ebd0d5c446 lwd_seq 1 year ago
Drup 58fd8c6b85 WIP tyxml lwd 1 year ago
Frédéric Bour bfc481aa54 WIP 1 year ago
Frédéric Bour a995047176 implement permanent sensors 1 year ago
Frédéric Bour b4447f82f3 wip 1 year ago
Frédéric Bour fe42d56bf5 full_sensor before/after 1 year ago
Frédéric Bour 9eb18e2207 Full_sensor trigger only once 1 year ago
Frédéric Bour 07823fed56 full-sensor 1 year ago
  1. 6
      Makefile
  2. 22
      README.md
  3. 6
      dune-project
  4. 5
      examples/pretty.ml
  5. 4
      lib/lwd/lwd.ml
  6. 1
      lib/lwd/lwd.mli
  7. 8
      lib/lwd/lwd_infix_letop.mli
  8. 101
      lib/lwd/lwd_seq.ml
  9. 120
      lib/lwd/lwd_seq.mli
  10. 75
      lib/lwd/lwd_table.mli
  11. 22
      lib/lwd/lwd_utils.ml
  12. 30
      lib/lwd/lwd_utils.mli
  13. 7
      lib/nottui-lwt/nottui_lwt.mli
  14. 6
      lib/nottui-pretty/nottui_pretty.ml
  15. 170
      lib/nottui-widgets/nottui_widgets.ml
  16. 93
      lib/nottui-widgets/nottui_widgets.mli
  17. 382
      lib/nottui/nottui.ml
  18. 296
      lib/nottui/nottui.mli
  19. 2
      lib/tyxml-lwd/Makefile
  20. 7
      lib/tyxml-lwd/dune
  21. 31
      lib/tyxml-lwd/lwdom.ml
  22. 32
      lib/tyxml-lwd/lwdom.mli
  23. 264
      lib/tyxml-lwd/tyxml_lwd.ml
  24. 25
      tyxml-lwd.opam

6
Makefile

@ -3,6 +3,9 @@ all:
TESTS=minimal misc reranger stress
$(TESTS):
dune build examples/$@.bc
run-minimal:
dune exec examples/minimal.bc
@ -18,6 +21,9 @@ run-stress:
run-pretty:
dune exec examples/pretty.bc
run-pretty-lambda:
dune exec examples/pretty_lambda.bc
run-stress.exe:
dune exec examples/stress.exe

22
README.md

@ -90,26 +90,6 @@ Here `Lwd.map : ('a -> 'b) -> 'a Lwd.t -> 'b Lwd.t` apply a transformation to a
When the `Link` is triggered, the counter is incremented. Because `document` depends on the value of the counter it is invalidated.
#### Optional: abstracting local state
This pattern of having local state that you want to manipulate in an almost purely functional way is very common and has been abstracted in the `Lwd_utils` library.
Here is another way to implement our button example:
```ocaml
val Lwd_utils.local_state : ('a Lwd.t -> ('a -> unit) -> 'a * 'b) -> 'b
Lwd_utils.local_state (fun counter update ->
let initial_value = 0 in
let increment clicks () = update (clicks + 1) in
let button clicks =
Link (increment clicks,
Text ("Clicked " ^ string_of_int clicks ^ " times"))
in
initial_value, Lwd.map button counter
)
```
### Building computation graph
`Lwd.t` implements a few abstractions that should be familiar to seasoned functional programmers:
@ -215,4 +195,4 @@ The first question can be answered positively with a naive encoding: put `Lwd.va
To answer the second question, it is interesting to observe that there is no concept of "diffing" here. _Lwd_ does not try to see if things have changed in order to update them. Rather, if an input change, the whole branch that depends on it is recomputed.
While this might lead to inefficient recomputations. ...TODO...
While this might lead to inefficient recomputations. ...TODO...

6
dune-project

@ -21,6 +21,12 @@
(description "TODO")
(depends dune lwd notty))
(package
(name tyxml-lwd)
(synopsis "Hello")
(description "TODO")
(depends dune lwd tyxml js_of_ocaml))
(package
(name nottui-pretty)
(synopsis "A pretty-printer based on PPrint rendering UIs")

5
examples/pretty.ml

@ -11,8 +11,7 @@ let spring = P.ui (Ui.resize ~sw:1 Ui.empty)
let selector text f choices =
Nottui_widgets.main_menu_item text (fun () ->
Lwd.pure @@
Lwd_utils.pure_pack Ui.pack_y (
Lwd.pure @@ Ui.vcat (
List.map
(fun choice ->
Nottui_widgets.sub_entry choice (fun () -> f choice))
@ -60,7 +59,7 @@ let varying_width f =
(f (Lwd.get width))
(fun ui ->
Nottui.Ui.size_sensor
(fun w _ -> if Lwd.peek width <> w then Lwd.set width w)
(fun ~w ~h:_ -> if Lwd.peek width <> w then Lwd.set width w)
(Nottui.Ui.resize ~sw:1 ~sh:1 ~w:0 ui))
let doc =

4
lib/lwd/lwd.ml

@ -73,6 +73,10 @@ let impure x = inj (
| other -> other
)
let is_pure x = match prj x with
| Pure x -> Some x
| _ -> None
let dummy = Pure (Any.any ())
let operator desc =

1
lib/lwd/lwd.mli

@ -46,6 +46,7 @@ val pair : 'a t -> 'b t -> ('a * 'b) t
(** [pair a b] is [map2 (fun x y->x,y) a b] *)
val impure : 'a t -> 'a t
val is_pure : 'a t -> 'a option
type 'a var
(** The workhorse of Lwd: a mutable variable that also tracks dependencies.

8
lib/lwd/lwd_infix_letop.mli

@ -1,6 +1,14 @@
val (let$) : 'a Lwd.t -> ('a -> 'b) -> 'b Lwd.t
(** Alias to {!Lwd.map'} suitable for let-op bindings *)
val (let$*) : 'a Lwd.t -> ('a -> 'b Lwd.t) -> 'b Lwd.t
(** Alias to {!Lwd.bind} suitable for let-op bindings *)
val (and$) : 'a Lwd.t -> 'b Lwd.t -> ('a * 'b) Lwd.t
(** Alias to {!Lwd.pair} suitable for let-op bindings *)
val ($=) : 'a Lwd.var -> 'a -> unit
(** Infix alias to {!Lwd.set} *)
val ($<-) : 'a Lwd_table.row -> 'a -> unit
(** Infix alias to {!Lwd_table.set} *)

101
lib/lwd/lwd_seq.ml

@ -448,24 +448,95 @@ end
(* Lwd interface *)
let rec pure_map_reduce map reduce = function
| Nil -> assert false
| Leaf t -> map t.v
| Join t ->
reduce
(pure_map_reduce map reduce t.l)
(pure_map_reduce map reduce t.r)
let fold ~map ~reduce seq =
let reducer = ref (Reducer.make ~map ~reduce) in
Lwd.map' seq @@ fun seq ->
let reducer' = Reducer.update !reducer seq in
reducer := reducer';
Reducer.reduce reducer'
match Lwd.is_pure seq with
| Some Nil -> Lwd.pure None
| Some other -> Lwd.pure (Some (pure_map_reduce map reduce other))
| None ->
let reducer = ref (Reducer.make ~map ~reduce) in
Lwd.map' seq @@ fun seq ->
let reducer' = Reducer.update !reducer seq in
reducer := reducer';
Reducer.reduce reducer'
let fold_monoid map (zero, reduce) seq =
let reducer = ref (Reducer.make ~map ~reduce) in
Lwd.map' seq @@ fun seq ->
let reducer' = Reducer.update !reducer seq in
reducer := reducer';
match Reducer.reduce reducer' with
| None -> zero
| Some x -> x
match Lwd.is_pure seq with
| Some Nil -> Lwd.pure zero
| Some other -> Lwd.pure (pure_map_reduce map reduce other)
| None ->
let reducer = ref (Reducer.make ~map ~reduce) in
Lwd.map' seq @@ fun seq ->
let reducer' = Reducer.update !reducer seq in
reducer := reducer';
match Reducer.reduce reducer' with
| None -> zero
| Some x -> x
let monoid = (empty, concat)
let transform_list ls f =
Lwd_utils.map_reduce f monoid ls
let of_list ls = transform_list ls element
let rec of_sub_array f arr i j =
if j < i then empty
else if j = i then f arr.(i)
else
let k = i + (j - i) / 2 in
concat (of_sub_array f arr i k) (of_sub_array f arr (k + 1) j)
let transform_array arr f = of_sub_array f arr 0 (Array.length arr - 1)
let of_array arr = transform_array arr element
let to_list x =
let rec fold x acc = match x with
| Nil -> acc
| Leaf t -> t.v :: acc
| Join t -> fold t.l (fold t.r acc)
in
fold x []
let to_array x =
let rec count = function
| Nil -> 0
| Leaf _ -> 1
| Join t -> count t.l + count t.r
in
match count x with
| 0 -> [||]
| n ->
let rec first = function
| Nil -> assert false
| Leaf t -> t.v
| Join t -> first t.l
in
let first = first x in
let arr = Array.make n first in
let rec fold i = function
| Nil -> i
| Leaf t -> arr.(i) <- t.v; i + 1
| Join t ->
let i = fold i t.l in
let i = fold i t.r in
i
in
let _ : int = fold 0 x in
arr
let lwd_empty : 'a t Lwd.t = Lwd.pure Nil
let lwd_monoid : 'a. 'a t Lwd.t Lwd_utils.monoid =
(lwd_empty, fun x y -> Lwd.map2 concat x y)
let map f seq =
fold_monoid (fun x -> element (f x)) monoid seq
@ -480,4 +551,8 @@ let filter_map f seq =
fold_monoid select monoid seq
let lift (seq : 'a Lwd.t seq Lwd.t) : 'a seq Lwd.t =
Lwd.join (fold_monoid (Lwd.map element) (Lwd_utils.lift_monoid monoid) seq)
Lwd.join (fold_monoid (Lwd.map element) lwd_monoid seq)
let bind (seq : 'a seq Lwd.t) (f : 'a -> 'b seq) : 'b seq Lwd.t =
fold_monoid f monoid seq

120
lib/lwd/lwd_seq.mli

@ -1,42 +1,46 @@
(* Sequence construction
(** {0 Sequence manipulation}
[Lwd_seq] implements a type of ordered collections with a pure interface.
In addition, changes to collections are easy to track.
[Lwd_seq] is an ordered collection with a pure interface.
Changes to collections are easy to track.
A collection can be transformed with the usual map, filter and fold
combinators. If later, the transformation is applied again to an updated
collection, shared elements (in the sense of physical sharing), the
result of the previous transformation will be reused for these elements.
A collection can be transformed with the usual map, filter and fold
combinators. If the collection is updated, shared elements (in the sense of
physical sharing), the result of the previous transformation will be reused
for these elements.
The book-keeping overhead is O(n) in the number of changes, so O(1) per
element.
The book-keeping overhead is O(n) in the number of changes, so O(1) per
element.
*)
type +'a t
type +'a seq = 'a t
(** The type of sequences *)
(** {1 Primitive constructors} *)
(* A sequence with no element. *)
val empty : 'a seq
(** A sequence with no element. *)
(* A singleton sequence. The physical identity of the element is considered
when reusing previous computations.
val element : 'a -> 'a seq
(** A singleton sequence. The physical identity of the element is considered
when reusing previous computations.
If you do:
let x1 = element x
let x2 = element x
If you do:
Then x1 and x2 are seen as different elements and no sharing will be done
during transformation.
*)
val element : 'a -> 'a seq
{[let x1 = element x
let x2 = element x]}
(* Concatenate two sequences into a bigger one.
As for [element], the physical identity of a sequence is considered for
reuse.
Then [x1] and [x2] are seen as different elements and no sharing will be
done during transformation.
*)
val concat : 'a seq -> 'a seq -> 'a seq
(** Concatenate two sequences into a bigger one.
As for [element], the physical identity of a sequence is considered for
reuse.
*)
(* Look at the contents of a sequence *)
(** {1 Looking at sequence contents} *)
type ('a, 'b) view =
| Empty
@ -44,18 +48,44 @@ type ('a, 'b) view =
| Concat of 'b * 'b
val view : 'a seq -> ('a, 'a seq) view
(** View how a sequence is defined *)
(** {1 Conversion between sequences, lists and arrays} *)
val transform_list : 'a list -> ('a -> 'b seq) -> 'b seq
(** Produce a sequence by transforming each element of a list and concatenating
all results. *)
val transform_array : 'a array -> ('a -> 'b seq) -> 'b seq
(** Produce a sequence by transforming each element of an array and
concatenating all results. *)
val of_list : 'a list -> 'a seq
(** Produce a sequence from a list *)
val of_array : 'a array -> 'a seq
(** Produce a sequence from an array *)
val to_list : 'a seq -> 'a list
(** Produce a list from a sequence *)
val to_array : 'a seq -> 'a array
(** Produce an array from a sequence *)
(** {1 Balanced variant of sequences *)
module Balanced : sig
(* A variant of the sequence type that guarantees that the depth of
transformation, as measured in the number of [concat] nodes, grows in
O(log n) where n is the number of elements in the sequnce.
(** A variant of the sequence type that guarantees that the depth of a
transformation, measured as the number of nested [concat] nodes, grows in
O(log n) where n is the number of elements in the sequnce.
This is useful to prevent stack overflows and to avoid degenerate cases
where a single element change, but it is at the end of a linear sequence
where a single element changes, but it is at the end of a linear sequence
of [concat] nodes, thus making the total work O(n).
For instance, in:
[concat e1 (concat e2 (concat e3 (... (concat e_n))...))]
{[concat e1 (concat e2 (concat e3 (... (concat e_n))...))]}
If [e_n] changes, the whole spine has to be recomputed.
@ -67,7 +97,10 @@ module Balanced : sig
only useful to balance the first sequence of the pipeline. Derived
sequence will have a depth bounded by the depth of the first one.
*)
type 'a t = private 'a seq
(** Type of balanced sequences *)
val empty : 'a t
val element : 'a -> 'a t
val concat : 'a t -> 'a t -> 'a t
@ -75,36 +108,51 @@ module Balanced : sig
val view : 'a t -> ('a, 'a t) view
end
(* Lwd interface.
(** {1 Transforming sequences} *)
(**
All sequences live in [Lwd] monad: if a sequence changes slightly, parts
that have not changed will not be re-transformed.
*)
(* [fold ~map ~reduce] transforms a sequence.
If the sequence is non-empty, the [map] function is applied to element nodes
and the [reduce] function is used to combine transformed concatenated nodes.
If the sequence is empty, None is returned.
*)
val fold :
map:('a -> 'b) -> reduce:('b -> 'b -> 'b) -> 'a seq Lwd.t -> 'b option Lwd.t
(** [fold ~map ~reduce] transforms a sequence.
If the sequence is non-empty, the [map] function is applied to element
nodes and the [reduce] function is used to combine transformed concatenated
nodes.
If the sequence is empty, None is returned.
*)
val fold_monoid :
('a -> 'b) -> 'b Lwd_utils.monoid -> 'a seq Lwd.t -> 'b Lwd.t
(** Like [fold], but reduction and default value are defined by a [monoid] *)
(* [map f] transforms a sequence by applying [f] to each element. *)
val map :
('a -> 'b) -> 'a seq Lwd.t -> 'b seq Lwd.t
(** [map f] transforms a sequence by applying [f] to each element. *)
val filter :
('a -> bool) -> 'a seq Lwd.t -> 'a seq Lwd.t
(** [filter p] transforms a sequence by keeping elements that satisfies [p]. *)
val filter_map :
('a -> 'b option) -> 'a seq Lwd.t -> 'b seq Lwd.t
(** Filter and map elements at the same time *)
val lift : 'a Lwd.t seq Lwd.t -> 'a seq Lwd.t
(** Remove a layer of [Lwd] inside a sequence. *)
val bind : 'a seq Lwd.t -> ('a -> 'b seq) -> 'b seq Lwd.t
(** Sequence forms a monad too... *)
val monoid : 'a t Lwd_utils.monoid
(** Monoid instance for sequences *)
val lwd_monoid : 'a t Lwd.t Lwd_utils.monoid
(** Monoid instance for reactive sequences *)
(* Low-level interface *)
(** {1 Low-level interface for observing changes} *)
module Reducer : sig
(* The interface allows to implement incremental sequence transformation

75
lib/lwd/lwd_table.mli

@ -1,29 +1,102 @@
(** {0 Table manipulation}
[Lwd_table] is an ordered collection with an impure interface.
It is designed to be efficient in an interactive setting.
The interface mimics the one of a doubly-linked lists: from a node, called
row, you can iterate backward and forward, insert and delete other nodes,
and change the value it is bound to.
The sequence of nodes can be observed by map/reduce operations, that will
be recomputed efficiently when sequence changes.
*)
type 'a t
type 'a row
(** The type of tables *)
val make : unit -> 'a t
val clear : 'a t -> unit
(** Create a new table *)
(** {1 Inserting rows} *)
val prepend : ?set:'a -> 'a t -> 'a row
(** Insert and return a new row at the start of a table.
It can be optionnally initialized to the value of [set]. *)
val append : ?set:'a -> 'a t -> 'a row
(** Insert and return a new row at the end of a table.
It can be optionnally initialized to the value of [set]. *)
val prepend' : 'a t -> 'a -> unit
(* Insert a new initialized row at start of a table *)
val append' : 'a t -> 'a -> unit
(* Insert a new initialized row at end of a table *)
val before : ?set:'a -> 'a row -> 'a row
(** Insert and return a new row just before an existing row.
It can be optionnally initialized to the value of [set].
If the input row is unbound ([is_bound] returns false), the returned row is
too.
*)
val after : ?set:'a -> 'a row -> 'a row
(** Insert and return a new row just after an existing row.
It can be optionnally initialized to the value of [set].
If the input row is unbound ([is_bound] returns false), the returned row is
too.
*)
(** {1 Iterating over rows} *)
val first : 'a t -> 'a row option
(** Returns the first row of a table, or [None] if the table is empty *)
val last : 'a t -> 'a row option
(** Returns the last row of a table, or [None] if the table is empty *)
val next : 'a row -> 'a row option
(** Returns the row next to another one, or [None] if the input row is unbound
or is the last row *)
val prev : 'a row -> 'a row option
(** Returns the row just before another one, or [None] if the input row is
unbound or is the first row *)
(** {1 Accessing and changing row contents} *)
val get : 'a row -> 'a option
(** Get the value associated with a row, if any, or [None] if the row is
unbound *)
val set : 'a row -> 'a -> unit
(** Set the value associated with a row, or do nothing if the row is unbound *)
val unset : 'a row -> unit
(** Unset the value associated with a row *)
(** {1 Removing rows} *)
val is_bound : 'a row -> bool
(** Returns [true] iff the row is bound in a table (it has not beem [remove]d
yet, the table has not been [clear]ed) *)
val remove : 'a row -> unit
(** [remove] a row from its table, [is_bound] will be [true] after that *)
val clear : 'a t -> unit
(** Remove all rows from a table *)
(** {1 Observing table contents} *)
val reduce : 'a Lwd_utils.monoid -> 'a t -> 'a Lwd.t
(** Observe the content of a table by reducing it with a monoid *)
val map_reduce : ('a row -> 'a -> 'b) -> 'b Lwd_utils.monoid -> 'a t -> 'b Lwd.t
(** Observe the content of a table by mapping and reducing it *)
val iter : ('a -> unit) -> 'a t -> unit
(** Immediate, non reactive, iteration over elements of a table *)

22
lib/lwd/lwd_utils.ml

@ -4,18 +4,21 @@ type 'a monoid = 'a * ('a -> 'a -> 'a)
let lift_monoid (zero, plus) =
(Lwd.return zero, Lwd.map2 plus)
let pure_pack (zero, plus) items =
let map_reduce inj (zero, plus) items =
let rec cons_monoid c xs v =
match xs with
| (c', v') :: xs when c = c' ->
cons_monoid (c + 1) xs (plus v' v)
| xs -> (c, v) :: xs
in
match List.fold_left (cons_monoid 0) [] items with
let cons_monoid xs v = cons_monoid 0 xs (inj v) in
match List.fold_left cons_monoid [] items with
| [] -> zero
| (_,x) :: xs ->
List.fold_left (fun acc (_, v) -> plus v acc) x xs
let reduce monoid items = map_reduce (fun x -> x) monoid items
let rec cons_lwd_monoid plus c xs v =
match xs with
| (c', v') :: xs when c = c' ->
@ -34,21 +37,6 @@ let pack_seq (zero, plus) items =
| (_,x) :: xs ->
List.fold_left (fun acc (_, v) -> Lwd.map2 plus v acc) x xs
let local_state f =
let r = ref None in
let acquire () = match !r with
| None -> invalid_arg "Lwd_utils.trace: cyclic evaluation"
| Some v -> v
in
let prim = Lwd.prim ~acquire ~release:ignore in
let update v =
r := Some v;
Lwd.invalidate prim
in
let v, result = f (Lwd.get_prim prim) update in
r := Some v;
result
let rec map_l (f:'a -> 'b Lwd.t) (l:'a list) : 'b list Lwd.t =
match l with
| [] -> Lwd.return []

30
lib/lwd/lwd_utils.mli

@ -1,12 +1,38 @@
type 'a monoid = 'a * ('a -> 'a -> 'a)
(** A monoid, defined by a default element and an associative operation *)
val lift_monoid : 'a monoid -> 'a Lwd.t monoid
(** Use a monoid inside [Lwd] *)
(** {1 List reduction functions}
All reductions are balanced, relying on operator associativity.
[fold_left] would compute a chain like:
[fold f [a; b; c; d] = f a (f b (f c d)]
[reduce] uses tree-shaped computations like:
[reduce f [a; b; c; d] = f (f a b) (f c d)]
The depth of the computation grows in O(log n) where n is the length of the
input sequence.
*)
val pack : 'a monoid -> 'a Lwd.t list -> 'a Lwd.t
(** Reduce a list of elements in [Lwd] monad *)
val pack_seq : 'a monoid -> 'a Lwd.t Seq.t -> 'a Lwd.t
val pure_pack : 'a monoid -> 'a list -> 'a
(** Reduce an (OCaml) [Seq.t] with a monoid *)
val reduce : 'a monoid -> 'a list -> 'a
(** Reduce a list with a monoid **)
val map_reduce : ('a -> 'b) -> 'b monoid -> 'a list -> 'b
(** Map and reduce a list with a monoid **)
val local_state : ('a Lwd.t -> ('a -> unit) -> 'a * 'b) -> 'b
(** {1 Other Lwd list functions} *)
val map_l : ('a -> 'b Lwd.t) -> 'a list -> 'b list Lwd.t
val flatten_l : 'a Lwd.t list -> 'a list Lwd.t
(** Commute [Lwd] and [list] *)

7
lib/nottui-lwt/nottui_lwt.mli

@ -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.
*)

6
lib/nottui-pretty/nottui_pretty.ml

@ -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 *)

170
lib/nottui-widgets/nottui_widgets.ml

@ -48,13 +48,15 @@ let attr_menu_main = A.(bg green ++ fg black)
let attr_menu_sub = A.(bg lightgreen ++ fg black)
let menu_overlay ?dx ?dy handler t =
let placeholder = Lwd.return (Ui.atom (I.void 1 0)) in
ignore (dx, dy, handler, t);
assert false
(*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
Ui.atom (I.char A.(bg lightgreen) ' ' w h)
in
Lwd.map (Ui.overlay ?dx ?dy ~handler) (Lwd_utils.pack Ui.pack_z [bg; body])
Lwd.map (Ui.overlay ?dx ?dy ~handler) (Lwd_utils.pack Ui.pack_z [bg; body])*)
let scroll_step = 1
@ -93,9 +95,9 @@ 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 _ h ->
|> Ui.size_sensor (fun ~w:_ ~h ->
let tchange =
if !total <> (Ui.layout_spec t).Ui.h
then (total := (Ui.layout_spec t).Ui.h; true)
@ -138,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
@ -230,7 +232,7 @@ let v_pane left right =
in
splitter $= Lwd.map (Ui.mouse_area action) (Lwd.get splitter_bg);
render ();
let on_resize ew eh =
let on_resize ~w:ew ~h:eh =
if !w <> ew || !h <> eh then (
w := ew; h := eh;
render ()
@ -239,44 +241,112 @@ let v_pane left right =
Lwd.map' node @@ fun t ->
Ui.size_sensor on_resize (Ui.resize ~w:10 ~h:10 ~sw:1 ~sh:1 t)
let h_pane top bottom =
let w = ref 10 in
let h = ref 10 in
let split = ref 0.5 in
let splitter = Lwd.var empty_lwd in
let splitter_bg = Lwd.var Ui.empty in
let top_pane = Lwd.var empty_lwd in
let bot_pane = Lwd.var empty_lwd in
let node = Lwd_utils.pack Ui.pack_x [!$top_pane; !$splitter; !$bot_pane] in
let render () =
let split = int_of_float (!split *. float !w) in
let split = min (!w - 1) (max split 0) in
top_pane $= Lwd.map' top
(fun t -> Ui.resize ~w:split ~h:!h t);
bot_pane $= Lwd.map' bottom
(fun t -> Ui.resize ~w:(!w - split - 1) ~h:!h t);
splitter_bg $= Ui.atom (Notty.I.char Notty.A.(bg lightyellow) ' ' 1 !h);
in
let action ~x:_ ~y:_ = function
| `Left ->
let x0 = int_of_float (!split *. float !w) in
`Grab ((fun ~x ~y:_ ->
let x0' = x0 + x in
split := min 1.0 (max 0.0 (float x0' /. float !w));
render ()
), (fun ~x:_ ~y:_ -> ()))
| _ -> `Unhandled
in
splitter $= Lwd.map (Ui.mouse_area action) (Lwd.get splitter_bg);
render ();
let on_resize ew eh =
if !w <> ew || !h <> eh then (
w := ew; h := eh;
render ()
)
type pane_state =
| Split of { pos: int; max: int }
| Re_split of { pos: int; max: int; at: int }
let h_pane l r =
let state_var = Lwd.var (Split {pos = 5; max = 10}) in
let render state (l, r) =
let (Split {pos; max} | Re_split {pos; max; _}) = state in
let l = Ui.resize ~w:0 ~h:0 ~sh:1 ~sw:pos l in
let r = Ui.resize ~w:0 ~h:0 ~sh:1 ~sw:(max - pos) r in
let splitter =
Ui.resize ~bg:Notty.A.(bg lightyellow) ~w:1 ~h:0 ~sw:0 ~sh:1 Ui.empty
in
let splitter =
Ui.mouse_area (fun ~x:_ ~y:_ -> function
| `Left ->
`Grab (
(fun ~x ~y:_ ->
match Lwd.peek state_var with
| Split {pos; max} ->
Lwd.set state_var (Re_split {pos; max; at = x})
| Re_split {pos; max; at} ->
if at <> x then
Lwd.set state_var (Re_split {pos; max; at = x})
),
(fun ~x:_ ~y:_ -> ())
)
| _ -> `Unhandled
) splitter
in
let ui = Ui.join_x l (Ui.join_x splitter r) in
let ui = Ui.resize ~w:10 ~h:10 ~sw:1 ~sh:1 ui in
let ui = match state with
| Split _ -> ui
| Re_split {at; _} ->
Ui.transient_sensor (fun ~x ~y:_ ~w ~h:_ () ->
Lwd.set state_var (Split {pos = (at - x); max = w})
) ui
in
ui
in
Lwd.map2 render (Lwd.get state_var) (Lwd.pair l r)
(*type pane_state =
| Static of { w : int; h : int; split : float }
| Resizing of { w : int; h : int; split : float; x : int; y : int; }
let pane_h (Static {h; _} | Resizing {h; _}) = h
let pane_w (Static {w; _} | Resizing {w; _}) = w
let pane_split (Static {split; _} | Resizing {split; _}) = split
let h_pane l r =
let state_var = Lwd.var (Static {w = 0; h = 0 ; split = 0.5}) in
let render state (l, r) =
let h = pane_h state in
let split = int_of_float (pane_split state *. float (pane_w state)) in
let l = Ui.resize ~w:split ~h l in
let r = Ui.resize ~w:(pane_w state - split - 1) ~h r in
let splitter = Ui.atom (Notty.I.char Notty.A.(bg lightyellow) ' ' 1 h) in
let splitter =
Ui.mouse_area (fun ~x:_ ~y:_ -> function
| `Left ->
`Grab (
(fun ~x ~y:_ ->
match Lwd.peek state_var with
| Static {w; h; split} ->
Lwd.set state_var (Resizing {x = min_int; y = min_int; w; h; split})
| Resizing r ->
if r.x > min_int then
let split = float (x - r.x) /. float r.w in
Lwd.set state_var (Resizing {r with split})
),
(fun ~x:_ ~y:_ ->
match Lwd.peek state_var with
| Static _ -> ()
| Resizing {w; h; split; _} ->
Lwd.set state_var (Static {w; h; split})
)
)
| _ -> `Unhandled
) splitter
in
let ui = Ui.join_x l (Ui.join_x splitter r) in
let ui = Ui.resize ~w:10 ~h:10 ~sw:1 ~sh:1 ui in
let ui = match state with
| Static _ ->
Ui.size_sensor (fun ~w ~h ->
match Lwd.peek state_var with
| Static r ->
if r.w <> w || r.h <> h then
Lwd.set state_var (Static {r with w; h})
| Resizing _ -> ()
) ui
| Resizing _ ->
Ui.permanent_sensor (fun ~x ~y ~w ~h ->
match Lwd.peek state_var with
| Static _ -> ignore
| Resizing r ->
if r.x <> x || r.y <> y || r.w <> w || r.h <> h then
Lwd.set state_var (Resizing {x; y; w; h; split = r.split});
ignore
) ui
in
ui
in
Lwd.map' node @@ fun t ->
Ui.size_sensor on_resize (Ui.resize ~w:10 ~h:10 ~sw:1 ~sh:1 t)
Lwd.map2 render (Lwd.get state_var) (Lwd.pair l r)*)
let sub' str p l =
if p = 0 && l = String.length str
@ -486,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
@ -494,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)
@ -527,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
@ -545,14 +615,14 @@ 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.pure_pack pack_pad_x row)
Lwd_utils.reduce pack_pad_x row)
rows
in
(* TODO: mouse and keyboard handling *)
let ui = Lwd_utils.pure_pack pack_pad_y rows in
let ui = Lwd_utils.reduce pack_pad_y rows in
Lwd.return ui
let button ?attr s f =

93
lib/nottui-widgets/nottui_widgets.mli

@ -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

382
lib/nottui/nottui.ml

@ -81,9 +81,6 @@ sig
val h : t -> direction
val v : t -> direction
val bottom_left : t
val bottom_right : t
type t2
val pair : t -> t -> t2
val p1 : t2 -> t
@ -112,9 +109,6 @@ struct
let h x = unpack (x lsr 2)
let v x = unpack (x land 3)
let bottom_left = make ~h:`Negative ~v:`Positive
let bottom_right = make ~h:`Positive ~v:`Positive
let pp_direction ppf dir =
let text = match dir with
| `Negative -> "`Negative"
@ -134,6 +128,35 @@ struct
end
type gravity = Gravity.t
module Interval : sig
type t = private int
val make : int -> int -> t
val shift : t -> int -> t
val fst : t -> int
val snd : t -> int
(*val size : t -> int*)
val zero : t
end = struct
type t = int
let half = Sys.word_size lsr 1
let mask = (1 lsl half) - 1
let make x y =
let size = y - x in
(*assert (size >= 0);*)
(x lsl half) lor (size land mask)
let shift t d =
t + d lsl half
let fst t = t asr half
let size t = t land mask
let snd t = fst t + size t
let zero = 0
end
module Ui =
struct
type may_handle = [ `Unhandled | `Handled ]
@ -165,42 +188,41 @@ struct
let pp_layout_spec ppf { w; h; sw; sh } =
Format.fprintf ppf "{ w = %d; h = %d; sw = %d; sh = %d }" w h sw sh
type 'a desc =
| Atom of image
| Size_sensor of 'a * (int -> int -> unit)
| Resize of 'a * Gravity.t2 * A.t
| Mouse_handler of 'a * mouse_handler
| Focus_area of 'a * (key -> may_handle)
| Scroll_area of 'a * int * int
| Event_filter of 'a * ([`Key of key | `Mouse of mouse] -> may_handle)
| Overlay of 'a overlay
| X of 'a * 'a
| Y of 'a * 'a
| Z of 'a * 'a
and 'a overlay = {
o_n : 'a;
o_h : mouse_handler;
o_x : int;
o_y : int;
o_z : int;
o_origin : Gravity.t;
o_direction : Gravity.t;
}
type flags = int
let flags_none = 0
let flag_transient_sensor = 1
let flag_permanent_sensor = 2
type size_sensor = w:int -> h:int -> unit
type frame_sensor = x:int -> y:int -> w:int -> h:int -> unit -> unit
type t = {
w : int; sw : int;
h : int; sh : int;
desc : t desc;
mutable desc : desc;
focus : Focus.status;
mutable flags : flags;
mutable sensor_cache : (int * int * int * int) option;
mutable cache : cache;
}
and cache = {
vx1 : int; vy1 : int;
vx2 : int; vy2 : int;
vx : Interval.t; vy : Interval.t;
image : image;
overlays: t overlay list;
}
and desc =
| Atom of image
| Size_sensor of t * size_sensor
| Transient_sensor of t * frame_sensor
| Permanent_sensor of t * frame_sensor
| Resize of t * Gravity.t2 * A.t
| Mouse_handler of t * mouse_handler
| Focus_area of t * (key -> may_handle)
| Shift_area of t * int * int
| Event_filter of t * ([`Key of key | `Mouse of mouse] -> may_handle)
| X of t * t
| Y of t * t
| Z of t * t
let layout_spec t : layout_spec =
{ w = t.w; h = t.h; sw = t.sw; sh = t.sh }
@ -210,20 +232,21 @@ struct
let layout_stretch_height t = t.sh
let cache : cache =
{ vx1 = 0; vy1 = 0; vx2 = 0; vy2 = 0;
image = I.empty; overlays = [] }
{ vx = Interval.zero; vy = Interval.zero; image = I.empty }
let empty : t =
{ w = 0; sw = 0; h = 0; sh = 0;
focus = Focus.empty; desc = Atom I.empty; cache }
{ w = 0; sw = 0; h = 0; sh = 0; flags = flags_none;
focus = Focus.empty; desc = Atom I.empty;
sensor_cache = None; cache }
let atom img : t =
{ w = I.width img; sw = 0;
h = I.height img; sh = 0;
focus = Focus.empty;
desc = Atom img; cache }
focus = Focus.empty; flags = flags_none;
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) }
@ -235,36 +258,31 @@ struct
in
{ t with desc = Focus_area (t, f); focus }
let scroll_area x y t : t =
{ t with desc = Scroll_area (t, x, y) }
let shift_area x y t : t =
{ t with desc = Shift_area (t, x, y) }
let size_sensor handler t : t =
{ t with desc = Size_sensor (t, handler) }
let resize ?w ?h ?sw ?sh ?fill ?crop ?(bg=A.empty) t : t =
let g = match fill, crop with
let transient_sensor frame_sensor t =
{ t with desc = Transient_sensor (t, frame_sensor);
flags = t.flags lor flag_transient_sensor }
let permanent_sensor frame_sensor t =
{ t with desc = Permanent_sensor (t, frame_sensor);
flags = t.flags lor flag_permanent_sensor }
let resize ?w ?h ?sw ?sh ?pad ?crop ?(bg=A.empty) t : t =
let g = match pad, crop with
| None, None -> Gravity.(pair default default)
| Some g, None | None, Some g -> Gravity.(pair g g)
| Some fill, Some crop -> Gravity.(pair fill crop)
| Some pad, Some crop -> Gravity.(pair pad crop)
in
match (w, t.w), (h, t.h), (sw, t.sw), (sh, t.sh) with
| (Some w, _ | None, w), (Some h, _ | None, h),
(Some sw, _ | None, sw), (Some sh, _ | None, sh) ->
{t with w; h; sw; sh; desc = Resize (t, g, bg)}
(* TODO: dangerous in a bind? use [Lwd_utils.local_state] instead? *)
let last_z = ref 0
let overlay ?dx:(o_x=0) ?dy:(o_y=0)
?handler:(o_h=fun ~x:_ ~y:_ _ -> `Unhandled)
?origin:(o_origin=Gravity.bottom_left)
?direction:(o_direction=Gravity.bottom_right)
=
let o_z = incr last_z; !last_z in
fun o_n ->
let desc = Overlay { o_n; o_x; o_y; o_h; o_z; o_origin; o_direction } in
{ w = 0; sw = 0; h = 0; sh = 0; desc; focus = Focus.empty; cache }
let event_filter ?focus f t : t =
let focus = match focus with
| None -> t.focus
@ -275,28 +293,34 @@ struct
let join_x a b = {
w = (a.w + b.w); sw = (a.sw + b.sw);
h = (maxi a.h b.h); sh = (maxi a.sh b.sh);
focus = Focus.merge a.focus b.focus; desc = X (a, b); cache
flags = a.flags lor b.flags;
focus = Focus.merge a.focus b.focus; desc = X (a, b);
sensor_cache = None; cache
}
let join_y a b = {
w = (maxi a.w b.w); sw = (maxi a.sw b.sw);
h = (a.h + b.h); sh = (a.sh + b.sh);
focus = Focus.merge a.focus b.focus; desc = Y (a, b); cache;
flags = a.flags lor b.flags;
focus = Focus.merge a.focus b.focus; desc = Y (a, b);
sensor_cache = None; cache;
}
let join_z a b = {
w = (maxi a.w b.w); sw = (maxi a.sw b.sw);
h = (maxi a.h b.h); sh = (maxi a.sh b.sh);
focus = Focus.merge a.focus b.focus; desc = Z (a, b); cache;
flags = a.flags lor b.flags;
focus = Focus.merge a.focus b.focus; desc = Z (a, b);
sensor_cache = None; cache;
}
let pack_x = (empty, join_x)
let pack_y = (empty, join_y)
let pack_z = (empty, join_z)
let hcat xs = Lwd_utils.pure_pack pack_x xs
let vcat xs = Lwd_utils.pure_pack pack_y xs
let zcat xs = Lwd_utils.pure_pack pack_z xs
let hcat xs = Lwd_utils.reduce pack_x xs
let vcat xs = Lwd_utils.reduce pack_y xs
let zcat xs = Lwd_utils.reduce pack_z xs
let has_focus t = Focus.has_focus t.focus
@ -309,6 +333,10 @@ struct
| Atom _ -> Format.fprintf ppf "Atom _"
| Size_sensor (desc, _) ->
Format.fprintf ppf "Size_sensor (@[%a,@ _@])" pp desc
| Transient_sensor (desc, _) ->
Format.fprintf ppf "Transient_sensor (@[%a,@ _@])" pp desc
| Permanent_sensor (desc, _) ->
Format.fprintf ppf "Permanent_sensor (@[%a,@ _@])" pp desc
| Resize (desc, gravity, _bg) ->
Format.fprintf ppf "Resize (@[%a,@ %a,@ %a@])" pp desc
Gravity.pp (Gravity.p1 gravity)
@ -317,26 +345,20 @@ struct
Format.fprintf ppf "Mouse_handler (@[%a,@ _@])" pp n
| Focus_area (n, _) ->
Format.fprintf ppf "Focus_area (@[%a,@ _@])" pp n
| Scroll_area (n, _, _) ->
Format.fprintf ppf "Scroll_area (@[%a,@ _@])" pp n
| Shift_area (n, _, _) ->
Format.fprintf ppf "Shift_area (@[%a,@ _@])" pp n
| Event_filter (n, _) ->
Format.fprintf ppf "Event_filter (@[%a,@ _@])" pp n
| Overlay o -> Format.fprintf ppf "Overlay (@[%a,@ _@])" pp_overlay o
| X (a, b) -> Format.fprintf ppf "X (@[%a,@ %a@])" pp a pp b
| Y (a, b) -> Format.fprintf ppf "Y (@[%a,@ %a@])" pp a pp b
| Z (a, b) -> Format.fprintf ppf "Z (@[%a,@ %a@])" pp a pp b
and pp_overlay ppf r =
Format.fprintf ppf
"{@[o_n=%a;@ o_h=%s;@ o_h=%d;@ o_x=%d;@ o_y=%d;@ \
o_origin=%a;@ o_direction=%a@]}" pp r.o_n "_" r.o_x r.o_y r.o_z
Gravity.pp r.o_origin Gravity.pp r.o_direction
let iter f ui = match ui.desc with
| Atom _ -> ()
| Size_sensor (u, _) | Resize (u, _, _) | Mouse_handler (u, _)
| Focus_area (u, _) | Scroll_area (u, _, _) | Event_filter (u, _)
| Overlay {o_n = u; _} -> f u
| Size_sensor (u, _) | Transient_sensor (u, _) | Permanent_sensor (u, _)
| Resize (u, _, _) | Mouse_handler (u, _)
| Focus_area (u, _) | Shift_area (u, _, _) | Event_filter (u, _)
-> f u
| X (u1, u2) | Y (u1, u2) | Z (u1, u2) -> f u1; f u2
end
type ui = Ui.t
@ -351,7 +373,7 @@ struct
type t = {
mutable size : size;
mutable view : ui;
mutable mouse_grab : (int * int * grab_function) option;
mutable mouse_grab : grab_function option;
}
let make () = {
@ -372,19 +394,6 @@ struct
in
aux ui
let update_focus ui =
match ui.focus with
| Focus.Empty | Focus.Handle _ -> ()
| Focus.Conflict i -> solve_focus ui i
let update t size ui =
t.size <- size;
t.view <- ui;
update_focus ui
let sort_overlays o = List.sort
(fun o1 o2 -> - compare o1.o_z o2.o_z) o
let split ~a ~sa ~b ~sb total =
let stretch = sa + sb in
let flex = total - a - b in
@ -410,12 +419,72 @@ struct
| `Neutral -> (flex / 2, fixed)
| `Positive -> (flex, fixed)
let has_transient_sensor flags = flags land flag_transient_sensor <> 0
let has_permanent_sensor flags = flags land flag_permanent_sensor <> 0