Use tsdl instead of ocamlsdl

gridbugs · Jul 7, 2023 · 450f865 · 450f865
1 parent 1fb7092
commit 450f865
Show file tree

Hide file tree

Showing 4 changed files with 114 additions and 115 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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,118 +180,128 @@ 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;
   input_signals : (bool Signal.t, float Signal.t) Input.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)