Audio callbacks: acquire runtime lock.

Tentative for #13. But still crashes.

.gitignore

@@ -3,4 +3,6 @@ tmp
 *~
 \.\#*
 \#*#
-CLOCK.org
+CLOCK.org
+*.native
+*.byte

_tags

@@ -16,6 +16,6 @@ true: thread
 <src/tsdl_top.*> : package(compiler-libs.toplevel)
 
 <test> : include
-<test/{sdlevents,test,min}.{native,byte}> : package(ctypes), \
+<test/{sdlevents,test,min,test_audio}.{native,byte}> : package(ctypes), \
   package(ctypes.foreign), use_sdl2
 <test/test.byte> : custom

src/tsdl.ml

@@ -4546,6 +4546,14 @@ type ('a, 'b) audio_spec =
 let audio_callback =
   (ptr void @-> ptr uint8_t @-> int @-> returning void)
 
+let funptr_opt ?abi ?name ?check_errno ?runtime_lock fn =
+  (* opt args missing in ctypes <= 0.4.0 see ctypes' issue #285 *)
+  let typ = (Foreign.funptr ?abi ?name ?check_errno ?runtime_lock fn) in
+  let from_ptr = coerce (ptr void) typ and to_ptr = coerce typ (ptr void) in
+  let read p = if to_voidp p = null then None else Some (from_ptr p)
+  and write = function None -> null | Some f -> to_ptr f in
+  view ~read ~write (ptr void)
+
 type _audio_spec
 let audio_spec : _audio_spec structure typ = structure "SDL_AudioSpec"
 let as_freq = field audio_spec "freq" int
@@ -4555,8 +4563,9 @@ let as_silence = field audio_spec "silence" int_as_uint8_t
 let as_samples = field audio_spec "samples" int_as_uint16_t
 let _ = field audio_spec "padding" uint16_t
 let as_size = field audio_spec "size" int32_as_uint32_t
-let as_callback = field audio_spec "callback" (funptr_opt audio_callback)
-(* let as_callback = field audio_spec "callback" (ptr void) *)
+let as_callback =
+  field audio_spec "callback" (funptr_opt ~runtime_lock:true audio_callback )
+
 let as_userdata = field audio_spec "userdata" (ptr void)
 let () = seal audio_spec
 
@@ -4590,9 +4599,7 @@ let audio_spec_to_c a =
   setf c as_silence a.as_silence; (* irrelevant *)
   setf c as_samples a.as_samples;
   setf c as_size a.as_size;       (* irrelevant *)
-  setf c as_callback wrap_cb; (* FIXME: this will run on another thread
-                                 (=> acquire runtime lock) and may move
-                                  does ctypes handle that ? *)
+  setf c as_callback wrap_cb;
   setf c as_userdata null;
   c
 

test/test_audio.ml

@@ -0,0 +1,64 @@
+
+(* Sample code provided by @psqu in issue #13. *)
+
+open Tsdl
+open Bigarray
+
+let audio_freq    = 44100
+let audio_samples = 4096
+let time = ref 0
+
+let audio_setup () =
+  let audio_callback (output : (int32, int32_elt) Sdl.bigarray) =
+    for i = 0 to ((Array1.dim output / 2) - 1) do
+      let phase = ((float_of_int !time) /.
+                   (66100.0 +. 1000.0 *. sin
+                                 (0.0001 *. (float_of_int !time)))) *. 3000.0 in
+      let sample = Int32.of_float ((sin phase) *. 1073741823.0) in
+      begin
+        output.{ 2 * i     } <- sample;
+        output.{ 2 * i + 1 } <- sample;
+        time := !time + 1
+      end
+    done
+  in
+  let desired_audiospec = {
+    Sdl.as_freq = audio_freq;
+    Sdl.as_format = Sdl.Audio.s32;
+    Sdl.as_channels = 2;
+    Sdl.as_callback = Some (audio_callback);
+    Sdl.as_samples = audio_samples;
+    Sdl.as_silence = 0;
+    Sdl.as_size =
+      Int32.of_int (audio_samples * 4 (* bajty na próbkę *) * 2 (* kanały *));
+    Sdl.as_ba_kind = int32; }
+  in
+  match Sdl.open_audio_device None false desired_audiospec 0 with
+  | `Error _ -> Sdl.log "Can't open audio device"; exit 1
+  | `Ok (device_id, _) -> device_id
+
+let video_setup () =
+  match Sdl.create_window ~w:640 ~h:480 "SDL Audio Test" Sdl.Window.opengl with
+  | `Error e -> Sdl.log "Create window error: %s" e; exit 1
+  | `Ok w -> w
+
+let main () = match Sdl.init Sdl.Init.(audio + video) with
+| `Error e -> Sdl.log "Init error: %s" e; exit 1
+| `Ok () ->
+    let window = video_setup () in
+    let device_id = audio_setup () in
+    let () = Sdl.pause_audio_device device_id false in
+    let e = Sdl.Event.create () in
+    let rec loop () = match Sdl.wait_event (Some e) with
+    | `Error err -> Sdl.log "Could not wait event: %s" err; ()
+    | `Ok () ->
+        match Sdl.Event.(enum (get e typ)) with
+        | `Quit ->
+            Sdl.pause_audio_device device_id true;
+            Sdl.destroy_window window;
+            Sdl.quit()
+        | _ -> loop ()
+    in
+    loop ()
+
+let () = main ()

test/tests.itarget

@@ -1,3 +1,4 @@
 test.native
+test_audio.native
 min.native
 sdlevents.native