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

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

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

{-|
Module      : Bindings.WLC.WLCWayland
Description : WLC Wayland
Copyright   : (c) Ashley Towns 2016
License     : BSD3
Maintainer  : mail@ashleytowns.id.au
Stability   : experimental
Portability : POSIX
-}
module Bindings.WLC.Wayland 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 15 "src/Bindings/WLC/Wayland.hsc" #-}

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

type C'wlc_resource = CUIntPtr

{-# LINE 20 "src/Bindings/WLC/Wayland.hsc" #-}

data C'wl_resource = C'wl_resource

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

{-# LINE 23 "src/Bindings/WLC/Wayland.hsc" #-}

data C'wl_client = C'wl_client

{-# LINE 25 "src/Bindings/WLC/Wayland.hsc" #-}
data C'wl_interface = C'wl_interface

{-# LINE 26 "src/Bindings/WLC/Wayland.hsc" #-}

-- |Returns Wayland display.
foreign import ccall "wlc_get_wl_display" c'wlc_get_wl_display
  :: IO (Ptr C'wl_display)
foreign import ccall "&wlc_get_wl_display" p'wlc_get_wl_display
  :: FunPtr (IO (Ptr C'wl_display))

{-# LINE 29 "src/Bindings/WLC/Wayland.hsc" #-}
-- |Returns view handle from wl_surface resource.
foreign import ccall "wlc_handle_from_wl_surface_resource" c'wlc_handle_from_wl_surface_resource
  :: Ptr C'wl_resource -> IO C'wlc_handle
foreign import ccall "&wlc_handle_from_wl_surface_resource" p'wlc_handle_from_wl_surface_resource
  :: FunPtr (Ptr C'wl_resource -> IO C'wlc_handle)

{-# LINE 31 "src/Bindings/WLC/Wayland.hsc" #-}
-- |Returns output handle from wl_output resource.
foreign import ccall "wlc_handle_from_wl_output_resource" c'wlc_handle_from_wl_output_resource
  :: Ptr C'wl_resource -> IO C'wlc_handle
foreign import ccall "&wlc_handle_from_wl_output_resource" p'wlc_handle_from_wl_output_resource
  :: FunPtr (Ptr C'wl_resource -> IO C'wlc_handle)

{-# LINE 33 "src/Bindings/WLC/Wayland.hsc" #-}
-- |Returns internal wlc surface from wl_surface resource.
foreign import ccall "wlc_resource_from_wl_surface_resource" c'wlc_resource_from_wl_surface_resource
  :: Ptr C'wl_resource -> IO C'wlc_resource
foreign import ccall "&wlc_resource_from_wl_surface_resource" p'wlc_resource_from_wl_surface_resource
  :: FunPtr (Ptr C'wl_resource -> IO C'wlc_resource)

{-# LINE 35 "src/Bindings/WLC/Wayland.hsc" #-}
-- |Get surface size.
foreign import ccall "wlc_surface_get_size" c'wlc_surface_get_size
  :: C'wlc_resource -> IO (Ptr C'wlc_size)
foreign import ccall "&wlc_surface_get_size" p'wlc_surface_get_size
  :: FunPtr (C'wlc_resource -> IO (Ptr C'wlc_size))

{-# LINE 37 "src/Bindings/WLC/Wayland.hsc" #-}
-- |Return wl_surface resource from internal wlc surface.
foreign import ccall "wlc_surface_get_wl_resource" c'wlc_surface_get_wl_resource
  :: C'wlc_resource -> IO (Ptr C'wl_resource)
foreign import ccall "&wlc_surface_get_wl_resource" p'wlc_surface_get_wl_resource
  :: FunPtr (C'wlc_resource -> IO (Ptr C'wl_resource))

{-# LINE 39 "src/Bindings/WLC/Wayland.hsc" #-}
-- |Turns wl_surface into a wlc view. Returns 0 on failure. This will also trigger view.created callback as any view would.
-- For the extra arguments see details of wl_resource_create and wl_resource_set_implementation.
-- The extra arguments may be set NULL, if you are not implementing Wayland interface for the surface role.
foreign import ccall "wlc_view_from_surface" c'wlc_view_from_surface
  :: C'wlc_resource -> Ptr C'wl_client -> Ptr C'wl_interface -> Ptr () -> CUInt -> CUInt -> Ptr () -> IO C'wlc_handle
foreign import ccall "&wlc_view_from_surface" p'wlc_view_from_surface
  :: FunPtr (C'wlc_resource -> Ptr C'wl_client -> Ptr C'wl_interface -> Ptr () -> CUInt -> CUInt -> Ptr () -> IO C'wlc_handle)

{-# LINE 43 "src/Bindings/WLC/Wayland.hsc" #-}
-- |Returns internal wlc surface from view handle
foreign import ccall "wlc_view_get_surface" c'wlc_view_get_surface
  :: C'wlc_handle -> IO C'wlc_resource
foreign import ccall "&wlc_view_get_surface" p'wlc_view_get_surface
  :: FunPtr (C'wlc_handle -> IO C'wlc_resource)

{-# LINE 45 "src/Bindings/WLC/Wayland.hsc" #-}
-- |Returns a list of the subsurfaces of the given surface
foreign import ccall "wlc_surface_get_subsurfaces" c'wlc_surface_get_subsurfaces
  :: C'wlc_resource -> Ptr CSize -> IO (Ptr C'wlc_resource)
foreign import ccall "&wlc_surface_get_subsurfaces" p'wlc_surface_get_subsurfaces
  :: FunPtr (C'wlc_resource -> Ptr CSize -> IO (Ptr C'wlc_resource))

{-# LINE 47 "src/Bindings/WLC/Wayland.hsc" #-}
-- |Returns the size of a subsurface and its position relative to parent
foreign import ccall "wlc_get_subsurface_geometry" c'wlc_get_subsurface_geometry
  :: C'wlc_resource -> Ptr C'wlc_geometry -> IO ()
foreign import ccall "&wlc_get_subsurface_geometry" p'wlc_get_subsurface_geometry
  :: FunPtr (C'wlc_resource -> Ptr C'wlc_geometry -> IO ())

{-# LINE 49 "src/Bindings/WLC/Wayland.hsc" #-}
-- |Returns wl_client from view handle
foreign import ccall "wlc_view_get_wl_client" c'wlc_view_get_wl_client
  :: C'wlc_handle -> IO (Ptr C'wl_client)
foreign import ccall "&wlc_view_get_wl_client" p'wlc_view_get_wl_client
  :: FunPtr (C'wlc_handle -> IO (Ptr C'wl_client))

{-# LINE 51 "src/Bindings/WLC/Wayland.hsc" #-}
-- |Returns surface role resource from view handle. Return value will be NULL if the view was not assigned role
-- or created with wlc_view_create_from_surface().
foreign import ccall "wlc_view_get_role" c'wlc_view_get_role
  :: C'wlc_handle -> IO (Ptr C'wl_resource)
foreign import ccall "&wlc_view_get_role" p'wlc_view_get_role
  :: FunPtr (C'wlc_handle -> IO (Ptr C'wl_resource))

{-# LINE 54 "src/Bindings/WLC/Wayland.hsc" #-}