|
- open Lwd_infix
- open Lwd.Infix
- open Notty
- open Nottui
-
- let (!$) x = Lwd.join (Lwd.get x)
- let empty_lwd = Lwd.return Ui.empty
-
- let string ?(attr=A.empty) str =
- let control_character_index str i =
- let len = String.length str in
- let i = ref i in
- while let i = !i in i < len && str.[i] >= ' ' do
- incr i;
- done;
- if !i = len then raise Not_found;
- !i
- in
- let rec split str i =
- match control_character_index str i with
- | j ->
- let img = I.string attr (String.sub str i (j - i)) in
- img :: split str (j + 1)
- | exception Not_found ->
- [I.string attr
- (if i = 0 then str
- else String.sub str i (String.length str - i))]
- in
- Ui.atom (I.vcat (split str 0))
-
- let int ?attr x = string ?attr (string_of_int x)
- let bool ?attr x = string ?attr (string_of_bool x)
- let float_ ?attr x = string ?attr (string_of_float x)
-
- let printf ?attr fmt =
- Printf.ksprintf (string ?attr) fmt
-
- let fmt ?attr fmt =
- Format.kasprintf (string ?attr) fmt
-
- let kprintf k ?attr fmt =
- Printf.ksprintf (fun str -> k (string ?attr str)) fmt
-
- let kfmt k ?attr fmt =
- Format.kasprintf (fun str -> k (string ?attr str)) fmt
-
- 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 =
- 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])*)
-
- let scroll_step = 1
-
- type scroll_state = {
- position: int;
- bound : int;
- visible : int;
- total : int;
- }
-
- let default_scroll_state = { position = 0; bound = 0; visible = 0; total = 0 }
-
- let vscroll_area ~state ~change t =
- let visible = ref (-1) in
- let total = ref (-1) in
- let scroll state delta =
- let position = state.position + delta in
- let position = max 0 (min state.bound position) in
- if position <> state.position then
- change `Action {state with position};
- `Handled
- in
- let focus_handler state = function
- (*| `Arrow `Left , _ -> scroll (-scroll_step) 0*)
- (*| `Arrow `Right, _ -> scroll (+scroll_step) 0*)
- | `Arrow `Up , [] -> scroll state (-scroll_step)
- | `Arrow `Down , [] -> scroll state (+scroll_step)
- | `Page `Up, [] -> scroll state ((-scroll_step) * 8)
- | `Page `Down, [] -> scroll state ((+scroll_step) * 8)
- | _ -> `Unhandled
- in
- let scroll_handler state ~x:_ ~y:_ = function
- | `Scroll `Up -> scroll state (-scroll_step)
- | `Scroll `Down -> scroll state (+scroll_step)
- | _ -> `Unhandled
- in
- Lwd.map2' t state @@ fun t state ->
- t
- |> Ui.shift_area 0 state.position
- |> Ui.resize ~h:0 ~sh:1
- |> 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)
- else false
- in
- let vchange =
- if !visible <> h
- then (visible := h; true)
- else false
- in
- if tchange || vchange then
- change `Content {state with visible = !visible; total = !total;
- bound = max 0 (!total - !visible); }
- )
- |> Ui.mouse_area (scroll_handler state)
- |> Ui.keyboard_area (focus_handler state)
-
- let scroll_area ?(offset=0,0) t =
- let offset = Lwd.var offset in
- let scroll d_x d_y =
- let s_x, s_y = Lwd.peek offset in
- let s_x = max 0 (s_x + d_x) in
- let s_y = max 0 (s_y + d_y) in
- Lwd.set offset (s_x, s_y);
- `Handled
- in
- let focus_handler = function
- | `Arrow `Left , [] -> scroll (-scroll_step) 0
- | `Arrow `Right, [] -> scroll (+scroll_step) 0
- | `Arrow `Up , [] -> scroll 0 (-scroll_step)
- | `Arrow `Down , [] -> scroll 0 (+scroll_step)
- | `Page `Up, [] -> scroll 0 ((-scroll_step) * 8)
- | `Page `Down, [] -> scroll 0 ((+scroll_step) * 8)
- | _ -> `Unhandled
- in
- let scroll_handler ~x:_ ~y:_ = function
- | `Scroll `Up -> scroll 0 (-scroll_step)
- | `Scroll `Down -> scroll 0 (+scroll_step)
- | _ -> `Unhandled
- in
- Lwd.map2' t (Lwd.get offset) @@ fun t (s_x, s_y) ->
- t
- |> Ui.shift_area s_x s_y
- |> Ui.mouse_area scroll_handler
- |> Ui.keyboard_area focus_handler
-
- let main_menu_item text f =
- let text = string ~attr:attr_menu_main (" " ^ text ^ " ") in
- let v = Lwd.var empty_lwd in
- let visible = ref false in
- let on_click ~x:_ ~y:_ = function
- | `Left ->
- visible := not !visible;
- if not !visible then (
- v $= Lwd.return Ui.empty
- ) else (
- let h ~x:_ ~y:_ = function
- | `Left ->
- visible := false; v $= Lwd.return Ui.empty; `Unhandled
- | _ -> `Unhandled
- in
- v $= menu_overlay h (f ())
- );
- `Handled
- | _ -> `Unhandled
- in
- Lwd_utils.pack Ui.pack_y [
- Lwd.return (Ui.mouse_area on_click text);
- Lwd.join (Lwd.get v)
- ]
-
- let sub_menu_item text f =
- let text = string ~attr:attr_menu_sub text in
- let v = Lwd.var empty_lwd in
- let visible = ref false in
- let on_click ~x:_ ~y:_ = function
- | `Left ->
- visible := not !visible;
- if not !visible then (
- v $= Lwd.return Ui.empty
- ) else (
- let h ~x:_ ~y:_ = function
- | `Left ->
- visible := false; v $= Lwd.return Ui.empty; `Unhandled
- | _ -> `Unhandled
- in
- v $= menu_overlay h (f ())
- );
- `Handled
- | _ -> `Unhandled
- in
- Lwd_utils.pack Ui.pack_x [
- Lwd.return (Ui.mouse_area on_click text);
- Lwd.join (Lwd.get v)
- ]
-
- let sub_entry text f =
- let text = string ~attr:attr_menu_sub text in
- let on_click ~x:_ ~y:_ = function
- | `Left -> f (); `Handled
- | _ -> `Unhandled
- in
- Ui.mouse_area on_click text
-
- let v_pane left right =
- 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 left_pane = Lwd.var empty_lwd in
- let right_pane = Lwd.var empty_lwd in
- let node = Lwd_utils.pack Ui.pack_y [!$left_pane; !$splitter; !$right_pane] in
- let render () =
- let split = int_of_float (!split *. float !h) in
- let split = min (!h - 1) (max split 0) in
- left_pane $= Lwd.map' left
- (fun t -> Ui.resize ~w:!w ~h:split t);
- right_pane $= Lwd.map' right
- (fun t -> Ui.resize ~w:!w ~h:(!h - split - 1) t);
- splitter_bg $= Ui.atom (I.char A.(bg lightyellow) ' ' !w 1);
- in
- let action ~x:_ ~y:_ = function
- | `Left ->
- let y0 = int_of_float (!split *. float !h) in
- `Grab ((fun ~x:_ ~y ->
- let y0' = y0 + y in
- split := min 1.0 (max 0.0 (float y0' /. float !h));
- render ()
- ), (fun ~x:_ ~y:_ -> ()))
- | _ -> `Unhandled
- in
- splitter $= Lwd.map (Ui.mouse_area action) (Lwd.get splitter_bg);
- render ();
- let on_resize ~w:ew ~h:eh =
- if !w <> ew || !h <> eh then (
- w := ew; h := eh;
- render ()
- )
- in
- Lwd.map' node @@ fun t ->
- Ui.size_sensor on_resize (Ui.resize ~w:10 ~h:10 ~sw:1 ~sh:1 t)
-
- 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.map2 render (Lwd.get state_var) (Lwd.pair l r)*)
-
- let sub' str p l =
- if p = 0 && l = String.length str
- then str
- else String.sub str p l
-
- let edit_field ?(focus=Focus.make()) state ~on_change ~on_submit =
- let update focus_h focus (text, pos) =
- let pos = min (max 0 pos) (String.length text) in
- let content =
- Ui.atom @@ I.hcat @@
- if Focus.has_focus focus then (
- let attr = A.(bg lightblue) 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 < String.length text then
- [I.string A.(bg lightred) (sub' text pos 1);
- I.string attr (sub' text (pos + 1) (len - pos - 1))]
- else [I.string A.(bg lightred) " "]);
- ) else
- [I.string A.(st underline) (if text = "" then " " else text)]
- in
- let handler = function
- | `ASCII 'U', [`Ctrl] -> on_change ("", 0); `Handled (* clear *)
- | `Escape, [] -> Focus.release focus_h; `Handled
- | `ASCII k, _ ->
- let text =
- if pos < String.length text then (
- String.sub text 0 pos ^ String.make 1 k ^
- String.sub text pos (String.length text - pos)
- ) else (
- text ^ String.make 1 k
- )
- in
- on_change (text, (pos + 1));
- `Handled
- | `Backspace, _ ->
- let text =
- if pos > 0 then (
- if pos < String.length text then (
- String.sub text 0 (pos - 1) ^
- String.sub text pos (String.length text - pos)
- ) else if String.length text > 0 then (
- String.sub text 0 (String.length text - 1)
- ) else text
- ) else text
- in
- let pos = max 0 (pos - 1) in
- on_change (text, pos);
- `Handled
- | `Enter, _ -> on_submit (text, pos); `Handled
- | `Arrow `Left, [] ->
- let pos = min (String.length text) pos in
- if pos > 0 then (
- on_change (text, pos - 1);
- `Handled
- )
- else `Unhandled
- | `Arrow `Right, [] ->
- let pos = pos + 1 in
- if pos <= String.length text
- then (on_change (text, pos); `Handled)
- else `Unhandled
- | _ -> `Unhandled
- in
- Ui.keyboard_area ~focus handler content
- in
- let node =
- Lwd.map2 (update focus) (Focus.status focus) state
- in
- let mouse_grab (text, pos) ~x ~y:_ = function
- | `Left ->
- if x <> pos then on_change (text, x);
- Nottui.Focus.request focus;
- `Handled
- | _ -> `Unhandled
- in
- Lwd.map2' state node @@ fun 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 =
- match tabs with
- | [] -> Lwd.return Ui.empty
- | _ ->
- let cur = Lwd.var 0 in
- Lwd.get cur >>= fun idx_sel ->
- let _, f = List.nth tabs idx_sel in
- let tab_bar =
- tabs
- |> List.mapi
- (fun i (s,_) ->
- let attr = if i = idx_sel then A.(st underline) else A.empty in
- let tab_annot = printf ~attr "[%s]" s in
- Ui.mouse_area
- (fun ~x:_ ~y:_ l -> if l=`Left then (Lwd.set cur i; `Handled) else `Unhandled)
- tab_annot)
- |> Ui.hcat
- in
- f() >|= Ui.join_y tab_bar
-
- (** Horizontal/vertical box. We fill lines until there is no room,
- and then go to the next ligne. All widgets in a line are considered to
- have the same height.
- @param width dynamic width (default 80)
- *)
- let flex_box ?(w=Lwd.return 80) (l: Ui.t Lwd.t list) : Ui.t Lwd.t =
- Lwd_utils.flatten_l l >>= fun l ->
- w >|= fun w_limit ->
- let rec box_render (acc:Ui.t) (i:int) l : Ui.t =
- match l with
- | [] -> acc
- | ui0 :: tl ->
- let w0 = (Ui.layout_spec ui0).Ui.w in
- if i + w0 >= w_limit then (
- (* newline starting with ui0 *)
- Ui.join_y acc (box_render ui0 w0 tl)
- ) else (
- (* same line *)
- box_render (Ui.join_x acc ui0) (i+w0) tl
- )
- in
- box_render Ui.empty 0 l
-
-
- (** Prints the summary, but calls [f()] to compute a sub-widget
- when clicked on. Useful for displaying deep trees. *)
- let unfoldable ?(folded_by_default=true) summary (f: unit -> Ui.t Lwd.t) : Ui.t Lwd.t =
- let open Lwd.Infix in
- let opened = Lwd.var (not folded_by_default) in
- let fold_content =
- Lwd.get opened >>= function
- | true ->
- (* call [f] and pad a bit *)
- f() |> Lwd.map (Ui.join_x (string " "))
- | false -> empty_lwd
- in
- (* pad summary with a "> " when it's opened *)
- let summary =
- Lwd.get opened >>= fun op ->
- summary >|= fun s ->
- Ui.hcat [string ~attr:A.(bg blue) (if op then "v" else ">"); string " "; s]
- in
- let cursor ~x:_ ~y:_ = function
- | `Left when Lwd.peek opened -> Lwd.set opened false; `Handled
- | `Left -> Lwd.set opened true; `Handled
- | _ -> `Unhandled
- in
- let mouse = Lwd.map (fun m -> Ui.mouse_area cursor m) summary in
- Lwd.map2
- (fun summary fold ->
- (* TODO: make this configurable/optional *)
- (* newline if it's too big to fit on one line nicely *)
- let spec_sum = Ui.layout_spec summary in
- let spec_fold = Ui.layout_spec fold in
- (* TODO: somehow, probe for available width here? *)
- let too_big =
- spec_fold.Ui.h > 1 ||
- (spec_fold.Ui.h>0 && spec_sum.Ui.w + spec_fold.Ui.w > 60)
- in
- if too_big
- then Ui.join_y summary (Ui.join_x (string " ") fold)
- else Ui.join_x summary fold)
- mouse fold_content
-
- let hbox l = Lwd_utils.pack Ui.pack_x l
- let vbox l = Lwd_utils.pack Ui.pack_y l
- let zbox l = Lwd_utils.pack Ui.pack_z l
-
- let vlist ?(bullet="- ") (l: Ui.t Lwd.t list) : Ui.t Lwd.t =
- l
- |> List.map (fun ui -> Lwd.map (Ui.join_x (string bullet)) ui)
- |> Lwd_utils.pack Ui.pack_y
-
- (** A list of items with a dynamic filter on the items *)
- let vlist_with
- ?(bullet="- ")
- ?(filter=Lwd.return (fun _ -> true))
- (f:'a -> Ui.t Lwd.t)
- (l:'a list Lwd.t) : Ui.t Lwd.t =
- let open Lwd.Infix in
- let rec filter_map_ acc f l =
- match l with
- | [] -> List.rev acc
- | x::l' ->
- let acc' = match f x with | None -> acc | Some y -> y::acc in
- filter_map_ acc' f l'
- in
- let l = l >|= List.map (fun x -> x, Lwd.map (Ui.join_x (string bullet)) @@ f x) in
- let l_filter : _ list Lwd.t =
- filter >>= fun filter ->
- l >|=
- filter_map_ []
- (fun (x,ui) -> if filter x then Some ui else None)
- in
- l_filter >>= Lwd_utils.pack Ui.pack_y
-
- let rec iterate n f x =
- if n=0 then x else iterate (n-1) f (f x)
-
- (** A grid layout, with alignment in all rows/columns.
- @param max_h maximum height of a cell
- @param max_w maximum width of a cell
- @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 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
- TODO: horizontal rule below headers
- TODO: headers *)
- let grid
- ?max_h ?max_w
- ?pad ?crop ?bg
- ?(h_space=0)
- ?(v_space=0)
- ?(headers:Ui.t Lwd.t list option)
- (rows: Ui.t Lwd.t list list) : Ui.t Lwd.t =
- let rows = match headers with
- | None -> rows
- | Some r -> r :: rows
- in
- (* build a [ui list list Lwd.t] *)
- begin
- Lwd_utils.map_l (fun r -> Lwd_utils.flatten_l r) rows
- end >>= fun (rows:Ui.t list list) ->
- (* determine width of each column and height of each row *)
- let n_cols = List.fold_left (fun n r -> max n (List.length r)) 0 rows in
- let col_widths = Array.make n_cols 1 in
- List.iter
- (fun row ->
- List.iteri
- (fun col_j cell ->
- let w = (Ui.layout_spec cell).Ui.w in
- col_widths.(col_j) <- max col_widths.(col_j) w)
- row)
- rows;
- begin match max_w with
- | None -> ()
- | Some max_w ->
- (* limit width *)
- Array.iteri (fun i x -> col_widths.(i) <- min x max_w) col_widths
- end;
- (* 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.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.space v_space 0; y]))
- in
- let rows =
- List.map
- (fun row ->
- let row_h =
- List.fold_left (fun n c -> max n (Ui.layout_spec c).Ui.h) 0 row
- in
- let row_h = match max_h with
- | None -> row_h
- | Some max_h -> min row_h max_h
- in
- let row =
- List.mapi
- (fun i c ->
- Ui.resize ~w:col_widths.(i) ~h:row_h ?crop ?pad ?bg c)
- row
- in
- Lwd_utils.reduce pack_pad_x row)
- rows
- in
- (* TODO: mouse and keyboard handling *)
- let ui = Lwd_utils.reduce pack_pad_y rows in
- Lwd.return ui
-
- let button ?attr s f =
- Ui.mouse_area (fun ~x:_ ~y:_ _ -> f(); `Handled) (string ?attr s)
-
-
- (* file explorer for selecting a file *)
- let file_select
- ?(abs=false)
- ?filter
- ~(on_select:string -> unit) () : Ui.t Lwd.t =
- let rec aux ~fold path =
- try
- let p_rel = if path = "" then "." else path in
- if Sys.is_directory p_rel then (
- let ui() =
- let arr = Sys.readdir p_rel in
- let l = Array.to_list arr |> List.map (Filename.concat path) in
- (* apply potential filter *)
- let l = match filter with None -> l | Some f -> List.filter f l in
- let l = Lwd.return @@ List.sort String.compare l in
- vlist_with ~bullet:"" (aux ~fold:true) l
- in
- if fold then (
- unfoldable ~folded_by_default:true
- (Lwd.return @@ string @@ path ^ "/") ui
- ) else ui ()
- ) else (
- Lwd.return @@
- button ~attr:A.(st underline) path (fun () -> on_select path)
- )
- with e ->
- Lwd.return @@ Ui.vcat [
- printf ~attr:A.(bg red) "cannot list directory %s" path;
- string @@ Printexc.to_string e;
- ]
- in
- let start = if abs then Sys.getcwd () else "" in
- aux ~fold:false start
-
- let toggle, toggle' =
- let toggle_ st (lbl:string Lwd.t) (f:bool -> unit) : Ui.t Lwd.t =
- let mk_but st_v lbl_v =
- let lbl = Printf.sprintf "[%s|%s]" lbl_v (if st_v then "✔" else "×");in
- button lbl (fun () ->
- let new_st = not st_v in
- Lwd.set st new_st; f new_st)
- in
- Lwd.map2 mk_but (Lwd.get st) lbl
- in
- (* Similar to {!toggle}, except it directly reflects the state of a variable. *)
- let toggle' (lbl:string Lwd.t) (v:bool Lwd.var) : Ui.t Lwd.t =
- toggle_ v lbl (Lwd.set v)
- (* a toggle, with a true/false state *)
- and toggle ?(init=false) (lbl:string Lwd.t) (f:bool -> unit) : Ui.t Lwd.t =
- let st = Lwd.var init in
- toggle_ st lbl f
- in
- toggle, toggle'
|