wip argument bindings

1 files changed, 50 insertions, 8 deletions

diff --git a/wayland/Wayland/Server/System.hsc b/wayland/Wayland/Server/System.hsc
index 6fcd52c..d4f5b50 100644
--- a/wayland/Wayland/Server/System.hsc
+++ b/wayland/Wayland/Server/System.hsc
@@ -4,8 +4,8 @@ module Wayland.Server.System where
 
 #include <wayland-server.h>
 
-import Foreign (FunPtr, Ptr, Storable(..))
-import Foreign.C (CString, CInt(..))
+import Foreign (FunPtr, Ptr, Storable(..), Int32)
+import Foreign.C (CString, CInt(..), CSize)
 import Data.Word (Word32)
 
 data WLMessage
@@ -25,15 +25,30 @@ data WLInterface
                 }
   deriving (Show)
 
-newtype WLDisplay     = WLDisplay     (Ptr WLDisplay)
-newtype WLEventLoop   = WLEventLoop   (Ptr WLEventLoop)
-newtype WLEventSource = WLEventSource (Ptr WLEventSource)
-newtype WLGlobal      = WLGlobal      (Ptr WLGlobal)
-newtype WLClient      = WLClient      (Ptr WLClient)
-newtype WLResource    = WLResource    (Ptr WLResource)
+newtype WLFixed = WLFixed #{type wl_fixed_t}
+  deriving (Show)
+
+data WLArray
+  = WLArray { arrSize  :: CSize
+            , arrAlloc :: CSize
+            , arrData  :: Ptr ()
+            }
+  deriving (Show)
+
+data WLArgument = WLArgument
+  deriving (Show)
+
+newtype WLDisplay     = WLDisplay     (Ptr WLDisplay)     deriving (Show)
+newtype WLEventLoop   = WLEventLoop   (Ptr WLEventLoop)   deriving (Show)
+newtype WLEventSource = WLEventSource (Ptr WLEventSource) deriving (Show)
+newtype WLGlobal      = WLGlobal      (Ptr WLGlobal)      deriving (Show)
+newtype WLClient      = WLClient      (Ptr WLClient)      deriving (Show)
+newtype WLResource    = WLResource    (Ptr WLResource)    deriving (Show)
 
 type WLEventLoopSignalFunc = CInt -> Ptr () -> IO CInt
 type WLGlobalBindFunc      = WLClient -> Ptr () -> Word32 -> Word32 -> IO ()
+type WLDispatcherFunc      = Ptr () -> WLResource -> Word32 -> Ptr WLMessage -> Ptr WLArgument -> IO CInt
+type WLResourceDestroyFunc = WLResource -> IO ()
 
 foreign import ccall "wrapper"
   wrapWLEventLoopSignalFunc :: WLEventLoopSignalFunc -> IO (FunPtr WLEventLoopSignalFunc)
@@ -68,6 +83,33 @@ foreign import ccall "wl_global_create"
 foreign import ccall "wl_resource_create"
   wlResourceCreate :: WLClient -> Ptr WLInterface -> CInt -> Word32 -> IO WLResource
 
+foreign import ccall "wl_resource_set_dispatcher"
+  wlResourceSetDispatcher :: WLResource -> FunPtr WLDispatcherFunc -> Ptr () -> Ptr () -> FunPtr WLResourceDestroyFunc -> IO ()
+
+wlArgumentGetInt :: Ptr WLArgument -> IO Int32
+wlArgumentGetInt = #{peek union wl_argument, i}
+
+wlArgumentGetUInt :: Ptr WLArgument -> IO Word32
+wlArgumentGetUInt = #{peek union wl_argument, u}
+
+wlArgumentGetFixed :: Ptr WLArgument -> IO WLFixed
+wlArgumentGetFixed = #{peek union wl_argument, f}
+
+wlArgumentGetString :: Ptr WLArgument -> IO CString
+wlArgumentGetString = #{peek union wl_argument, s}
+
+wlArgumentGetObject :: Ptr WLArgument -> IO WLResource
+wlArgumentGetObject = #{peek union wl_argument, o}
+
+wlArgumentGetNewID :: Ptr WLArgument -> IO Word32
+wlArgumentGetNewID = #{peek union wl_argument, n}
+
+wlArgumentGetArray :: Ptr WLArgument -> IO (Ptr WLArray)
+wlArgumentGetArray = #{peek union wl_argument, a}
+
+wlArgumentGetFD :: Ptr WLArgument -> IO Int32
+wlArgumentGetFD = #{peek union wl_argument, h}
+
 instance Storable WLMessage where
   sizeOf    _ = #{size struct wl_message}
   alignment _ = #{alignment struct wl_message}