diff options
Diffstat (limited to 'src/wayland-client.adb')
-rw-r--r-- | src/wayland-client.adb | 544 |
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; + |