Setup basic layout system

- add Enter event bindings
- Add some more window bindings.

src/kutu/layout.ml

@@ -0,0 +1,90 @@
+type direction = Horizontal | Vertical
+type rect = { rect_x : int; rect_y : int; rect_width : int; rect_height : int }
+
+type layout =
+  | Nothing
+  | Leaf of { layout_window : Xcb.Types.Window.t }
+  | Split of {
+      layout_direction : direction;
+      layout_ratio : float;
+      layout_l : layout;
+      layout_r : layout;
+    }
+
+type fwindow = { fw_rect : rect; fw_window : Xcb.Types.Window.t }
+type workspace = { mutable ws_root : layout; ws_fwindows : fwindow array }
+
+let flip_direction = function Horizontal -> Vertical | Vertical -> Horizontal
+
+let rec insert direction window = function
+  | Nothing -> Leaf { layout_window = window }
+  | Leaf { layout_window = existing } ->
+      Split
+        {
+          layout_direction = Horizontal;
+          layout_ratio = 0.5;
+          layout_l = Leaf { layout_window = existing };
+          layout_r = Leaf { layout_window = window };
+        }
+  | Split { layout_direction; layout_ratio; layout_l; layout_r } ->
+      Split
+        {
+          layout_direction;
+          layout_ratio;
+          layout_l;
+          layout_r = insert (flip_direction layout_direction) window layout_r;
+        }
+
+let split_rect rect direction ratio =
+  match direction with
+  | Horizontal ->
+      let left_width = int_of_float (float rect.rect_width *. ratio) in
+      let right_width = rect.rect_width - left_width in
+      let left =
+        {
+          rect_x = rect.rect_x;
+          rect_y = rect.rect_y;
+          rect_width = left_width;
+          rect_height = rect.rect_height;
+        }
+      in
+      let right =
+        {
+          rect_x = rect.rect_x + left_width;
+          rect_y = rect.rect_y;
+          rect_width = right_width;
+          rect_height = rect.rect_height;
+        }
+      in
+      (left, right)
+  | Vertical ->
+      let top_height = int_of_float (float rect.rect_height *. ratio) in
+      let bottom_height = rect.rect_height - top_height in
+      let top =
+        {
+          rect_x = rect.rect_x;
+          rect_y = rect.rect_y;
+          rect_width = rect.rect_width;
+          rect_height = top_height;
+        }
+      in
+      let bottom =
+        {
+          rect_x = rect.rect_x;
+          rect_y = rect.rect_y + top_height;
+          rect_width = rect.rect_width;
+          rect_height = bottom_height;
+        }
+      in
+      (top, bottom)
+
+let rec calculate rect = function
+  | Nothing -> []
+  | Leaf { layout_window } -> [ { fw_rect = rect; fw_window = layout_window } ]
+  | Split { layout_direction; layout_ratio; layout_l; layout_r } ->
+      let left_rect, right_rect =
+        split_rect rect layout_direction layout_ratio
+      in
+      let left_windows = calculate left_rect layout_l in
+      let right_windows = calculate right_rect layout_r in
+      left_windows @ right_windows

src/main.ml

@@ -4,6 +4,9 @@ type wm_state = {
   mrb : Mruby.Types.Mrb_state.mrb_ptr;
   root : Xcb.Types.Window.t;
   mutable focus : Xcb.Types.Window.t;
+  workspaces : Kutu.Layout.workspace array;
+  mutable current : int;
+  screen : Kutu.Layout.rect;
 }
 
 let () =
@@ -11,12 +14,27 @@ let () =
     let conn = Xcb.Connection.connect () in
     let mrb = Mruby.Core.mrb_open in
     let root = Xcb.Utils.get_root conn in
-    { running = true; conn; mrb; root; focus = root }
+    let _ = Xcb.Window.setup conn root in
+    {
+      running = true;
+      conn;
+      mrb;
+      root;
+      focus = root;
+      workspaces = [| { ws_root = Kutu.Layout.Nothing; ws_fwindows = [||] } |];
+      current = 0;
+      screen =
+        {
+          Kutu.Layout.rect_x = 100;
+          Kutu.Layout.rect_y = 100;
+          Kutu.Layout.rect_width = 100;
+          Kutu.Layout.rect_height = 100;
+        };
+    }
   in
 
   print_endline "Started Kutu WM";
 
-  Xcb.Window.setup state.conn state.root;
   Xcb.Window.keybind state.conn state.root 0 24;
   Xcb.Window.keybind state.conn state.root 0 25;
   Xcb.Window.keybind state.conn state.root 0 26;
@@ -43,7 +61,30 @@ let () =
             let req = Xcb.Types.Events.Map_request.from ev in
             let window = Xcb.Types.Events.Map_request.window req in
             state.focus <- window;
-            Xcb.Window.map state.conn window
+            state.workspaces.(state.current).ws_root <-
+              Kutu.Layout.insert Kutu.Layout.Horizontal window
+                state.workspaces.(state.current).ws_root;
+            Xcb.Window.map state.conn window;
+            Xcb.Window.setup_window state.conn window;
+            Xcb.Window.focus state.conn window;
+            List.iter
+              (fun {
+                     Kutu.Layout.fw_window = window;
+                     fw_rect =
+                       {
+                         rect_x = x;
+                         rect_y = y;
+                         rect_width = width;
+                         rect_height = height;
+                       };
+                   } -> Xcb.Window.reshape state.conn window x y width height)
+              (Kutu.Layout.calculate state.screen
+                 state.workspaces.(state.current).ws_root)
+        | Enter ->
+            let req = Xcb.Types.Events.Enter.from ev in
+            let window = Xcb.Types.Events.Enter.window req in
+            state.focus <- window;
+            Xcb.Window.focus state.conn window
         | _ -> ());
         Xcb.Utils.free ev);
     Mruby.Core.error_check state.mrb;

