Setup basic xcb bindings and loop

flake.nix

@@ -50,8 +50,6 @@
         buildInputs = with pkgs; [
           libxcb
           xcbutilwm
-          xrandr
-          xprop
           ocamlPackages.ctypes
           ocamlPackages.ctypes-foreign
           mruby
@@ -76,6 +74,32 @@
         mruby = mruby;
       };
 
+      apps.${system}.default = {
+        type = "app";
+        program = "${pkgs.writeShellScript "kutu-run" ''
+          set -e
+          if [ -z "$DISPLAY" ]; then
+            exec ${pkgs.xinit}/bin/startx \
+              ${kutu}/bin/kutu \
+              -- \
+              ${pkgs.xorg-server}/bin/X
+          else
+            DISPLAY_NUM=:100
+            ${pkgs.xorg-server}/bin/Xephyr \
+              $DISPLAY_NUM \
+              -screen 1280x720 \
+              -ac \
+              > /tmp/kutu-xephyr.log 2>&1 &
+            XEPHYR_PID=$!
+            cleanup() { kill "$XEPHYR_PID" 2>/dev/null || true; }
+            trap cleanup EXIT INT TERM
+            sleep 1
+            DISPLAY=$DISPLAY_NUM ${kutu}/bin/kutu
+            echo "Returned: $?"
+          fi
+        ''}";
+      };
+
       devShells.${system}.default = pkgs.mkShell {
         inputsFrom = [ kutu ];
 

src/dune

@@ -6,4 +6,7 @@
             -cclib -L%{env:MRUBY_LIB=../libs/mruby/build/host/lib}
             -cclib -Wl,--whole-archive
             -cclib -lmruby
-            -cclib -Wl,--no-whole-archive))
+            -cclib -Wl,--no-whole-archive
+            -cclib -lxcb
+            -cclib -lxcb-icccm
+            -cclib -lxcb-randr))

src/main.ml

@@ -1,20 +1,22 @@
-open Ctypes
+let spawn cmd =
-open Foreign
+  match Unix.fork () with 0 -> Unix.execvp cmd.(0) cmd | _pid -> ()
-
-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 () =
-  let mrb_instance = mrb_open () in
+  let conn = Xcb.connect () in
 
-  print_endline "Executing Ruby code from OCaml:";
+  print_endline "connected";
-  let _ = mrb_load_string mrb_instance "puts 'hello1234'.match?(/hello\\d+/)" in
 
-  mrb_close mrb_instance;
+  let _ = Xcb.window_attribute_setup conn in
-  print_endline "mruby instance closed successfully."
+
+  Xcb.flush conn;
+
+  spawn [| "kitty" |];
+
+  while true do
+    Xcb.flush conn;
+    Unix.sleepf 0.01
+  done;
+
+  Xcb.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.ml

@@ -0,0 +1,95 @@
+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"
+
+let xcb_connect =
+  foreign "xcb_connect" (string_opt @-> ptr int @-> returning (ptr connection))
+
+let xcb_disconnect = foreign "xcb_disconnect" (ptr connection @-> returning void)
+let xcb_flush = foreign "xcb_flush" (ptr connection @-> returning int)
+
+let connect () =
+  let screen = allocate int 0 in
+  xcb_connect None screen
+
+let disconnect conn = xcb_disconnect conn
+let flush conn = ignore (xcb_flush conn)
+
+let get_setup =
+  foreign "xcb_get_setup" (ptr connection @-> returning (ptr setup))
+
+let setup_roots_iterator =
+  foreign "xcb_setup_roots_iterator" (ptr setup @-> returning screen_iterator)
+
+let scr conn = getf (setup_roots_iterator (get_setup conn)) data
+let root_window conn : window = getf !@(scr conn) 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 connection @-> uint32_t @-> uint32_t @-> ptr uint32_t
+   @-> returning void_cookie)
+
+let xcb_request_check =
+  foreign "xcb_request_check"
+    (ptr connection @-> void_cookie @-> returning (ptr_opt 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"