Generate bindings using ctypes-stubs instead of ctypes-foreign (Minimize the use of libffi)

.merlin

@@ -1,4 +1,5 @@
 PKG b0.kit ctypes ctypes-foreign
 S src
+S support
 S test
 B _build/**

CHANGES.md

@@ -1,5 +1,7 @@
 - Fix bug in `Message_box` color scheme handling.
   Thanks to Matthieu Dubuget for the patch (#105).
+- Remove legacy function `get_revision_number` (`get_revision` should
+  be used instead).
 
 v1.1.0 2024-09-12 Zagreb
 ------------------------

_tags

@@ -1,13 +1,17 @@
 true: bin_annot, safe_string, thread
 <_b0> : -traverse
 <src> : include
+<support> : include
 
-<support/consts_stub.c> : use_sdl2
-<support/consts.{ml,native,byte}> : custom, link_consts_stub
+<*/*_stub*.c> : use_sdl2, package(ctypes)
+
+<support/types_*_gen.*> : package(ctypes.stubs)
+<support/*_generator.*> : package(ctypes.stubs)
 
 <src/tsdl.{mli,ml,cma,cmxa,cmxs}> : package(ctypes ctypes-foreign)
-<src/tsdl.ml> : sdl_consts
-<src/tsdl_stubs.c> : use_sdl2
+<src/*_description.ml> : package(ctypes)
+<src/types_stubs.ml> : package(ctypes)
+<src/*_generated.ml> : package(ctypes)
 <src/libtsdl_stubs.*> : use_sdl2
 <src/tsdl.{cma,cmxa}> : record_tsdl_stubs
 <src/tsdl.cmxs> : link_tsdl_stubs_archive

myocamlbuild.ml

@@ -68,30 +68,45 @@ let lib_with_clib ~lib ~clib ~has_lib ~src_dir ~stublib =
     ocaml_lib ~tag_name:use_lib ~dir:src_dir (strf "%s/%s" src_dir lib)
   end
 
-(* tsdl_const.ml generation. *)
+let ctypes_stub_gen () =
+  (* Types stubs generators *)
+  (* Generate stubs. Steps 1, 2, & 3 of Makefile (1 & 2 via built-in rules).
+     ML -> C *)
+  rule "cstubs: x_c_gen.native -> x_stubs_gen.c"
+    ~dep:"%_c_gen.native"
+    ~prod:"%_stubs_gen.c"
+    (fun env _build -> Cmd (A (env "./%_c_gen.native")));
 
-let sdl_consts_build () =
-  let obj s = match !Ocamlbuild_plugin.Options.ext_obj with
-  | "" -> s ^ ".o"
-  | x -> s ^ "." ^ x
-  in
-  dep [ "link"; "ocaml"; "link_consts_stub" ] [ obj "support/consts_stub" ];
-  dep [ "sdl_consts" ] [ "src/tsdl_consts.ml" ];
-  rule "sdl_consts: consts.byte -> tsdl_consts.ml"
-    ~dep:"support/consts.byte"
-    ~prod:"src/tsdl_consts.ml"
-    begin fun env build ->
-      let enums = env "support/consts.byte" in
-      let prod = env "src/tsdl_consts.ml" in
-      Cmd (S [A enums; A prod])
-    end;
-;;
+  (* Step 4. OCamlbuild (nor ocamlc/ocamlopt) has a built in rule for
+     linking executables from C. Call out to 'cc'. *)
+  rule "stub_gen 1: x_stubs_gen.o -> x_stubs_gen"
+    ~dep:"%_stubs_gen.o"
+    ~prod:"%_stubs_gen"
+    (fun env _build ->
+      Cmd (S [ A "cc"; A "-o"; A (env "%_stubs_gen"); A (env "%_stubs_gen.o") ]));
+
+  (* Step 5. Generate ml stubs.  C -> ML  *)
+  rule "stubs_gen 2: x_stubs_gen -> x_stubs.ml"
+    ~dep:"support/%_stubs_gen"
+    ~prod:"src/%_stubs.ml"
+    (fun env _build -> Cmd (S[A (env "support/%_stubs_gen"); Sh">"; A (env "src/%_stubs.ml")]));
+
+  (* Functions stubs generators *)
+  rule "cstubs functions: x_generator.native -> x_stubs.c"
+    ~dep:"support/%_generator.native"
+    ~prod:"src/%_stubs.c"
+    (fun env _build -> Cmd (S[A (env "./support/%_generator.native"); A "c"]));
+
+ rule "mlstubs functions: x_generator.native -> x_generated.ml"
+    ~dep:"support/%_generator.native"
+    ~prod:"src/%_generated.ml"
+    (fun env _build -> Cmd (S[A (env "./support/%_generator.native"); A "ml"]))
 
 let () =
   dispatch begin function
   | After_rules ->
       lib_with_clib ~lib:"tsdl" ~clib:"sdl2" ~has_lib:"-DHAS_SDL2"
         ~src_dir:"src" ~stublib:"tsdl_stubs";
-      sdl_consts_build ()
+      ctypes_stub_gen ()
   | _ -> ()
   end

src/async_function_description.ml

@@ -0,0 +1,23 @@
+open Ctypes
+
+module Types = Types_generated
+
+module Functions (F : FOREIGN) = struct
+  let delay =
+    F.(foreign "SDL_Delay" (int32_t @-> returning void))
+
+  let render_present =
+    F.(foreign "SDL_RenderPresent" (ptr Types.Renderer.t @-> returning void))
+
+  let wait_event =
+    F.(foreign "SDL_WaitEvent" (ptr Types.Event.t @-> returning int))
+
+  let wait_event_timeout =
+    F.(foreign "SDL_WaitEventTimeout"
+         (ptr Types.Event.t @-> int @-> returning bool))
+
+  let load_wav_rw =
+    F.(foreign "SDL_LoadWAV_RW"
+         (Types.rw_ops @-> int @-> ptr Types.audio_spec @-> ptr (ptr uint8_t) @->
+          ptr uint32_t @-> returning (ptr_opt Types.audio_spec)))
+end