+89 -66

forks/nottui/lib/nottui/nottui_main.ml

reviewed

··· 257 257 258 258 type semantic_key = 259 259 [ (* Clipboard *) 260 260 - `Copy 260 260 + `Copy 261 261 | `Paste 262 262 | (* Focus management *) 263 263 - `Focus of 264 264 - [ `Out | `Next | `Prev | `Left | `Right | `Up | `Down ] 263 263 + `Focus of [ `Out | `Next | `Prev | `Left | `Right | `Up | `Down ] 265 264 ] 266 265 267 266 type key = ··· 653 652 let has_permanent_sensor flags = flags land flag_permanent_sensor <> 0 654 653 655 654 let rec update_sensors ox oy sw sh mw mh ui = 656 656 - if has_transient_sensor ui.flags 657 657 - || (has_permanent_sensor ui.flags 658 658 - && 659 659 - match ui.sensor_cache with 660 660 - | None -> true 661 661 - | Some (ox', oy', sw', sh') -> 662 662 - not (ox = ox' && oy = oy' && sw = sw' && sh = sh')) 655 655 + if 656 656 + has_transient_sensor ui.flags 657 657 + || (has_permanent_sensor ui.flags 658 658 + && 659 659 + match ui.sensor_cache with 660 660 + | None -> true 661 661 + | Some (ox', oy', sw', sh') -> not (ox = ox' && oy = oy' && sw = sw' && sh = sh') 662 662 + ) 663 663 then ( 664 664 ui.flags <- ui.flags land lnot flag_transient_sensor; 665 665 if has_permanent_sensor ui.flags then ui.sensor_cache <- Some (ox, oy, sw, sh); ··· 765 765 ;; 766 766 767 767 let dispatch_mouse t (event, (x, y), _mods) = 768 768 - if match event with 769 769 - | `Press btn -> 770 770 - release_grab t x y; 771 771 - let w, h = t.size in 772 772 - dispatch_mouse t x y btn w h t.view 773 773 - | `Drag -> 774 774 - (match t.mouse_grab with 775 775 - | None -> false 776 776 - | Some (drag, _) -> 777 777 - drag ~x ~y; 778 778 - true) 779 779 - | `Release -> 780 780 - release_grab t x y; 781 781 - true 768 768 + if 769 769 + match event with 770 770 + | `Press btn -> 771 771 + release_grab t x y; 772 772 + let w, h = t.size in 773 773 + dispatch_mouse t x y btn w h t.view 774 774 + | `Drag -> 775 775 + (match t.mouse_grab with 776 776 + | None -> false 777 777 + | Some (drag, _) -> 778 778 + drag ~x ~y; 779 779 + true) 780 780 + | `Release -> 781 781 + release_grab t x y; 782 782 + true 782 783 then `Handled 783 784 else `Unhandled 784 785 ;; ··· 798 799 let same_size w h image = w = I.width image && h = I.height image 799 800 800 801 let rec render_node vx1 vy1 vx2 vy2 sw sh t : cache = 801 801 - if let cache = t.cache in 802 802 - vx1 >= Interval.fst cache.vx 803 803 - && vy1 >= Interval.fst cache.vy 804 804 - && vx2 <= Interval.snd cache.vx 805 805 - && vy2 <= Interval.snd cache.vy 806 806 - && same_size sw sh cache.image 802 802 + if 803 803 + let cache = t.cache in 804 804 + vx1 >= Interval.fst cache.vx 805 805 + && vy1 >= Interval.fst cache.vy 806 806 + && vx2 <= Interval.snd cache.vx 807 807 + && vy2 <= Interval.snd cache.vy 808 808 + && same_size sw sh cache.image 807 809 then t.cache 808 810 else if vx2 < 0 || vy2 < 0 || sw < vx1 || sh < vy1 809 811 then ( ··· 1067 1069 -> ui Lwd.root 1068 1070 -> unit 1069 1071 1070 1070 - let await_read_unix fd timeout : [ `Ready | `NotReady ] = 1072 1072 + let await_read_unix fd timeout : [ `Ready | `NotReady | `LwdStateUpdate ] = 1071 1073 let rec select () = 1072 1074 match Unix.select [ fd ] [] [ fd ] timeout with 1073 1075 | [], [], [] -> `NotReady ··· 1080 1082 (* FIXME Uses of [quick_sample] and [quick_release] should be replaced by 1081 1083 [sample] and [release] with the appropriate release management. *) 1082 1084 1085 1085 + let cache = ref None 1086 1086 + 1083 1087 let step 1084 1084 - ?(await_read = await_read_unix) 1085 1085 - ?(process_event = true) 1086 1086 - ?(timeout = -1.0) 1087 1087 - ~renderer 1088 1088 - term 1089 1089 - root 1088 1088 + ?(await_read = await_read_unix) 1089 1089 + ?(process_event = true) 1090 1090 + ?(timeout = -1.0) 1091 1091 + ~renderer 1092 1092 + term 1093 1093 + root 1090 1094 = 1091 1095 let size = Term.size term in 1092 1096 let image = 1093 1093 - let rec stabilize () = 1094 1094 - let tree = Lwd.quick_sample root in 1095 1095 - Renderer.update renderer size tree; 1096 1096 - let image = Renderer.image renderer in 1097 1097 - if Lwd.is_damaged root then stabilize () else image 1098 1098 - in 1099 1099 - stabilize () 1097 1097 + if (not (Lwd.is_damaged root)) && !cache |> Option.is_some 1098 1098 + then !cache |> Option.get 1099 1099 + else ( 1100 1100 + let rec stabilize () = 1101 1101 + let tree = Lwd.quick_sample root in 1102 1102 + Renderer.update renderer size tree; 1103 1103 + let image = Renderer.image renderer in 1104 1104 + (* If we are already damaged then we should re-calculate*) 1105 1105 + if Lwd.is_damaged root then stabilize () else image 1106 1106 + in 1107 1107 + stabilize ()) 1100 1108 in 1109 1109 + cache := Some image; 1101 1110 Term.image term image; 1111 1111 + (* Now we wait for another event or the timeout*) 1102 1112 if process_event 1103 1113 then ( 1104 1114 let wait_for_event () = 1105 1115 let i, _ = Term.fds term in 1106 1116 match await_read i timeout with 1107 1107 - | `NotReady -> Term.pending term 1117 1117 + | `NotReady -> false 1108 1118 | `Ready -> true 1119 1119 + | `LwdStateUpdate -> false 1109 1120 in 1110 1110 - let has_event = timeout < 0.0 || Term.pending term || wait_for_event () in 1111 1111 - if has_event 1121 1121 + (* for async I should extend this to include changed lwd.var values*) 1122 1122 + (* let has_event =Term.pending term in *) 1123 1123 + if wait_for_event () 1112 1124 then ( 1125 1125 + Printf.eprintf "getting term event\n"; 1113 1126 match Term.event term with 1114 1127 | `End -> () 1115 1128 | `Resize _ -> () ··· 1121 1134 type run_with_term_intern = 1122 1135 step:step 1123 1136 -> Term.t 1137 1137 + -> ?on_invalidate:(ui -> unit) 1124 1138 -> ?tick_period:float 1125 1139 -> ?tick:(unit -> unit) 1126 1140 -> renderer:Renderer.t ··· 1130 1144 1131 1145 type run_with_term = 1132 1146 Term.t 1147 1147 + -> ?on_invalidate:(ui -> unit) 1133 1148 -> ?tick_period:float 1134 1149 -> ?tick:(unit -> unit) 1135 1150 -> renderer:Renderer.t ··· 1138 1153 -> unit 1139 1154 1140 1155 let run_with_term : run_with_term_intern = 1141 1141 - fun ~(step : step) term ?tick_period ?(tick = ignore) ~renderer quit t -> 1156 1156 + fun ~(step : step) 1157 1157 + term 1158 1158 + ?(on_invalidate = fun _ -> ()) 1159 1159 + ?tick_period 1160 1160 + ?(tick = ignore) 1161 1161 + ~renderer 1162 1162 + quit 1163 1163 + t -> 1142 1164 let quit = Lwd.observe (Lwd.get quit) in 1143 1143 - let root = Lwd.observe t in 1165 1165 + let root = Lwd.observe ~on_invalidate t in 1144 1166 let rec loop () = 1145 1167 let quit = Lwd.quick_sample quit in 1146 1168 if not quit ··· 1155 1177 ;; 1156 1178 1157 1179 let run 1158 1158 - ~(run_with_term : run_with_term) 1159 1159 - ?tick_period 1160 1160 - ?tick 1161 1161 - ?term 1162 1162 - ?(renderer = Renderer.make ()) 1163 1163 - ?quit 1164 1164 - ?(quit_on_escape = true) 1165 1165 - ?(quit_on_ctrl_q = true) 1166 1166 - t 1180 1180 + ~(run_with_term : run_with_term) 1181 1181 + ?on_invalidate 1182 1182 + ?tick_period 1183 1183 + ?tick 1184 1184 + ?term 1185 1185 + ?(renderer = Renderer.make ()) 1186 1186 + ?quit 1187 1187 + ?(quit_on_escape = true) 1188 1188 + ?(quit_on_ctrl_q = true) 1189 1189 + t 1167 1190 = 1168 1191 let quit = 1169 1192 match quit with ··· 1175 1198 t 1176 1199 ~f: 1177 1200 (Ui.event_filter (function 1178 1178 - | `Key (`ASCII 'Q', [ `Ctrl ]) when quit_on_ctrl_q -> 1179 1179 - Lwd.set quit true; 1180 1180 - `Handled 1181 1181 - | `Key (`Escape, []) when quit_on_escape -> 1182 1182 - Lwd.set quit true; 1183 1183 - `Handled 1184 1184 - | _ -> `Unhandled)) 1201 1201 + | `Key (`ASCII 'Q', [ `Ctrl ]) when quit_on_ctrl_q -> 1202 1202 + Lwd.set quit true; 1203 1203 + `Handled 1204 1204 + | `Key (`Escape, []) when quit_on_escape -> 1205 1205 + Lwd.set quit true; 1206 1206 + `Handled 1207 1207 + | _ -> `Unhandled)) 1185 1208 in 1186 1209 match term with 1187 1210 | Some term -> run_with_term term ?tick_period ?tick ~renderer quit t 1188 1211 | None -> 1189 1212 let term = Term.create () in 1190 1190 - run_with_term term ?tick_period ?tick ~renderer quit t; 1213 1213 + run_with_term term ?on_invalidate ?tick_period ?tick ~renderer quit t; 1191 1214 Term.release term 1192 1215 ;; 1193 1216 end

+15 -11

forks/nottui/lib/nottui/nottui_main.mli

reviewed

··· 188 188 Copy and paste, as well as focus movements. *) 189 189 type semantic_key = 190 190 [ (* Clipboard *) 191 191 - `Copy 191 191 + `Copy 192 192 | `Paste 193 193 | (* Focus management *) 194 194 - `Focus of 195 195 - [ `Out | `Next | `Prev | `Left | `Right | `Up | `Down ] 194 194 + `Focus of [ `Out | `Next | `Prev | `Left | `Right | `Up | `Down ] 196 195 ] 197 196 198 197 (** A key is the pair of a main key and a list of modifiers *) ··· 391 390 To simulate concurrency in a polling fashion, tick function and period 392 391 can be provided. Use the [Lwt] backend for real concurrency. *) 393 392 val run 394 394 - : ?tick_period:float 393 393 + : ?on_invalidate:(ui -> unit) 394 394 + -> ?tick_period:float 395 395 -> ?tick:(unit -> unit) 396 396 -> ?term:Term.t 397 397 -> ?renderer:Renderer.t ··· 416 416 -> ui Lwd.root 417 417 -> unit 418 418 419 419 - val await_read_unix : Unix.file_descr -> float -> [ `NotReady | `Ready ] 419 419 + val await_read_unix : Unix.file_descr -> float -> [ `NotReady | `Ready | `LwdStateUpdate] 420 420 421 421 (** Run one step of the main loop. 422 422 ··· 426 426 427 427 [?await_read]- A function that waits for the file handle to be ready for reading for up to the provided timeout (-1.0 for no timeout). This exists entirely so this waiting can be overriden to interoperate with an effects based async system. *) 428 428 val step 429 429 - : ?await_read:(Unix.file_descr -> float -> [ `Ready | `NotReady ]) 429 429 + : ?await_read:(Unix.file_descr -> float -> [ `Ready | `NotReady | `LwdStateUpdate ]) 430 430 -> ?process_event:bool 431 431 -> ?timeout:float 432 432 -> renderer:Renderer.t ··· 434 434 -> ui Lwd.root 435 435 -> unit 436 436 437 437 - type run_with_term_intern= 437 437 + type run_with_term_intern = 438 438 step:step 439 439 -> Term.t 440 440 + -> ?on_invalidate:(ui -> unit) 440 441 -> ?tick_period:float 441 442 -> ?tick:(unit -> unit) 442 443 -> renderer:Renderer.t ··· 444 445 -> ui Lwd.t 445 446 -> unit 446 447 447 447 - type run_with_term= 448 448 + type run_with_term = 448 449 Term.t 450 450 + -> ?on_invalidate:(ui -> unit) 449 451 -> ?tick_period:float 450 452 -> ?tick:(unit -> unit) 451 453 -> renderer:Renderer.t 452 454 -> bool Lwd.var 453 455 -> ui Lwd.t 454 456 -> unit 455 455 - val run_with_term:run_with_term_intern 456 457 457 457 - val run: 458 458 - run_with_term:run_with_term 458 458 + val run_with_term : run_with_term_intern 459 459 + 460 460 + val run 461 461 + : run_with_term:run_with_term 462 462 + -> ?on_invalidate:(ui -> unit) 459 463 -> ?tick_period:float 460 464 -> ?tick:(unit -> unit) 461 465 -> ?term:Term.t

