diff --git a/bogue.opam b/bogue.opam index 2eef9d4..753dcf0 100644 --- a/bogue.opam +++ b/bogue.opam @@ -31,7 +31,7 @@ depends: [ "tsdl-image" {>= "0.3.0"} "tsdl-ttf" {>= "0.3"} "ocaml" {>= "4.08.0"} - "tsdl" {>= "0.9.7" & < "0.9.9"} + "tsdl" {> "0.9.9"} "directories" "odoc" {with-doc} ] @@ -50,3 +50,4 @@ build: [ ] ] dev-repo: "git+https://github.com/sanette/bogue.git" +available: [ (os-distribution != "opensuse-leap" | os-version >= 16) ] diff --git a/bogue.opam.template b/bogue.opam.template new file mode 100644 index 0000000..54fdc4c --- /dev/null +++ b/bogue.opam.template @@ -0,0 +1 @@ +available: [ (os-distribution != "opensuse-leap" | os-version >= 16) ] diff --git a/dune-project b/dune-project index 54e571f..2c64940 100644 --- a/dune-project +++ b/dune-project @@ -8,6 +8,7 @@ (authors "Vu Ngoc San ") (source (github sanette/bogue)) (documentation "http://sanette.github.io/bogue/Bogue.html") +(formatting disabled) (package (name bogue) @@ -33,6 +34,6 @@ Threads when non-blocking reactions are needed.") (tsdl-image (>= 0.3.0)) (tsdl-ttf (>= 0.3)) (ocaml (>= 4.08.0)) - (tsdl (and (>= 0.9.7) (< 0.9.9))) + (tsdl (and (> 0.9.9))) directories )) diff --git a/lib/b_draw.ml b/lib/b_draw.ml index ce28ac4..06bdb36 100644 --- a/lib/b_draw.ml +++ b/lib/b_draw.ml @@ -1225,6 +1225,17 @@ let create_window ?x ?y ~w ~h name = should try 'export SDL_VIDEO_X11_VISUALID='"; raise (Sdl_error ("SDL ERROR: " ^ (Sdl.get_error ()))) +let set_vsync () = + (* SDL_RendererSetVSync is not bound, but it wouldn't know about adaptive vsync *) + match Sdl.gl_set_swap_interval (-1) with + | Ok () -> printd debug_graphics "Enabled Adaptive VSync" + | Error (`Msg m) -> + printd (debug_graphics+debug_warning) "Failed to enable Adaptive VSync, falling back to regular: %s" m; + match Sdl.gl_set_swap_interval 1 with + | Ok () -> printd debug_graphics "Enabled VSync" + | Error (`Msg m) -> + printd (debug_graphics+debug_error) "Failed to enable VSync: %s" m + (* Sdl init. [w,h] is the physical size of the window in pixels. In case of High-DPI mode, SDL might actually produce a larger window. We need to correct this, because we have our own DPI engine. @@ -1291,6 +1302,8 @@ let init ?window ?(name="BOGUE Window") ?fill ?x ?y ~w ~h () = end; printd debug_graphics "Canvas created"; + if not (Theme.get_bool "NO_VSYNC") then + set_vsync (); let fill = default_lazy fill (lazy (fill_of_string renderer Theme.background)) in diff --git a/lib/b_main.ml b/lib/b_main.ml index ef78a62..e32c9e7 100644 --- a/lib/b_main.ml +++ b/lib/b_main.ml @@ -878,10 +878,11 @@ let event_loop anim new_anim board = let e = !Trigger.my_event in continue e 0 +let nop_event_fps = Time.make_fps () (* [one_step] is what is executed during the main loop *) let one_step ?before_display anim (start_fps, fps) ?clear board = - Timeout.run (); + let (_ : Time.t) = Timeout.run () in let new_anim = has_anim board in if new_anim && not anim then start_fps (); event_loop anim new_anim board; @@ -919,7 +920,7 @@ let one_step ?before_display anim (start_fps, fps) ?clear board = end; (* else *) - if anim then fps () else Thread.delay 0.005; + if anim then fps (); (* even when there is no anim, we need to to be nice to other treads, in particular when an event is triggered very rapidly (mouse_motion) and captured by a connection, without anim. Should we put also here a FPS?? *) @@ -929,6 +930,11 @@ let one_step ?before_display anim (start_fps, fps) ?clear board = printd debug_graphics "==> Rendering took %u ms" (Time.now () - t); Avar.new_frame (); (* This is used for updating animated variables. *) printd debug_graphics "---------- end of loop -----------"; + if not anim then + if Layout.is_fresh board.windows_house then + nop_event_fps 60 + else + Thread.delay 0.005; anim (* Create an SDL window for each top layout. *) @@ -985,6 +991,17 @@ let create ?shortcuts ?(connections = []) ?on_user_event windows = mouse_alive = false; on_user_event } +let get_monitor_refresh_rate board = + Option.bind Layout.(window_opt board.windows_house) @@ fun win -> + match Sdl.get_window_display_mode win with + | Ok Sdl.{dm_refresh_rate = Some rate; _ } -> Some rate + | Ok Sdl.{dm_refresh_rate = None; _ } -> + printd (debug_graphics + debug_warning) "No refresh rate information in display mode"; + None + | Error (`Msg m) -> + printd (debug_graphics + debug_warning) "Cannot get display mode from window: %s" m; + None + let of_windows = create (* Create a board from layouts. Each layout in the list will be displayed in a @@ -1006,13 +1023,17 @@ let make ?shortcuts connections layouts = CTRL-L which would occur before it. "after_display" means just after all textures have been calculated and rendered. Of course these two will not be executed at all if there is no event to trigger display. *) -let run ?before_display ?after_display board = +let run ?(vsync=true) ?before_display ?after_display board = printd debug_board "==> Running board!"; Trigger.flush_all (); if not (Sync.is_empty ()) then Trigger.push_action (); if not (Update.is_empty ()) then Update.push_all (); Trigger.main_tread_id := Thread.(id (self ())); - let fps = Time.adaptive_fps 60 in + let desired_fps = + if vsync then get_monitor_refresh_rate board |> Option.value ~default:60 + else 60 in + printd debug_graphics "Desired FPS=%u" desired_fps; + let start, fps = Time.adaptive_fps ~vsync desired_fps in make_sdl_windows board; show board; Thread.delay 0.01; (* we need some delay for the initial Mouse position to be detected *) @@ -1048,7 +1069,7 @@ let run ?before_display ?after_display board = (List.flatten (List.map Widget.connections (Layout.get_widgets board.windows_house))); Trigger.renew_my_event (); let rec loop anim = - let anim' = one_step ?before_display ~clear:true anim fps board in + let anim' = one_step ?before_display ~clear:true anim (start,fps) board in do_option after_display (fun f -> f ()); (* TODO? *) loop anim' in try diff --git a/lib/b_time.ml b/lib/b_time.ml index 44c159f..1a57c26 100644 --- a/lib/b_time.ml +++ b/lib/b_time.ml @@ -40,27 +40,47 @@ let delay x = Thread.delay (float x /. 1000.) ie. about 24 days. TODO change this? *) let now () : t = Int32.to_int (Sdl.get_ticks ()) -let make_fps () = +let make_fps ?(min_delay=5) () = + assert (min_delay >= 0); let start = ref 0 in fun fps -> - if !start = 0 then (delay 5; start := now ()) + if !start = 0 then (delay min_delay; start := now ()) else let round_trip = now () - !start in begin - let wait = max 5 ((1000 / fps) - round_trip) in + let wait = max min_delay ((1000 / fps) - round_trip) in printd debug_graphics "FPS:%u (round_trip=%u)\n" (1000 / (round_trip + wait)) round_trip; - delay wait; + if wait > 0 then + delay wait; start := now (); end -let adaptive_fps fps = +let set_swap_interval = + let swap_interval = ref min_int in + fun desired -> + if !swap_interval <> desired then begin + match Sdl.gl_set_swap_interval desired with + | Ok () -> + swap_interval := desired; + true; + | Error (`Msg m) -> + printd (debug_graphics+debug_warning) "Failed to set desired swap interval to %u: %s" desired m; + false + end else true + +let adaptive_fps ?(vsync=false) fps = let start = ref 0 in let frame = ref 1 in let total_wait = ref 0 in (* only for debugging *) + let vsync_used = ref false in (* the start function *) (fun () -> start := now (); total_wait := 0; + if vsync then begin + vsync_used := set_swap_interval 1; + printd debug_graphics "VSync used: %b" !vsync_used; + end; frame := 1), (* the main function *) @@ -78,7 +98,23 @@ let adaptive_fps fps = frame := 0; total_wait := 0; start := now (); + if !vsync_used then + (* turn on adaptive vsync if supported *) + if set_swap_interval (-1) then + printd debug_graphics "Warning: Adaptive VSync enabled" + else begin + printd debug_graphics "Warning: Disabling VSync"; + (* fall back to turning vsync off *) + let (_:bool) = set_swap_interval 0 in + vsync_used := false + end; 5) + else if !vsync_used then + (* trust VSync and the released runtime lock in Sdl.render_present + to maintain FPS, but use the usual 5ms to allow other OCaml code + to run if needed + *) + 5 else (printd debug_graphics "Wait=%u, Avg.=%u" wait (!total_wait / !frame); wait) in delay wait; diff --git a/lib/b_timeout.ml b/lib/b_timeout.ml index 8f99be6..cbfe282 100644 --- a/lib/b_timeout.ml +++ b/lib/b_timeout.ml @@ -114,8 +114,15 @@ let iter stack = in let remaining = loop list in (* Utils.(printd debug_custom "Remaining size %i" (List.length remaining)); *) - Var.update stack (fun modified -> insert_sublist modified remaining) + Var.update stack (fun modified -> insert_sublist modified remaining); + match Var.get stack with + | [] -> -1 (* wait forever until next event *) + | hd :: _ -> + (* ensure returned value is never negative, + since that would mean wait forever *) + max Time.(hd.timeout - Time.now ()) 0 let run () = (* the stack should be empty most of the time, so we add a test to be faster *) if Var.get stack <> [] then iter stack + else -1 (* wait forever until next event *) diff --git a/lib/b_trigger.ml b/lib/b_trigger.ml index f524fcf..3d37d85 100644 --- a/lib/b_trigger.ml +++ b/lib/b_trigger.ml @@ -14,6 +14,7 @@ open Tsdl open B_utils module E = Sdl.Event module Var = B_var +module Timeout = B_timeout open Result (* We initialize SDL with only the events subsystem *) @@ -138,55 +139,7 @@ let renew_my_event () = let of_event ev = E.(get ev typ) -(* See tsdl.mli *) -(* TODO when we switch to Tsdl 0.9.8, we should use their 'Event.enum' type - instead, so that we don't become incompatible every time they add a new - variant... See PR https://github.com/dbuenzli/tsdl/pull/54 *) -(* Or, one could copy here the function 'enum' from tsdl.ml *) - -type sdl_event = -[ `App_did_enter_background -| `App_did_enter_foreground -| `App_low_memory -| `App_terminating -| `App_will_enter_background -| `App_will_enter_foreground -| `Clipboard_update -| `Controller_axis_motion -| `Controller_button_down -| `Controller_button_up -| `Controller_device_added -| `Controller_device_remapped -| `Controller_device_removed -| `Dollar_gesture -| `Dollar_record -| `Drop_file -| `Finger_down -| `Finger_motion -| `Finger_up -| `Joy_axis_motion -| `Joy_ball_motion -| `Joy_button_down -| `Joy_button_up -| `Joy_device_added -| `Joy_device_removed -| `Joy_hat_motion -| `Key_down -| `Key_up -| `Mouse_button_down -| `Mouse_button_up -| `Mouse_motion -| `Mouse_wheel -| `Multi_gesture -| `Quit -| `Sys_wm_event -| `Text_editing -| `Text_input -| `Unknown of int -| `User_event -| `Window_event -| `Display_event -| `Sensor_update ] +type sdl_event = Sdl.Event.enum type bogue_event = [ `Bogue_startup @@ -840,42 +793,41 @@ let mouse_pos () = (* check if mouse didn't move for a while *) (* TODO use get_touch_finger *) let check_mouse_rest = - let pos0 = ref (0,0) - and t = ref (Some 0.) in + let t = ref None in + let on_mouse_idle () = + push_event @@ create_event mouse_at_rest + in + let start_timer () = + t := Some (mouse_pos (), Timeout.add 1000 on_mouse_idle) + in fun () -> match !t with - | None -> (* we start timer *) - t := Some (Unix.gettimeofday ()); - pos0 := mouse_pos (); - 0. - | Some t0 -> + | None -> start_timer () + | Some (pos0, timeout) -> let p = mouse_pos () in - if p <> !pos0 (* we have moved *) - then t := None; - Unix.gettimeofday () -. t0 + if p <> pos0 (* we have moved *) + then begin + Timeout.cancel timeout; + start_timer () + end + +let no_timeout () = -1 + +let poll_noevent_fps = B_time.make_fps () + +let wait_event_timeout = + let major, minor, patch = Sdl.get_version () in + if (major, minor, patch) >= (2,0,16) then Sdl.wait_event_timeout + else fun ev _ -> Sdl.poll_event ev (* Wait for next event. Returns the SAME event structure e (modified) *) -(* Remark: (Sdl.wait_event (Some e); Some e) is supposed to to the job, but - (quoted from DOC) as of SDL 2.0, this function does not put the application's - process to sleep waiting for events; it polls for events in a loop - internally. This may change in the future to improve power savings. *) -(* ME: as a result, it seems that Sdl.wait_event prevents other threads from - executing nicely *) -let rec wait_event ?(action = nop) e = - action (); - if Sdl.poll_event (Some e) then e - (* TODO send an event instead, and reset mouse *) - else begin - let t = check_mouse_rest () in (* TODO use Timeout instead *) - if t > 1. && not !is_mouse_at_rest - then (is_mouse_at_rest := true; - push_event (create_event mouse_at_rest)) - (* TODO save mouse position in event *) - else if t < 1. && !is_mouse_at_rest - then is_mouse_at_rest := false; (* the mouse has moved *) - Thread.delay 0.01; - wait_event ~action e - end +let rec wait_event ?(action = no_timeout) e = + check_mouse_rest (); + let timeout = action () in + poll_noevent_fps 100; + let has_event = wait_event_timeout (Some e) timeout in + if has_event then e + else wait_event ~action e let mm_pressed ev = Int32.logand E.(get ev mouse_motion_state) (Sdl.Button.lmask) <> 0l diff --git a/lib/b_widget.ml b/lib/b_widget.ml index aaf7638..a326e29 100644 --- a/lib/b_widget.ml +++ b/lib/b_widget.ml @@ -603,9 +603,9 @@ let check_box_with_label text = ok only for very fast actions. *) let mouse_over ?(enter = nop) ?(leave = nop) w = - let c = connect w w (fun w _ _ -> enter w) [Trigger.mouse_enter] in + let c = connect_main w w (fun w _ _ -> enter w) [Trigger.mouse_enter] in add_connection w c; - let c' = connect w w (fun w _ _ -> leave w) [Trigger.mouse_leave] in + let c' = connect_main w w (fun w _ _ -> leave w) [Trigger.mouse_leave] in add_connection w c' let on_click ~click w = diff --git a/lib/bogue.mli b/lib/bogue.mli index d2d52d6..a3929ff 100644 --- a/lib/bogue.mli +++ b/lib/bogue.mli @@ -319,7 +319,7 @@ module Time : sig (** Time elapsed from the initialization of SDL (roughly, since the start of your program). *) - val adaptive_fps : int -> (unit -> unit) * (unit -> unit) + val adaptive_fps : ?vsync:bool -> int -> (unit -> unit) * (unit -> unit) (** Create helper functions to help controlling the frame rate of the graphics loop. This is only useful if you have your own graphics loop, and do not use {!Main.run}. @@ -330,7 +330,16 @@ module Time : sig rate. It works on average: if some frames take longer, it will shorten the next frame to keep up. However, it tries to be nice to the CPU: even if one is really too slow, it will guarantee a 5ms sleep to the CPU and {e not} - try to keep up. *) + try to keep up. + + [vsync] is [false] by default, when [true] it sets GL swap interval to [1] + to wait for next vsync, and if it can't keep up with that during animation + it will set swap interval to [-1] if supported by platform to use + adaptive vsync. + (which should avoid forcing the animation rate to an integer ratio of monitor refresh rate) + + @see {!Main.get_monitor_refresh_rate} + *) end (* of Time *) @@ -490,50 +499,7 @@ module Trigger : sig (** {2 SDL events} *) - type sdl_event = - [ `App_did_enter_background - | `App_did_enter_foreground - | `App_low_memory - | `App_terminating - | `App_will_enter_background - | `App_will_enter_foreground - | `Clipboard_update - | `Controller_axis_motion - | `Controller_button_down - | `Controller_button_up - | `Controller_device_added - | `Controller_device_remapped - | `Controller_device_removed - | `Dollar_gesture - | `Dollar_record - | `Drop_file - | `Finger_down - | `Finger_motion - | `Finger_up - | `Joy_axis_motion - | `Joy_ball_motion - | `Joy_button_down - | `Joy_button_up - | `Joy_device_added - | `Joy_device_removed - | `Joy_hat_motion - | `Key_down - | `Key_up - | `Mouse_button_down - | `Mouse_button_up - | `Mouse_motion - | `Mouse_wheel - | `Multi_gesture - | `Quit - | `Sys_wm_event - | `Text_editing - | `Text_input - | `Unknown of int - | `User_event - | `Window_event - | `Display_event - | `Sensor_update - ] + type sdl_event = Tsdl.Sdl.Event.enum type bogue_event = [ `Bogue_startup @@ -2494,6 +2460,11 @@ module Main : sig *) + val get_monitor_refresh_rate: board -> int option + (** [get_monitor_refresh_rate board] returns the monitor refresh rate, + for the monitor containing [board]. + *) + val of_windows : ?shortcuts:shortcuts -> ?connections:(Widget.connection list) -> ?on_user_event:(Tsdl.Sdl.event -> unit) -> Window.t list -> board @@ -2517,13 +2488,17 @@ module Main : sig @deprecated (since 20220418). Use {!of_layouts} or {!create} instead. *) val run : + ?vsync:bool -> ?before_display:(unit -> unit) -> ?after_display:(unit -> unit) -> board -> unit (** This is finally how you run your app! It creates the SDL windows associated with the {!Window.t}s registered with the board, and launches the main loop. This function only returns when all windows are closed (in case at least one window was created), or when the {!Exit} exception is - raised. *) + raised. + [vsync] defaults to [true] and enables synchronization to monitor refresh rate + where possible, otherwise a 60 FPS {!Time.adaptive_fps} is used. + *) (** {3:shortcuts Creating global keyboard shortcuts} *)