src/xcb/types.ml

@@ -68,6 +68,31 @@ module Events = struct
     let from ptr = Ctypes.from_voidp typ (to_voidp ptr)
     let window ptr = getf !@ptr window
   end
+
+  module Enter = struct
+    open Ctypes
+
+    type t
+
+    let typ : t structure typ = structure "xcb_enter_notify_event_t"
+    let response_type = field typ "response_type" uint8_t
+    let detail = field typ "detail" uint8_t
+    let sequence = field typ "sequence" uint16_t
+    let time = field typ "time" uint32_t
+    let root = field typ "root" Window.typ
+    let event = field typ "event" Window.typ
+    let child = field typ "child" Window.typ
+    let root_x = field typ "root_x" int16_t
+    let root_y = field typ "root_y" int16_t
+    let event_x = field typ "event_x" int16_t
+    let event_y = field typ "event_y" int16_t
+    let state = field typ "state" uint16_t
+    let mode = field typ "mode" uint8_t
+    let same_screen = field typ "same_screen_focus" uint8_t
+    let () = seal typ
+    let from ptr = Ctypes.from_voidp typ (to_voidp ptr)
+    let window ptr = getf !@ptr event
+  end
 end
 
 module Client_message = struct
@@ -205,22 +230,7 @@ typedef struct xcb_map_notify_event_t {
 /**
  * @brief xcb_enter_notify_event_t
  **/
-typedef struct xcb_enter_notify_event_t {
+
-    uint8_t         response_type;
-    uint8_t         detail;
-    uint16_t        sequence;
-    xcb_timestamp_t time;
-    xcb_window_t    root;
-    xcb_window_t    event;
-    xcb_window_t    child;
-    int16_t         root_x;
-    int16_t         root_y;
-    int16_t         event_x;
-    int16_t         event_y;
-    uint16_t        state;
-    uint8_t         mode;
-    uint8_t         same_screen_focus;
-} xcb_enter_notify_event_t;
 
 
 typedef xcb_enter_notify_event_t xcb_leave_notify_event_t;

src/xcb/window.ml

@@ -6,9 +6,10 @@ let _xcb_change_window_attributes_checked =
     (ptr Types.Connection.typ @-> Types.Window.typ @-> uint32_t @-> ptr uint32_t
     @-> returning Types.Cookie.Void.typ)
 
-let values =
+let event_mask =
-  CArray.of_list uint32_t
+  (1 lsl 4) lor (1 lsl 17) lor (1 lsl 19) lor (1 lsl 20) lor (1 lsl 22)
-    [ Unsigned.UInt32.of_int (1048576 lor 524288 lor 131072 lor 4194304) ]
+
+let values = CArray.of_list uint32_t [ Unsigned.UInt32.of_int event_mask ]
 
 let setup conn root =
   let cookie =
@@ -18,6 +19,42 @@ let setup conn root =
   in
   Error.check conn cookie
 
+let window_event_mask = 1 lsl 4
+
+let values_window =
+  CArray.of_list uint32_t [ Unsigned.UInt32.of_int window_event_mask ]
+
+let setup_window conn window =
+  let cookie =
+    _xcb_change_window_attributes_checked conn window
+      (Unsigned.UInt32.of_int 2048)
+      (CArray.start values_window)
+  in
+  Error.check conn cookie
+
+let _xcb_configure_window =
+  foreign "xcb_configure_window"
+    (ptr Types.Connection.typ @-> Types.Window.typ @-> uint16_t @-> ptr uint32_t
+    @-> returning Types.Cookie.Void.typ)
+
+let reshape conn window x y width height =
+  let mask = (1 lsl 0) lor (1 lsl 1) lor (1 lsl 2) lor (1 lsl 3) in
+  let values =
+    CArray.of_list uint32_t
+      [
+        Unsigned.UInt32.of_int x;
+        Unsigned.UInt32.of_int y;
+        Unsigned.UInt32.of_int width;
+        Unsigned.UInt32.of_int height;
+      ]
+  in
+  let cookie =
+    _xcb_configure_window conn window
+      (Unsigned.UInt16.of_int mask)
+      (CArray.start values)
+  in
+  Error.check conn cookie
+
 let _xcb_grab_key =
   foreign "xcb_grab_key"
     (ptr Types.Connection.typ @-> uint8_t @-> Types.Window.typ @-> uint16_t
@@ -42,6 +79,18 @@ let map conn window =
   let cookie = _xcb_map_window conn window in
   Error.check conn cookie
 
+let _xcb_set_input_focus =
+  foreign "xcb_set_input_focus"
+    (ptr Types.Connection.typ @-> uint8_t @-> Types.Window.typ @-> uint32_t
+    @-> returning Types.Cookie.Void.typ)
+
+let focus conn window =
+  let cookie =
+    _xcb_set_input_focus conn (Unsigned.UInt8.of_int 0) window
+      (Unsigned.UInt32.of_int 0)
+  in
+  Error.check conn cookie
+
 let _xcb_kill_client =
   foreign "xcb_kill_client"
     (ptr Types.Connection.typ @-> Types.Window.typ