diff --git a/src/kutu/layout.ml b/src/kutu/layout.ml new file mode 100644 index 0000000..d408df7 --- /dev/null +++ b/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 diff --git a/src/main.ml b/src/main.ml index 96e1b7a..7ddde89 100644 --- a/src/main.ml +++ b/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; diff --git a/src/xcb/types.ml b/src/xcb/types.ml index 7bb3c72..2331ff0 100644 --- a/src/xcb/types.ml +++ b/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; diff --git a/src/xcb/window.ml b/src/xcb/window.ml index e6f31f5..007181b 100644 --- a/src/xcb/window.ml +++ b/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 = - 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