1 files changed, 544 insertions, 0 deletions
diff --git a/src/wayland-client.adb b/src/wayland-client.adb
new file mode 100644
index 0000000..21d5cc2
--- /dev/null
+++ b/src/wayland-client.adb
@@ -0,0 +1,544 @@
+
+
+with
+
+    Interfaces.C.Strings;
+
+
+package body Wayland.Client is
+
+
+    --  C constructors
+
+    function wl_proxy_create
+           (P, I : in System.Address)
+        return System.Address
+        with Convention => C,
+             Import => True;
+
+    function wl_display_connect
+           (N : in Interfaces.C.Strings.chars_ptr)
+        return System.Address
+        with Convention => C,
+             Import => True;
+
+    function wl_display_connect_to_fd
+           (FD : in Interfaces.C.int)
+        return System.Address
+        with Convention => C,
+             Import => True;
+
+    function wl_display_create_queue
+           (D : in System.Address)
+        return System.Address
+        with Convention => C,
+             Import => True;
+
+
+
+
+
+    --  C destructors
+
+    procedure wl_proxy_destroy
+           (P : in System.Address)
+        with Convention => C,
+             Import => True;
+
+    procedure wl_display_disconnect
+           (D : in System.Address)
+        with Convention => C,
+             Import => True;
+
+    procedure wl_event_queue_destroy
+           (E : in System.Address)
+        with Convention => C,
+             Import => True;
+
+
+
+
+
+    --  C proxy functions
+
+    function wl_proxy_get_version
+           (P : in System.Address)
+        return Interfaces.C.Unsigned
+        with Convention => C,
+             Import => True;
+
+    function wl_proxy_get_version
+           (P : in System.Address)
+        return Interfaces.C.Unsigned
+        with Convention => C,
+             Import => True;
+
+    function wl_proxy_get_class
+           (P : in System.Address)
+        return Interfaces.C.Strings.chars_ptr
+        with Convention => C,
+             Import => True;
+
+    procedure wl_proxy_set_queue
+           (P, E : in System.Address)
+        with Convention => C,
+             Import => True;
+
+
+
+
+
+    --  C display functions
+
+    function wl_display_get_fd
+           (D : in System.Address)
+        return Interfaces.C.int
+        with Convention => C,
+             Import => True;
+
+    function wl_display_dispatch
+           (D : in System.Address)
+        return Interfaces.C.int
+        with Convention => C,
+             Import => True;
+
+    function wl_display_dispatch_pending
+           (D : in System.Address)
+        return Interfaces.C.int
+        with Convention => C,
+             Import => True;
+
+    function wl_display_dispatch_queue
+           (D, Q : in System.Address)
+        return Interfaces.C.int
+        with Convention => C,
+             Import => True;
+
+    function wl_display_dispatch_queue_pending
+           (D, Q : in System.Address)
+        return Interfaces.C.int
+        with Convention => C,
+             Import => True;
+
+    function wl_display_get_error
+           (D : in System.Address)
+        return Interfaces.C.int
+        with Convention => C,
+             Import => True;
+
+    function wl_display_get_protocol_error
+           (D, P : in System.Address;
+            ID   : in Interfaces.C.unsigned)
+        return Interfaces.C.unsigned
+        with Convention => C,
+             Import => True;
+
+    function wl_display_flush
+           (D : in System.Address)
+        return Interfaces.C.int
+        with Convention => C,
+             Import => True;
+
+    function wl_display_roundtrip_queue
+           (D, Q : in System.Address)
+        return Interfaces.C.int
+        with Convention => C,
+             Import => True;
+
+    function wl_display_roundtrip
+           (D : in System.Address)
+        return Interfaces.C.int
+        with Convention => C,
+             Import => True;
+
+    function wl_display_prepare_read
+           (D : in System.Address)
+        return Interfaces.C.int
+        with Convention => C,
+             Import => True;
+
+    function wl_display_prepare_read_queue
+           (D, Q : in System.Address)
+        return Interfaces.C.int
+        with Convention => C,
+             Import => True;
+
+    function wl_display_read_events
+           (D : in System.Address)
+        return Interfaces.C.int
+        with Convention => C,
+             Import => True;
+
+
+
+
+
+    --  C log handling
+
+    procedure wayland_client_set_log_hook
+           (F : in System.Address)
+        with Convention => C,
+             Import => True;
+
+
+
+
+
+    --  Ada Destructors
+
+    procedure Finalize
+           (This : in out Proxy) is
+    begin
+        if This.Void_Ptr /= System.Null_Address then
+            wl_proxy_destroy (This.Void_Ptr);
+            This.Void_Ptr := System.Null_Address;
+        end if;
+    end Finalize;
+
+
+    procedure Finalize
+           (This : in out Display) is
+    begin
+        if This.Void_Ptr /= System.Null_Address then
+            wl_display_disconnect (This.Void_Ptr);
+            This.Void_Ptr := System.Null_Address;
+        end if;
+    end Finalize;
+
+
+    procedure Finalize
+           (This : in out Event_Queue) is
+    begin
+        if This.Void_Ptr /= System.Null_Address then
+            wl_event_queue_destroy (This.Void_Ptr);
+            This.Void_Ptr := System.Null_Address;
+        end if;
+    end Finalize;
+
+
+
+
+
+    --  Internal callback hooks
+
+    function Dispatcher_Hook
+           (P, V : in System.Address;
+            Op   : in Opcode;
+            M    : in Message_Signature;
+            Args : in Argument_Array)
+    is
+        This_Proxy : access Proxy'Class :=
+            Proxy_Convert.To_Pointer (P);
+    begin
+        
+    end Dispatcher_Hook;
+
+
+    Current_Log_Function : Log_Function := null;
+
+    procedure Log_Function_Hook
+           (Msg  : in Interfaces.C.Strings.chars_ptr;
+            Fail : in Interfaces.C.int)
+        with Convention => C,
+             Export => True
+    is
+        Text : String := Interfaces.C.Strings.Value (Msg);
+    begin
+        if Fail /= 0 then
+            raise Storage_Error;
+        end if;
+
+        if Current_Log_Function /= null then
+            Current_Log_Function.all (Text);
+        end if;
+    end Log_Function_Hook;
+
+
+
+
+
+    --  Proxy
+
+    function Create
+           (Factory      : in Proxy;
+            My_Interface : in Protocol_Interface)
+        return Proxy
+    is
+        Ptr : System.Address :=
+            wl_proxy_create (Factor.Void_Ptr, My_Interface.Void_Ptr);
+    begin
+        if Ptr = System.Null_Address then
+            raise Storage_Error;
+        end if;
+
+        return This : Proxy do
+            This.Void_Ptr := Ptr;
+            This.Current_Dispatcher := null;
+            
+        end return;
+    end Create;
+
+
+    procedure Marshal
+           (This : in out Proxy;
+            Op   : in     Opcode;
+            Args : in     Argument_Array);
+
+    function Marshal_Constructor
+           (This         : in out Proxy;
+            My_Interface : in     Protocol_Interface;
+            Op           : in     Opcode;
+            Args         : in     Argument_Array)
+        return Proxy;
+
+    function Marshal_Constructor
+           (This         : in out Proxy;
+            My_Interface : in     Protocol_Interface;
+            Op           : in     Opcode;
+            Args         : in     Argument_Array;
+            Version      : in     Version_Number)
+        return Proxy;
+
+
+    procedure Set_Dispatcher
+           (This : in out Proxy;
+            Func : in     Dispatcher_Function) is
+    begin
+        This.Current_Dispatcher := Func;
+    end Set_Dispatcher;
+
+
+    function Get_Version
+           (This : in Proxy)
+        return Version_Number is
+    begin
+        return Version_Number (wl_proxy_get_version (This.Void_Ptr));
+    end Get_Version;
+
+
+    function Get_ID
+           (This : in Proxy)
+        return ID_Number is
+    begin
+        return ID_Number (wl_proxy_get_id (This.Void_Ptr));
+    end Get_ID;
+
+
+    function Get_Interface_Name
+           (This : in Proxy)
+        return String is
+    begin
+        return Interfaces.C.Strings.Value (wl_proxy_get_class (This.Void_Ptr));
+    end Get_Interfaces_Name;
+
+
+    procedure Set_Queue
+           (This  : in out Proxy;
+            Queue : in     Event_Queue_Access) is
+    begin
+        if Queue = null then
+            wl_proxy_set_queue (This.Void_Ptr, System.Null_Address);
+        else
+            wl_proxy_set_queue (This.Void_Ptr, Queue.Void_Ptr);
+        end if;
+    end Set_Queue;
+
+
+
+
+
+    --  Display
+
+    function Connect
+           (Name : in String)
+        return Display
+    is
+        Ptr : System.Address :=
+            wl_display_connect (Interfaces.C.To_C (Name));
+    begin
+        if Ptr = System.Null_Address then
+            raise Storage_Error;
+        end if;
+
+        return This : Display do
+            This.Void_Ptr := Ptr;
+            This.Current_Dispatcher := null;
+        end return;
+    end Connect;
+
+
+    function Connect_To_FD
+           (FD : in File_Descriptor)
+        return Display
+    is
+        Ptr : System.Address :=
+            wl_display_connect_to_fd (Interfaces.C.int (FD));
+    begin
+        if Ptr = System.Null_Address then
+            raise Storage_Error;
+        end if;
+
+        return This : Display do
+            This.Void_Ptr := Ptr;
+            This.Current_Dispatcher := null;
+        end return;
+    end Connect_To_FD;
+
+
+    function Get_FD
+           (This : in Display)
+        return File_Descriptor is
+    begin
+        return File_Descriptor (wl_display_get_fd (This.Void_Ptr));
+    end Get_FD;
+
+
+    function Dispatch
+           (This : in out Display)
+        return Num_Events_Dispatched is
+    begin
+        return Num_Events_Dispatched (wl_display_dispatch (This.Void_Ptr));
+    end Dispatch;
+
+
+    function Dispatch_Pending
+           (This : in out Display)
+        return Num_Events_Dispatched is
+    begin
+        return Num_Events_Dispatched (wl_display_dispatch_pending (This.Void_Ptr));
+    end Dispatch_Pending;
+
+
+    function Dispatch_Queue
+           (This  : in out Display;
+            Queue : in out Event_Queue)
+        return Num_Events_Dispatched is
+    begin
+        return Num_Events_Dispatched
+            (wl_display_dispatch_queue (This.Void_Ptr, Queue.Void_Ptr));
+    end Dispatch_Queue;
+
+
+    function Dispatch_Queue_Pending
+           (This  : in out Display;
+            Queue : in out Event_Queue)
+        return Num_Events_Dispatched is
+    begin
+        return Num_Events_Dispatched
+            (wl_display_dispatch_queue_pending (This.Void_Ptr, Queue.Void_Ptr));
+    end Dispatch_Queue_Pending;
+
+
+    function Get_Error
+           (This : in out Display)
+        return Error_Value is
+    begin
+        return Error_Value (wl_display_get_error (This.Void_Ptr));
+    end Get_Error;
+
+
+    function Get_Protocol_Error
+           (This         : in Display;
+            My_Interface : in Protocol_Interface_Access;
+            ID           : in ID_Number)
+        return Error_Value is
+    begin
+        return Error_Value
+            (wl_display_get_protocol_error
+                (This.Void_Ptr, My_Interfaces.Void_Ptr, Interfaces.C.unsigned (ID)));
+    end Get_Protocol_Error;
+
+
+    function Flush
+           (This : in out Display)
+        return Num_Bytes_Sent is
+    begin
+        return Num_Bytes_Sent (wl_display_flush (This.Void_Ptr));
+    end Flush;
+
+
+    function Roundtrip_Queue
+           (This  : in out Display;
+            Queue : in out Event_Queue)
+        return Num_Events_Dispatched is
+    begin
+        return Num_Events_Dispatched
+            (wl_display_roundtrip_queue (This.Void_Ptr, Queue.Void_Ptr));
+    end Roundtrip_Queue;
+
+
+    function Roundtrip
+           (This : in out Display)
+        return Num_Events_Dispatched is
+    begin
+        return Num_Events_Dispatched (wl_display_roundtrip (This.Void_Ptr));
+    end Roundtrip;
+
+
+    procedure Read_Events
+           (This  : in out Display) is
+    begin
+        if  wl_display_prepare_read (This.Void_Ptr) /= 0 or else
+            wl_display_read_events (This.Void_Ptr) /= 0
+        then
+            raise Wayland_Error;
+        end if;
+    end Read_Events;
+
+
+    procedure Read_Events
+           (This  : in out Display;
+            Queue : in out Event_Queue) is
+    begin
+        if  wl_display_prepare_read_queue (This.Void_Ptr, Queue.Void_Ptr) /= 0 or else
+            wl_display_read_events (This.Void_Ptr) /= 0
+        then
+            raise Wayland_Error;
+        end if;
+    end Read_Events;
+
+
+
+
+
+    --  Event_Queue
+
+    function Create_Queue
+           (This : in out Display)
+        return Event_Queue
+    is
+        Ptr : System.Address :=
+            wl_display_create_queue (This.Void_Ptr);
+    begin
+        if Ptr = System.Null_Address then
+            raise Storage_Error;
+        end if;
+
+        return Queue : Event_Queue do
+            Queue.Void_Ptr := Ptr;
+        end return;
+    end Create_Queue;
+
+
+
+
+
+    --  Log
+
+    procedure Set_Log_Handler
+           (Handler : in Log_Function) is
+    begin
+        Current_Log_Function := Handler;
+    end Set_Log_Handler;
+
+
+
+
+begin
+
+
+    wayland_client_set_log_hook (Log_Function_Hook'Access);
+
+
+end Wayland.Client;
+