From 539930f228d9dda1fe3462e5a6d913061dc6a652 Mon Sep 17 00:00:00 2001
From: Hannes Schulze <haschu0103@outlook.de>
Date: Thu, 8 Aug 2024 18:47:02 +0200
Subject: finish implementing wayland server api

---
 wayland/Wayland/Server/System.hsc | 84 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 84 insertions(+)

(limited to 'wayland/Wayland/Server/System.hsc')

diff --git a/wayland/Wayland/Server/System.hsc b/wayland/Wayland/Server/System.hsc
index 8340efa..960caf4 100644
--- a/wayland/Wayland/Server/System.hsc
+++ b/wayland/Wayland/Server/System.hsc
@@ -18,16 +18,37 @@ import Foreign (FunPtr, Ptr, Int32, Storable(..), castPtr)
 import Foreign.C (CString, CSize, CInt(..))
 import Data.Word (Word32)
 
+-- * Constants
+
+wlEventReadable :: Word32
+wlEventReadable = #{const WL_EVENT_READABLE}
+wlEventWritable :: Word32
+wlEventWritable = #{const WL_EVENT_WRITABLE}
+wlEventHangup   :: Word32
+wlEventHangup   = #{const WL_EVENT_HANGUP}
+wlEventError    :: Word32
+wlEventError    = #{const WL_EVENT_ERROR}
+
 -- * Callback Types
 
 type WLEventLoopSignalFunc = CInt -> Ptr () -> IO CInt
+type WLEventLoopTimerFunc  = Ptr () -> IO CInt
+type WLEventLoopFdFunc     = CInt -> Word32 -> 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 ()
+type WLNotifyFunc          = Ptr WLListener -> Ptr () -> IO ()
+type WLUserDataDestroyFunc = Ptr () -> IO ()
 
 foreign import ccall "wrapper"
   wrapWLEventLoopSignalFunc :: WLEventLoopSignalFunc -> IO (FunPtr WLEventLoopSignalFunc)
 
+foreign import ccall "wrapper"
+  wrapWLEventLoopTimerFunc :: WLEventLoopTimerFunc -> IO (FunPtr WLEventLoopTimerFunc)
+
+foreign import ccall "wrapper"
+  wrapWLEventLoopFdFunc :: WLEventLoopFdFunc -> IO (FunPtr WLEventLoopFdFunc)
+
 foreign import ccall "wrapper"
   wrapWLGlobalBindFunc :: WLGlobalBindFunc -> IO (FunPtr WLGlobalBindFunc)
 
@@ -37,6 +58,12 @@ foreign import ccall "wrapper"
 foreign import ccall "wrapper"
   wrapWLResourceDestroyFunc :: WLResourceDestroyFunc -> IO (FunPtr WLResourceDestroyFunc)
 
+foreign import ccall "wrapper"
+  wrapWLNotifyFunc :: WLNotifyFunc -> IO (FunPtr WLNotifyFunc)
+
+foreign import ccall "wrapper"
+  wrapWLUserDataDestroyFunc :: WLUserDataDestroyFunc -> IO (FunPtr WLUserDataDestroyFunc)
+
 -- * Primitive Types
 
 -- ** wl_message
@@ -190,6 +217,24 @@ wlArgumentPokeArray  = #{poke union wl_argument, a}
 wlArgumentPokeFD     :: Ptr WLArgument -> Int32 -> IO ()
 wlArgumentPokeFD     = #{poke union wl_argument, h}
 
+-- ** wl_listener
+
+newtype WLListener = WLListener (FunPtr WLNotifyFunc)
+  deriving (Show)
+
+instance Storable WLListener where
+  sizeOf    _ = #{size struct wl_listener}
+  alignment _ = #{alignment struct wl_listener}
+  peek p = do
+    notify <- #{peek struct wl_listener, notify} p
+    return $ WLListener notify
+  poke p (WLListener notify) = do
+    #{poke struct wl_listener, notify} p notify
+    return ()
+
+foreign import ccall "wl_list_remove"
+  wlListenerRemove :: Ptr WLListener -> IO ()
+
 -- * Opaque Types
 
 -- ** wl_display
