syedm/kutu
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Setup basic layout system

Browse Source 
- add Enter event bindings
- Add some more window bindings.
This commit is contained in:
syedm
2026-09-09 14:02:54 +01:00
parent 30dbf2ed2d
commit c06bc3a933
4 changed files with 212 additions and 22 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/kutu/layout.ml
+90
View File
@@ -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
+44 -3
View File
@@ -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
+26 -16
View File
@@ -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
+52 -3
View File
@@ -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 =
CArray.of_list uint32_t
[ Unsigned.UInt32.of_int (1048576 lor 524288 lor 131072 lor 4194304) ]
let event_mask =
(1 lsl 4) lor (1 lsl 17) lor (1 lsl 19) lor (1 lsl 20) lor (1 lsl 22)
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