{-# LINE 1 "src/Bindings/WLC/Core.hsc" #-}

{-# LINE 2 "src/Bindings/WLC/Core.hsc" #-}

{-# LINE 3 "src/Bindings/WLC/Core.hsc" #-}

{-|
Module      : Bindings.WLC.Core
Description : Core WLC
Copyright   : (c) Ashley Towns 2016
License     : BSD3
Maintainer  : mail@ashleytowns.id.au
Stability   : experimental
Portability : POSIX

Provides bindings to the core WLC API.
-}
module Bindings.WLC.Core where
import Foreign.Ptr (Ptr,FunPtr,plusPtr)
import Foreign.Ptr (wordPtrToPtr,castPtrToFunPtr)
import Foreign.Storable
import Foreign.C.Types
import Foreign.C.String (CString,CStringLen,CWString,CWStringLen)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Array (peekArray,pokeArray)
import Data.Int
import Data.Word

{-# LINE 17 "src/Bindings/WLC/Core.hsc" #-}

import Bindings.WLC.Defines
import Bindings.WLC.Geometry

data C'wlc_event_source = C'wlc_event_source

{-# LINE 22 "src/Bindings/WLC/Core.hsc" #-}
data C'xkb_state = C'xkb_state

{-# LINE 23 "src/Bindings/WLC/Core.hsc" #-}
data C'xkb_keymap = C'xkb_keymap

{-# LINE 24 "src/Bindings/WLC/Core.hsc" #-}
data C'libinput_device = C'libinput_device

{-# LINE 25 "src/Bindings/WLC/Core.hsc" #-}

-- |wlc_log(), wlc_vlog();
type C'wlc_log_type = CUInt

{-# LINE 28 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_LOG_INFO = 0
c'WLC_LOG_INFO :: (Num a) => a

{-# LINE 29 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_LOG_WARN = 1
c'WLC_LOG_WARN :: (Num a) => a

{-# LINE 30 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_LOG_ERROR = 2
c'WLC_LOG_ERROR :: (Num a) => a

{-# LINE 31 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_LOG_WAYLAND = 3
c'WLC_LOG_WAYLAND :: (Num a) => a

{-# LINE 32 "src/Bindings/WLC/Core.hsc" #-}

-- |wlc_get_backend_type();
type C'wlc_backend_type = CUInt

{-# LINE 35 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_BACKEND_NONE = 0
c'WLC_BACKEND_NONE :: (Num a) => a

{-# LINE 36 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_BACKEND_DRM = 1
c'WLC_BACKEND_DRM :: (Num a) => a

{-# LINE 37 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_BACKEND_X11 = 2
c'WLC_BACKEND_X11 :: (Num a) => a

{-# LINE 38 "src/Bindings/WLC/Core.hsc" #-}

-- |mask in wlc_event_loop_add_fd();
type C'wlc_event_bit = CUInt

{-# LINE 41 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_EVENT_READABLE = 1
c'WLC_EVENT_READABLE :: (Num a) => a

{-# LINE 42 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_EVENT_WRITABLE = 2
c'WLC_EVENT_WRITABLE :: (Num a) => a

{-# LINE 43 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_EVENT_HANGUP = 4
c'WLC_EVENT_HANGUP :: (Num a) => a

{-# LINE 44 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_EVENT_ERROR = 8
c'WLC_EVENT_ERROR :: (Num a) => a

{-# LINE 45 "src/Bindings/WLC/Core.hsc" #-}

-- |wlc_view_get_state();
type C'wlc_view_state_bit = CUInt

{-# LINE 48 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_BIT_MAXIMIZED = 1
c'WLC_BIT_MAXIMIZED :: (Num a) => a

{-# LINE 49 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_BIT_FULLSCREEN = 2
c'WLC_BIT_FULLSCREEN :: (Num a) => a

{-# LINE 50 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_BIT_RESIZING = 4
c'WLC_BIT_RESIZING :: (Num a) => a

{-# LINE 51 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_BIT_MOVING = 8
c'WLC_BIT_MOVING :: (Num a) => a

{-# LINE 52 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_BIT_ACTIVATED = 16
c'WLC_BIT_ACTIVATED :: (Num a) => a

{-# LINE 53 "src/Bindings/WLC/Core.hsc" #-}

-- |wlc_view_get_type();
type C'wlc_view_type_bit = CUInt

{-# LINE 56 "src/Bindings/WLC/Core.hsc" #-}
-- |Override redirect (x11)
c'WLC_BIT_OVERRIDE_REDIRECT = 1
c'WLC_BIT_OVERRIDE_REDIRECT :: (Num a) => a

{-# LINE 58 "src/Bindings/WLC/Core.hsc" #-}
-- |Tooltips, DnD's, menus (x11)
c'WLC_BIT_UNMANAGED = 2
c'WLC_BIT_UNMANAGED :: (Num a) => a

{-# LINE 60 "src/Bindings/WLC/Core.hsc" #-}
-- |Splash screens (x11)
c'WLC_BIT_SPLASH = 4
c'WLC_BIT_SPLASH :: (Num a) => a

{-# LINE 62 "src/Bindings/WLC/Core.hsc" #-}
-- |Modal windows (x11)
c'WLC_BIT_MODAL = 8
c'WLC_BIT_MODAL :: (Num a) => a

{-# LINE 64 "src/Bindings/WLC/Core.hsc" #-}
-- |xdg-shell, wl-shell popups
c'WLC_BIT_POPUP = 16
c'WLC_BIT_POPUP :: (Num a) => a

{-# LINE 66 "src/Bindings/WLC/Core.hsc" #-}

-- |wlc_view_set_geometry(); Edges in interface interface.view.request.resize function.
type C'wlc_resize_edge = CUInt

{-# LINE 69 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_RESIZE_EDGE_NONE = 0
c'WLC_RESIZE_EDGE_NONE :: (Num a) => a

{-# LINE 70 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_RESIZE_EDGE_TOP = 1
c'WLC_RESIZE_EDGE_TOP :: (Num a) => a

{-# LINE 71 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_RESIZE_EDGE_BOTTOM = 2
c'WLC_RESIZE_EDGE_BOTTOM :: (Num a) => a

{-# LINE 72 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_RESIZE_EDGE_LEFT = 4
c'WLC_RESIZE_EDGE_LEFT :: (Num a) => a

{-# LINE 73 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_RESIZE_EDGE_TOP_LEFT = 5
c'WLC_RESIZE_EDGE_TOP_LEFT :: (Num a) => a

{-# LINE 74 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_RESIZE_EDGE_BOTTOM_LEFT = 6
c'WLC_RESIZE_EDGE_BOTTOM_LEFT :: (Num a) => a

{-# LINE 75 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_RESIZE_EDGE_RIGHT = 8
c'WLC_RESIZE_EDGE_RIGHT :: (Num a) => a

{-# LINE 76 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_RESIZE_EDGE_TOP_RIGHT = 9
c'WLC_RESIZE_EDGE_TOP_RIGHT :: (Num a) => a

{-# LINE 77 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_RESIZE_EDGE_BOTTOM_RIGHT = 10
c'WLC_RESIZE_EDGE_BOTTOM_RIGHT :: (Num a) => a

{-# LINE 78 "src/Bindings/WLC/Core.hsc" #-}

-- |Mods in interface.keyboard.key function.
type C'wlc_modifier_bit = CUInt

{-# LINE 81 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_BIT_MOD_SHIFT = 1
c'WLC_BIT_MOD_SHIFT :: (Num a) => a

{-# LINE 82 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_BIT_MOD_CAPS = 2
c'WLC_BIT_MOD_CAPS :: (Num a) => a

{-# LINE 83 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_BIT_MOD_CTRL = 4
c'WLC_BIT_MOD_CTRL :: (Num a) => a

{-# LINE 84 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_BIT_MOD_ALT = 8
c'WLC_BIT_MOD_ALT :: (Num a) => a

{-# LINE 85 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_BIT_MOD_MOD2 = 16
c'WLC_BIT_MOD_MOD2 :: (Num a) => a

{-# LINE 86 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_BIT_MOD_MOD3 = 32
c'WLC_BIT_MOD_MOD3 :: (Num a) => a

{-# LINE 87 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_BIT_MOD_LOGO = 64
c'WLC_BIT_MOD_LOGO :: (Num a) => a

{-# LINE 88 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_BIT_MOD_MOD5 = 128
c'WLC_BIT_MOD_MOD5 :: (Num a) => a

{-# LINE 89 "src/Bindings/WLC/Core.hsc" #-}

-- |Leds in interface.keyboard.key function.
type C'wlc_led_bit = CUInt

{-# LINE 92 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_BIT_LED_NUM = 1
c'WLC_BIT_LED_NUM :: (Num a) => a

{-# LINE 93 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_BIT_LED_CAPS = 2
c'WLC_BIT_LED_CAPS :: (Num a) => a

{-# LINE 94 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_BIT_LED_SCROLL = 4
c'WLC_BIT_LED_SCROLL :: (Num a) => a

{-# LINE 95 "src/Bindings/WLC/Core.hsc" #-}

-- |State in interface.keyboard.key function.
type C'wlc_key_state = CUInt

{-# LINE 98 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_KEY_STATE_RELEASED = 0
c'WLC_KEY_STATE_RELEASED :: (Num a) => a

{-# LINE 99 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_KEY_STATE_PRESSED = 1
c'WLC_KEY_STATE_PRESSED :: (Num a) => a

{-# LINE 100 "src/Bindings/WLC/Core.hsc" #-}

-- |State in interface.pointer.button function.
type C'wlc_button_state = CUInt

{-# LINE 103 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_BUTTON_STATE_RELEASED = 0
c'WLC_BUTTON_STATE_RELEASED :: (Num a) => a

{-# LINE 104 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_BUTTON_STATE_PRESSED = 1
c'WLC_BUTTON_STATE_PRESSED :: (Num a) => a

{-# LINE 105 "src/Bindings/WLC/Core.hsc" #-}

-- |Axis in interface.pointer.scroll function.
type C'wlc_scroll_axis_bit = CUInt

{-# LINE 108 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_SCROLL_AXIS_VERTICAL = 1
c'WLC_SCROLL_AXIS_VERTICAL :: (Num a) => a

{-# LINE 109 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_SCROLL_AXIS_HORIZONTAL = 2
c'WLC_SCROLL_AXIS_HORIZONTAL :: (Num a) => a

{-# LINE 110 "src/Bindings/WLC/Core.hsc" #-}

-- |Type in interface.touch.touch function
type C'wlc_touch_type = CUInt

{-# LINE 113 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_TOUCH_DOWN = 0
c'WLC_TOUCH_DOWN :: (Num a) => a

{-# LINE 114 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_TOUCH_UP = 1
c'WLC_TOUCH_UP :: (Num a) => a

{-# LINE 115 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_TOUCH_MOTION = 2
c'WLC_TOUCH_MOTION :: (Num a) => a

{-# LINE 116 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_TOUCH_FRAME = 3
c'WLC_TOUCH_FRAME :: (Num a) => a

{-# LINE 117 "src/Bindings/WLC/Core.hsc" #-}
c'WLC_TOUCH_CANCEL = 4
c'WLC_TOUCH_CANCEL :: (Num a) => a

{-# LINE 118 "src/Bindings/WLC/Core.hsc" #-}

-- |State of keyboard modifiers in various functions.

{-# LINE 121 "src/Bindings/WLC/Core.hsc" #-}

{-# LINE 122 "src/Bindings/WLC/Core.hsc" #-}

{-# LINE 123 "src/Bindings/WLC/Core.hsc" #-}
data C'wlc_modifiers = C'wlc_modifiers{
  c'wlc_modifiers'leds :: C'wlc_led_bit,
  c'wlc_modifiers'mods :: C'wlc_modifier_bit
} deriving (Eq,Show)
p'wlc_modifiers'leds p = plusPtr p 0
p'wlc_modifiers'leds :: Ptr (C'wlc_modifiers) -> Ptr (C'wlc_led_bit)
p'wlc_modifiers'mods p = plusPtr p 4
p'wlc_modifiers'mods :: Ptr (C'wlc_modifiers) -> Ptr (C'wlc_modifier_bit)
instance Storable C'wlc_modifiers where
  sizeOf _ = 8
  alignment _ = 4
  peek p = do
    v0 <- peekByteOff p 0
    v1 <- peekByteOff p 4
    return $ C'wlc_modifiers v0 v1
  poke p (C'wlc_modifiers v0 v1) = do
    pokeByteOff p 0 v0
    pokeByteOff p 4 v1
    return ()

{-# LINE 124 "src/Bindings/WLC/Core.hsc" #-}

-- * Callback API
-- ** Types
-- *** Output
type C'output_created_cb = FunPtr (C'wlc_handle -> IO Bool)
foreign import ccall "wrapper" mk'output_created_cb
  :: (C'wlc_handle -> IO Bool) -> IO C'output_created_cb
foreign import ccall "dynamic" mK'output_created_cb
  :: C'output_created_cb -> (C'wlc_handle -> IO Bool)

{-# LINE 129 "src/Bindings/WLC/Core.hsc" #-}
type C'output_destroyed_cb = FunPtr (C'wlc_handle -> IO ())
foreign import ccall "wrapper" mk'output_destroyed_cb
  :: (C'wlc_handle -> IO ()) -> IO C'output_destroyed_cb
foreign import ccall "dynamic" mK'output_destroyed_cb
  :: C'output_destroyed_cb -> (C'wlc_handle -> IO ())

{-# LINE 130 "src/Bindings/WLC/Core.hsc" #-}
type C'output_focus_cb = FunPtr (C'wlc_handle -> Bool -> IO ())
foreign import ccall "wrapper" mk'output_focus_cb
  :: (C'wlc_handle -> Bool -> IO ()) -> IO C'output_focus_cb
foreign import ccall "dynamic" mK'output_focus_cb
  :: C'output_focus_cb -> (C'wlc_handle -> Bool -> IO ())

{-# LINE 131 "src/Bindings/WLC/Core.hsc" #-}
type C'output_resolution_cb = FunPtr (C'wlc_handle -> Ptr C'wlc_size -> Ptr C'wlc_size -> IO ())
foreign import ccall "wrapper" mk'output_resolution_cb
  :: (C'wlc_handle -> Ptr C'wlc_size -> Ptr C'wlc_size -> IO ()) -> IO C'output_resolution_cb
foreign import ccall "dynamic" mK'output_resolution_cb
  :: C'output_resolution_cb -> (C'wlc_handle -> Ptr C'wlc_size -> Ptr C'wlc_size -> IO ())

{-# LINE 132 "src/Bindings/WLC/Core.hsc" #-}
type C'output_render_pre_cb = FunPtr (C'wlc_handle -> IO ())
foreign import ccall "wrapper" mk'output_render_pre_cb
  :: (C'wlc_handle -> IO ()) -> IO C'output_render_pre_cb
foreign import ccall "dynamic" mK'output_render_pre_cb
  :: C'output_render_pre_cb -> (C'wlc_handle -> IO ())

{-# LINE 133 "src/Bindings/WLC/Core.hsc" #-}
type C'output_render_post_cb = FunPtr (C'wlc_handle -> IO ())
foreign import ccall "wrapper" mk'output_render_post_cb
  :: (C'wlc_handle -> IO ()) -> IO C'output_render_post_cb
foreign import ccall "dynamic" mK'output_render_post_cb
  :: C'output_render_post_cb -> (C'wlc_handle -> IO ())

{-# LINE 134 "src/Bindings/WLC/Core.hsc" #-}
-- *** View
type C'view_created_cb = FunPtr (C'wlc_handle -> IO Bool)
foreign import ccall "wrapper" mk'view_created_cb
  :: (C'wlc_handle -> IO Bool) -> IO C'view_created_cb
foreign import ccall "dynamic" mK'view_created_cb
  :: C'view_created_cb -> (C'wlc_handle -> IO Bool)

{-# LINE 136 "src/Bindings/WLC/Core.hsc" #-}
type C'view_destroyed_cb = FunPtr (C'wlc_handle -> IO ())
foreign import ccall "wrapper" mk'view_destroyed_cb
  :: (C'wlc_handle -> IO ()) -> IO C'view_destroyed_cb
foreign import ccall "dynamic" mK'view_destroyed_cb
  :: C'view_destroyed_cb -> (C'wlc_handle -> IO ())

{-# LINE 137 "src/Bindings/WLC/Core.hsc" #-}
type C'view_focus_cb = FunPtr (C'wlc_handle -> Bool -> IO ())
foreign import ccall "wrapper" mk'view_focus_cb
  :: (C'wlc_handle -> Bool -> IO ()) -> IO C'view_focus_cb
foreign import ccall "dynamic" mK'view_focus_cb
  :: C'view_focus_cb -> (C'wlc_handle -> Bool -> IO ())

{-# LINE 138 "src/Bindings/WLC/Core.hsc" #-}
type C'view_move_to_output_cb = FunPtr (C'wlc_handle -> C'wlc_handle -> C'wlc_handle -> IO ())
foreign import ccall "wrapper" mk'view_move_to_output_cb
  :: (C'wlc_handle -> C'wlc_handle -> C'wlc_handle -> IO ()) -> IO C'view_move_to_output_cb
foreign import ccall "dynamic" mK'view_move_to_output_cb
  :: C'view_move_to_output_cb -> (C'wlc_handle -> C'wlc_handle -> C'wlc_handle -> IO ())

{-# LINE 139 "src/Bindings/WLC/Core.hsc" #-}
type C'view_request_geometry_cb = FunPtr (C'wlc_handle -> Ptr C'wlc_geometry -> IO ())
foreign import ccall "wrapper" mk'view_request_geometry_cb
  :: (C'wlc_handle -> Ptr C'wlc_geometry -> IO ()) -> IO C'view_request_geometry_cb
foreign import ccall "dynamic" mK'view_request_geometry_cb
  :: C'view_request_geometry_cb -> (C'wlc_handle -> Ptr C'wlc_geometry -> IO ())

{-# LINE 140 "src/Bindings/WLC/Core.hsc" #-}
type C'view_request_state_cb = FunPtr (C'wlc_handle -> C'wlc_view_state_bit -> Bool -> IO ())
foreign import ccall "wrapper" mk'view_request_state_cb
  :: (C'wlc_handle -> C'wlc_view_state_bit -> Bool -> IO ()) -> IO C'view_request_state_cb
foreign import ccall "dynamic" mK'view_request_state_cb
  :: C'view_request_state_cb -> (C'wlc_handle -> C'wlc_view_state_bit -> Bool -> IO ())

{-# LINE 141 "src/Bindings/WLC/Core.hsc" #-}
type C'view_request_move_cb = FunPtr (C'wlc_handle -> Ptr C'wlc_point -> IO ())
foreign import ccall "wrapper" mk'view_request_move_cb
  :: (C'wlc_handle -> Ptr C'wlc_point -> IO ()) -> IO C'view_request_move_cb
foreign import ccall "dynamic" mK'view_request_move_cb
  :: C'view_request_move_cb -> (C'wlc_handle -> Ptr C'wlc_point -> IO ())

{-# LINE 142 "src/Bindings/WLC/Core.hsc" #-}
type C'view_request_resize_cb = FunPtr (C'wlc_handle -> CUInt -> Ptr C'wlc_point -> IO ())
foreign import ccall "wrapper" mk'view_request_resize_cb
  :: (C'wlc_handle -> CUInt -> Ptr C'wlc_point -> IO ()) -> IO C'view_request_resize_cb
foreign import ccall "dynamic" mK'view_request_resize_cb
  :: C'view_request_resize_cb -> (C'wlc_handle -> CUInt -> Ptr C'wlc_point -> IO ())

{-# LINE 143 "src/Bindings/WLC/Core.hsc" #-}
type C'view_render_pre_cb = FunPtr (C'wlc_handle -> IO ())
foreign import ccall "wrapper" mk'view_render_pre_cb
  :: (C'wlc_handle -> IO ()) -> IO C'view_render_pre_cb
foreign import ccall "dynamic" mK'view_render_pre_cb
  :: C'view_render_pre_cb -> (C'wlc_handle -> IO ())

{-# LINE 144 "src/Bindings/WLC/Core.hsc" #-}
type C'view_render_post_cb = FunPtr (C'wlc_handle -> IO ())
foreign import ccall "wrapper" mk'view_render_post_cb
  :: (C'wlc_handle -> IO ()) -> IO C'view_render_post_cb
foreign import ccall "dynamic" mK'view_render_post_cb
  :: C'view_render_post_cb -> (C'wlc_handle -> IO ())

{-# LINE 145 "src/Bindings/WLC/Core.hsc" #-}
-- *** Input
type C'keyboard_key_cb = FunPtr (C'wlc_handle -> CUInt -> Ptr C'wlc_modifiers -> CUInt -> C'wlc_key_state -> IO Bool)
foreign import ccall "wrapper" mk'keyboard_key_cb
  :: (C'wlc_handle -> CUInt -> Ptr C'wlc_modifiers -> CUInt -> C'wlc_key_state -> IO Bool) -> IO C'keyboard_key_cb
foreign import ccall "dynamic" mK'keyboard_key_cb
  :: C'keyboard_key_cb -> (C'wlc_handle -> CUInt -> Ptr C'wlc_modifiers -> CUInt -> C'wlc_key_state -> IO Bool)

{-# LINE 147 "src/Bindings/WLC/Core.hsc" #-}
type C'pointer_button_cb = FunPtr (C'wlc_handle -> CUInt -> Ptr C'wlc_modifiers -> CUInt -> C'wlc_button_state -> Ptr C'wlc_point -> IO Bool)
foreign import ccall "wrapper" mk'pointer_button_cb
  :: (C'wlc_handle -> CUInt -> Ptr C'wlc_modifiers -> CUInt -> C'wlc_button_state -> Ptr C'wlc_point -> IO Bool) -> IO C'pointer_button_cb
foreign import ccall "dynamic" mK'pointer_button_cb
  :: C'pointer_button_cb -> (C'wlc_handle -> CUInt -> Ptr C'wlc_modifiers -> CUInt -> C'wlc_button_state -> Ptr C'wlc_point -> IO Bool)

{-# LINE 148 "src/Bindings/WLC/Core.hsc" #-}
type C'pointer_scroll_cb = FunPtr (C'wlc_handle -> CUInt -> Ptr C'wlc_modifiers -> C'wlc_scroll_axis_bit -> Double -> IO Bool)
foreign import ccall "wrapper" mk'pointer_scroll_cb
  :: (C'wlc_handle -> CUInt -> Ptr C'wlc_modifiers -> C'wlc_scroll_axis_bit -> Double -> IO Bool) -> IO C'pointer_scroll_cb
foreign import ccall "dynamic" mK'pointer_scroll_cb
  :: C'pointer_scroll_cb -> (C'wlc_handle -> CUInt -> Ptr C'wlc_modifiers -> C'wlc_scroll_axis_bit -> Double -> IO Bool)

{-# LINE 149 "src/Bindings/WLC/Core.hsc" #-}
type C'pointer_motion_cb = FunPtr (C'wlc_handle -> CUInt -> Ptr C'wlc_point -> IO Bool)
foreign import ccall "wrapper" mk'pointer_motion_cb
  :: (C'wlc_handle -> CUInt -> Ptr C'wlc_point -> IO Bool) -> IO C'pointer_motion_cb
foreign import ccall "dynamic" mK'pointer_motion_cb
  :: C'pointer_motion_cb -> (C'wlc_handle -> CUInt -> Ptr C'wlc_point -> IO Bool)

{-# LINE 150 "src/Bindings/WLC/Core.hsc" #-}
type C'touch_cb = FunPtr (C'wlc_handle -> CUInt -> Ptr C'wlc_modifiers -> C'wlc_touch_type -> CInt -> Ptr C'wlc_point -> IO Bool)
foreign import ccall "wrapper" mk'touch_cb
  :: (C'wlc_handle -> CUInt -> Ptr C'wlc_modifiers -> C'wlc_touch_type -> CInt -> Ptr C'wlc_point -> IO Bool) -> IO C'touch_cb
foreign import ccall "dynamic" mK'touch_cb
  :: C'touch_cb -> (C'wlc_handle -> CUInt -> Ptr C'wlc_modifiers -> C'wlc_touch_type -> CInt -> Ptr C'wlc_point -> IO Bool)

{-# LINE 151 "src/Bindings/WLC/Core.hsc" #-}
-- *** Other
type C'compositor_ready_cb = FunPtr (IO ())
foreign import ccall "wrapper" mk'compositor_ready_cb
  :: (IO ()) -> IO C'compositor_ready_cb
foreign import ccall "dynamic" mK'compositor_ready_cb
  :: C'compositor_ready_cb -> (IO ())

{-# LINE 153 "src/Bindings/WLC/Core.hsc" #-}
type C'compositor_terminate_cb = FunPtr (IO ())
foreign import ccall "wrapper" mk'compositor_terminate_cb
  :: (IO ()) -> IO C'compositor_terminate_cb
foreign import ccall "dynamic" mK'compositor_terminate_cb
  :: C'compositor_terminate_cb -> (IO ())

{-# LINE 154 "src/Bindings/WLC/Core.hsc" #-}

-- ** Functions
-- *** Output
-- |Output was created. Return false if you want to destroy the output. (e.g. failed to allocate data related to view)
foreign import ccall "wlc_set_output_created_cb" c'wlc_set_output_created_cb
  :: C'output_created_cb -> IO ()
foreign import ccall "&wlc_set_output_created_cb" p'wlc_set_output_created_cb
  :: FunPtr (C'output_created_cb -> IO ())

{-# LINE 159 "src/Bindings/WLC/Core.hsc" #-}
-- |Output was destroyed.
foreign import ccall "wlc_set_output_destroyed_cb" c'wlc_set_output_destroyed_cb
  :: C'output_destroyed_cb -> IO ()
foreign import ccall "&wlc_set_output_destroyed_cb" p'wlc_set_output_destroyed_cb
  :: FunPtr (C'output_destroyed_cb -> IO ())

{-# LINE 161 "src/Bindings/WLC/Core.hsc" #-}
-- |Output got or lost focus.
foreign import ccall "wlc_set_output_focus_cb" c'wlc_set_output_focus_cb
  :: C'output_focus_cb -> IO ()
foreign import ccall "&wlc_set_output_focus_cb" p'wlc_set_output_focus_cb
  :: FunPtr (C'output_focus_cb -> IO ())

{-# LINE 163 "src/Bindings/WLC/Core.hsc" #-}
-- |Output resolution changed.
foreign import ccall "wlc_set_output_resolution_cb" c'wlc_set_output_resolution_cb
  :: C'output_resolution_cb -> IO ()
foreign import ccall "&wlc_set_output_resolution_cb" p'wlc_set_output_resolution_cb
  :: FunPtr (C'output_resolution_cb -> IO ())

{-# LINE 165 "src/Bindings/WLC/Core.hsc" #-}
-- |Output pre render hook.
foreign import ccall "wlc_set_output_render_pre_cb" c'wlc_set_output_render_pre_cb
  :: C'output_render_pre_cb -> IO ()
foreign import ccall "&wlc_set_output_render_pre_cb" p'wlc_set_output_render_pre_cb
  :: FunPtr (C'output_render_pre_cb -> IO ())

{-# LINE 167 "src/Bindings/WLC/Core.hsc" #-}
-- |Output post render hook.
foreign import ccall "wlc_set_output_render_post_cb" c'wlc_set_output_render_post_cb
  :: C'output_render_post_cb -> IO ()
foreign import ccall "&wlc_set_output_render_post_cb" p'wlc_set_output_render_post_cb
  :: FunPtr (C'output_render_post_cb -> IO ())

{-# LINE 169 "src/Bindings/WLC/Core.hsc" #-}
-- *** View
-- |View was created. Return false if you want to destroy the view. (e.g. failed to allocate data related to view)
foreign import ccall "wlc_set_view_created_cb" c'wlc_set_view_created_cb
  :: C'view_created_cb -> IO ()
foreign import ccall "&wlc_set_view_created_cb" p'wlc_set_view_created_cb
  :: FunPtr (C'view_created_cb -> IO ())

{-# LINE 172 "src/Bindings/WLC/Core.hsc" #-}
-- |View was destroyed.
foreign import ccall "wlc_set_view_destroyed_cb" c'wlc_set_view_destroyed_cb
  :: C'view_destroyed_cb -> IO ()
foreign import ccall "&wlc_set_view_destroyed_cb" p'wlc_set_view_destroyed_cb
  :: FunPtr (C'view_destroyed_cb -> IO ())

{-# LINE 174 "src/Bindings/WLC/Core.hsc" #-}
-- |View got or lost focus.
foreign import ccall "wlc_set_view_focus_cb" c'wlc_set_view_focus_cb
  :: C'view_focus_cb -> IO ()
foreign import ccall "&wlc_set_view_focus_cb" p'wlc_set_view_focus_cb
  :: FunPtr (C'view_focus_cb -> IO ())

{-# LINE 176 "src/Bindings/WLC/Core.hsc" #-}
-- |View was moved to output.
foreign import ccall "wlc_set_view_move_to_output_cb" c'wlc_set_view_move_to_output_cb
  :: C'view_move_to_output_cb -> IO ()
foreign import ccall "&wlc_set_view_move_to_output_cb" p'wlc_set_view_move_to_output_cb
  :: FunPtr (C'view_move_to_output_cb -> IO ())

{-# LINE 178 "src/Bindings/WLC/Core.hsc" #-}
-- |Request to set given geometry for view. Apply using wlc_view_set_geometry to agree.
foreign import ccall "wlc_set_view_request_geometry_cb" c'wlc_set_view_request_geometry_cb
  :: C'view_request_geometry_cb -> IO ()
foreign import ccall "&wlc_set_view_request_geometry_cb" p'wlc_set_view_request_geometry_cb
  :: FunPtr (C'view_request_geometry_cb -> IO ())

{-# LINE 180 "src/Bindings/WLC/Core.hsc" #-}
-- |Request to disable or enable the given state for view. Apply using wlc_view_set_state to agree.
foreign import ccall "wlc_set_view_request_state_cb" c'wlc_set_view_request_state_cb
  :: C'view_request_state_cb -> IO ()
foreign import ccall "&wlc_set_view_request_state_cb" p'wlc_set_view_request_state_cb
  :: FunPtr (C'view_request_state_cb -> IO ())

{-# LINE 182 "src/Bindings/WLC/Core.hsc" #-}
-- |Request to move itself. Start a interactive move to agree.
foreign import ccall "wlc_set_view_request_move_cb" c'wlc_set_view_request_move_cb
  :: C'view_request_move_cb -> IO ()
foreign import ccall "&wlc_set_view_request_move_cb" p'wlc_set_view_request_move_cb
  :: FunPtr (C'view_request_move_cb -> IO ())

{-# LINE 184 "src/Bindings/WLC/Core.hsc" #-}
-- |Request to resize itself with the given edges. Start a interactive resize to agree.
foreign import ccall "wlc_set_view_request_resize_cb" c'wlc_set_view_request_resize_cb
  :: C'view_request_resize_cb -> IO ()
foreign import ccall "&wlc_set_view_request_resize_cb" p'wlc_set_view_request_resize_cb
  :: FunPtr (C'view_request_resize_cb -> IO ())

{-# LINE 186 "src/Bindings/WLC/Core.hsc" #-}
-- |View pre render hook.
foreign import ccall "wlc_set_view_render_pre_cb" c'wlc_set_view_render_pre_cb
  :: C'view_render_pre_cb -> IO ()
foreign import ccall "&wlc_set_view_render_pre_cb" p'wlc_set_view_render_pre_cb
  :: FunPtr (C'view_render_pre_cb -> IO ())

{-# LINE 188 "src/Bindings/WLC/Core.hsc" #-}
-- |View post render hook.
foreign import ccall "wlc_set_view_render_post_cb" c'wlc_set_view_render_post_cb
  :: C'view_render_post_cb -> IO ()
foreign import ccall "&wlc_set_view_render_post_cb" p'wlc_set_view_render_post_cb
  :: FunPtr (C'view_render_post_cb -> IO ())

{-# LINE 190 "src/Bindings/WLC/Core.hsc" #-}
-- *** Input
-- |Key event was triggered, view handle will be zero if there was no focus. Return true to prevent sending the
-- event to clients.
foreign import ccall "wlc_set_keyboard_key_cb" c'wlc_set_keyboard_key_cb
  :: C'keyboard_key_cb -> IO ()
foreign import ccall "&wlc_set_keyboard_key_cb" p'wlc_set_keyboard_key_cb
  :: FunPtr (C'keyboard_key_cb -> IO ())

{-# LINE 194 "src/Bindings/WLC/Core.hsc" #-}
-- |Button event was triggered, view handle will be zero if there was no focus. Return true to prevent sending the
-- event to clients.
foreign import ccall "wlc_set_pointer_button_cb" c'wlc_set_pointer_button_cb
  :: C'pointer_button_cb -> IO ()
foreign import ccall "&wlc_set_pointer_button_cb" p'wlc_set_pointer_button_cb
  :: FunPtr (C'pointer_button_cb -> IO ())

{-# LINE 197 "src/Bindings/WLC/Core.hsc" #-}
-- |Scroll event was triggered, view handle will be zero if there was no focus. Return true to prevent sending the
-- event to clients.
foreign import ccall "wlc_set_pointer_scroll_cb" c'wlc_set_pointer_scroll_cb
  :: C'pointer_scroll_cb -> IO ()
foreign import ccall "&wlc_set_pointer_scroll_cb" p'wlc_set_pointer_scroll_cb
  :: FunPtr (C'pointer_scroll_cb -> IO ())

{-# LINE 200 "src/Bindings/WLC/Core.hsc" #-}
-- |Motion event was triggered, view handle will be zero if there was no focus. Apply with wlc_pointer_set_position to
-- agree. Return true to prevent sending the event to clients.
foreign import ccall "wlc_set_pointer_motion_cb" c'wlc_set_pointer_motion_cb
  :: C'pointer_motion_cb -> IO ()
foreign import ccall "&wlc_set_pointer_motion_cb" p'wlc_set_pointer_motion_cb
  :: FunPtr (C'pointer_motion_cb -> IO ())

{-# LINE 203 "src/Bindings/WLC/Core.hsc" #-}
-- |Touch event was triggered, view handle will be zero if there was no focus. Return true to prevent sending the
-- event to clients.
foreign import ccall "wlc_set_touch_cb" c'wlc_set_touch_cb
  :: C'touch_cb -> IO ()
foreign import ccall "&wlc_set_touch_cb" p'wlc_set_touch_cb
  :: FunPtr (C'touch_cb -> IO ())

{-# LINE 206 "src/Bindings/WLC/Core.hsc" #-}
-- *** Other
-- |Compositor is ready to accept clients.
foreign import ccall "wlc_set_compositor_ready_cb" c'wlc_set_compositor_ready_cb
  :: C'compositor_ready_cb -> IO ()
foreign import ccall "&wlc_set_compositor_ready_cb" p'wlc_set_compositor_ready_cb
  :: FunPtr (C'compositor_ready_cb -> IO ())

{-# LINE 209 "src/Bindings/WLC/Core.hsc" #-}
-- |Compositor is about to terminate
foreign import ccall "wlc_set_compositor_terminate_cb" c'wlc_set_compositor_terminate_cb
  :: C'compositor_terminate_cb -> IO ()
foreign import ccall "&wlc_set_compositor_terminate_cb" p'wlc_set_compositor_terminate_cb
  :: FunPtr (C'compositor_terminate_cb -> IO ())

{-# LINE 211 "src/Bindings/WLC/Core.hsc" #-}

-- * Core API

-- |Creates a log handler callback
type C'log_handler_cb = FunPtr (C'wlc_log_type -> CString -> IO ())
foreign import ccall "wrapper" mk'log_handler_cb
  :: (C'wlc_log_type -> CString -> IO ()) -> IO C'log_handler_cb
foreign import ccall "dynamic" mK'log_handler_cb
  :: C'log_handler_cb -> (C'wlc_log_type -> CString -> IO ())

{-# LINE 216 "src/Bindings/WLC/Core.hsc" #-}

-- |Set log handler. Can be set before wlc_init.
foreign import ccall "wlc_log_set_handler" c'wlc_log_set_handler
  :: C'log_handler_cb -> IO ()
foreign import ccall "&wlc_log_set_handler" p'wlc_log_set_handler
  :: FunPtr (C'log_handler_cb -> IO ())

{-# LINE 219 "src/Bindings/WLC/Core.hsc" #-}

-- |Initialize wlc. Returns false on failure.
--
-- Avoid running unverified code before wlc_init as wlc compositor may be run with higher
-- privileges on non logind systems where compositor binary needs to be suid.
--
-- wlc_init's purpose is to initialize and drop privileges as soon as possible.
--
-- Callbacks should be set using wlc_set_*_cb functions before calling wlc_init2,
-- failing to do so will cause any callback the init may trigger to not be called.
foreign import ccall "wlc_init2" c'wlc_init2
  :: IO Bool
foreign import ccall "&wlc_init2" p'wlc_init2
  :: FunPtr (IO Bool)

{-# LINE 230 "src/Bindings/WLC/Core.hsc" #-}
-- |Terminate wlc.
foreign import ccall "wlc_terminate" c'wlc_terminate
  :: IO ()
foreign import ccall "&wlc_terminate" p'wlc_terminate
  :: FunPtr (IO ())

{-# LINE 232 "src/Bindings/WLC/Core.hsc" #-}
-- |Query backend wlc is using.
foreign import ccall "wlc_get_backend_type" c'wlc_get_backend_type
  :: IO C'wlc_backend_type
foreign import ccall "&wlc_get_backend_type" p'wlc_get_backend_type
  :: FunPtr (IO C'wlc_backend_type)

{-# LINE 234 "src/Bindings/WLC/Core.hsc" #-}
-- |Exec program.
foreign import ccall "wlc_exec" c'wlc_exec
  :: CString -> Ptr CString -> IO ()
foreign import ccall "&wlc_exec" p'wlc_exec
  :: FunPtr (CString -> Ptr CString -> IO ())

{-# LINE 236 "src/Bindings/WLC/Core.hsc" #-}
-- |Run event loop.
foreign import ccall "wlc_run" c'wlc_run
  :: IO ()
foreign import ccall "&wlc_run" p'wlc_run
  :: FunPtr (IO ())

{-# LINE 238 "src/Bindings/WLC/Core.hsc" #-}
-- |Link custom data to handle.
foreign import ccall "wlc_handle_set_user_data" c'wlc_handle_set_user_data
  :: C'wlc_handle -> Ptr () -> IO ()
foreign import ccall "&wlc_handle_set_user_data" p'wlc_handle_set_user_data
  :: FunPtr (C'wlc_handle -> Ptr () -> IO ())

{-# LINE 240 "src/Bindings/WLC/Core.hsc" #-}
-- |Get linked custom data from handle.
foreign import ccall "wlc_handle_get_user_data" c'wlc_handle_get_user_data
  :: C'wlc_handle -> IO (Ptr ())
foreign import ccall "&wlc_handle_get_user_data" p'wlc_handle_get_user_data
  :: FunPtr (C'wlc_handle -> IO (Ptr ()))

{-# LINE 242 "src/Bindings/WLC/Core.hsc" #-}

-- * Output API

-- |Get outputs. Returned array is a direct reference, careful when moving and destroying handles.
foreign import ccall "wlc_get_outputs" c'wlc_get_outputs
  :: Ptr CSize -> IO (Ptr C'wlc_handle)
foreign import ccall "&wlc_get_outputs" p'wlc_get_outputs
  :: FunPtr (Ptr CSize -> IO (Ptr C'wlc_handle))

{-# LINE 247 "src/Bindings/WLC/Core.hsc" #-}
-- |Get focused output.
foreign import ccall "wlc_get_focused_output" c'wlc_get_focused_output
  :: IO C'wlc_handle
foreign import ccall "&wlc_get_focused_output" p'wlc_get_focused_output
  :: FunPtr (IO C'wlc_handle)

{-# LINE 249 "src/Bindings/WLC/Core.hsc" #-}
-- |Get output name.
foreign import ccall "wlc_output_get_name" c'wlc_output_get_name
  :: C'wlc_handle -> IO CString
foreign import ccall "&wlc_output_get_name" p'wlc_output_get_name
  :: FunPtr (C'wlc_handle -> IO CString)

{-# LINE 251 "src/Bindings/WLC/Core.hsc" #-}
-- |Get sleep state.
foreign import ccall "wlc_output_get_sleep" c'wlc_output_get_sleep
  :: C'wlc_handle -> IO Bool
foreign import ccall "&wlc_output_get_sleep" p'wlc_output_get_sleep
  :: FunPtr (C'wlc_handle -> IO Bool)

{-# LINE 253 "src/Bindings/WLC/Core.hsc" #-}
-- |Wake up / sleep.
foreign import ccall "wlc_output_set_sleep" c'wlc_output_set_sleep
  :: C'wlc_handle -> Bool -> IO ()
foreign import ccall "&wlc_output_set_sleep" p'wlc_output_set_sleep
  :: FunPtr (C'wlc_handle -> Bool -> IO ())

{-# LINE 255 "src/Bindings/WLC/Core.hsc" #-}
-- |Get resolution.
foreign import ccall "wlc_output_get_resolution" c'wlc_output_get_resolution
  :: C'wlc_handle -> IO (Ptr C'wlc_size)
foreign import ccall "&wlc_output_get_resolution" p'wlc_output_get_resolution
  :: FunPtr (C'wlc_handle -> IO (Ptr C'wlc_size))

{-# LINE 257 "src/Bindings/WLC/Core.hsc" #-}
-- |Set resolution.
foreign import ccall "wlc_output_set_resolution" c'wlc_output_set_resolution
  :: C'wlc_handle -> Ptr C'wlc_size -> IO ()
foreign import ccall "&wlc_output_set_resolution" p'wlc_output_set_resolution
  :: FunPtr (C'wlc_handle -> Ptr C'wlc_size -> IO ())

{-# LINE 259 "src/Bindings/WLC/Core.hsc" #-}
-- |Get current visibility bitmask.
foreign import ccall "wlc_output_get_mask" c'wlc_output_get_mask
  :: C'wlc_handle -> IO CUInt
foreign import ccall "&wlc_output_get_mask" p'wlc_output_get_mask
  :: FunPtr (C'wlc_handle -> IO CUInt)

{-# LINE 261 "src/Bindings/WLC/Core.hsc" #-}
-- |Set visibility bitmask.
foreign import ccall "wlc_output_set_mask" c'wlc_output_set_mask
  :: C'wlc_handle -> CUInt -> IO ()
foreign import ccall "&wlc_output_set_mask" p'wlc_output_set_mask
  :: FunPtr (C'wlc_handle -> CUInt -> IO ())

{-# LINE 263 "src/Bindings/WLC/Core.hsc" #-}
-- |Get views in stack order. Returned array is a direct reference, careful when moving and destroying handles.
foreign import ccall "wlc_output_get_views" c'wlc_output_get_views
  :: C'wlc_handle -> Ptr CSize -> IO (Ptr wlc_handle)
foreign import ccall "&wlc_output_get_views" p'wlc_output_get_views
  :: FunPtr (C'wlc_handle -> Ptr CSize -> IO (Ptr wlc_handle))

{-# LINE 265 "src/Bindings/WLC/Core.hsc" #-}
-- |Set views in stack order. This will also change mutable views. Returns false on failure.
foreign import ccall "wlc_output_set_views" c'wlc_output_set_views
  :: C'wlc_handle -> Ptr C'wlc_handle -> CSize -> IO Bool
foreign import ccall "&wlc_output_set_views" p'wlc_output_set_views
  :: FunPtr (C'wlc_handle -> Ptr C'wlc_handle -> CSize -> IO Bool)

{-# LINE 267 "src/Bindings/WLC/Core.hsc" #-}

-- |Focus output. Pass zero for no focus.
foreign import ccall "wlc_output_focus" c'wlc_output_focus
  :: C'wlc_handle -> IO ()
foreign import ccall "&wlc_output_focus" p'wlc_output_focus
  :: FunPtr (C'wlc_handle -> IO ())

{-# LINE 270 "src/Bindings/WLC/Core.hsc" #-}

-- * View API
-- |Focus view. Pass zero for no focus.
foreign import ccall "wlc_view_focus" c'wlc_view_focus
  :: C'wlc_handle -> IO ()
foreign import ccall "&wlc_view_focus" p'wlc_view_focus
  :: FunPtr (C'wlc_handle -> IO ())

{-# LINE 274 "src/Bindings/WLC/Core.hsc" #-}
-- |Close view.
foreign import ccall "wlc_view_close" c'wlc_view_close
  :: C'wlc_handle -> IO ()
foreign import ccall "&wlc_view_close" p'wlc_view_close
  :: FunPtr (C'wlc_handle -> IO ())

{-# LINE 276 "src/Bindings/WLC/Core.hsc" #-}
-- |Get current output.
foreign import ccall "wlc_view_get_output" c'wlc_view_get_output
  :: C'wlc_handle -> IO C'wlc_handle
foreign import ccall "&wlc_view_get_output" p'wlc_view_get_output
  :: FunPtr (C'wlc_handle -> IO C'wlc_handle)

{-# LINE 278 "src/Bindings/WLC/Core.hsc" #-}
-- |Set output. Alternatively you can wlc_output_set_views.
foreign import ccall "wlc_view_set_output" c'wlc_view_set_output
  :: C'wlc_handle -> C'wlc_handle -> IO ()
foreign import ccall "&wlc_view_set_output" p'wlc_view_set_output
  :: FunPtr (C'wlc_handle -> C'wlc_handle -> IO ())

{-# LINE 280 "src/Bindings/WLC/Core.hsc" #-}
-- |Send behind everything.
foreign import ccall "wlc_view_send_to_back" c'wlc_view_send_to_back
  :: C'wlc_handle -> IO ()
foreign import ccall "&wlc_view_send_to_back" p'wlc_view_send_to_back
  :: FunPtr (C'wlc_handle -> IO ())

{-# LINE 282 "src/Bindings/WLC/Core.hsc" #-}
-- |Send below another view.
foreign import ccall "wlc_view_send_below" c'wlc_view_send_below
  :: C'wlc_handle -> C'wlc_handle -> IO ()
foreign import ccall "&wlc_view_send_below" p'wlc_view_send_below
  :: FunPtr (C'wlc_handle -> C'wlc_handle -> IO ())

{-# LINE 284 "src/Bindings/WLC/Core.hsc" #-}
-- |Send above another view.
foreign import ccall "wlc_view_bring_above" c'wlc_view_bring_above
  :: C'wlc_handle -> C'wlc_handle -> IO ()
foreign import ccall "&wlc_view_bring_above" p'wlc_view_bring_above
  :: FunPtr (C'wlc_handle -> C'wlc_handle -> IO ())

{-# LINE 286 "src/Bindings/WLC/Core.hsc" #-}
-- |Bring to front of everything.
foreign import ccall "wlc_view_bring_to_front" c'wlc_view_bring_to_front
  :: C'wlc_handle -> IO ()
foreign import ccall "&wlc_view_bring_to_front" p'wlc_view_bring_to_front
  :: FunPtr (C'wlc_handle -> IO ())

{-# LINE 288 "src/Bindings/WLC/Core.hsc" #-}
-- |Get current visibility bitmask.
foreign import ccall "wlc_view_get_mask" c'wlc_view_get_mask
  :: C'wlc_handle -> IO CUInt
foreign import ccall "&wlc_view_get_mask" p'wlc_view_get_mask
  :: FunPtr (C'wlc_handle -> IO CUInt)

{-# LINE 290 "src/Bindings/WLC/Core.hsc" #-}
-- |Set visibility bitmask.
foreign import ccall "wlc_view_set_mask" c'wlc_view_set_mask
  :: C'wlc_handle -> CUInt -> IO ()
foreign import ccall "&wlc_view_set_mask" p'wlc_view_set_mask
  :: FunPtr (C'wlc_handle -> CUInt -> IO ())

{-# LINE 292 "src/Bindings/WLC/Core.hsc" #-}
-- |Get current geometry. (what client sees)
foreign import ccall "wlc_view_get_geometry" c'wlc_view_get_geometry
  :: C'wlc_handle -> IO (Ptr C'wlc_geometry)
foreign import ccall "&wlc_view_get_geometry" p'wlc_view_get_geometry
  :: FunPtr (C'wlc_handle -> IO (Ptr C'wlc_geometry))

{-# LINE 294 "src/Bindings/WLC/Core.hsc" #-}
-- |Get visible geometry. (what wlc displays)
foreign import ccall "wlc_view_get_visible_geometry" c'wlc_view_get_visible_geometry
  :: C'wlc_handle -> Ptr C'wlc_geometry -> IO ()
foreign import ccall "&wlc_view_get_visible_geometry" p'wlc_view_get_visible_geometry
  :: FunPtr (C'wlc_handle -> Ptr C'wlc_geometry -> IO ())

{-# LINE 296 "src/Bindings/WLC/Core.hsc" #-}
-- |Set geometry. Set edges if the geometry change is caused by interactive resize.
foreign import ccall "wlc_view_set_geometry" c'wlc_view_set_geometry
  :: C'wlc_handle -> CUInt -> Ptr C'wlc_geometry -> IO ()
foreign import ccall "&wlc_view_set_geometry" p'wlc_view_set_geometry
  :: FunPtr (C'wlc_handle -> CUInt -> Ptr C'wlc_geometry -> IO ())

{-# LINE 298 "src/Bindings/WLC/Core.hsc" #-}
-- |Get type bitfield.
foreign import ccall "wlc_view_get_type" c'wlc_view_get_type
  :: C'wlc_handle -> IO CUInt
foreign import ccall "&wlc_view_get_type" p'wlc_view_get_type
  :: FunPtr (C'wlc_handle -> IO CUInt)

{-# LINE 300 "src/Bindings/WLC/Core.hsc" #-}
-- |Set type bit. Toggle indicates whether it is set or not.
foreign import ccall "wlc_view_set_type" c'wlc_view_set_type
  :: C'wlc_handle -> C'wlc_view_type_bit -> Bool -> IO ()
foreign import ccall "&wlc_view_set_type" p'wlc_view_set_type
  :: FunPtr (C'wlc_handle -> C'wlc_view_type_bit -> Bool -> IO ())

{-# LINE 302 "src/Bindings/WLC/Core.hsc" #-}
-- |Get current state bitfield.
foreign import ccall "wlc_view_get_state" c'wlc_view_get_state
  :: C'wlc_handle -> IO CUInt
foreign import ccall "&wlc_view_get_state" p'wlc_view_get_state
  :: FunPtr (C'wlc_handle -> IO CUInt)

{-# LINE 304 "src/Bindings/WLC/Core.hsc" #-}
-- |Set state bit. Toggle indicates whether it is set or not.
foreign import ccall "wlc_view_set_state" c'wlc_view_set_state
  :: C'wlc_handle -> C'wlc_view_state_bit -> Bool -> IO ()
foreign import ccall "&wlc_view_set_state" p'wlc_view_set_state
  :: FunPtr (C'wlc_handle -> C'wlc_view_state_bit -> Bool -> IO ())

{-# LINE 306 "src/Bindings/WLC/Core.hsc" #-}
-- |Get parent view.
foreign import ccall "wlc_view_get_parent" c'wlc_view_get_parent
  :: C'wlc_handle -> IO C'wlc_handle
foreign import ccall "&wlc_view_get_parent" p'wlc_view_get_parent
  :: FunPtr (C'wlc_handle -> IO C'wlc_handle)

{-# LINE 308 "src/Bindings/WLC/Core.hsc" #-}
-- |Set parent view.
foreign import ccall "wlc_view_set_parent" c'wlc_view_set_parent
  :: C'wlc_handle -> C'wlc_handle -> IO ()
foreign import ccall "&wlc_view_set_parent" p'wlc_view_set_parent
  :: FunPtr (C'wlc_handle -> C'wlc_handle -> IO ())

{-# LINE 310 "src/Bindings/WLC/Core.hsc" #-}
-- |Get title.
foreign import ccall "wlc_view_get_title" c'wlc_view_get_title
  :: C'wlc_handle -> IO CString
foreign import ccall "&wlc_view_get_title" p'wlc_view_get_title
  :: FunPtr (C'wlc_handle -> IO CString)

{-# LINE 312 "src/Bindings/WLC/Core.hsc" #-}
-- |Get class. (shell-surface only)
foreign import ccall "wlc_view_get_class" c'wlc_view_get_class
  :: C'wlc_handle -> IO CString
foreign import ccall "&wlc_view_get_class" p'wlc_view_get_class
  :: FunPtr (C'wlc_handle -> IO CString)

{-# LINE 314 "src/Bindings/WLC/Core.hsc" #-}
-- |Get app id. (xdg-surface only)
foreign import ccall "wlc_view_get_app_id" c'wlc_view_get_app_id
  :: C'wlc_handle -> IO CString
foreign import ccall "&wlc_view_get_app_id" p'wlc_view_get_app_id
  :: FunPtr (C'wlc_handle -> IO CString)

{-# LINE 316 "src/Bindings/WLC/Core.hsc" #-}

-- * Input API
-- |Get currently held keys.
foreign import ccall "wlc_keyboard_get_current_keys" c'wlc_keyboard_get_current_keys
  :: Ptr CSize -> IO (Ptr CUInt)
foreign import ccall "&wlc_keyboard_get_current_keys" p'wlc_keyboard_get_current_keys
  :: FunPtr (Ptr CSize -> IO (Ptr CUInt))

{-# LINE 320 "src/Bindings/WLC/Core.hsc" #-}
-- |Utility function to convert raw keycode to keysym. Passed modifiers may transform the key.
foreign import ccall "wlc_keyboard_get_keysym_for_key" c'wlc_keyboard_get_keysym_for_key
  :: CUInt -> Ptr C'wlc_modifiers -> IO CUInt
foreign import ccall "&wlc_keyboard_get_keysym_for_key" p'wlc_keyboard_get_keysym_for_key
  :: FunPtr (CUInt -> Ptr C'wlc_modifiers -> IO CUInt)

{-# LINE 322 "src/Bindings/WLC/Core.hsc" #-}
-- |Utility function to convert raw keycode to Unicode/UTF-32 codepoint. Passed modifiers may transform the key.
foreign import ccall "wlc_keyboard_get_utf32_for_key" c'wlc_keyboard_get_utf32_for_key
  :: CUInt -> Ptr C'wlc_modifiers -> IO CUInt
foreign import ccall "&wlc_keyboard_get_utf32_for_key" p'wlc_keyboard_get_utf32_for_key
  :: FunPtr (CUInt -> Ptr C'wlc_modifiers -> IO CUInt)

{-# LINE 324 "src/Bindings/WLC/Core.hsc" #-}
-- |Get current pointer position.
foreign import ccall "wlc_pointer_get_position" c'wlc_pointer_get_position
  :: Ptr C'wlc_point -> IO ()
foreign import ccall "&wlc_pointer_get_position" p'wlc_pointer_get_position
  :: FunPtr (Ptr C'wlc_point -> IO ())

{-# LINE 326 "src/Bindings/WLC/Core.hsc" #-}
-- |Set current pointer position.
foreign import ccall "wlc_pointer_set_position" c'wlc_pointer_set_position
  :: Ptr C'wlc_point -> IO ()
foreign import ccall "&wlc_pointer_set_position" p'wlc_pointer_set_position
  :: FunPtr (Ptr C'wlc_point -> IO ())

{-# LINE 328 "src/Bindings/WLC/Core.hsc" #-}