diff --git a/common/bitwise.ml b/common/bitwise.ml
new file mode 100644
index 0000000..5fe02be
--- /dev/null
+++ b/common/bitwise.ml
@@ -0,0 +1,40 @@
+open Ctypes
+
+module type Size = sig
+  type t
+  val zero : t
+  val logor : t -> t -> t
+  val logand : t -> t -> t
+end
+
+module type Elems = sig
+  type t
+  module Size : Size
+  val size : Size.t typ
+  val desc : (t * Size.t) list
+end
+
+module type Enum = sig
+  type elem
+  type t
+  val t : t
+end
+
+module Make (E : Elems) : Enum = struct
+  type elem = E.t
+  type t = E.t list typ
+  let t : t =
+    let read i =
+      List.filter_map (fun (x, cst) ->
+          if (E.Size.logand i cst) <> E.Size.zero then
+            Some x
+          else None
+        ) E.desc
+    in
+    let write items =
+      List.fold_left (fun i item ->
+          E.Size.logor (List.assoc item E.desc) i
+        ) E.Size.zero items
+    in
+    view ~read ~write E.size
+end
diff --git a/common/dune b/common/dune
index e500ad6..1e9637c 100644
--- a/common/dune
+++ b/common/dune
@@ -1,6 +1,7 @@
 (library
  (name wlroots_common)
  (public_name wlroots.common)
+ (modules utils bitwise sigs)
  (libraries ctypes))
 
 ;; xdg-shell-protocol.h
diff --git a/common/utils.ml b/common/utils.ml
index 73eb088..ab6768f 100644
--- a/common/utils.ml
+++ b/common/utils.ml
@@ -13,24 +13,6 @@ let ptr_hash : 'a ptr -> int = fun p ->
   to_voidp p |> raw_address_of_ptr |> Hashtbl.hash
 
 let mk_equal compare x y = compare x y = 0
-
-let bitwise_enum desc =
-  let open Unsigned.UInt64 in
-  let open Infix in
-  let read i =
-    List.filter_map (fun (x, cst) ->
-      if (i land cst) <> zero then
-        Some x
-      else None
-    ) desc
-  in
-  let write items =
-    List.fold_left (fun i item ->
-      (List.assoc item desc) lor i
-    ) zero items
-  in
-  view ~read ~write uint64_t
-
 module Ptr = struct
   let compare = ptr_compare
   let hash = ptr_hash
diff --git a/ffi/ffi.ml b/ffi/ffi.ml
index 4e3c681..be647b0 100644
--- a/ffi/ffi.ml
+++ b/ffi/ffi.ml
@@ -31,6 +31,10 @@ struct
         allocate Time_unix.Timespec.t timespec)
       (ptr Time_unix.Timespec.t)
 
+  (* FIXME: The void pointer is a pixman_region32_t for which no bindings exist (yet).
+     This is only ok because so far, no one uses it. *)
+  let pixman_region32_t = ptr void
+
   (* wl_list *)
 
   type wl_list_p = Wl_list.t ptr
@@ -130,6 +134,15 @@ struct
   let wlr_output_enable = foreign "wlr_output_enable"
       (wlr_output_p @-> bool @-> returning void)
 
+  let wlr_output_effective_resolution = foreign "wlr_output_effective_resolution"
+      (wlr_output_p @-> ptr int @-> ptr int @-> returning void)
+
+  let wlr_output_transform_invert = foreign "wlr_output_transform_invert"
+      (Wl_output_transform.t @-> returning Wl_output_transform.t)
+
+  let wlr_output_render_software_cursors = foreign "wlr_output_render_software_cursors"
+      (wlr_output_p @-> pixman_region32_t @-> returning void)
+
   (* wlr_output_layout *)
 
   let wlr_output_layout_p = ptr Output_layout.t
@@ -140,6 +153,9 @@ struct
   let wlr_output_layout_add_auto = foreign "wlr_output_layout_add_auto"
       (wlr_output_layout_p @-> wlr_output_p @-> returning void)
 
+  let wlr_output_layout_output_coords = foreign "wlr_output_layout_output_coords"
+      (wlr_output_layout_p @-> wlr_output_p @-> ptr double @-> ptr double @-> returning void)
+
   (* wlr_box *)
 
   let wlr_box_p = ptr Box.t
@@ -169,6 +185,9 @@ struct
   let wlr_surface_send_frame_done = foreign "wlr_surface_send_frame_done"
       (wlr_surface_p @-> time @-> returning void)
 
+  let wlr_surface_get_texture = foreign "wlr_surface_get_texture"
+      (wlr_surface_p @-> returning wlr_texture_p)
+
   (* wlr_renderer *)
 
   let wlr_renderer_p = ptr Renderer.t
@@ -185,6 +204,9 @@ struct
   let wlr_renderer_init_wl_display = foreign "wlr_renderer_init_wl_display"
       (wlr_renderer_p @-> wl_display_p @-> returning bool)
 
+  let wlr_render_texture_with_matrix = foreign "wlr_render_texture_with_matrix"
+      (wlr_renderer_p @-> wlr_texture_p @-> ptr double @-> double @-> returning bool)
+
   (* wlr_keyboard *)
 
   let wlr_keyboard_p = ptr Keyboard.t
@@ -192,6 +214,14 @@ struct
   let wlr_keyboard_set_keymap = foreign "wlr_keyboard_set_keymap"
       (wlr_keyboard_p @-> Xkbcommon.Keymap.t @-> returning bool)
 
+  let wlr_keyboard_modifiers_p = ptr Keyboard_modifiers.t
+
+  let wlr_keyboard_set_repeat_info = foreign "wlr_keyboard_set_repeat_info"
+      (wlr_keyboard_p @-> int32_t @-> int32_t @-> returning void)
+
+  let wlr_keyboard_get_modifiers = foreign "wlr_keyboard_get_modifiers"
+      (wlr_keyboard_p @-> returning uint32_t)
+
   (* wlr_backend *)
 
   let wlr_backend_p = ptr Backend.t
@@ -229,6 +259,33 @@ struct
   let wlr_xdg_shell_create = foreign "wlr_xdg_shell_create"
       (wl_display_p @-> returning wlr_xdg_shell_p)
 
+  (* wlr_xdg_surface *)
+
+  let wlr_xdg_surface_p = ptr Xdg_surface.t
+
+  let wlr_surface_is_xdg_surface = foreign "wlr_surface_is_xdg_surface"
+      (wlr_surface_p @-> returning bool)
+
+  let wlr_xdg_surface_from_wlr_surface = foreign "wlr_xdg_surface_from_wlr_surface"
+      (wlr_surface_p @-> returning wlr_xdg_surface_p)
+
+  let wlr_xdg_surface_get_geometry = foreign "wlr_xdg_surface_get_geometry"
+      (wlr_xdg_surface_p @-> wlr_box_p @-> returning void)
+
+  let wlr_xdg_surface_surface_at = foreign "wlr_xdg_surface_surface_at"
+      (wlr_xdg_surface_p @-> double @-> double @-> ptr double @-> ptr double @-> returning wlr_surface_p)
+
+  let wlr_xdg_surface_for_each_surface = foreign "wlr_xdg_surface_for_each_surface"
+      (wlr_xdg_surface_p @-> Surface.wlr_surface_iterator_func_t @-> ptr void @-> returning void)
+
+  (* wlr_xdg_toplevel *)
+
+  let wlr_xdg_toplevel_set_activated = foreign "wlr_xdg_toplevel_set_activated"
+      (wlr_xdg_surface_p @-> bool @-> returning uint32_t)
+
+  let wlr_xdg_toplevel_set_size = foreign "wlr_xdg_toplevel_set_size"
+      (wlr_xdg_surface_p @-> int @-> int @-> returning uint32_t)
+
   (* wlr_input_device *)
 
   let wlr_input_device_p = ptr Input_device.t
@@ -252,6 +309,13 @@ struct
     foreign "wlr_cursor_set_surface"
       (wlr_cursor_p @-> wlr_surface_p @-> int @-> int @-> returning void)
 
+  let wlr_cursor_move =
+    foreign "wlr_cursor_move"
+      (wlr_cursor_p @-> wlr_input_device_p @-> double @-> double @-> returning void)
+
+  let wlr_cursor_warp_absolute = foreign "wlr_cursor_warp_absolute"
+      (wlr_cursor_p @-> wlr_input_device_p @-> double @-> double @-> returning void)
+
   (* wlr_xcursor_manager *)
 
   let wlr_xcursor_manager_p = ptr Xcursor_manager.t
@@ -262,6 +326,9 @@ struct
   let wlr_xcursor_manager_load = foreign "wlr_xcursor_manager_load"
       (wlr_xcursor_manager_p @-> float @-> returning int)
 
+  let wlr_xcursor_manager_set_cursor_image = foreign "wlr_xcursor_manager_set_cursor_image"
+      (wlr_xcursor_manager_p @-> string @-> wlr_cursor_p @-> returning void)
+
   (* wlr_seat *)
 
   let wlr_seat_p = ptr Seat.t
@@ -272,6 +339,47 @@ struct
   let wlr_seat_set_capabilities = foreign "wlr_seat_set_capabilities"
       (wlr_seat_p @-> Wl_seat_capability.t @-> returning void)
 
+  let wlr_seat_set_keyboard = foreign "wlr_seat_set_keyboard"
+      (wlr_seat_p @-> wlr_input_device_p @-> returning void)
+
+  let wlr_seat_keyboard_notify_modifiers = foreign "wlr_seat_keyboard_notify_modifiers"
+      (wlr_seat_p @-> wlr_keyboard_modifiers_p @-> returning void)
+
+  let wlr_seat_keyboard_notify_enter = foreign "wlr_seat_keyboard_notify_enter"
+      (wlr_seat_p
+       @-> wlr_surface_p
+       @-> Keycodes.t
+       @-> size_t
+       @-> wlr_keyboard_modifiers_p
+       @-> returning void)
+
+  let wlr_seat_keyboard_notify_key = foreign "wlr_seat_keyboard_notify_key"
+      (wlr_seat_p @-> uint32_t @-> uint32_t @-> uint32_t @-> returning void)
+
+  let wlr_seat_pointer_notify_enter = foreign "wlr_seat_pointer_notify_enter"
+      (wlr_seat_p @-> wlr_surface_p @-> double @-> double @-> returning void)
+
+  let wlr_seat_pointer_clear_focus = foreign "wlr_seat_pointer_clear_focus"
+      (wlr_seat_p @-> returning void)
+
+  let wlr_seat_pointer_notify_motion = foreign "wlr_seat_pointer_notify_motion"
+      (wlr_seat_p @-> uint32_t @-> double @-> double @-> returning void)
+
+  let wlr_seat_pointer_notify_button = foreign "wlr_seat_pointer_notify_button"
+      (wlr_seat_p @-> uint32_t @-> uint32_t @-> Button_state.t @-> returning uint32_t)
+
+  let wlr_seat_pointer_notify_axis = foreign "wlr_seat_pointer_notify_axis"
+      (wlr_seat_p
+       @-> uint32_t
+       @-> Axis_orientation.t
+       @-> double
+       @-> int32_t
+       @-> Axis_source.t
+       @-> returning void)
+
+  let wlr_seat_pointer_notify_frame = foreign "wlr_seat_pointer_notify_frame"
+      (wlr_seat_p @-> returning void)
+
   (* wlr_log *)
 
   (* TODO *)
