diff --git a/dune b/dune index ec6a057..f464241 100644 --- a/dune +++ b/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 diff --git a/main.ml b/main.ml index 3190353..67ae643 100644 --- a/main.ml +++ b/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 *)