@@ -218,6 +263,9 @@ foreign import ccall "wl_display_terminate"
 foreign import ccall "wl_display_get_event_loop"
   wlDisplayGetEventLoop :: WLDisplay -> IO WLEventLoop
 
+foreign import ccall "wl_display_add_client_created_listener"
+  wlDisplayAddClientCreatedListener :: WLDisplay -> Ptr WLListener -> IO ()
+
 -- ** wl_event_loop
 
 newtype WLEventLoop = WLEventLoop (Ptr WLEventLoop)
@@ -226,11 +274,26 @@ newtype WLEventLoop = WLEventLoop (Ptr WLEventLoop)
 foreign import ccall "wl_event_loop_add_signal"
   wlEventLoopAddSignal :: WLEventLoop -> CInt -> FunPtr WLEventLoopSignalFunc -> Ptr () -> IO WLEventSource
 
+foreign import ccall "wl_event_loop_add_timer"
+  wlEventLoopAddTimer :: WLEventLoop -> FunPtr WLEventLoopTimerFunc -> Ptr () -> IO WLEventSource
+
+foreign import ccall "wl_event_loop_add_fd"
+  wlEventLoopAddFd :: WLEventLoop -> CInt -> Word32 -> FunPtr WLEventLoopFdFunc -> Ptr () -> IO WLEventSource
+
 -- ** wl_event_source
 
 newtype WLEventSource = WLEventSource (Ptr WLEventSource)
   deriving (Show, Eq, Storable)
 
+foreign import ccall "wl_event_source_remove"
+  wlEventSourceRemove :: WLEventSource -> IO CInt
+
+foreign import ccall "wl_event_source_fd_update"
+  wlEventSourceFdUpdate :: WLEventSource -> Word32 -> IO CInt
+
+foreign import ccall "wl_event_source_timer_update"
+  wlEventSourceTimerUpdate :: WLEventSource -> CInt -> IO CInt
+
 -- ** wl_global
 
 newtype WLGlobal = WLGlobal (Ptr WLGlobal)
@@ -239,11 +302,29 @@ newtype WLGlobal = WLGlobal (Ptr WLGlobal)
 foreign import ccall "wl_global_create"
   wlGlobalCreate :: WLDisplay -> Ptr WLInterface -> CInt -> Ptr () -> FunPtr WLGlobalBindFunc -> IO WLGlobal
 
+foreign import ccall "wl_global_remove"
+  wlGlobalRemove :: WLGlobal -> IO ()
+
+foreign import ccall "wl_global_destroy"
+  wlGlobalDestroy :: WLGlobal -> IO ()
+
 -- ** wl_client
 
 newtype WLClient = WLClient (Ptr WLClient)
   deriving (Show, Eq, Storable)
 
+foreign import ccall "wl_client_destroy"
+  wlClientDestroy :: WLClient -> IO ()
+
+foreign import ccall "wl_client_flush"
+  wlClientFlush :: WLClient -> IO ()
+
+foreign import ccall "wl_client_set_user_data"
+  wlClientSetUserData :: WLClient -> Ptr () -> FunPtr WLUserDataDestroyFunc -> IO ()
+
+foreign import ccall "wl_client_get_user_data"
+  wlClientGetUserData :: WLClient -> IO (Ptr ())
+
 -- ** wl_resource
 
 newtype WLResource = WLResource (Ptr WLResource)
@@ -263,3 +344,6 @@ foreign import ccall "wl_resource_post_event_array"
 
 foreign import ccall "wl_resource_destroy"
   wlResourceDestroy :: WLResource -> IO ()
+
+foreign import ccall "wl_resource_get_client"
+  wlResourceGetClient :: WLResource -> IO WLClient
-- 
cgit v1.3.1