Files
kutu/src/xcb/types.ml
T
2026-09-09 23:39:05 +01:00

388 lines
10 KiB
OCaml

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 typ = 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 Key = struct
type t
let typ : t structure typ = structure "xcb_key_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" uint32_t
let event = field typ "event" uint32_t
let child = field typ "child" uint32_t
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 same_screen = field typ "same_screen" uint8_t
let pad0 = field typ "pad0" uint8_t
let () = seal typ
let from ptr = from_voidp typ (to_voidp ptr)
let detail ptr = getf !@ptr detail |> Unsigned.UInt8.to_int
let state ptr = getf !@ptr state |> Unsigned.UInt16.to_int
let window ptr = getf !@ptr event
end
module Map_request = struct
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 = from_voidp typ (to_voidp ptr)
let window ptr = getf !@ptr window
end
module Enter = struct
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 = from_voidp typ (to_voidp ptr)
let window ptr = getf !@ptr event
end
module Destroy = struct
type t
let typ : t structure typ = structure "xcb_destroy_notify_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 event = field typ "event" uint32_t
let window = field typ "window" Window.typ
let () = seal typ
let from ptr = 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 typ = 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
let width ptr = Unsigned.UInt16.to_int (getf ptr width_in_pixels)
let height ptr = Unsigned.UInt16.to_int (getf ptr height_in_pixels)
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 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;*)