+7 -2

forks/nottui/lib/nottui_picos/dune

reviewed

··· 1 1 (library 2 2 (name nottui_picos) 3 3 (public_name nottui_picos) 4 4 - (libraries nottui picos picos_std.structured picos_io picos_std.finally ) 5 5 - ) 4 4 + (libraries 5 5 + nottui 6 6 + picos 7 7 + picos_std.structured 8 8 + picos_io 9 9 + picos_std.finally 10 10 + picos_std.sync))

+49 -21

forks/nottui/lib/nottui_picos/nottui_picos.ml

reviewed

··· 2 2 open Nottui 3 3 open Picos 4 4 open Picos_std_structured 5 5 - open Picos_std_finally 5 5 + open Picos_std_finally 6 6 + open Picos_std_event 7 7 + open Picos_std_sync 6 8 7 9 module Ui_loop = struct 8 8 - let step in_fd = 9 9 - Ui_loop.Internal.step ~await_read:(fun _ timeout -> 10 10 - (*await the read inside a promise*) 11 11 - let rec select ()= 12 12 - match Picos_io.Unix.select [in_fd] [] [in_fd ] timeout with 13 13 - | [], [], [] -> `NotReady 14 14 - | _ -> `Ready 15 15 - | exception Unix.Unix_error (Unix.EINTR, _, _) -> select () 16 16 - 10 10 + let step computation in_fd = 11 11 + Ui_loop.Internal.step ~await_read:(fun _ timeout -> 12 12 + let rec select () = 13 13 + Printf.eprintf "waiting on events\n"; 14 14 + computation := Ivar.create (); 15 15 + let cancelEvent = Ivar.read_evt !computation in 16 16 + let ret = 17 17 + Event.select 18 18 + [ Picos_io_select.on in_fd `R |> Event.map (fun x -> `Ready) 19 19 + ; Picos_io_select.on in_fd `W |> Event.map (fun _ -> `Ready) 20 20 + ; cancelEvent 21 21 + |> Event.map (fun x -> 22 22 + Printf.eprintf "rerun-invalidation\n"; 23 23 + `LwdStateUpdate) 24 24 + ; Picos_io_select.timeout ~seconds:10.0 25 25 + |> Event.map (fun x -> `NotReady) 26 26 + ] 27 27 + in 28 28 + Printf.eprintf "finished waiting\n"; 29 29 + ret 30 30 + (* match Picos_io.Unix.select [ in_fd ] [] [ in_fd ] timeout with *) 31 31 + (* | [], [], [] -> `NotReady *) 32 32 + (* | _ -> `Ready *) 33 33 + (* | exception Unix.Unix_error (Unix.EINTR, _, _) -> select () *) 17 34 in 18 18 - select () 19 19 - ) 20 20 - ;; 35 35 + select ()) 36 36 + ;; 21 37 22 22 - let run_with_term term = 23 23 - let in_fd,out_fd= Notty_unix.Term.fds term in 24 24 - let in_fd=Picos_io_fd.create in_fd in 25 25 - let step= step in_fd in 26 26 - 27 27 - Ui_loop.Internal.run_with_term ~step term 28 28 - ;; 38 38 + let a = ref 0 29 39 40 40 + let run_with_term term ?on_invalidate = 41 41 + let in_fd, out_fd = Notty_unix.Term.fds term in 42 42 + (* the term will likely be attached to stdin so we check to make sure we don't recreate that file handle, because picos creates this handle at startup*) 43 43 + let in_picos_fd = 44 44 + if in_fd = (Picos_io.Unix.stdin |> Picos_io_fd.unsafe_get) 45 45 + then Picos_io.Unix.stdin 46 46 + else Picos_io_fd.create ~dispose:false in_fd 47 47 + in 48 48 + let trigger = ref (Ivar.create ()) in 49 49 + let step = step trigger in_picos_fd in 50 50 + a := !a + 1; 51 51 + Ui_loop.Internal.run_with_term 52 52 + ~on_invalidate:(fun _ -> 53 53 + Printf.eprintf "invalidated\n"; 54 54 + Ivar.fill !trigger ()) 55 55 + ~step 56 56 + term 57 57 + ;; 30 58 31 31 - let run = Ui_loop.Internal.run ~run_with_term 59 59 + let run = Ui_loop.Internal.run ~run_with_term 32 60 end

+10 -4

forks/nottui/lib/nottui_picos/nottui_picos.mli

reviewed

··· 1 1 - 2 1 open Notty 3 2 open Nottui 4 3 open Picos 4 4 + 5 5 module Ui_loop : sig 6 6 open Notty_unix 7 7 - 8 7 9 8 (** Run one step of the main loop. 10 9 ··· 13 12 consume and dispatch it. 14 13 15 14 *) 16 16 - val step: 15 15 + (* 16 16 + val step: 17 17 Picos_io_fd.t 18 18 -> ?process_event:bool 19 19 -> ?timeout:float ··· 21 21 -> Term.t 22 22 -> ui Lwd.root 23 23 -> unit 24 24 + *) 24 25 26 26 + (* 27 27 + NOTE: Currently we use a tick and a timeout, this is essentially how long we will wait to respond to events that happened 28 28 + *) 25 29 (** Repeatedly run steps of the main loop, until either: 26 30 - [quit] becomes true, 27 31 - the ui computation raises an exception, ··· 34 38 Uses Picos for concurrency. 35 39 The only change vs the normal version is this yields whenever waiting for input 36 40 *) 41 41 + 37 42 val run 38 38 - : ?tick_period:float 43 43 + : ?on_invalidate:(ui -> unit) 44 44 + -> ?tick_period:float 39 45 -> ?tick:(unit -> unit) 40 46 -> ?term:Term.t 41 47 -> ?renderer:Renderer.t

+7 -21

jj_tui/bin/main.ml

reviewed

··· 40 40 | _ -> 41 41 `Unhandled) 42 42 in 43 43 - let rec loop () = 44 44 - if not (Lwd.peek quit) 45 45 - then ( 46 46 - (* let start_time = Unix.gettimeofday() in *) 47 47 - let term_width, term_height = Notty_unix.Term.size (Vars.get_term ()) in 48 48 - let prev_term_width, prev_term_height = Lwd.peek Vars.term_width_height in 49 49 - if term_width <> prev_term_width || term_height <> prev_term_height 50 50 - then Lwd.set Vars.term_width_height (term_width, term_height); 51 51 - Nottui_picos.step 52 52 - ~await_read:(fun fd timeout -> 53 53 - (*await the read inside a promise*) 54 54 - Promise.await @@ Flock.fork_as_promise (fun _ -> await_read_unix fd timeout)) 55 55 - ~process_event:true 56 56 - ~timeout:0.01 57 57 - ~renderer 58 58 - term 59 59 - (Lwd.observe @@ root); 60 60 - loop ()) 43 43 + let tick () = 44 44 + let term_width, term_height = Notty_unix.Term.size (Vars.get_term ()) in 45 45 + let prev_term_width, prev_term_height = Lwd.peek Vars.term_width_height in 46 46 + if term_width <> prev_term_width || term_height <> prev_term_height 47 47 + then Lwd.set Vars.term_width_height (term_width, term_height) 61 48 in 62 62 - loop () 49 49 + Nottui_picos.Ui_loop.run ~tick ~term ~renderer ~quit root 63 50 ;; 64 51 65 52 let start_ui () = ··· 70 57 Flock.terminate () 71 58 ;; 72 59 73 73 - Picos_io.Unix 74 60 let start () = 75 75 - Picos_mux_multififo.run_on ~n_domains:1 (fun _ -> 61 61 + Picos_mux_multififo.run_on ~n_domains:4 (fun _ -> 76 62 Flock.join_after @@ fun () -> 77 63 init_logging (); 78 64 start_ui ())

perf.data

reviewed

This is a binary file and will not be displayed.

perf.data.old

reviewed

This is a binary file and will not be displayed.