Rearrange xcb bindings

flake.nix

@@ -11,24 +11,19 @@
       mruby = pkgs.stdenv.mkDerivation {
         pname = "mruby";
         version = "0.0.1";
-
         src = pkgs.lib.cleanSourceWith {
           src = ./libs;
           name = "mruby-src";
         };
-
         patches = [ ./libs/changes.patch ];
-
         nativeBuildInputs = with pkgs; [
           ruby
           gnumake
           gcc
         ];
-
         buildPhase = ''
           (cd mruby && rake)
         '';
-
         installPhase = ''
           mkdir -p $out
           cp -r mruby/build/host/lib $out/
@@ -38,15 +33,12 @@
       kutu = pkgs.stdenv.mkDerivation {
         pname = "kutu";
         version = "0.1.0";
-
         src = ./.;
-
         nativeBuildInputs = with pkgs; [
           dune_3
           ocaml
           ocamlPackages.findlib
         ];
-
         buildInputs = with pkgs; [
           libxcb
           xcbutilwm
@@ -54,30 +46,18 @@
           ocamlPackages.ctypes-foreign
           mruby
         ];
-
         buildPhase = ''
           export MRUBY_LIB=${mruby}/lib
           dune build src/main.exe --release
         '';
-
         installPhase = ''
           mkdir -p $out/bin
           cp _build/default/src/main.exe $out/bin/kutu
         '';
       };
 
-    in
-    {
-      packages.${system} = {
-        default = kutu;
-        kutu = kutu;
-        mruby = mruby;
-      };
-
-      apps.${system}.default = {
-        type = "app";
-        program = "${pkgs.writeShellScript "kutu-run" ''
-          set -e
+      kutu-run = pkgs.writeShellScriptBin "kutu-run" ''
+        set -e
           if [ -z "$DISPLAY" ]; then
             exec ${pkgs.xinit}/bin/startx \
               ${kutu}/bin/kutu \
@@ -97,7 +77,18 @@
             DISPLAY=$DISPLAY_NUM ${kutu}/bin/kutu
             echo "Returned: $?"
           fi
-        ''}";
+      '';
+    in
+    {
+      packages.${system} = {
+        default = kutu;
+        kutu = kutu;
+        mruby = mruby;
+      };
+
+      apps.${system}.default = {
+        type = "app";
+        program = "${kutu-run}/bin/kutu-run";
       };
 
       devShells.${system}.default = pkgs.mkShell {

src/dune

@@ -1,3 +1,5 @@
+(include_subdirs qualified)
+
 (executable
  (name main)
  (libraries ctypes-foreign)

src/main.ml

@@ -1,20 +1,29 @@
-open Ctypes
-open Foreign
-
-type mrb = unit ptr
-
-let mrb : mrb typ = ptr void
-let mrb_open = foreign "mrb_open" (void @-> returning mrb)
-let mrb_close = foreign "mrb_close" (mrb @-> returning void)
-
-let mrb_load_string =
-  foreign "mrb_load_string" (mrb @-> string @-> returning void)
+let spawn cmd =
+  match Unix.fork () with
+  | 0 ->
+      let devnull = Unix.openfile "/dev/null" [ Unix.O_WRONLY ] 0o666 in
+      Unix.dup2 devnull Unix.stdout;
+      Unix.dup2 devnull Unix.stderr;
+      Unix.close devnull;
+      Unix.execvp cmd.(0) cmd
+  | _pid -> ()
 
 let () =
-  let mrb_instance = mrb_open () in
+  let conn = Xcb.Functions.connect () in
 
-  print_endline "Executing Ruby code from OCaml:";
-  let _ = mrb_load_string mrb_instance "puts 'hello1234'.match?(/hello\\d+/)" in
+  print_endline "connected";
 
-  mrb_close mrb_instance;
-  print_endline "mruby instance closed successfully."
+  Xcb.Functions.window_attribute_setup conn;
+
+  if Xcb.Functions.flush conn <= 0 then exit 1;
+
+  spawn [| "kitty" |];
+
+  while true do
+    if Xcb.Functions.flush conn <= 0 then exit 1;
+    Unix.sleepf 0.01
+  done;
+
+  Xcb.Functions.disconnect conn;
+
+  print_endline "done"

src/mruby.ml

@@ -0,0 +1,11 @@
+open Ctypes
+open Foreign
+
+type mrb = unit ptr
+
+let mrb : mrb typ = ptr void
+let mrb_open = foreign "mrb_open" (void @-> returning mrb)
+let mrb_close = foreign "mrb_close" (mrb @-> returning void)
+
+let mrb_load_string =
+  foreign "mrb_load_string" (mrb @-> string @-> returning void)

src/xcb/functions.ml

@@ -0,0 +1,53 @@
+open Ctypes
+open Foreign
+
+let xcb_connect =
+  foreign "xcb_connect"
+    (string_opt @-> ptr int @-> returning (ptr Types.connection))
+
+let disconnect =
+  foreign "xcb_disconnect" (ptr Types.connection @-> returning void)
+
+let flush = foreign "xcb_flush" (ptr Types.connection @-> returning int)
+
+let connect () =
+  let screen = allocate int 0 in
+  xcb_connect None screen
+
+let get_setup =
+  foreign "xcb_get_setup" (ptr Types.connection @-> returning (ptr Types.setup))
+
+let setup_roots_iterator =
+  foreign "xcb_setup_roots_iterator"
+    (ptr Types.setup @-> returning Types.screen_iterator)
+
+let scr conn = getf (setup_roots_iterator (get_setup conn)) Types.data
+let root_window conn : Types.window = getf !@(scr conn) Types.root
+
+let values =
+  CArray.of_list uint32_t
+    [ Unsigned.UInt32.of_int (1048576 lor 524288 lor 131072 lor 4194304) ]
+
+let xcb_change_window_attributes_checked =
+  foreign "xcb_change_window_attributes_checked"
+    (ptr Types.connection @-> uint32_t @-> uint32_t @-> ptr uint32_t
+    @-> returning Types.void_cookie)
+
+let xcb_request_check =
+  foreign "xcb_request_check"
+    (ptr Types.connection @-> Types.void_cookie
+    @-> returning (ptr_opt Types.generic_error))
+
+let window_attribute_setup conn =
+  let cookie =
+    xcb_change_window_attributes_checked conn (root_window conn)
+      (Unsigned.UInt32.of_int 2048)
+      (CArray.start values)
+  in
+
+  match xcb_request_check conn cookie with
+  | None -> print_endline "WM ownership acquired"
+  | Some _ -> print_endline "another WM already owns the display"
+
+let connection_has_error =
+  foreign "xcb_connection_has_error" (ptr Types.connection @-> returning int)

src/xcb/types.ml

@@ -0,0 +1,45 @@
+open Ctypes
+open Foreign
+
+type connection
+type screen
+type screen_iterator
+type setup
+type window = Unsigned.UInt32.t
+type void_cookie
+type generic_error
+
+let generic_error : generic_error structure typ =
+  structure "xcb_generic_error_t"
+
+let void_cookie : void_cookie structure typ = structure "xcb_void_cookie_t"
+let sequence = field void_cookie "sequence" uint32_t
+let () = seal void_cookie
+let screen : screen structure typ = structure "xcb_screen_t"
+let root = field screen "root" uint32_t
+let default_colormap = field screen "default_colormap" uint32_t
+let white_pixel = field screen "white_pixel" uint32_t
+let black_pixel = field screen "black_pixel" uint32_t
+let current_input_masks = field screen "current_input_masks" uint32_t
+let width_in_pixels = field screen "width_in_pixels" uint16_t
+let height_in_pixels = field screen "height_in_pixels" uint16_t
+let width_in_millimeters = field screen "width_in_millimeters" uint16_t
+let height_in_millimeters = field screen "height_in_millimeters" uint16_t
+let min_installed_maps = field screen "min_installed_maps" uint16_t
+let max_installed_maps = field screen "max_installed_maps" uint16_t
+let root_visual = field screen "root_visual" uint32_t
+let backing_stores = field screen "backing_stores" uint8_t
+let save_unders = field screen "save_unders" uint8_t
+let root_depth = field screen "root_depth" uint8_t
+let allowed_depths_len = field screen "allowed_depths_len" uint8_t
+let () = seal screen
+
+let screen_iterator : screen_iterator structure typ =
+  structure "xcb_screen_iterator_t"
+
+let data = field screen_iterator "data" (ptr screen)
+let rem = field screen_iterator "rem" int
+let index = field screen_iterator "index" int
+let () = seal screen_iterator
+let setup : setup structure typ = structure "xcb_setup_t"
+let connection : connection structure typ = structure "xcb_connection_t"