diff --git a/lib/cursor.ml b/lib/cursor.ml
index 2529e4f..dd2ca18 100644
--- a/lib/cursor.ml
+++ b/lib/cursor.ml
@@ -7,33 +7,40 @@ module Types = Wlroots_ffi_f.Ffi.Types
 type t = Types.Cursor.t ptr
 include Ptr
 
+let x = getfield Types.Cursor.x
+let y = getfield Types.Cursor.y
+
+
 let create = Bindings.wlr_cursor_create
 let attach_output_layout = Bindings.wlr_cursor_attach_output_layout
 let attach_input_device = Bindings.wlr_cursor_attach_input_device
 let set_surface = Bindings.wlr_cursor_set_surface
+let move = Bindings.wlr_cursor_move
 
-let signal_motion (cursor: t) : Pointer.Event_motion.t Wl.Signal.t = {
+let signal_motion (cursor: t) : Event_pointer_motion.t Wl.Signal.t = {
   c = cursor |-> Types.Cursor.events_motion;
-  typ = Pointer.Event_motion.t;
+  typ = Event_pointer_motion.t;
 }
 
 let signal_motion_absolute (cursor: t) :
-  Pointer.Event_motion_absolute.t Wl.Signal.t = {
+  Event_pointer_motion_absolute.t Wl.Signal.t = {
   c = cursor |-> Types.Cursor.events_motion_absolute;
-  typ = Pointer.Event_motion_absolute.t;
+  typ = Event_pointer_motion_absolute.t;
 }
 
-let signal_button (cursor: t) : Pointer.Event_button.t Wl.Signal.t = {
+let signal_button (cursor: t) : Event_pointer_button.t Wl.Signal.t = {
   c = cursor |-> Types.Cursor.events_button;
-  typ = Pointer.Event_button.t;
+  typ = Event_pointer_button.t;
 }
 
-let signal_axis (cursor: t) : Pointer.Event_axis.t Wl.Signal.t = {
+let signal_axis (cursor: t) : Event_pointer_axis.t Wl.Signal.t = {
   c = cursor |-> Types.Cursor.events_axis;
-  typ = Pointer.Event_axis.t;
+  typ = Event_pointer_axis.t;
 }
 
 let signal_frame (cursor: t) : unit Wl.Signal.t = {
   c = cursor |-> Types.Cursor.events_frame;
   typ = void;
 }
+
+let warp_absolute = Bindings.wlr_cursor_warp_absolute
diff --git a/lib/dune b/lib/dune
index 9b028b8..9a3841d 100644
--- a/lib/dune
+++ b/lib/dune
@@ -14,10 +14,36 @@
   (public_name wlroots)
   (modules wlroots
            generated_ffi
-           wl log texture surface box matrix output
-           keyboard pointer touch tablet_tool tablet_pad input_device
-           backend renderer data_device compositor xdg_shell cursor
-           xcursor_manager seat output_layout)
+           wl
+           log
+           texture
+           surface
+           box
+           matrix
+           output
+           keyboard
+           pointer
+           event_pointer_button
+           event_pointer_motion
+           event_pointer_motion_absolute
+           event_pointer_axis
+           edges_elems
+           touch
+           tablet_tool
+           tablet_pad
+           input_device
+           keycodes
+           backend
+           renderer
+           data_device
+           compositor
+           xdg_shell
+           xdg_surface
+           xdg_toplevel
+           cursor
+           xcursor_manager
+           seat
+           output_layout)
   (c_names generated_ffi_stubs)
   (c_flags (:standard -Werror -pedantic -Wall -Wunused -DWLR_USE_UNSTABLE -O0) -w
            (:include ../config/wlroots-ccopt.sexp)
diff --git a/lib/edges_elems.ml b/lib/edges_elems.ml
new file mode 100644
index 0000000..120a95a
--- /dev/null
+++ b/lib/edges_elems.ml
@@ -0,0 +1,14 @@
+open Ctypes
+module Types = Wlroots_ffi_f.Ffi.Types
+
+type t = None | Top | Bottom | Left | Right
+module Size = Unsigned.UInt32
+let size = uint32_t
+open Types.Edges
+let desc = [
+    None, _WLR_EDGE_NONE;
+    Top, _WLR_EDGE_TOP;
+    Bottom, _WLR_EDGE_BOTTOM;
+    Right, _WLR_EDGE_RIGHT;
+    Left, _WLR_EDGE_LEFT;
+]
diff --git a/lib/event_pointer_axis.ml b/lib/event_pointer_axis.ml
new file mode 100644
index 0000000..95aa3ec
--- /dev/null
+++ b/lib/event_pointer_axis.ml
@@ -0,0 +1,15 @@
+open Ctypes
+open Wlroots_common.Utils
+
+module Bindings = Wlroots_ffi_f.Ffi.Make (Generated_ffi)
+module Types = Wlroots_ffi_f.Ffi.Types
+
+type t = Types.Event_pointer_axis.t ptr
+let t = ptr Types.Event_pointer_axis.t
+include Ptr
+
+let time_msec = getfield Types.Event_pointer_axis.time_msec
+let orientation = getfield Types.Event_pointer_axis.orientation
+let delta = getfield Types.Event_pointer_axis.delta
+let delta_discrete = getfield Types.Event_pointer_axis.delta_discrete
+let source = getfield Types.Event_pointer_axis.source
diff --git a/lib/event_pointer_button.ml b/lib/event_pointer_button.ml
new file mode 100644
index 0000000..663d98f
--- /dev/null
+++ b/lib/event_pointer_button.ml
@@ -0,0 +1,13 @@
+open Ctypes
+open Wlroots_common.Utils
+
+module Bindings = Wlroots_ffi_f.Ffi.Make (Generated_ffi)
+module Types = Wlroots_ffi_f.Ffi.Types
+
+type t = Types.Event_pointer_button.t ptr
+let t = ptr Types.Event_pointer_button.t
+include Ptr
+
+let time_msec = getfield Types.Event_pointer_button.time_msec
+let button = getfield Types.Event_pointer_button.button
+let state = getfield Types.Event_pointer_button.state
diff --git a/lib/event_pointer_motion.ml b/lib/event_pointer_motion.ml
new file mode 100644
index 0000000..f21ee11
--- /dev/null
+++ b/lib/event_pointer_motion.ml
@@ -0,0 +1,14 @@
+open Ctypes
+open Wlroots_common.Utils
+
+module Bindings = Wlroots_ffi_f.Ffi.Make (Generated_ffi)
+module Types = Wlroots_ffi_f.Ffi.Types
+
+type t = Types.Event_pointer_motion.t ptr
+let t = ptr Types.Event_pointer_motion.t
+include Ptr
+
+let device = getfield Types.Event_pointer_motion.device
+let time_msec = getfield Types.Event_pointer_motion.time_msec
+let delta_x = getfield Types.Event_pointer_motion.delta_x
+let delta_y = getfield Types.Event_pointer_motion.delta_y
diff --git a/lib/event_pointer_motion_absolute.ml b/lib/event_pointer_motion_absolute.ml
new file mode 100644
index 0000000..22dfb82
--- /dev/null
+++ b/lib/event_pointer_motion_absolute.ml
@@ -0,0 +1,14 @@
+open Ctypes
+open Wlroots_common.Utils
+
+module Bindings = Wlroots_ffi_f.Ffi.Make (Generated_ffi)
+module Types = Wlroots_ffi_f.Ffi.Types
+
+type t = Types.Event_pointer_motion_absolute.t ptr
+let t = ptr Types.Event_pointer_motion_absolute.t
+include Ptr
+
+let device = getfield Types.Event_pointer_motion_absolute.device
+let x = getfield Types.Event_pointer_motion_absolute.x
+let y = getfield Types.Event_pointer_motion_absolute.y
+let time_msec = getfield Types.Event_pointer_motion_absolute.time_msec
diff --git a/lib/keyboard.ml b/lib/keyboard.ml
index 67f33b5..d117d28 100644
--- a/lib/keyboard.ml
+++ b/lib/keyboard.ml
@@ -1,5 +1,6 @@
 open Ctypes
 open Wlroots_common.Utils
+open Wlroots_common
 
 module Bindings = Wlroots_ffi_f.Ffi.Make (Generated_ffi)
 module Types = Wlroots_ffi_f.Ffi.Types
@@ -19,11 +20,69 @@ module Event_key = struct
   let state = getfield Types.Event_keyboard_key.state
 end
 
+module Modifiers = struct
+  type t = Types.Keyboard_modifiers.t ptr
+  let t = ptr Types.Keyboard_modifiers.t
+  include Ptr
+end
+
+module Modifier_elems : Bitwise.Elems = struct
+  open Types.Keyboard_modifier
+  type t =
+    Shift | Caps | Ctrl | Alt | Mod2 | Mod3 | Logo | Mod5
+  module Size = Unsigned.UInt32
+  let size = uint32_t
+  let desc = [
+      Shift, _WLR_MODIFIER_SHIFT;
+      Caps, _WLR_MODIFIER_CAPS;
+      Ctrl, _WLR_MODIFIER_CTRL;
+      Alt, _WLR_MODIFIER_ALT;
+      Mod2, _WLR_MODIFIER_MOD2;
+      Mod3, _WLR_MODIFIER_MOD3;
+      Logo, _WLR_MODIFIER_LOGO;
+      Mod5, _WLR_MODIFIER_MOD5;
+    ]
+end
+
+module Modifier = struct
+  include Bitwise.Make(Modifier_elems)
+  include Poly
+end
+
 let xkb_state = getfield Types.Keyboard.xkb_state
 
-let signal_key (keyboard : t) : Event_key.t Wl.Signal.t = {
-  c = keyboard |-> Types.Keyboard.events_key;
-  typ = ptr Types.Event_keyboard_key.t;
-}
+let modifiers = getfield Types.Keyboard.modifiers
+let keycodes = getfield Types.Keyboard.keycodes
+let num_keycodes = getfield Types.Keyboard.num_keycodes
 
 let set_keymap = Bindings.wlr_keyboard_set_keymap
+let get_modifiers = Bindings.wlr_keyboard_get_modifiers
+
+let set_repeat_info keyboard rate delay =
+  Bindings.wlr_keyboard_set_repeat_info
+    keyboard
+    (Signed.Int32.of_int rate)
+    (Signed.Int32.of_int delay)
+
+module Events = struct
+  let key (keyboard : t) : Event_key.t Wl.Signal.t = {
+      c = keyboard |-> Types.Keyboard.events_key;
+      typ = ptr Types.Event_keyboard_key.t;
+  }
+
+  let modifiers (keyboard : t) : t Wl.Signal.t = {
+      c = keyboard |-> Types.Keyboard.events_modifiers;
+      typ = ptr Types.Keyboard.t;
+  }
+end
+
+module Modifiers = struct
+  type t = Types.Keyboard_modifiers.t ptr
+  include Ptr
+
+  let has_alt modifiers =
+    Signed.Int64.of_int 0 !=
+      Signed.Int64.logand
+         (Unsigned.UInt32.to_int64 modifiers)
+         Types.Keyboard_modifier._WLR_MODIFIER_ALT
+end
diff --git a/lib/keycodes.ml b/lib/keycodes.ml
new file mode 100644
index 0000000..659486b
--- /dev/null
+++ b/lib/keycodes.ml
@@ -0,0 +1,7 @@
+open Wlroots_common.Utils
+
+module Bindings = Wlroots_ffi_f.Ffi.Make (Generated_ffi)
+module Types = Wlroots_ffi_f.Ffi.Types
+
+type t = Types.Keycodes.t
+include Ptr
diff --git a/lib/output.ml b/lib/output.ml
index 74545b3..f4c9d96 100644
--- a/lib/output.ml
+++ b/lib/output.ml
@@ -53,3 +53,18 @@ let commit (output : t): bool =
   Bindings.wlr_output_commit output
 
 let enable = Bindings.wlr_output_enable
+
+let scale = getfield Types.Output.scale
+
+let effective_resolution (output: t) : int * int =
+  let width = allocate int 0 in
+  let height = allocate int 0 in
+  Bindings.wlr_output_effective_resolution output width height;
+  (!@ width, !@ height)
+
+type transform = Types.Wl_output_transform.transform
+
+let transform_invert = Bindings.wlr_output_transform_invert
+
+let render_software_cursors output =
+  Bindings.wlr_output_render_software_cursors output null
diff --git a/lib/output_layout.ml b/lib/output_layout.ml
index 837fe73..1165f0d 100644
--- a/lib/output_layout.ml
+++ b/lib/output_layout.ml
@@ -9,3 +9,9 @@ include Ptr
 
 let create = Bindings.wlr_output_layout_create
 let add_auto = Bindings.wlr_output_layout_add_auto
+
+let output_coords layout output x y =
+  let lx = allocate double x in
+  let ly = allocate double y in
+  Bindings.wlr_output_layout_output_coords layout output lx ly;
+  (!@ lx, !@ ly)
diff --git a/lib/pointer.ml b/lib/pointer.ml
index 50f4188..673383e 100644
--- a/lib/pointer.ml
+++ b/lib/pointer.ml
@@ -7,26 +7,8 @@ module Types = Wlroots_ffi_f.Ffi.Types
 type t = Types.Pointer.t ptr
 include Ptr
 
-module Event_motion = struct
-  type t = Types.Event_pointer_motion.t ptr
-  let t = ptr Types.Event_pointer_motion.t
-  include Ptr
-end
+type button_state = Types.Button_state.t = Released | Pressed
 
-module Event_motion_absolute = struct
-  type t = Types.Event_pointer_motion_absolute.t ptr
-  let t = ptr Types.Event_pointer_motion_absolute.t
-  include Ptr
-end
+type axis_source = Types.Axis_source.t = Wheel | Finger | Continuous | Wheel_tilt
 
-module Event_button = struct
-  type t = Types.Event_pointer_button.t ptr
-  let t = ptr Types.Event_pointer_button.t
-  include Ptr
-end
-
-module Event_axis = struct
-  type t = Types.Event_pointer_axis.t ptr
-  let t = ptr Types.Event_pointer_axis.t
-  include Ptr
-end
+type axis_orientation = Types.Axis_orientation.t = Vertical | Horizontal
diff --git a/lib/renderer.ml b/lib/renderer.ml
index 53a3f08..1aa9469 100644
--- a/lib/renderer.ml
+++ b/lib/renderer.ml
@@ -18,3 +18,6 @@ let clear (renderer : t) ((c1,c2,c3,c4) : float * float * float * float) =
   Bindings.wlr_renderer_clear renderer (CArray.start color_arr)
 
 let init_wl_display = Bindings.wlr_renderer_init_wl_display
+
+let render_texture_with_matrix renderer texture matrix alpha =
+  Bindings.wlr_render_texture_with_matrix renderer texture matrix alpha
diff --git a/lib/seat.ml b/lib/seat.ml
index f7eb320..6f0d634 100644
--- a/lib/seat.ml
+++ b/lib/seat.ml
@@ -35,9 +35,26 @@ module Pointer_state = struct
 
   let focused_client (st: t) =
     st |->> Types.Seat_pointer_state.focused_client
+  let focused_surface =
+    getfield Types.Seat_pointer_state.focused_surface
+end
+
+module Keyboard_state = struct
+  type t = Types.Seat_keyboard_state.t ptr
+  let t = ptr Types.Seat_keyboard_state.t
+  include Ptr
+
+  let keyboard = getfield Types.Seat_keyboard_state.keyboard
+
+  let focused_surface (st : t) =
+    let surf = st |-> Types.Seat_keyboard_state.focused_surface in
+    if is_null surf
+    then None
+    else Some (!@ surf)
 end
 
 let pointer_state seat = seat |-> Types.Seat.pointer_state
+let keyboard_state seat = seat |-> Types.Seat.keyboard_state
 
 let create = Bindings.wlr_seat_create
 
@@ -46,6 +63,39 @@ let signal_request_set_cursor (seat: t) : _ Wl.Signal.t = {
   typ = Pointer_request_set_cursor_event.t
 }
 
-let set_capabilities seat caps =
+let set_capabilities =
   Bindings.wlr_seat_set_capabilities
-    seat (coerce Wl.Seat_capability.t uint64_t caps)
+
+let set_keyboard =
+  Bindings.wlr_seat_set_keyboard
+
+let keyboard_notify_modifiers =
+  Bindings.wlr_seat_keyboard_notify_modifiers
+
+let keyboard_notify_enter =
+  Bindings.wlr_seat_keyboard_notify_enter
+
+let keyboard_notify_key seat evt =
+  Bindings.wlr_seat_keyboard_notify_key
+    seat
+    (Keyboard.Event_key.time_msec evt)
+    (Unsigned.UInt32.of_int (Keyboard.Event_key.keycode evt))
+    (coerce Types.Key_state.t uint32_t (Keyboard.Event_key.state evt))
+
+let pointer_notify_enter =
+  Bindings.wlr_seat_pointer_notify_enter
+
+let pointer_clear_focus =
+  Bindings.wlr_seat_pointer_clear_focus
+
+let pointer_notify_motion =
+  Bindings.wlr_seat_pointer_notify_motion
+
+let pointer_notify_button =
+  Bindings.wlr_seat_pointer_notify_button
+
+let pointer_notify_axis =
+  Bindings.wlr_seat_pointer_notify_axis
+
+let pointer_notify_frame =
+  Bindings.wlr_seat_pointer_notify_frame
diff --git a/lib/surface.ml b/lib/surface.ml
index 22b48e0..62ba144 100644
--- a/lib/surface.ml
+++ b/lib/surface.ml
@@ -23,3 +23,9 @@ let current = getfield Types.Surface.current
 let pending = getfield Types.Surface.pending
 
 let send_frame_done = Bindings.wlr_surface_send_frame_done
+
+let get_texture surf =
+  let t = Bindings.wlr_surface_get_texture surf in
+  if is_null t
+  then None
+  else Some t
diff --git a/lib/wl.ml b/lib/wl.ml
index 3cedaf8..dfd2a99 100644
--- a/lib/wl.ml
+++ b/lib/wl.ml
@@ -1,4 +1,5 @@
 open Ctypes
+open Wlroots_common
 open Wlroots_common.Utils
 
 module Bindings = Wlroots_ffi_f.Ffi.Make (Generated_ffi)
@@ -115,20 +116,19 @@ module Resource = struct
   include Ptr
 end
 
-module Output_transform = struct
-  type t = Types.Wl_output_transform.t
-  include Poly
+module Seat_capability_elems : Bitwise.Elems = struct
+  type t = Pointer | Keyboard | Touch
+  module Size = Signed.Int64
+  let size = int64_t
+  open Types.Wl_seat_capability
+  let desc = [
+      Pointer, _WL_SEAT_CAPABILITY_POINTER;
+      Keyboard, _WL_SEAT_CAPABILITY_KEYBOARD;
+      Touch, _WL_SEAT_CAPABILITY_TOUCH;
+  ]
 end
 
 module Seat_capability = struct
-  type cap = Pointer | Keyboard | Touch
-  type t = cap list
+  include Bitwise.Make(Seat_capability_elems)
   include Poly
-
-  let t : cap list typ =
-    bitwise_enum Types.Wl_seat_capability.([
-      Pointer, _WL_SEAT_CAPABILITY_POINTER;
-      Keyboard, _WL_SEAT_CAPABILITY_KEYBOARD;
-      Touch, _WL_SEAT_CAPABILITY_TOUCH;
-    ])
 end
diff --git a/lib/wlroots.ml b/lib/wlroots.ml
index 50312c0..01c8c27 100644
--- a/lib/wlroots.ml
+++ b/lib/wlroots.ml
@@ -1,17 +1,30 @@
 include Event
+open Wlroots_common
 
 module Output_layout = Output_layout
 module Seat = Seat
 module Xcursor_manager = Xcursor_manager
 module Cursor = Cursor
 module Xdg_shell = Xdg_shell
+module Xdg_surface = Xdg_surface
+module Xdg_toplevel = Xdg_toplevel
 module Compositor = Compositor
 module Data_device = Data_device
 module Backend = Backend
 module Output = Output
 module Input_device = Input_device
 module Keyboard = Keyboard
+module Keycodes = Keycodes
 module Pointer = Pointer
+module Event_pointer_motion = Event_pointer_motion
+module Event_pointer_motion_absolute = Event_pointer_motion_absolute
+module Event_pointer_button = Event_pointer_button
+module Event_pointer_axis = Event_pointer_axis
+module Edges_elems = Edges_elems
+module Edges = struct
+  include Bitwise.Make(Edges_elems)
+  include Utils.Poly
+end
 module Touch = Touch
 module Tablet_tool = Tablet_tool
 module Tablet_pad = Tablet_pad
diff --git a/lib/wlroots.mli b/lib/wlroots.mli
index 7a39660..1befd63 100644
--- a/lib/wlroots.mli
+++ b/lib/wlroots.mli
@@ -1,4 +1,5 @@
 open Wlroots_common.Sigs
+open Wlroots_common
 
 module Wl : sig
   module Event_loop : sig
@@ -36,13 +37,9 @@ module Wl : sig
     include Comparable0
   end
 
-  module Output_transform : sig
-    include Comparable0
-  end
-
   module Seat_capability : sig
-    type cap = Pointer | Keyboard | Touch
-    include Comparable0 with type t = cap list
+    include Bitwise.Enum
+    include Comparable0 with type t := t
   end
 end
 
@@ -60,12 +57,13 @@ module Surface : sig
     include Comparable0
     val width : t -> int
     val height : t -> int
-    val transform : t -> Wl.Output_transform.t
+    val transform : t -> Output.transform
   end
 
   val current : t -> State.t
   val pending : t -> State.t
   val send_frame_done : t -> Mtime.t -> unit
+  val get_texture : t -> Texture.t option
 end
 
 module Box : sig
@@ -75,10 +73,11 @@ end
 
 module Matrix : sig
   include Comparable0
-  val project_box : Box.t -> Wl.Output_transform.t -> rotation:float -> t -> t
+  val project_box : Box.t -> Output.transform -> rotation:float -> t -> t
 end
 
 module Output : sig
+  type transform = Wlroots_ffi_f.Ffi.Types.Wl_output_transform.transform
   include Comparable0
 
   module Mode : sig
@@ -95,14 +94,22 @@ module Output : sig
   val set_mode : t -> Mode.t -> unit
   val preferred_mode : t -> Mode.t option
 
+  val scale : t -> float
+
   val transform_matrix : t -> Matrix.t
   val create_global : t -> unit
   val attach_render : t -> bool
   val commit : t -> bool
   val enable : t -> bool -> unit
 
+  val effective_resolution : t -> int * int
+
   val signal_frame : t -> t Wl.Signal.t
   val signal_destroy : t -> t Wl.Signal.t
+
+  val transform_invert : transform -> transform
+
+  val render_software_cursors : t -> unit
 end
 
 module Output_layout : sig
@@ -110,6 +117,11 @@ module Output_layout : sig
 
   val create : unit -> t
   val add_auto : t -> Output.t -> unit
+  val output_coords : t -> Output.t -> float -> float -> float * float
+end
+
+module Keycodes : sig
+  include Comparable0
 end
 
 module Keyboard : sig
@@ -127,28 +139,37 @@ module Keyboard : sig
   end
 
   val xkb_state : t -> Xkbcommon.State.t
-  val signal_key : t -> Event_key.t Wl.Signal.t
+  val modifiers : t -> Keyboard.Modifiers.t
+  val keycodes : t -> Keycodes.t
+  val num_keycodes : t -> Unsigned.size_t
   val set_keymap : t -> Xkbcommon.Keymap.t -> bool
-end
-
-module Pointer : sig
-  include Comparable0
+  val set_repeat_info : t -> int -> int -> unit
+  val get_modifiers : t -> Unsigned.uint32
 
-  module Event_motion : sig
-    include Comparable0
+  module Events : sig
+    val key : t -> Event_key.t Wl.Signal.t
+    val modifiers : t -> t Wl.Signal.t
   end
 
-  module Event_motion_absolute : sig
+  module Modifiers : sig
     include Comparable0
+    val has_alt : Unsigned.uint32 -> bool
   end
+end
 
-  module Event_button : sig
-    include Comparable0
-  end
+module Pointer : sig
+  include Comparable0
 
-  module Event_axis : sig
-    include Comparable0
-  end
+  type button_state = Released | Pressed
+  type axis_source = Wheel | Finger | Continuous | Wheel_tilt
+  type axis_orientation = Vertical | Horizontal
+end
+
+module Edges_elems : Bitwise.Elems
+
+module Edges : sig
+  include Bitwise.Enum
+  include Comparable0 with type t := t
 end
 
 module Touch : sig
@@ -181,6 +202,42 @@ module Input_device : sig
   val signal_destroy : t -> t Wl.Signal.t
 end
 
+module Event_pointer_motion : sig
+  include Comparable0
+
+  val device : t -> Input_device.t
+  val time_msec : t -> Unsigned.uint32
+  val delta_x : t -> float
+  val delta_y : t -> float
+end
+
+module Event_pointer_motion_absolute : sig
+  include Comparable0
+
+  val device : t -> Input_device.t
+  val x : t -> float
+  val y : t -> float
+  val time_msec : t -> Unsigned.uint32
+end
+
+module Event_pointer_button : sig
+  include Comparable0
+
+  val time_msec : t -> Unsigned.uint32
+  val button : t -> Unsigned.uint32
+  val state : t -> Pointer.button_state
+end
+
+module Event_pointer_axis : sig
+  include Comparable0
+
+  val time_msec : t -> Unsigned.uint32
+  val orientation : t -> Pointer.axis_orientation
+  val delta : t -> float
+  val delta_discrete : t -> Signed.Int32.t
+  val source : t -> Pointer.axis_source
+end
+
 module Renderer : sig
   include Comparable0
 
@@ -188,6 +245,7 @@ module Renderer : sig
   val end_ : t -> unit
   val clear : t -> float * float * float * float -> unit
   val init_wl_display : t -> Wl.Display.t -> bool
+  val render_texture_with_matrix : t -> Texture.t -> Matrix.t -> float -> bool
 end
 
 module Backend : sig
@@ -218,40 +276,85 @@ module Compositor : sig
   val create : Wl.Display.t -> Renderer.t -> t
 end
 
-module Xdg_shell : sig
+module rec Xdg_toplevel: sig
   include Comparable0
 
-  module Surface : sig
-    include Comparable0
+  module Events: sig
+    module Move : sig
+      type t
+      val surface : t -> Xdg_surface.t
+      val seat : t -> Seat.t
+      val serial : t -> Unsigned.UInt32.t
+    end
+
+    module Resize : sig
+      type t
+      val surface : t -> Xdg_surface.t
+      val seat : t -> Seat.t
+      val serial : t -> Unsigned.UInt32.t
+      val edges : t -> Edges.t
+    end
+
+    val request_move : t -> Move.t Wl.Signal.t
+    val request_resize : t -> Resize.t Wl.Signal.t
+  end
+end
+
+and Xdg_surface : sig
+  include Comparable0
+  type role = Wlroots_ffi_f.Ffi.Types.Xdg_surface_role.role
+
+  val role : t -> role
+  val surface : t -> Surface.t
+  val toplevel : t -> Xdg_toplevel.t
+
+  val from_surface : Surface.t -> t option
+  val get_geometry : t -> Box.t
+  val toplevel_set_activated : t -> bool -> Unsigned.uint32
+  val toplevel_set_size : t -> int -> int -> Unsigned.uint32
+  val surface_at : t -> float -> float -> (Surface.t * float * float) option
+  val for_each_surface : t -> (Surface.t -> int -> int -> unit) -> unit
+
+  module Events : sig
+    val destroy : t -> t Wl.Signal.t
+    val ping_timeout : t -> t Wl.Signal.t
+    val new_popup : t -> t Wl.Signal.t
+    val map : t -> t Wl.Signal.t
+    val unmap : t -> t Wl.Signal.t
+    val configure : t -> t Wl.Signal.t
+    val ack_configure : t -> t Wl.Signal.t
+
   end
+end
+
+and Xdg_shell : sig
+  include Comparable0
 
   val create : Wl.Display.t -> t
-  val signal_new_surface : t -> Surface.t Wl.Signal.t
+  val signal_new_surface : t -> Xdg_surface.t Wl.Signal.t
 end
 
-module Cursor : sig
+and Cursor : sig
   include Comparable0
 
+  val x : t -> float
+  val y : t -> float
+
   val create : unit -> t
   val attach_output_layout : t -> Output_layout.t -> unit
   val attach_input_device : t -> Input_device.t -> unit
   val set_surface : t -> Surface.t -> int -> int -> unit
-  
-  val signal_motion : t -> Pointer.Event_motion.t Wl.Signal.t
-  val signal_motion_absolute : t -> Pointer.Event_motion_absolute.t Wl.Signal.t
-  val signal_button : t -> Pointer.Event_button.t Wl.Signal.t
-  val signal_axis : t -> Pointer.Event_axis.t Wl.Signal.t
-  val signal_frame : t -> unit (* ? *) Wl.Signal.t
-end
+  val move : t -> Input_device.t -> float -> float -> unit
 
-module Xcursor_manager : sig
-  include Comparable0
-
-  val create : string option -> int -> t
-  val load : t -> float -> int
+  val signal_motion : t -> Event_pointer_motion.t Wl.Signal.t
+  val signal_motion_absolute : t -> Event_pointer_motion_absolute.t Wl.Signal.t
+  val signal_button : t -> Event_pointer_button.t Wl.Signal.t
+  val signal_axis : t -> Event_pointer_axis.t Wl.Signal.t
+  val signal_frame : t -> unit (* ? *) Wl.Signal.t
+  val warp_absolute : t -> Input_device.t -> float -> float -> unit
 end
 
-module Seat : sig
+and Seat : sig
   include Comparable0
 
   module Client : sig
@@ -262,6 +365,14 @@ module Seat : sig
     include Comparable0
 
     val focused_client : t -> Client.t
+    val focused_surface : t -> Surface.t
+  end
+
+  module Keyboard_state : sig
+    include Comparable0
+
+    val keyboard : t -> Keyboard.t
+    val focused_surface : t -> Surface.t option
   end
 
   module Pointer_request_set_cursor_event : sig
@@ -274,11 +385,37 @@ module Seat : sig
   end
 
   val pointer_state : t -> Pointer_state.t
+  val keyboard_state : t -> Keyboard_state.t
 
   val create : Wl.Display.t -> string -> t
   val signal_request_set_cursor :
     t -> Pointer_request_set_cursor_event.t Wl.Signal.t
   val set_capabilities : t -> Wl.Seat_capability.t -> unit
+  val set_keyboard : t -> Input_device.t -> unit
+  val keyboard_notify_modifiers : t -> Keyboard.Modifiers.t -> unit
+  val keyboard_notify_enter :
+    t -> Surface.t -> Keycodes.t -> Unsigned.size_t -> Keyboard.Modifiers.t -> unit
+  val keyboard_notify_key :
+    t -> Keyboard.Event_key.t -> unit
+  val pointer_notify_enter :
+    t -> Surface.t -> float -> float -> unit
+  val pointer_clear_focus :
+    t -> unit
+  val pointer_notify_motion :
+    t -> Unsigned.uint32 -> float -> float -> unit
+  val pointer_notify_button :
+    t -> Unsigned.uint32 -> Unsigned.uint32 -> Pointer.button_state -> Unsigned.uint32
+  val pointer_notify_axis :
+    t -> Unsigned.uint32 -> Pointer.axis_orientation -> float -> Signed.Int32.t -> Pointer.axis_source -> unit
+  val pointer_notify_frame :
+    t -> unit
+end
+module Xcursor_manager : sig
+  include Comparable0
+
+  val create : string option -> int -> t
+  val load : t -> float -> int
+  val set_cursor_image : t -> string -> Cursor.t -> unit
 end
 
 module Log : sig
diff --git a/lib/xcursor_manager.ml b/lib/xcursor_manager.ml
index 29ece3c..1d8ad63 100644
--- a/lib/xcursor_manager.ml
+++ b/lib/xcursor_manager.ml
@@ -9,3 +9,4 @@ include Ptr
 
 let create = Bindings.wlr_xcursor_manager_create
 let load = Bindings.wlr_xcursor_manager_load
+let set_cursor_image = Bindings.wlr_xcursor_manager_set_cursor_image
diff --git a/lib/xdg_shell.ml b/lib/xdg_shell.ml
index 8a27ede..8327e56 100644
--- a/lib/xdg_shell.ml
+++ b/lib/xdg_shell.ml
@@ -4,19 +4,13 @@ open Wlroots_common.Utils
 module Bindings = Wlroots_ffi_f.Ffi.Make (Generated_ffi)
 module Types = Wlroots_ffi_f.Ffi.Types
 
-module Surface = struct
-  type t = Types.Xdg_surface.t ptr
-  let t = ptr Types.Xdg_surface.t
-  include Ptr
-end
-
 type t = Types.Xdg_shell.t ptr
 let t = ptr Types.Xdg_shell.t
 include Ptr
 
 let create = Bindings.wlr_xdg_shell_create
 
-let signal_new_surface (shell : t) : Surface.t Wl.Signal.t = {
+let signal_new_surface (shell : t) : Xdg_surface.t Wl.Signal.t = {
   c = shell |-> Types.Xdg_shell.events_new_surface;
-  typ = Surface.t;
+  typ = Xdg_surface.t;
 }
diff --git a/lib/xdg_surface.ml b/lib/xdg_surface.ml
new file mode 100644
index 0000000..132eb35
--- /dev/null
+++ b/lib/xdg_surface.ml
@@ -0,0 +1,85 @@
+open Ctypes
+open Wlroots_common.Utils
+
+module Bindings = Wlroots_ffi_f.Ffi.Make (Generated_ffi)
+module Types = Wlroots_ffi_f.Ffi.Types
+
+type t = Types.Xdg_surface.t ptr
+let t = ptr Types.Xdg_surface.t
+
+type role = Types.Xdg_surface_role.role
+
+include Ptr
+
+let role (surface : t) : role =
+  surface |->> Types.Xdg_surface.role
+let surface = getfield Types.Xdg_surface.surface
+let toplevel = getfield Types.Xdg_surface.toplevel
+
+let from_surface (surface : Surface.t) : t option =
+  (* This is not exactly a verbatim binding but it is safer *)
+  (* Worth it? *)
+  if Bindings.wlr_surface_is_xdg_surface surface
+  then
+    (* assert is called so this might blow up *)
+    Some (Bindings.wlr_xdg_surface_from_wlr_surface surface)
+  else None
+
+let get_geometry (surface : t) =
+  let box = make Types.Box.t in
+  let () = Bindings.wlr_xdg_surface_get_geometry surface (addr box) in
+  Box.of_c (addr box)
+
+let surface_at (surface : t) sx sy =
+  let sub_x = allocate double 0.0 in
+  let sub_y = allocate double 0.0 in
+  let found_surf = Bindings.wlr_xdg_surface_surface_at surface sx sy sub_x sub_y in
+  if is_null found_surf
+  then None
+  else Some (found_surf, !@ sub_x, !@ sub_y)
+
+let toplevel_set_activated =
+  Bindings.wlr_xdg_toplevel_set_activated
+
+let toplevel_set_size =
+  Bindings.wlr_xdg_toplevel_set_size
+
+let for_each_surface (surf : t) (f : Surface.t -> int -> int -> unit) =
+  Bindings.wlr_xdg_surface_for_each_surface surf (fun s x y _ -> f s x y) null
+
+module Events = struct
+  let destroy (surface : t) : t Wl.Signal.t = {
+    c = surface |-> Types.Xdg_surface.events_destroy;
+    typ = t;
+  }
+
+  let ping_timeout (surface : t) : t Wl.Signal.t = {
+    c = surface |-> Types.Xdg_surface.events_ping_timeout;
+    typ = t;
+  }
+
+  let new_popup (surface : t) : t Wl.Signal.t = {
+    c = surface |-> Types.Xdg_surface.events_new_popup;
+    typ = t;
+  }
+
+  let map (surface : t) : t Wl.Signal.t = {
+    c = surface |-> Types.Xdg_surface.events_map;
+    typ = t;
+  }
+
+  let unmap (surface : t) : t Wl.Signal.t = {
+    c = surface |-> Types.Xdg_surface.events_unmap;
+    typ = t;
+  }
+
+  let configure (surface : t) : t Wl.Signal.t = {
+    c = surface |-> Types.Xdg_surface.events_configure;
+    typ = t;
+  }
+
+  let ack_configure (surface : t) : t Wl.Signal.t = {
+    c = surface |-> Types.Xdg_surface.events_ack_configure;
+    typ = t;
+  }
+end
diff --git a/lib/xdg_toplevel.ml b/lib/xdg_toplevel.ml
new file mode 100644
index 0000000..bbedff3
--- /dev/null
+++ b/lib/xdg_toplevel.ml
@@ -0,0 +1,42 @@
+open Ctypes
+open Wlroots_common.Utils
+
+module Bindings = Wlroots_ffi_f.Ffi.Make (Generated_ffi)
+module Types = Wlroots_ffi_f.Ffi.Types
+
+type t = Types.Xdg_toplevel.t ptr
+let t = ptr Types.Xdg_toplevel.t
+
+include Ptr
+
+module Events = struct
+  module Move = struct
+    type t = Types.Xdg_toplevel_move_event.t ptr
+    let t = ptr Types.Xdg_toplevel_move_event.t
+
+    let surface = getfield Types.Xdg_toplevel_move_event.surface
+    let seat = getfield Types.Xdg_toplevel_move_event.seat
+    let serial = getfield Types.Xdg_toplevel_move_event.serial
+  end
+
+  module Resize = struct
+    type t = Types.Xdg_toplevel_resize_event.t ptr
+    let t = ptr Types.Xdg_toplevel_resize_event.t
+
+    let surface = getfield Types.Xdg_toplevel_resize_event.surface
+    let seat = getfield Types.Xdg_toplevel_resize_event.seat
+    let serial = getfield Types.Xdg_toplevel_resize_event.serial
+    let edges ev = coerce uint32_t Edges.t
+                     (getfield Types.Xdg_toplevel_resize_event.edges ev)
+  end
+
+  let request_move (toplevel : t) : Move.t Wl.Signal.t = {
+    c = toplevel |-> Types.Xdg_toplevel.events_request_move;
+    typ = Move.t;
+  }
+
+  let request_resize (toplevel : t) : Resize.t Wl.Signal.t = {
+    c = toplevel |-> Types.Xdg_toplevel.events_request_resize;
+    typ = Resize.t;
+  }
+end
diff --git a/tinywl/tinywl.ml b/tinywl/tinywl.ml
index ef98f18..8f9cfd6 100644
--- a/tinywl/tinywl.ml
+++ b/tinywl/tinywl.ml
@@ -1,13 +1,41 @@
 open Wlroots
 
-type view
-  
+type view = {
+  surface : Xdg_surface.t;
+  listener: Wl.Listener.t;
+  mutable mapped: bool;
+  mutable x: int;
+  mutable y: int;
+}
+
+type resize = {
+  geobox: Box.t;
+  edges: Edges.t;
+}
+
+type grab = {
+  view: view;
+  x: float;
+  y: float;
+  resize: resize option;
+}
+
+type keyboard = {
+  device: Keyboard.t;
+  modifiers: Wl.Listener.t;
+  key: Wl.Listener.t;
+}
+
 type tinywl_output = {
   output : Output.t;
 
   frame : Wl.Listener.t;
 }
 
+type cursor_mode = Passthrough
+                 | Move
+                 | Resize of Edges.t
+
 type tinywl_server = {
   display : Wl.Display.t;
   backend : Backend.t;
@@ -15,67 +43,384 @@ type tinywl_server = {
   output_layout : Output_layout.t;
   seat : Seat.t;
   cursor : Cursor.t;
+  mutable cursor_mode : cursor_mode;
+  cursor_mgr : Xcursor_manager.t;
   mutable outputs : tinywl_output list;
   mutable views : view list;
-  mutable keyboards : Keyboard.t list;
+  mutable keyboards : keyboard list;
 
   new_output : Wl.Listener.t;
+
+  mutable grab: grab option;
+}
+
+let default_xkb_rules : Xkbcommon.Rule_names.t = {
+  rules = None;
+  model = None;
+  layout = None;
+  variant = None;
+  options = None;
 }
 
-let output_frame _st _ _ =
-  failwith "todo"
+let render_surface st output (view : view) when_ surf sx sy = Surface.(
+    match get_texture surf with
+    | None -> ()
+    | Some texture ->
+       let (ox', oy') : float * float = Output_layout.output_coords st.output_layout output 0.0 0.0 in
+       let ox = Float.(add ox' (of_int (view.x + sx))) in
+       let oy = Float.(add oy' (of_int (view.y + sy))) in
+       let scale = Output.scale output in
+       let current_surf = current surf in
+       let box: Box.t = {
+         x = Float.(to_int (mul ox scale));
+         y = Float.(to_int (mul oy scale));
+         width = Float.(to_int (mul (of_int (State.width current_surf)) scale));
+         height = Float.(to_int (mul (of_int (State.height current_surf)) scale));
+       } in
+       let transform = Output.transform_invert (State.transform current_surf) in
+       let matrix = Matrix.project_box box transform ~rotation:0.0 (Output.transform_matrix output) in
+       ignore (Renderer.render_texture_with_matrix st.renderer texture matrix 1.0);
+       send_frame_done surf when_
+  )
+
+let output_frame st output _ _ =
+  let now = Mtime_clock.now () in
+  if Output.attach_render output
+  then
+    let (w, h) = Output.effective_resolution output in Renderer.(
+      begin_ st.renderer ~width:w ~height:h;
+      clear st.renderer (0.3, 0.3, 0.3, 1.0);
+      List.iter (fun view ->
+        if view.mapped
+        then Xdg_surface.for_each_surface view.surface
+               (render_surface st output view now)
+      ) (List.rev st.views);
+      Output.render_software_cursors output;
+      end_ st.renderer;
+      ignore (Output.commit output)
+    )
+
 
 let server_new_output st _ output =
   let output_ok =
     match Output.preferred_mode output with
     | Some mode ->
-      Output.set_mode output mode;
-      Output.enable output true;
-      Output.commit output
+       Output.(
+         set_mode output mode;
+         enable output true;
+         commit output
+       )
     | None -> true
   in
   if output_ok then begin
     let o = { output; frame = Wl.Listener.create () } in
-    Wl.Signal.add (Output.signal_frame output) o.frame (output_frame st);
+    Wl.Signal.add (Output.signal_frame output) o.frame (output_frame st output);
     st.outputs <- o :: st.outputs;
 
     Output_layout.add_auto st.output_layout output;
     Output.create_global output;
   end
 
-let server_new_xdg_surface _st _ _ =
-  failwith "todo"
+let begin_interactive st view mode =
+  let focused_surface = Seat.(Pointer_state.focused_surface (pointer_state st.seat)) in
+  if Xdg_surface.surface view.surface == focused_surface then (
+    st.cursor_mode <- mode;
+    match mode with
+    | Passthrough -> ()
+    | Move ->
+      st.grab <- Some {
+        view = view;
+        x = Float.(sub (Cursor.x st.cursor) (of_int view.x));
+        y = Float.(sub (Cursor.y st.cursor) (of_int view.y));
+        resize = None;
+      }
+    | Resize edges ->
+      let geobox = Xdg_surface.get_geometry view.surface in
+      let border_x =
+        view.x + geobox.x + (
+          if List.exists ((==) Edges.Right) edges then geobox.width else 0
+        )
+      in
+      let border_y =
+        view.y + geobox.y + (
+          if List.exists ((==) Edges.Bottom) edges then geobox.height else 0
+        )
+      in
+      st.grab <- Some {
+        view = view;
+        x = Float.(sub (Cursor.x st.cursor) (of_int border_x));
+        y = Float.(sub (Cursor.y st.cursor) (of_int border_y));
+        resize = Some { edges; geobox; };
+      }
+  )
 
-let server_cursor_motion _st _ _ =
-  failwith "todo"
 
-let server_cursor_motion_absolute _st _ _ =
-  failwith "todo"
+let focus_view st view surf =
+  let keyboard_state = Seat.keyboard_state st.seat in
+  let prev_surface = Seat.Keyboard_state.focused_surface keyboard_state in
+  let to_deactivate =
+    Option.bind prev_surface (fun prev ->
+        if prev == Xdg_surface.surface surf
+        then None
+        else Xdg_surface.from_surface prev
+      )
+  in
+  Option.iter (fun s -> ignore (Xdg_surface.toplevel_set_activated s false))
+    to_deactivate;
+  let keyboard = Seat.Keyboard_state.keyboard keyboard_state in
+  st.views <- view :: List.filter ((!=) view) st.views;
+  ignore (Xdg_surface.toplevel_set_activated surf true);
+  Keyboard.(
+    Seat.keyboard_notify_enter
+      st.seat
+      (Xdg_surface.surface surf)
+      (keycodes keyboard)
+      (num_keycodes keyboard)
+      (modifiers keyboard)
+  )
 
-let server_cursor_button _st _ _ =
-  failwith "todo"
+let keyboard_handle_modifiers st device _ keyboard =
+  let _ = Seat.set_keyboard st.seat device in
+  let _ = Seat.keyboard_notify_modifiers st.seat (Keyboard.modifiers keyboard) in
+  ()
 
-let server_cursor_axis _st _ _ =
-  failwith "todo"
+let server_new_xdg_surface st _listener (surf : Xdg_surface.t) =
+  begin match Xdg_surface.role surf with
+    | None -> ()
+    | Popup -> ()
+    | TopLevel ->
+      let view_listener = Wl.Listener.create () in
+
+      let view = {
+        surface = surf;
+        listener = view_listener;
+        mapped = false;
+        x = 0;
+        y = 0;
+      } in
+
+      st.views <- view :: st.views;
+
+      Wl.Signal.(
+        Xdg_surface.Events.(
+          add (destroy surf) view_listener
+            (fun _ _ -> st.views <- List.filter (fun item -> item <> view) st.views;);
+          add (map surf) view_listener
+            (fun _ _ ->
+              view.mapped <- true;
+              focus_view st view surf);
+          add (unmap surf) view_listener
+            (fun _ _ -> view.mapped <- false;)
+        );
+
+        Xdg_toplevel.Events.(
+          (* cotd *)
+          let toplevel = Xdg_surface.toplevel surf in
+
+          add (request_move toplevel) view_listener
+            (fun _ _ -> begin_interactive st view Move);
+          add (request_resize toplevel) view_listener
+            (fun _ ev -> begin_interactive st view (Resize (Resize.edges ev)))
+        )
+      )
+  end
 
-let server_cursor_frame _st _ _ =
-  failwith "todo"
+let process_cursor_move st _time grab =
+  grab.view.x <- Float.(to_int (sub (Cursor.x st.cursor) grab.x));
+  grab.view.y <- Float.(to_int (sub (Cursor.y st.cursor) grab.y))
+
+let process_cursor_resize st _time edges (grab, resize) =
+  let view = grab.view in
+  let border_x = Float.sub (Cursor.x st.cursor) grab.x in
+  let border_y = Float.sub (Cursor.y st.cursor) grab.y in
+
+  let (new_top, new_bottom) =
+    if List.exists ((==) Edges.Top) edges
+    then
+      let new_top = border_y in
+      let new_bottom = resize.geobox.y + resize.geobox.height in
+      if new_top >= Float.of_int new_bottom
+      then (new_bottom - 1, new_bottom)
+      else (truncate new_top, new_bottom)
+    else if List.exists ((==) Edges.Bottom) edges
+    then
+      let new_top = resize.geobox.y in
+      let new_bottom = border_y in
+      if new_bottom <= Float.of_int new_top
+      then (new_top, new_top + 1)
+      else (new_top, truncate new_bottom)
+    else (resize.geobox.y, resize.geobox.y + resize.geobox.height)
+  in
+  let (new_left, new_right) =
+    if List.exists ((==) Edges.Left) edges
+    then
+      let new_left = border_x in
+      let new_right = resize.geobox.x + resize.geobox.width in
+      if new_left >= Float.of_int new_right
+      then (new_right - 1, new_right)
+      else (truncate new_left, new_right)
+    else if List.exists ((==) Edges.Right) edges
+    then
+      let new_left = resize.geobox.x in
+      let new_right = border_x in
+      if new_right <= Float.of_int new_left
+      then (new_left, new_left + 1)
+      else (new_left, truncate new_right)
+    else (resize.geobox.x, resize.geobox.x + resize.geobox.width)
+  in
+
+  let geobox = Xdg_surface.get_geometry view.surface in
+  view.x <- new_left - geobox.x;
+  view.y <- new_top - geobox.y;
+
+  let new_width = new_right - new_left in
+  let new_height = new_bottom - new_top in
+
+  ignore (Xdg_surface.toplevel_set_size view.surface, new_width, new_height)
+
+let view_at lx ly (view : view) =
+  let view_sx = Float.(sub lx (of_int view.x)) in
+  let view_sy = Float.(sub ly (of_int view.y)) in
+  Xdg_surface.surface_at view.surface view_sx view_sy
+
+let desktop_view_at cursor =
+  List.find_map (fun view ->
+      Option.map (fun (surf, x, y) -> (view, surf, x, y))
+        Cursor.(view_at (x cursor) (y cursor) view))
+
+let process_cursor_motion st time =
+  begin match st.cursor_mode with
+  | Move ->
+    Option.iter (process_cursor_move st time) st.grab
+  | Resize edges -> Option.(
+       let resizing = bind st.grab (fun g -> map (fun r -> (g, r)) g.resize)
+       in iter (process_cursor_resize st time edges) resizing
+     )
+  | Passthrough ->
+    let view = desktop_view_at st.cursor st.views in
+    match view with
+    | None ->
+      Xcursor_manager.set_cursor_image st.cursor_mgr "left_ptr" st.cursor;
+      Seat.pointer_clear_focus st.seat
+    | Some (_view, surf, sub_x, sub_y) ->
+      let focus_changed = Seat.(Pointer_state.focused_surface (pointer_state st.seat)) != surf in
+      Seat.pointer_notify_enter st.seat surf sub_x sub_y;
+      if not focus_changed then Seat.pointer_notify_motion st.seat time sub_x sub_y
+  end
 
-let server_new_keyboard _st (_keyboard: Keyboard.t) =
-  failwith "todo"
+let server_cursor_motion st _ (evt: Event_pointer_motion.t) = Event_pointer_motion.(
+    Cursor.move st.cursor (device evt) (delta_x evt) (delta_y evt);
+    process_cursor_motion st (time_msec evt)
+  )
+
+let server_cursor_motion_absolute st _ (evt: Event_pointer_motion_absolute.t) =
+  Event_pointer_motion_absolute.(
+    Cursor.warp_absolute st.cursor (device evt) (x evt) (y evt);
+    process_cursor_motion st (time_msec evt)
+  )
+
+let server_cursor_button st _ (evt: Event_pointer_button.t) =
+  let button_state = Event_pointer_button.state evt in
+  ignore Event_pointer_button.(
+    Seat.pointer_notify_button st.seat (time_msec evt) (button evt) button_state
+  );
+  if button_state == Pointer.Released
+  then st.cursor_mode <- Passthrough
+  else
+    let found_view = desktop_view_at st.cursor st.views in
+    Option.iter (fun (view, surf, _, _) ->
+        Option.iter (focus_view st view) (Xdg_surface.from_surface surf))
+      found_view
+
+let server_cursor_axis st _ (evt : Event_pointer_axis.t) = Event_pointer_axis.(
+    Seat.pointer_notify_axis
+      st.seat
+      (time_msec evt)
+      (orientation evt)
+      (delta evt)
+      (delta_discrete evt)
+      (source evt)
+ )
+
+let server_cursor_frame st _ _ =
+  Seat.pointer_notify_frame st.seat
+
+let handle_keybinding st sym =
+  if sym == Xkbcommon.Keysyms._Escape
+  then
+    let () = Wl.Display.terminate st.display in
+    true
+  else if sym == Xkbcommon.Keysyms._F1
+  then
+    match st.views with
+    | [] -> true
+    | [_] -> true
+    | (x :: y :: xs) ->
+       let () = focus_view st y y.surface in
+       st.views <- y :: List.append xs [x];
+       true
+  else false
+
+let keyboard_handle_key st keyboard device _ key_evt =
+  let keycode = Keyboard.Event_key.keycode key_evt in
+  let syms = Xkbcommon.State.key_get_syms (Keyboard.xkb_state keyboard) keycode in
+  let modifiers = Keyboard.get_modifiers keyboard in
+  let handled =
+    if Keyboard_modifiers.has_alt modifiers && Keyboard.Event_key.state key_evt == Keyboard.Pressed
+    then List.fold_left (fun _ sym -> handle_keybinding st sym) false syms
+    else false
+  in
+  if not handled then
+    let () = Seat.set_keyboard st.seat device in
+    Seat.keyboard_notify_key st.seat key_evt
+
+let server_new_keyboard_set_settings (keyboard: Keyboard.t) =
+  let xkb_context = match Xkbcommon.Context.create () with
+    | Some ctx -> ctx
+    | None -> failwith "Xkbcommon.Context.create"
+  in
+  let keymap = match Xkbcommon.Keymap.new_from_names xkb_context default_xkb_rules with
+    | Some m -> m
+    | None -> failwith "Xkbcommon.Keymap.new_from_names"
+  in
+  let _ = Keyboard.set_keymap keyboard keymap in
+  (* Is this for some reference counting stuff?????? *)
+  let _ = Xkbcommon.Keymap.unref keymap in
+  let _ = Xkbcommon.Context.unref xkb_context in
+  Keyboard.set_repeat_info keyboard 25 6000
+
+let server_new_keyboard st (device: Input_device.t) =
+  match Input_device.typ device with
+  | Input_device.Keyboard keyboard ->
+     server_new_keyboard_set_settings keyboard;
+     let modifiers_l = Wl.Listener.create () in
+     let key_l = Wl.Listener.create () in
+     Wl.Signal.(Keyboard.Events.(
+       add (modifiers keyboard) modifiers_l
+         (keyboard_handle_modifiers st device);
+       add (key keyboard) key_l
+         (keyboard_handle_key st keyboard device);
+     ));
+     let tinywl_keyboard = {
+       device = keyboard;
+       modifiers = modifiers_l;
+       key = key_l;
+     } in
+
+     st.keyboards <- tinywl_keyboard :: st.keyboards;
+  | _ -> ()
 
 let server_new_pointer st (pointer: Input_device.t) =
   Cursor.attach_input_device st.cursor pointer
 
-let server_new_input st _ (device: Input_device.t) =
-  begin match Input_device.typ device with
-  | Input_device.Keyboard keyboard ->
-    server_new_keyboard st keyboard
-  | Input_device.Pointer _ ->
-    server_new_pointer st device
-  | _ ->
-    ()
-  end;
+let server_new_input st _ (device: Input_device.t) = Input_device.(
+    match typ device with
+    | Keyboard _ ->
+      server_new_keyboard st device
+    | Pointer _ ->
+      server_new_pointer st device
+    | _ -> ()
+  );
 
   let caps =
     Wl.Seat_capability.Pointer ::
@@ -86,12 +431,12 @@ let server_new_input st _ (device: Input_device.t) =
   Seat.set_capabilities st.seat caps
 
 let server_request_cursor st _ (ev: Seat.Pointer_request_set_cursor_event.t) =
-  let module E = Seat.Pointer_request_set_cursor_event in
   let focused_client =
     st.seat |> Seat.pointer_state |> Seat.Pointer_state.focused_client in
 
-  if Seat.Client.equal focused_client (E.seat_client ev) then (
-    Cursor.set_surface st.cursor (E.surface ev) (E.hotspot_x ev) (E.hotspot_y ev)
+  Seat.Pointer_request_set_cursor_event.(
+    if Seat.Client.equal focused_client (seat_client ev)
+    then Cursor.set_surface st.cursor (surface ev) (hotspot_x ev) (hotspot_y ev)
   )
 
 let () =
@@ -125,49 +470,56 @@ let () =
 
   let seat = Seat.create display "seat0" in
 
-  let new_output = Wl.Listener.create () in
-  let new_xdg_surface = Wl.Listener.create () in
-  let cursor_motion = Wl.Listener.create () in
-  let cursor_motion_absolute = Wl.Listener.create () in
-  let cursor_button = Wl.Listener.create () in
-  let cursor_axis = Wl.Listener.create () in
-  let cursor_frame = Wl.Listener.create () in
-  let new_input = Wl.Listener.create () in
-  let request_cursor = Wl.Listener.create () in
-  let st = { display; backend; renderer; output_layout; new_output; seat;
-             cursor; outputs = []; views = []; keyboards = [] } in
-
-  Wl.Signal.add (Backend.signal_new_output backend) new_output
-    (server_new_output st);
-  Wl.Signal.add (Xdg_shell.signal_new_surface xdg_shell) new_xdg_surface
-    (server_new_xdg_surface st);
-
-  Wl.Signal.add (Cursor.signal_motion cursor) cursor_motion
-    (server_cursor_motion st);
-  Wl.Signal.add (Cursor.signal_motion_absolute cursor) cursor_motion_absolute
-    (server_cursor_motion_absolute st);
-  Wl.Signal.add (Cursor.signal_button cursor) cursor_button
-    (server_cursor_button st);
-  Wl.Signal.add (Cursor.signal_axis cursor) cursor_axis
-    (server_cursor_axis st);
-  Wl.Signal.add (Cursor.signal_frame cursor) cursor_frame
-    (server_cursor_frame st);
-
-  Wl.Signal.add (Backend.signal_new_input backend) new_input
-    (server_new_input st);
-  Wl.Signal.add (Seat.signal_request_set_cursor seat) request_cursor
-    (server_request_cursor st);
+  Wl.Listener.(
+    let new_output = create () in
+    let new_xdg_surface = create () in
+    let cursor_motion = create () in
+    let cursor_motion_absolute = create () in
+    let cursor_button = create () in
+    let cursor_axis = create () in
+    let cursor_frame = create () in
+    let new_input = create () in
+    let request_cursor = create () in
+    let st = { display; backend; renderer; output_layout; new_output; seat;
+               cursor; cursor_mode = Passthrough; cursor_mgr; outputs = [];
+               views = []; keyboards = []; grab = None } in
+
+    Wl.Signal.(
+      add (Backend.signal_new_output backend) new_output
+        (server_new_output st);
+      add (Xdg_shell.signal_new_surface xdg_shell) new_xdg_surface
+        (server_new_xdg_surface st);
+
+      Cursor.(
+        add (signal_motion cursor) cursor_motion
+          (server_cursor_motion st);
+        add (signal_motion_absolute cursor) cursor_motion_absolute
+          (server_cursor_motion_absolute st);
+        add (signal_button cursor) cursor_button
+          (server_cursor_button st);
+        add (signal_axis cursor) cursor_axis
+          (server_cursor_axis st);
+        add (signal_frame cursor) cursor_frame
+          (server_cursor_frame st)
+      );
+
+      add (Backend.signal_new_input backend) new_input
+        (server_new_input st);
+      add (Seat.signal_request_set_cursor seat) request_cursor
+        (server_request_cursor st)
+    )
+  );
 
   let socket = match Wl.Display.add_socket_auto display with
     | None -> Backend.destroy backend; exit 1
     | Some socket -> socket
   in
 
-  if not (Backend.start backend) then (
-    Backend.destroy backend;
+  Backend.(if not (start backend) then (
+    destroy backend;
     Wl.Display.destroy display;
     exit 1
-  );
+  ));
 
   Unix.putenv "WAYLAND_DISPLAY" socket;
   begin match startup_cmd with
@@ -177,9 +529,9 @@ let () =
   end;
 
   Printf.printf "Running wayland compositor on WAYLAND_DISPLAY=%s" socket;
-  Wl.Display.run display;
-
-  Wl.Display.destroy_clients display;
-  Wl.Display.destroy display;
 
-  ()
+  Wl.Display.(
+    run display;
+    destroy_clients display;
+    destroy display
+  )
diff --git a/types/types.ml b/types/types.ml
index 680b39e..07f92b5 100644
--- a/types/types.ml
+++ b/types/types.ml
@@ -40,17 +40,40 @@ module Make (S : Cstubs_structs.TYPE) = struct
   end
 
   module Wl_output_transform = struct
-    (* FIXME *)
-    type t = int64
-    let t : t typ = int64_t
+    type transform = Ninety
+                   | OneEighty
+                   | TwoSeventy
+                   | Flipped
+                   | FlippedNinety
+                   | FlippedOneEighty
+                   | FlippedTwoSeventy
+
+    type t = [`wl_output_transform] Ctypes.structure
+    let _WL_OUTPUT_TRANSFORM_90 = constant "WL_OUTPUT_TRANSFORM_90" int64_t (* 1 *)
+    let _WL_OUTPUT_TRANSFORM_180 = constant "WL_OUTPUT_TRANSFORM_180" int64_t (* 2 *)
+    let _WL_OUTPUT_TRANSFORM_270 = constant "WL_OUTPUT_TRANSFORM_270" int64_t (* 3 *)
+    let _WL_OUTPUT_TRANSFORM_FLIPPED = constant "WL_OUTPUT_TRANSFORM_FLIPPED" int64_t (* 4 *)
+    let _WL_OUTPUT_TRANSFORM_FLIPPED_90 = constant "WL_OUTPUT_TRANSFORM_FLIPPED_90" int64_t (* 5 *)
+    let _WL_OUTPUT_TRANSFORM_FLIPPED_180 = constant "WL_OUTPUT_TRANSFORM_FLIPPED_180" int64_t (* 6 *)
+    let _WL_OUTPUT_TRANSFORM_FLIPPED_270 = constant "WL_OUTPUT_TRANSFORM_FLIPPED_270" int64_t (* 7 *)
+
+    let t : transform typ = enum "wl_output_transform" [
+      Ninety, _WL_OUTPUT_TRANSFORM_90;
+      OneEighty, _WL_OUTPUT_TRANSFORM_180;
+      TwoSeventy, _WL_OUTPUT_TRANSFORM_270;
+      Flipped, _WL_OUTPUT_TRANSFORM_FLIPPED;
+      FlippedNinety, _WL_OUTPUT_TRANSFORM_FLIPPED_90;
+      FlippedOneEighty, _WL_OUTPUT_TRANSFORM_FLIPPED_180;
+      FlippedTwoSeventy, _WL_OUTPUT_TRANSFORM_FLIPPED_270;
+    ]
   end
 
   module Wl_seat_capability = struct
-    type t = Unsigned.uint64
-    let t : t typ = uint64_t
-    let _WL_SEAT_CAPABILITY_POINTER = constant "WL_SEAT_CAPABILITY_POINTER" uint64_t
-    let _WL_SEAT_CAPABILITY_KEYBOARD = constant "WL_SEAT_CAPABILITY_KEYBOARD" uint64_t
-    let _WL_SEAT_CAPABILITY_TOUCH = constant "WL_SEAT_CAPABILITY_TOUCH" uint64_t
+    type t = Signed.Int64.t
+    let t : t typ = int64_t
+    let _WL_SEAT_CAPABILITY_POINTER = constant "WL_SEAT_CAPABILITY_POINTER" t
+    let _WL_SEAT_CAPABILITY_KEYBOARD = constant "WL_SEAT_CAPABILITY_KEYBOARD" t
+    let _WL_SEAT_CAPABILITY_TOUCH = constant "WL_SEAT_CAPABILITY_TOUCH" t
   end
 
   module Renderer = struct
@@ -80,6 +103,10 @@ module Make (S : Cstubs_structs.TYPE) = struct
     let pending = field t "pending" (ptr Surface_state.t)
     (* TODO *)
     let () = seal t
+
+    type wlr_surface_iterator_func_t =  t ptr -> int -> int -> unit ptr -> unit
+    let wlr_surface_iterator_func_t: wlr_surface_iterator_func_t typ =
+      lift_typ (Foreign.funptr (ptr t @-> int @-> int @-> ptr void @-> returning void))
   end
 
   module Box = struct
@@ -108,6 +135,7 @@ module Make (S : Cstubs_structs.TYPE) = struct
     let t : t typ = structure "wlr_output"
 
     let modes = field t "modes" Wl_list.t
+    let scale = field t "scale" double
     let current_mode = field t "current_mode" (ptr Output_mode.t)
     let events_destroy = field t "events.destroy" Wl_signal.t
     let events_frame = field t "events.frame" Wl_signal.t
@@ -135,6 +163,24 @@ module Make (S : Cstubs_structs.TYPE) = struct
     ]
   end
 
+  module Button_state = struct
+    type t = Released | Pressed
+
+    let _RELEASED = constant "WLR_BUTTON_RELEASED" int64_t
+    let _PRESSED = constant "WLR_BUTTON_PRESSED" int64_t
+
+    let t : t typ = enum "wlr_button_state" [
+      Released, _RELEASED;
+      Pressed, _PRESSED;
+    ]
+  end
+
+  (* This is an array of unit32_t keycodes: uint32_t keycodes[] *)
+  module Keycodes = struct
+    type t = unit ptr
+    let t : t typ = ptr void
+  end
+
   module Event_keyboard_key = struct
     type t = [`event_keyboard_key] Ctypes.structure
     let t : t typ = structure "wlr_event_keyboard_key"
@@ -144,12 +190,36 @@ module Make (S : Cstubs_structs.TYPE) = struct
     let state = field t "state" Key_state.t
   end
 
+  module Keyboard_modifier = struct
+    type t = Unsigned.uint32
+    let t : t typ = uint32_t
+
+    let _WLR_MODIFIER_SHIFT = constant "WLR_MODIFIER_SHIFT" t
+    let _WLR_MODIFIER_CAPS = constant "WLR_MODIFIER_CAPS" t
+    let _WLR_MODIFIER_CTRL = constant "WLR_MODIFIER_CTRL" t
+    let _WLR_MODIFIER_ALT = constant "WLR_MODIFIER_ALT" t
+    let _WLR_MODIFIER_MOD2 = constant "WLR_MODIFIER_MOD2" t
+    let _WLR_MODIFIER_MOD3 = constant "WLR_MODIFIER_MOD3" t
+    let _WLR_MODIFIER_LOGO = constant "WLR_MODIFIER_LOGO" t
+    let _WLR_MODIFIER_MOD5 = constant "WLR_MODIFIER_MOD5" t
+  end
+
+  module Keyboard_modifiers = struct
+    type t = [`keyboard_modifier] Ctypes.structure
+    let t : t typ = structure "wlr_keyboard_modifiers"
+    let () = seal t
+  end
+
   module Keyboard = struct
     type t = [`keyboard] Ctypes.structure
     let t : t typ = structure "wlr_keyboard"
 
     let xkb_state = field t "xkb_state" (lift_typ Xkbcommon.State.t)
+    let modifiers = field t "modifiers" (ptr Keyboard_modifiers.t)
     let events_key = field t "events.key" Wl_signal.t
+    let events_modifiers = field t "events.modifiers" Wl_signal.t
+    let keycodes = field t "keycodes" Keycodes.t
+    let num_keycodes = field t "num_keycodes" size_t
     let () = seal t
   end
 
@@ -160,34 +230,67 @@ module Make (S : Cstubs_structs.TYPE) = struct
     let () = seal t
   end
 
-  module Event_pointer_motion = struct
-    type t = [`event_pointer_motion] Ctypes.structure
-    let t : t typ = structure "wlr_event_pointer_motion"
+  module Event_pointer_button = struct
+    type t = [`event_pointer_button] Ctypes.structure
+    let t : t typ = structure "wlr_event_pointer_button"
 
+    let time_msec = field t "time_msec" uint32_t
+    let button = field t "button" uint32_t
+    let state = field t "state" Button_state.t
     let () = seal t
   end
 
-  module Event_pointer_motion_absolute = struct
-    type t = [`event_pointer_motion_absolute] Ctypes.structure
-    let t : t typ = structure "wlr_event_pointer_motion_absolute"
+  module Axis_source = struct
+    type t = Wheel | Finger | Continuous | Wheel_tilt
 
-    let () = seal t
+    let _WLR_AXIS_SOURCE_WHEEL = constant "WLR_AXIS_SOURCE_WHEEL" int64_t
+    let _WLR_AXIS_SOURCE_FINGER = constant "WLR_AXIS_SOURCE_FINGER" int64_t
+    let _WLR_AXIS_SOURCE_CONTINUOUS = constant "WLR_AXIS_SOURCE_CONTINUOUS" int64_t
+    let _WLR_AXIS_SOURCE_WHEEL_TILT = constant "WLR_AXIS_SOURCE_WHEEL_TILT" int64_t
+
+    let t : t typ = enum "wlr_axis_source" [
+      Wheel, _WLR_AXIS_SOURCE_WHEEL;
+      Finger, _WLR_AXIS_SOURCE_FINGER;
+      Continuous, _WLR_AXIS_SOURCE_CONTINUOUS;
+      Wheel_tilt, _WLR_AXIS_SOURCE_WHEEL_TILT;
+    ]
   end
 
-  module Event_pointer_button = struct
-    type t = [`event_pointer_button] Ctypes.structure
-    let t : t typ = structure "wlr_event_pointer_button"
+  module Axis_orientation = struct
+    type t = Vertical | Horizontal
 
-    let () = seal t
+    let _WLR_AXIS_ORIENTATION_VERTICAL = constant "WLR_AXIS_ORIENTATION_VERTICAL" int64_t
+    let _WLR_AXIS_ORIENTATION_HORIZONTAL = constant "WLR_AXIS_ORIENTATION_HORIZONTAL" int64_t
+
+    let t : t typ = enum "wlr_axis_orientation" [
+      Vertical, _WLR_AXIS_ORIENTATION_VERTICAL;
+      Horizontal, _WLR_AXIS_ORIENTATION_HORIZONTAL;
+    ]
   end
 
   module Event_pointer_axis = struct
     type t = [`event_pointer_axis] Ctypes.structure
     let t : t typ = structure "wlr_event_pointer_axis"
 
+    let time_msec = field t "time_msec" uint32_t
+    let orientation = field t "orientation" Axis_orientation.t
+    let delta = field t "delta" double
+    let delta_discrete = field t "delta_discrete" int32_t
+    let source = field t "source" Axis_source.t
     let () = seal t
   end
 
+  module Edges = struct
+    type t = Unsigned.uint32
+    let t : t typ = uint32_t
+
+    let _WLR_EDGE_NONE = constant "WLR_EDGE_NONE" uint32_t
+    let _WLR_EDGE_TOP = constant "WLR_EDGE_TOP" uint32_t
+    let _WLR_EDGE_BOTTOM = constant "WLR_EDGE_BOTTOM" uint32_t
+    let _WLR_EDGE_LEFT = constant "WLR_EDGE_LEFT" uint32_t
+    let _WLR_EDGE_RIGHT = constant "WLR_EDGE_RIGHT" uint32_t
+  end
+
   module Touch = struct
     type t = [`touch] Ctypes.structure
     let t : t typ = structure "wlr_touch"
@@ -252,6 +355,29 @@ module Make (S : Cstubs_structs.TYPE) = struct
     let () = seal t
   end
 
+  module Event_pointer_motion_absolute = struct
+    type t = [`event_pointer_motion_absolute] Ctypes.structure
+    let t : t typ = structure "wlr_event_pointer_motion_absolute"
+
+    let device = field t "device" (ptr Input_device.t)
+    let x = field t "x" double
+    let y = field t "y" double
+    let time_msec = field t "time_msec" uint32_t
+    let () = seal t
+  end
+
+  module Event_pointer_motion = struct
+    type t = [`event_pointer_motion] Ctypes.structure
+    let t : t typ = structure "wlr_event_pointer_motion"
+
+    let device = field t "device" (ptr Input_device.t)
+    let time_msec = field t "time_msec" uint32_t
+    let delta_x = field t "delta_x" double
+    let delta_y = field t "delta_y" double
+
+    let () = seal t
+  end
+
   module Backend = struct
     type t = [`backend] Ctypes.structure
     let t : t typ = structure "wlr_backend"
@@ -285,10 +411,47 @@ module Make (S : Cstubs_structs.TYPE) = struct
     let () = seal t
   end
 
+  module Xdg_surface_role = struct
+    (* The type of these may be compiler dependent *)
+    let none = constant "WLR_XDG_SURFACE_ROLE_NONE" int64_t
+    let top_level = constant "WLR_XDG_SURFACE_ROLE_TOPLEVEL" int64_t
+    let popup = constant "WLR_XDG_SURFACE_ROLE_POPUP" int64_t
+
+    type role = None | TopLevel | Popup
+
+    type t = [`xdg_surface_role] Ctypes.structure
+    let t : role typ = enum "wlr_xdg_surface_role" [
+        None, none;
+        TopLevel, top_level;
+        Popup, popup;
+      ]
+  end
+
+  module Xdg_toplevel = struct
+    type t = [`xdg_toplevel] Ctypes.structure
+    let t : t typ = structure "wlr_xdg_toplevel"
+
+    let events_request_move = field t "events.request_move" Wl_signal.t
+    let events_request_resize = field t "events.request_resize" Wl_signal.t
+
+    let () = seal t
+  end
+
   module Xdg_surface = struct
     type t = [`xdg_surface] Ctypes.structure
     let t : t typ = structure "wlr_xdg_surface"
 
+    let role = field t "role" Xdg_surface_role.t
+    let surface = field t "surface" (ptr Surface.t)
+    let toplevel = field t "toplevel" (ptr Xdg_toplevel.t)
+
+    let events_destroy = field t "events.destroy" Wl_signal.t
+    let events_ping_timeout = field t "events.ping_timeout" Wl_signal.t
+    let events_new_popup = field t "events.new_popup" Wl_signal.t
+    let events_map = field t "events.map" Wl_signal.t
+    let events_unmap = field t "events.unmap" Wl_signal.t
+    let events_configure = field t "events.configure" Wl_signal.t
+    let events_ack_configure = field t "events.ack_configure" Wl_signal.t
     let () = seal t
   end
 
@@ -305,6 +468,9 @@ module Make (S : Cstubs_structs.TYPE) = struct
     type t = [`cursor] Ctypes.structure
     let t : t typ = structure "wlr_cursor"
 
+    let x = field t "x" double
+    let y = field t "y" double
+
     let events_motion = field t "events.motion" Wl_signal.t
     let events_motion_absolute = field t "events.motion_absolute" Wl_signal.t
     let events_button = field t "events.button" Wl_signal.t
@@ -330,6 +496,17 @@ module Make (S : Cstubs_structs.TYPE) = struct
     let t : t typ = structure "wlr_seat_pointer_state"
     let focused_client = field t "focused_client"
         (ptr Seat_client.t)
+    let focused_surface = field t "focused_surface"
+        (ptr Surface.t)
+    let () = seal t
+  end
+
+  module Seat_keyboard_state = struct
+    type t = [`seat_keyboard_state] Ctypes.structure
+    let t : t typ = structure "wlr_seat_keyboard_state"
+    let focused_surface = field t "focused_surface"
+        (ptr Surface.t)
+    let keyboard = field t "keyboard" (ptr Keyboard.t)
     let () = seal t
   end
 
@@ -341,6 +518,31 @@ module Make (S : Cstubs_structs.TYPE) = struct
       field t "events.request_set_cursor" Wl_signal.t
     let pointer_state =
       field t "pointer_state" Seat_pointer_state.t
+    let keyboard_state =
+      field t "keyboard_state" Seat_keyboard_state.t
+    let () = seal t
+  end
+
+  module Xdg_toplevel_move_event = struct
+    type t = [`xdg_toplevel_move_event] Ctypes.structure
+    let t : t typ = structure "wlr_xdg_toplevel_move_event"
+
+    let surface = field t "surface" (ptr Xdg_surface.t)
+    let seat = field t "seat" (ptr Seat.t)
+    let serial = field t "serial" uint32_t
+
+    let () = seal t
+  end
+
+  module Xdg_toplevel_resize_event = struct
+    type t = [`xdg_toplevel_resize_event] Ctypes.structure
+    let t : t typ = structure "wlr_xdg_toplevel_resize_event"
+
+    let surface = field t "surface" (ptr Xdg_surface.t)
+    let seat = field t "seat" (ptr Seat.t)
+    let serial = field t "serial" uint32_t
+    let edges = field t "edges" Edges.t
+
     let () = seal t
   end