From 450f86511ecf121c9b38c33ed6e8295e770f6f01 Mon Sep 17 00:00:00 2001 From: Stephen Sherratt Date: Fri, 7 Jul 2023 11:58:46 +1000 Subject: [PATCH] Use tsdl instead of ocamlsdl --- dune-project | 2 +- llama_interactive.opam | 2 +- src/interactive/dune | 13 +-- src/interactive/window.ml | 212 ++++++++++++++++++++------------------ 4 files changed, 114 insertions(+), 115 deletions(-) diff --git a/dune-project b/dune-project index bdc10366..d623edbc 100644 --- a/dune-project +++ b/dune-project @@ -38,5 +38,5 @@ (synopsis "Visualization and live interaction for Llama synthesizer library") (depends (llama (= :version)) - (ocamlsdl2 (>= 0.04)) + (tsdl (>= 1)) (conf-pkg-config :build))) diff --git a/llama_interactive.opam b/llama_interactive.opam index c80f0169..2ec1a5a9 100644 --- a/llama_interactive.opam +++ b/llama_interactive.opam @@ -9,7 +9,7 @@ bug-reports: "https://github.com/gridbugs/llama/issues" depends: [ "dune" {>= "3.0"} "llama" {= version} - "ocamlsdl2" {>= "0.04"} + "tsdl" {>= "1"} "conf-pkg-config" {build} "odoc" {with-doc} ] diff --git a/src/interactive/dune b/src/interactive/dune index 28812c41..a26542e5 100644 --- a/src/interactive/dune +++ b/src/interactive/dune @@ -1,14 +1,3 @@ -(rule - (action - (with-stdout-to - library_flags.sexp - (progn - (echo "( -cclib \"") - (run pkg-config --libs sdl2) - (echo "\")"))))) - (library (public_name llama_interactive) - (libraries llama lwt lwt.unix sdl2) - (library_flags - (:include library_flags.sexp))) + (libraries llama lwt lwt.unix tsdl)) diff --git a/src/interactive/window.ml b/src/interactive/window.ml index b25e10d3..05afa7e3 100644 --- a/src/interactive/window.ml +++ b/src/interactive/window.ml @@ -1,4 +1,4 @@ -open Sdl +open Tsdl module Signal = Llama.Signal module Ctx = Signal.Ctx module List = Llama.List @@ -7,9 +7,12 @@ module Global = struct let initialized = ref false let init () = - if not !initialized then ( - Sdl.init [ `VIDEO ]; - initialized := true) + if not !initialized then + match Sdl.init Sdl.Init.video with + | Error (`Msg msg) -> + Sdl.log "Error initializing sdl: %s" msg; + exit 1 + | Ok () -> initialized := true end let f_01_to_byte f = Llama.Float.clamp_01 f *. 255.0 |> Float.to_int @@ -18,7 +21,7 @@ let rgba_01_to_bytes (r, g, b, a) = (f_01_to_byte r, f_01_to_byte g, f_01_to_byte b, f_01_to_byte a) module Rect_rgba = struct - type t = { sdl_rect : Rect.t; rgb : int * int * int; a : int } + type t = { sdl_rect : Sdl.rect; rgb : int * int * int; a : int } end module Visualization_style = struct @@ -131,12 +134,9 @@ module Visualization = struct (t.style.sample_scale *. interpolated_sample)) in let sdl_rect = - { - Rect.h = t.style.pixel_scale; - w = t.style.pixel_scale; - x; - y = scaled_pixel_y * t.style.pixel_scale; - } + Sdl.Rect.create ~x + ~y:(scaled_pixel_y * t.style.pixel_scale) + ~w:t.style.pixel_scale ~h:t.style.pixel_scale in { Rect_rgba.sdl_rect; rgb = (r, g, b); a } in @@ -180,54 +180,54 @@ let create_inputs () = (signals, refs) let key_of_scancode (all_keyboard : 'a Input.All_keyboard.t) - (scancode : Sdlscancode.t) = - match scancode with - | A -> Some all_keyboard.key_a - | B -> Some all_keyboard.key_b - | C -> Some all_keyboard.key_c - | D -> Some all_keyboard.key_d - | E -> Some all_keyboard.key_e - | F -> Some all_keyboard.key_f - | G -> Some all_keyboard.key_g - | H -> Some all_keyboard.key_h - | I -> Some all_keyboard.key_i - | J -> Some all_keyboard.key_j - | K -> Some all_keyboard.key_k - | L -> Some all_keyboard.key_l - | M -> Some all_keyboard.key_m - | N -> Some all_keyboard.key_n - | O -> Some all_keyboard.key_o - | P -> Some all_keyboard.key_p - | Q -> Some all_keyboard.key_q - | R -> Some all_keyboard.key_r - | S -> Some all_keyboard.key_s - | T -> Some all_keyboard.key_t - | U -> Some all_keyboard.key_u - | V -> Some all_keyboard.key_v - | W -> Some all_keyboard.key_w - | X -> Some all_keyboard.key_x - | Y -> Some all_keyboard.key_y - | Z -> Some all_keyboard.key_z - | SEMICOLON -> Some all_keyboard.key_semicolon - | APOSTROPHE -> Some all_keyboard.key_apostrophe - | COMMA -> Some all_keyboard.key_comma - | PERIOD -> Some all_keyboard.key_period - | SPACE -> Some all_keyboard.key_space - | Num1 -> Some all_keyboard.key_1 - | Num2 -> Some all_keyboard.key_2 - | Num3 -> Some all_keyboard.key_3 - | Num4 -> Some all_keyboard.key_4 - | Num5 -> Some all_keyboard.key_5 - | Num6 -> Some all_keyboard.key_6 - | Num7 -> Some all_keyboard.key_7 - | Num8 -> Some all_keyboard.key_8 - | Num9 -> Some all_keyboard.key_9 - | Num0 -> Some all_keyboard.key_0 + (scancode : Sdl.scancode) = + match Sdl.Scancode.enum scancode with + | `A -> Some all_keyboard.key_a + | `B -> Some all_keyboard.key_b + | `C -> Some all_keyboard.key_c + | `D -> Some all_keyboard.key_d + | `E -> Some all_keyboard.key_e + | `F -> Some all_keyboard.key_f + | `G -> Some all_keyboard.key_g + | `H -> Some all_keyboard.key_h + | `I -> Some all_keyboard.key_i + | `J -> Some all_keyboard.key_j + | `K -> Some all_keyboard.key_k + | `L -> Some all_keyboard.key_l + | `M -> Some all_keyboard.key_m + | `N -> Some all_keyboard.key_n + | `O -> Some all_keyboard.key_o + | `P -> Some all_keyboard.key_p + | `Q -> Some all_keyboard.key_q + | `R -> Some all_keyboard.key_r + | `S -> Some all_keyboard.key_s + | `T -> Some all_keyboard.key_t + | `U -> Some all_keyboard.key_u + | `V -> Some all_keyboard.key_v + | `W -> Some all_keyboard.key_w + | `X -> Some all_keyboard.key_x + | `Y -> Some all_keyboard.key_y + | `Z -> Some all_keyboard.key_z + | `Semicolon -> Some all_keyboard.key_semicolon + | `Apostrophe -> Some all_keyboard.key_apostrophe + | `Comma -> Some all_keyboard.key_comma + | `Period -> Some all_keyboard.key_period + | `Space -> Some all_keyboard.key_space + | `K1 -> Some all_keyboard.key_1 + | `K2 -> Some all_keyboard.key_2 + | `K3 -> Some all_keyboard.key_3 + | `K4 -> Some all_keyboard.key_4 + | `K5 -> Some all_keyboard.key_5 + | `K6 -> Some all_keyboard.key_6 + | `K7 -> Some all_keyboard.key_7 + | `K8 -> Some all_keyboard.key_8 + | `K9 -> Some all_keyboard.key_9 + | `K0 -> Some all_keyboard.key_0 | _ -> None type t = { - window : Window.t; - render : Render.t; + window : Sdl.window; + renderer : Sdl.renderer; fps : float; background_rgba_01 : Types.rgba_01; visualization : Visualization.t option ref; @@ -235,63 +235,73 @@ type t = { input_refs : (bool ref, float ref) Input.t; } -let proc_events t = function - | Event.Mouse_Motion { mm_x; mm_y; _ } -> - let window_width, window_height = Window.get_size t.window in - let mouse_x_01 = Float.of_int mm_x /. Float.of_int window_width in - let mouse_y_01 = Float.of_int mm_y /. Float.of_int window_height in - t.input_refs.mouse.mouse_x := mouse_x_01; - t.input_refs.mouse.mouse_y := mouse_y_01 - | Event.KeyDown { scancode; _ } -> ( - match key_of_scancode t.input_refs.keyboard scancode with - | Some key_ref -> key_ref := true - | None -> ()) - | Event.KeyUp { scancode; _ } -> ( - match key_of_scancode t.input_refs.keyboard scancode with - | Some key_ref -> key_ref := false - | None -> ()) - | Event.Quit _ -> - Sdl.quit (); - exit 0 - | _ -> () +let proc_event t event = + let typ = Sdl.Event.get event Sdl.Event.typ in + if typ == Sdl.Event.quit then ( + Sdl.quit (); + exit 0) + else if typ == Sdl.Event.key_down then + let scancode = Sdl.Event.get event Sdl.Event.keyboard_scancode in + match key_of_scancode t.input_refs.keyboard scancode with + | Some key_ref -> key_ref := true + | None -> () + else if typ == Sdl.Event.key_up then + let scancode = Sdl.Event.get event Sdl.Event.keyboard_scancode in + match key_of_scancode t.input_refs.keyboard scancode with + | Some key_ref -> key_ref := false + | None -> () + else if typ == Sdl.Event.mouse_motion then ( + let mm_x = Sdl.Event.get event Sdl.Event.mouse_motion_x in + let mm_y = Sdl.Event.get event Sdl.Event.mouse_motion_y in + let window_width, window_height = Sdl.get_window_size t.window in + let mouse_x_01 = Float.of_int mm_x /. Float.of_int window_width in + let mouse_y_01 = Float.of_int mm_y /. Float.of_int window_height in + t.input_refs.mouse.mouse_x := mouse_x_01; + t.input_refs.mouse.mouse_y := mouse_y_01) let rec drain_events t = - match Event.poll_event () with - | None -> () - | Some ev -> - proc_events t ev; - drain_events t + let event = Sdl.Event.create () in + if Sdl.poll_event (Some event) then ( + proc_event t event; + drain_events t) + else () let create ~title ~width ~height ~fps ~background_rgba_01 = Global.init (); - let window, render = - Render.create_window_and_renderer ~width ~height ~flags:[] - in - let input_signals, input_refs = create_inputs () in - Window.set_title ~window ~title; - { - window; - render; - fps; - background_rgba_01; - visualization = ref None; - input_signals; - input_refs; - } + match + Sdl.create_window_and_renderer ~w:width ~h:height Sdl.Window.windowed + with + | Error (`Msg msg) -> + Sdl.log "Error creating window: %s" msg; + exit 1 + | Ok (window, renderer) -> + let input_signals, input_refs = create_inputs () in + Sdl.set_window_title window title; + { + window; + renderer; + fps; + background_rgba_01; + visualization = ref None; + input_signals; + input_refs; + } + +let log_error = function Ok () -> () | Error (`Msg msg) -> Sdl.log "%s" msg let render t = let r, g, b, a = rgba_01_to_bytes t.background_rgba_01 in - Render.set_draw_color t.render ~rgb:(r, g, b) ~a; - Render.clear t.render; + Sdl.set_render_draw_color t.renderer r g b a |> log_error; + Sdl.render_clear t.renderer |> log_error; (match !(t.visualization) with | None -> () | Some visualization -> Visualization.rect_rgba_drain_iter visualization - ~window_size:(Window.get_size t.window) - ~f:(fun { Rect_rgba.sdl_rect; rgb; a } -> - Render.set_draw_color t.render ~rgb ~a; - Render.fill_rect t.render sdl_rect)); - Render.render_present t.render + ~window_size:(Sdl.get_window_size t.window) + ~f:(fun { Rect_rgba.sdl_rect; rgb = r, g, b; a } -> + Sdl.set_render_draw_color t.renderer r g b a |> log_error; + Sdl.render_fill_rect t.renderer (Some sdl_rect) |> log_error)); + Sdl.render_present t.renderer let visualize t ?(pixel_scale = Defaults.pixel_scale) ?(sample_scale = Defaults.sample_scale)