Source file `nottui_unix.ml`

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
open Notty
open Notty_unix
open Nottui

(* FIXME Uses of [quick_sample] and [quick_release] should be replaced by
         [sample] and [release] with the appropriate release management. *)

let step ?(process_event=true) ?(timeout=(-1.0)) ~renderer term root =
  let size = Term.size term in
  let image =
    let rec stabilize () =
      let tree = Lwd.quick_sample root in
      Renderer.update renderer size tree;
      let image = Renderer.image renderer in
      if Lwd.is_damaged root
      then stabilize ()
      else image
    in
    stabilize ()
  in
  Term.image term image;
  if process_event then
    let i, _ = Term.fds term in
    let has_event =
      let rec select () =
        match Unix.select [i] [] [i] timeout with
        | [], [], [] -> false
        | _ -> true
        | exception (Unix.Unix_error (Unix.EINTR, _, _)) -> select ()
      in
      select ()
    in
    if has_event then
      match Term.event term with
      | `End -> ()
      | `Resize _ -> ()
      | #Unescape.event as event ->
        let event = (event : Unescape.event :> Ui.event) in
        ignore (Renderer.dispatch_event renderer event : [`Handled | `Unhandled])

let run_with_term term ?tick_period ?(tick=ignore) ~renderer quit t =
  let quit = Lwd.observe (Lwd.get quit) in
  let root = Lwd.observe t in
  let rec loop () =
    let quit = Lwd.quick_sample quit in
    if not quit then (
      step ~process_event:true ?timeout:tick_period ~renderer term root;
      tick ();
      loop ()
    )
  in
  loop ();
  ignore (Lwd.quick_release root);
  ignore (Lwd.quick_release quit)

let run ?tick_period ?tick ?term ?(renderer=Renderer.make ())
        ?quit ?(quit_on_escape=true) ?(quit_on_ctrl_q=true) t =
  let quit = match quit with
    | Some quit -> quit
    | None -> Lwd.var false
  in
  let t = Lwd.map t ~f:(Ui.event_filter (function
      | `Key (`ASCII 'Q', [`Ctrl]) when quit_on_ctrl_q ->
        Lwd.set quit true; `Handled
      | `Key (`Escape, []) when quit_on_escape ->
        Lwd.set quit true; `Handled
      | _ -> `Unhandled
    ))
  in
  match term with
  | Some term -> run_with_term term ?tick_period ?tick ~renderer quit t
  | None ->
    let term = Term.create () in
    run_with_term term ?tick_period ?tick ~renderer quit t;
    Term.release term