Setup proper WM lifecycle and xcb bindings
This commit is contained in:
@@ -0,0 +1,340 @@
|
||||
open Ctypes
|
||||
open Foreign
|
||||
|
||||
module Connection = struct
|
||||
type t
|
||||
type conn_ptr = t structure ptr
|
||||
|
||||
let typ : t structure typ = structure "xcb_connection_t"
|
||||
end
|
||||
|
||||
module Window = struct
|
||||
type t = Unsigned.UInt32.t
|
||||
|
||||
let typ : t Ctypes.typ = Ctypes.uint32_t
|
||||
let of_int x = Unsigned.UInt32.of_int x
|
||||
end
|
||||
|
||||
module Cookie = struct
|
||||
module Void = struct
|
||||
type t
|
||||
|
||||
let typ : t structure typ = structure "xcb_void_cookie_t"
|
||||
let sequence = field typ "sequence" uint32_t
|
||||
let () = seal typ
|
||||
end
|
||||
|
||||
module Atom = struct
|
||||
type t
|
||||
|
||||
let typ : t structure typ = structure "xcb_intern_atom_cookie_t"
|
||||
let sequence = field typ "sequence" uint32_t
|
||||
let () = seal typ
|
||||
end
|
||||
end
|
||||
|
||||
module Error = struct
|
||||
type t
|
||||
|
||||
let typ : t structure typ = structure "xcb_generic_error_t"
|
||||
end
|
||||
|
||||
module Event = struct
|
||||
type t
|
||||
|
||||
let typ : t structure typ = structure "xcb_generic_event_t"
|
||||
let response_type = field typ "response_type" uint8_t
|
||||
let pad0 = field typ "pad0" uint8_t
|
||||
let sequence = field typ "sequence" uint16_t
|
||||
let pad = field typ "pad" (array 7 uint32_t)
|
||||
let full_sequence = field typ "full_sequence" uint32_t
|
||||
let () = seal typ
|
||||
let response_type ptr = getf !@ptr response_type
|
||||
end
|
||||
|
||||
module Events = struct
|
||||
module Map_request = struct
|
||||
open Ctypes
|
||||
|
||||
type t
|
||||
|
||||
let typ : t structure typ = structure "xcb_map_request_event_t"
|
||||
let response_type = field typ "response_type" uint8_t
|
||||
let pad0 = field typ "pad0" uint8_t
|
||||
let sequence = field typ "sequence" uint16_t
|
||||
let parent = field typ "parent" uint32_t
|
||||
let window = field typ "window" Window.typ
|
||||
let () = seal typ
|
||||
let from ptr = Ctypes.from_voidp typ (to_voidp ptr)
|
||||
let window ptr = getf !@ptr window
|
||||
end
|
||||
end
|
||||
|
||||
module Client_message = struct
|
||||
type t
|
||||
|
||||
let typ : t structure typ = structure "xcb_client_message_event_t"
|
||||
let response_type = field typ "response_type" uint8_t
|
||||
let format = field typ "format" uint8_t
|
||||
let sequence = field typ "sequence" uint16_t
|
||||
let window = field typ "window" Window.typ
|
||||
let type_ = field typ "type" uint32_t
|
||||
let data = field typ "data" (array 5 uint32_t)
|
||||
let () = seal typ
|
||||
let ptr ev = to_voidp (addr ev) |> from_voidp char
|
||||
end
|
||||
|
||||
module Atom = struct
|
||||
type t = Unsigned.UInt32.t
|
||||
|
||||
let typ : t Ctypes.typ = Ctypes.uint32_t
|
||||
end
|
||||
|
||||
module Reply = struct
|
||||
type t
|
||||
|
||||
let typ : t structure typ = structure "xcb_intern_atom_reply_t"
|
||||
let response_type = field typ "response_type" uint8_t
|
||||
let pad0 = field typ "pad0" uint8_t
|
||||
let sequence = field typ "sequence" uint16_t
|
||||
let length = field typ "length" uint32_t
|
||||
let atom = field typ "atom" Atom.typ
|
||||
let () = seal typ
|
||||
let get_atom ptr = getf !@ptr atom
|
||||
end
|
||||
|
||||
module Screen = struct
|
||||
type t
|
||||
|
||||
let typ : t structure typ = structure "xcb_screen_t"
|
||||
let root = field typ "root" Window.typ
|
||||
let default_colormap = field typ "default_colormap" uint32_t
|
||||
let white_pixel = field typ "white_pixel" uint32_t
|
||||
let black_pixel = field typ "black_pixel" uint32_t
|
||||
let current_input_masks = field typ "current_input_masks" uint32_t
|
||||
let width_in_pixels = field typ "width_in_pixels" uint16_t
|
||||
let height_in_pixels = field typ "height_in_pixels" uint16_t
|
||||
let width_in_millimeters = field typ "width_in_millimeters" uint16_t
|
||||
let height_in_millimeters = field typ "height_in_millimeters" uint16_t
|
||||
let min_installed_maps = field typ "min_installed_maps" uint16_t
|
||||
let max_installed_maps = field typ "max_installed_maps" uint16_t
|
||||
let root_visual = field typ "root_visual" uint32_t
|
||||
let backing_stores = field typ "backing_stores" uint8_t
|
||||
let save_unders = field typ "save_unders" uint8_t
|
||||
let root_depth = field typ "root_depth" uint8_t
|
||||
let allowed_depths_len = field typ "allowed_depths_len" uint8_t
|
||||
let () = seal typ
|
||||
let root ptr = getf ptr root
|
||||
end
|
||||
|
||||
module Setup = struct
|
||||
type t
|
||||
|
||||
let typ : t structure typ = structure "xcb_setup_t"
|
||||
end
|
||||
|
||||
module Screen_iterator = struct
|
||||
type t
|
||||
|
||||
let typ : t structure typ = structure "xcb_screen_iterator_t"
|
||||
let data = field typ "data" (ptr Screen.typ)
|
||||
let rem = field typ "rem" int
|
||||
let index = field typ "index" int
|
||||
let () = seal typ
|
||||
let screen ptr = !@(getf ptr data)
|
||||
end
|
||||
|
||||
(* TODO: convert all these:
|
||||
/* Opcode for xcb_create_notify. */
|
||||
/**
|
||||
* @brief xcb_create_notify_event_t
|
||||
**/
|
||||
typedef struct xcb_create_notify_event_t {
|
||||
uint8_t response_type;
|
||||
uint8_t pad0;
|
||||
uint16_t sequence;
|
||||
xcb_window_t parent;
|
||||
xcb_window_t window;
|
||||
int16_t x;
|
||||
int16_t y;
|
||||
uint16_t width;
|
||||
uint16_t height;
|
||||
uint16_t border_width;
|
||||
uint8_t override_redirect;
|
||||
uint8_t pad1;
|
||||
} xcb_create_notify_event_t;
|
||||
|
||||
/**
|
||||
* @brief xcb_destroy_notify_event_t
|
||||
**/
|
||||
typedef struct xcb_destroy_notify_event_t {
|
||||
uint8_t response_type;
|
||||
uint8_t pad0;
|
||||
uint16_t sequence;
|
||||
xcb_window_t event;
|
||||
xcb_window_t window;
|
||||
} xcb_destroy_notify_event_t;
|
||||
|
||||
/**
|
||||
* @brief xcb_unmap_notify_event_t
|
||||
**/
|
||||
typedef struct xcb_unmap_notify_event_t {
|
||||
uint8_t response_type;
|
||||
uint8_t pad0;
|
||||
uint16_t sequence;
|
||||
xcb_window_t event;
|
||||
xcb_window_t window;
|
||||
uint8_t from_configure;
|
||||
uint8_t pad1[3];
|
||||
} xcb_unmap_notify_event_t;
|
||||
/**
|
||||
* @brief xcb_map_notify_event_t
|
||||
**/
|
||||
typedef struct xcb_map_notify_event_t {
|
||||
uint8_t response_type;
|
||||
uint8_t pad0;
|
||||
uint16_t sequence;
|
||||
xcb_window_t event;
|
||||
xcb_window_t window;
|
||||
uint8_t override_redirect;
|
||||
uint8_t pad1[3];
|
||||
} 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;
|
||||
|
||||
|
||||
|
||||
|
||||
typedef xcb_key_press_event_t xcb_key_release_event_t;
|
||||
|
||||
typedef enum xcb_button_mask_t {
|
||||
XCB_BUTTON_MASK_1 = 256,
|
||||
XCB_BUTTON_MASK_2 = 512,
|
||||
XCB_BUTTON_MASK_3 = 1024,
|
||||
XCB_BUTTON_MASK_4 = 2048,
|
||||
XCB_BUTTON_MASK_5 = 4096,
|
||||
XCB_BUTTON_MASK_ANY = 32768
|
||||
} xcb_button_mask_t;
|
||||
|
||||
|
||||
/**
|
||||
* @brief xcb_button_press_event_t
|
||||
**/
|
||||
typedef struct xcb_button_press_event_t {
|
||||
uint8_t response_type;
|
||||
xcb_button_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 same_screen;
|
||||
uint8_t pad0;
|
||||
} xcb_button_press_event_t;
|
||||
|
||||
|
||||
typedef xcb_button_press_event_t xcb_button_release_event_t;
|
||||
|
||||
typedef enum xcb_motion_t {
|
||||
XCB_MOTION_NORMAL = 0,
|
||||
XCB_MOTION_HINT = 1
|
||||
} xcb_motion_t;
|
||||
|
||||
|
||||
/**
|
||||
* @brief xcb_motion_notify_event_t
|
||||
**/
|
||||
typedef struct xcb_motion_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 same_screen;
|
||||
uint8_t pad0;
|
||||
} xcb_motion_notify_event_t;
|
||||
|
||||
typedef enum xcb_notify_detail_t {
|
||||
XCB_NOTIFY_DETAIL_ANCESTOR = 0,
|
||||
XCB_NOTIFY_DETAIL_VIRTUAL = 1,
|
||||
XCB_NOTIFY_DETAIL_INFERIOR = 2,
|
||||
XCB_NOTIFY_DETAIL_NONLINEAR = 3,
|
||||
XCB_NOTIFY_DETAIL_NONLINEAR_VIRTUAL = 4,
|
||||
XCB_NOTIFY_DETAIL_POINTER = 5,
|
||||
XCB_NOTIFY_DETAIL_POINTER_ROOT = 6,
|
||||
XCB_NOTIFY_DETAIL_NONE = 7
|
||||
} xcb_notify_detail_t;
|
||||
|
||||
typedef enum xcb_notify_mode_t {
|
||||
XCB_NOTIFY_MODE_NORMAL = 0,
|
||||
XCB_NOTIFY_MODE_GRAB = 1,
|
||||
XCB_NOTIFY_MODE_UNGRAB = 2,
|
||||
XCB_NOTIFY_MODE_WHILE_GRABBED = 3
|
||||
} xcb_notify_mode_t;
|
||||
|
||||
|
||||
/**
|
||||
* @brief xcb_configure_request_event_t
|
||||
**/
|
||||
typedef struct xcb_configure_request_event_t {
|
||||
uint8_t response_type;
|
||||
uint8_t stack_mode;
|
||||
uint16_t sequence;
|
||||
xcb_window_t parent;
|
||||
xcb_window_t window;
|
||||
xcb_window_t sibling;
|
||||
int16_t x;
|
||||
int16_t y;
|
||||
uint16_t width;
|
||||
uint16_t height;
|
||||
uint16_t border_width;
|
||||
uint16_t value_mask;
|
||||
} xcb_configure_request_event_t;
|
||||
|
||||
|
||||
/**
|
||||
* @brief xcb_resize_request_event_t
|
||||
**/
|
||||
typedef struct xcb_resize_request_event_t {
|
||||
uint8_t response_type;
|
||||
uint8_t pad0;
|
||||
uint16_t sequence;
|
||||
xcb_window_t window;
|
||||
uint16_t width;
|
||||
uint16_t height;
|
||||
} xcb_resize_request_event_t;*)
|
||||
Reference in New Issue
Block a user