how to start lwt-ifying the pane tree portion where Display.state gets threaded through all the image drawing functions

dune

@@ -9,6 +9,7 @@
  (link_flags (-linkall))
  (libraries
   topinf
+   lwt_ppx
   tsdl
   tgls.tgles2
   wall
@@ -27,6 +28,7 @@
  (libraries
    fmt
    topinf
+   lwt_ppx
    irc-client
    irc-client-lwt
    irc-client-unix
@@ -39,6 +41,7 @@
  (modules boot)
  (link_flags (-linkall))
  (libraries
+   lwt_ppx
    lambda-term
    topinf))
 
@@ -47,7 +50,7 @@
  (modes byte)
  (modules topinf)
  (libraries
-  fmt
+   fmt
   tsdl
   tgls.tgles2
   wall

main.ml

@@ -400,7 +400,7 @@ module Display = struct
   module P = Path
   module Text = Wall_text
 
-  let ( >>= ) x f =
+  let ( >>>= ) x f =
     match x with Ok a -> f a | Error _ as result -> result
 
   let get_result = function
@@ -417,10 +417,11 @@ module Display = struct
   (* the box2 here is cannonically the place the returner drew
      (the Wall.image extents) *)
   type image = box2 * Wall.image
-  type pane = state -> state * image
+  type pane = (state -> state * image) Lwt.t
 
-  let pane_empty s =
-    (s, (Box2.of_pts (Box2.o s.box) (Box2.o s.box), Image.empty))
+  let pane_empty =
+    Lwt.return (fun s ->
+        (s, (Box2.of_pts (Box2.o s.box) (Box2.o s.box), Image.empty)) )
 
   type frame =
     { sdl_win: Sdl.window
@@ -440,17 +441,17 @@ module Display = struct
 
   let make_frame ?(title = "komm") ~w ~h () =
     Lazy.force video_initialized
-    >>= fun () ->
+    >>>= fun () ->
     Sdl.create_window ~w ~h title
       Sdl.Window.(
         opengl + allow_highdpi + resizable (*+ input_grabbed*))
-    >>= fun sdl_win ->
+    >>>= fun sdl_win ->
     Sdl.set_window_title sdl_win title ;
     ignore (Sdl.gl_set_swap_interval (-1)) ;
     ignore (Sdl.gl_set_attribute Sdl.Gl.stencil_size 1) ;
     on_failure
       ( Sdl.gl_create_context sdl_win
-      >>= fun gl ->
+      >>>= fun gl ->
       let wall =
         Wall.Renderer.create ~antialias:true ~stencil_strokes:true ()
       in
@@ -480,29 +481,15 @@ module Display = struct
         | _ -> () )
       events
 
-  let display_frame frame actor =
-    (* create and fill event list *)
-    let convert_event ev =
-      match Event.event_of_sdlevent ev with
-      (* Handle relevant events *)
-      | a -> a in
-    let ev = Sdl.Event.create () in
-    let events : Event.t list ref = ref [] in
-    if Sdl.wait_event_timeout (Some ev) 100 then (
-      events := !events @ [convert_event ev] ;
-      while Sdl.wait_event_timeout (Some ev) 1 do
-        events := !events @ [convert_event ev]
-      done ) ;
-    handle_frame_events frame !events ;
+  let draw_pane frame pane =
     let width, height = Sdl.gl_get_drawable_size frame.sdl_win in
-    if List.length !events > 0 then frame.last_pane <- actor !events ;
     let _, (_, image) =
-      frame.last_pane
+      (Lwt_main.run pane)
         { box= Box2.v (P2.v 0. 0.) (P2.v (float width) (float height))
         ; time= ticks ()
         ; wall= frame.wall } in
     Sdl.gl_make_current frame.sdl_win frame.gl
-    >>= fun () ->
+    >>>= fun () ->
     let width, height = Sdl.gl_get_drawable_size frame.sdl_win in
     Gl.viewport 0 0 width height ;
     Gl.clear_color 0.0 0.0 0.0 1.0 ;
@@ -519,6 +506,26 @@ module Display = struct
     Sdl.gl_swap_window frame.sdl_win ;
     Ok ()
 
+  let display_frame frame actor =
+    (* create and fill event list *)
+    let convert_event ev =
+      match Event.event_of_sdlevent ev with
+      (* Handle relevant events *)
+      | a -> a in
+    let ev = Sdl.Event.create () in
+    let events : Event.t list ref = ref [] in
+    if Sdl.wait_event_timeout (Some ev) 100 then (
+      events := !events @ [convert_event ev] ;
+      while Sdl.wait_event_timeout (Some ev) 1 do
+        events := !events @ [convert_event ev]
+      done ) ;
+    handle_frame_events frame !events ;
+    if List.length !events > 0 then
+      (* recompute the actor definition with the new events to return a new pane *)
+      frame.last_pane <- actor !events ;
+    (* call draw_pane because we should redraw now that we have updated *)
+    draw_pane frame frame.last_pane
+
   let run frame render () =
     let frame = get_result frame in
     Sdl.show_window frame.sdl_win ;
@@ -632,7 +639,7 @@ module Display = struct
       List.fold_left
         (fun (sp, (bp, ip)) (pane : pane) ->
           (* uses br to hold max extent of boxes *)
-          let sr, (br, ir) = pane sp in
+          let sr, (br, ir) = pane (sp in
           (* draw the pane *)
           let _, (_, irb) = path_box Color.blue br sr in
           (* draw the box around the pane *)