From fe69d2cc0c3b671378e1bff40863c03d3b2679ed Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Sun, 17 Dec 2017 11:32:11 +1100 Subject: Ada specification files for core binding mostly done --- src/wayland-client.ads | 206 +++++++++++++++++ src/wayland-server.ads | 601 +++++++++++++++++++++++++++++++++++++++++++++++++ src/wayland.ads | 113 ++++++++++ 3 files changed, 920 insertions(+) create mode 100644 src/wayland-client.ads create mode 100644 src/wayland-server.ads create mode 100644 src/wayland.ads diff --git a/src/wayland-client.ads b/src/wayland-client.ads new file mode 100644 index 0000000..2d6fff0 --- /dev/null +++ b/src/wayland-client.ads @@ -0,0 +1,206 @@ + + +package Wayland.Client is + + + subtype Num_Events_Dispatched is Natural; + subtype Num_Bytes_Sent is Natural; + + + + + type Proxy is new Wayland_Object with private; + type Proxy_Access is access Proxy; + + + type Display is new Proxy with private; + type Display_Access is access Display; + + + type Event_Queue is new Wayland_Object private; + type Event_Queue_Access is access Event_Queue; + + + + + type Dispatcher_Function is access procedure + (Obj : in Wayland_Object; + Op : in Opcode); + + + + + -- Proxy + + function Create + (Factory : in Proxy; + My_Interface : in Protocol_Interface) + return Proxy; + + 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 Add_Listener + (This : in out Proxy; + Op : in Opcode; + Func : in Listener_Function); + + function Get_Listener + (This : in Proxy; + Op : in Opcode) + return Listener_Function; + + procedure Remove_Listener + (This : in out Proxy; + Op : in Opcode); + + procedure Set_Dispatcher + (This : in out Proxy; + Func : in Dispatcher_Function); + + function Get_Version + (This : in Proxy) + return Version_Number; + + function Get_ID + (This : in Proxy) + return ID_Number; + + function Get_Interface_Name + (This : in Proxy) + return String; + + procedure Set_Queue + (This : in out Proxy; + Queue : in Event_Queue_Access); + + + + + -- Display + + function Connect + (Name : in String) + return Display; + + function Connect_To_FD + (FD : in File_Descriptor) + return Display; + + procedure Disconnect + (This : in out Display); + + function Get_FD + (This : in Display) + return File_Descriptor; + + function Dispatch + (This : in out Display) + return Num_Events_Dispatched; + + function Dispatch_Pending + (This : in out Display) + return Num_Events_Dispatched; + + function Dispatch_Queue + (This : in out Display; + Queue : in out Event_Queue) + return Num_Events_Dispatched; + + function Dispatch_Queue_Pending + (This : in out Display; + Queue : in out Event_Queue) + return Num_Events_Dispatched; + + function Get_Error + (This : in out Display) + return Error_Value; + + function Get_Protocol_Error + (This : in Display; + My_Interface : in Protocol_Interface_Access; + ID : in ID_Number) + return Error_Value; + + function Flush + (This : in out Display) + return Num_Bytes_Sent; + + function Roundtrip_Queue + (This : in out Display; + Queue : in out Event_Queue) + return Num_Events_Dispatched; + + function Roundtrip + (This : in out Display) + return Num_Events_Dispatched; + + procedure Read_Events + (This : in out Display); + + procedure Read_Events + (This : in out Display; + Queue : in out Event_Queue); + + + + + -- Event_Queue + + function Create_Queue + (This : in out Display) + return Event_Queue; + + + + + -- Log + + procedure Set_Log_Handler + (Handler : in Log_Function); + + +private + + + type Proxy is new Wayland_Object with null record; + + procedure Finalize + (This : in out Proxy); + + + + + type Display is new Proxy with null record; + + procedure Finalize + (This : in out Display); + + + + + type Event_Queue is new Wayland_Object with null record; + + procedure Finalize + (This : in out Event_Queue); + + +end Wayland.Client; + diff --git a/src/wayland-server.ads b/src/wayland-server.ads new file mode 100644 index 0000000..c9ab05c --- /dev/null +++ b/src/wayland-server.ads @@ -0,0 +1,601 @@ + + +package Wayland.Server is + + + -- All types declared first to make primitive op grouping easier + + + type Signal is new Wayland_Object with private; + type Signal_Number is new Integer; + + + + + type Event_Source is new Wayland_Object with private; + + + + + type Event_Loop is new Wayland_Object with private; + type Event_Loop_Access is access Event_Loop; + + type Event_Loop_Reference (Data : not null access Event_Loop) is limited private + with Implicit_Dereference => Data; + + type Event_Loop_FD_Function is access function + (This : in out Event_Loop; + FD : in File_Descriptor; + Mask : in Client_State) + return Boolean; + + type Event_Loop_Timer_Function is access function + (This : in out Event_Loop) + return Boolean; + + type Event_Loop_Signal_Function is access function + (This : in out Event_Loop; + Num : in Signal_Number) + return Boolean; + + type Event_Loop_Idle_Function is access procedure + (This : in out Event_Loop); + + + + + type Client is new Wayland_Object with private + with Variable_Indexing => Get_Object; + type Client_Access is access Client; + + type Client_Reference (Data : not null access Client) is limited private + with Implicit_Dereference => Data; + + type Client_State is record + Readable : Boolean := False; + Writable : Boolean := False; + Hangup : Boolean := False; + Error : Boolean := False; + end record; + + + + + type Display is new Wayland_Object with private; + type Display_Access is access Display; + + type Display_Reference (Data : not null access Display) is limited private + with Implicit_Dereference => Data; + + + + + type Global is new Wayland_Object with private; + type Global_Access is access Global; + + type Global_Bind_Function is access procedure + (My_Client : in Client_Access; + Version : in Version_Number; + ID : in ID_Number); + + + + + type Global_Filter_Function is access function + (Caller : in Display; + My_Client : in Client; + My_Global : in Global) + return Boolean; + + + + + type Resource is new Wayland_Object with private; + type Resource_Access is access Resource; + + type Resource_Reference (Data : not null access Resource) is limited private + with Implicit_Dereference => Data; + + + + + type Pixel_Value is new Unsigned_Integer; + type Stride_Size is new Positive; + type Pixel_Format is new Unsigned_Integer; + + type Shared_Memory is new Wayland_Object with private; + type SHM_Access is access Shared_Memory; + + + + + type Shared_Pool is new Wayland_Object with private; + type SHM_Pool_Access is access Shared_Pool; + + + + + type Protocol_Logger is new Wayland_Object with private; + type Protocol_Logger_Direction is (Request, Event); + + type Protocol_Logger_Message is record + end record; + + type Protocol_Logger_Function is access procedure + (From : in Display; + Dir : in Protocol_Logger_Direction; + Msg : in Protocol_Logger_Message); + + + + + -- Signal + + function Create + return Signal; + + procedure Add + (This : in out Signal; + Func : in Listener_Function); + + function Has + (This : in Signal; + Func : in Listener_Function) + return Boolean; + + procedure Remove + (This : in out Signal; + Func : in Listener_Function); + + procedure Emit + (This : in Signal); + + + + + -- Event_Source + + function FD_Update + (Source : in Event_Source; + Mask : in Client_State) + return Result; + + function Timer_Update + (Source : in Event_Source; + Time : in Duration) + return Result; + + procedure Remove + (Source : in Event_Source); + + procedure Check + (Source : in Event_Source); + + + + + -- Event_Loop + + function Create + return Event_Loop; + + function Add_FD + (This : in out Event_Loop; + FD : in File_Descriptor; + Mask : in Client_State; + Func : in Event_Loop_FD_Function) + return Event_Source; + + function Get_FD + (This : in Event_Loop) + return File_Descriptor; + + function Add_Timer + (This : in out Event_Loop; + Func : in Event_Loop_Timer_Function) + return Event_Source; + + function Add_Signal + (This : in out Event_Loop; + Sig : in Signal_Number; + Func : in Event_Loop_Signal_Function) + return Event_Source; + + function Add_Idle + (This : in out Event_Loop; + Func : in Event_Loop_Idle_Function) + return Event_Source; + + function Dispatch + (This : in out Event_Loop; + Timeout : in Natural) + return Result; + + procedure Dispatch_Idle + (This : in out Event_Loop); + + procedure Add_Destroy_Listener + (This : in out Event_Loop; + Func : in Listener_Function); + + function Has_Destroy_Listener + (This : in Event_Loop; + Func : in Listener_Function) + return Boolean; + + procedure Remove_Destroy_Listener + (This : in out Event_Loop; + Func : in Listener_Function); + + + + + -- Display + + function Create + return Display; + + function Get_Event_Loop + (This : in Display) + return Event_Loop_Reference; + + function Add_Socket + (This : in out Display; + Name : in String) + return Result; + + function Add_Socket_Auto + (This : in out Display) + return String; + + function Add_Socket_FD + (This : in out Display; + FD : in File_Descriptor) + return Result; + + procedure Stop + (This : in out Display); + + procedure Run + (This : in out Display); + + procedure Flush_Clients + (This : in out Display); + + function Get_Serial + (This : in Display) + return Serial_Number; + + function Next_Serial + (This : in Display) + return Serial_Number; + + procedure Add_Destroy_Listener + (This : in out Display; + Func : in Listener_Function); + + function Has_Destroy_Listener + (This : in Display; + Func : in Listener_Function) + return Boolean; + + procedure Remove_Destroy_Listener + (This : in out Display; + Func : in Listener_Function); + + procedure Add_Client_Created_Listener + (This : in out Display; + Func : in Listener_Function); + + function Has_Client_Created_Listener + (This : in Display) + Func : in Listener_Function) + return Boolean; + + procedure Remove_Client_Created_Listener + (This : in out Display; + Func : in Listener_Function); + + procedure Set_Global_Filter + (This : in out Display; + Func : in Global_Filter_Function); + + function Add_Protocol_Logger + (This : in out Display; + Func : in Protocol_Logger_Function) + return Protocol_Logger; + + + + + -- Client + + function Create + (My_Display : in Display_Access; + FD : in File_Descriptor) + return Client; + + procedure Flush + (This : in out Client); + + procedure Get_Credentials + (This : in Client; + PID : out Process_ID; + UID : out User_ID; + GID : out Group_ID); + + function Get_Display + (This : in Client) + return Display_Reference; + + function Get_FD + (This : in Client) + return File_Descriptor; + + function Get_Object + (This : in Client; + ID : in ID_Number) + return Resource_Reference; + + procedure Post_No_Memory + (This : in out Client); + + procedure Add_Destroy_Listener + (This : in out Client; + Func : in Listener_Function); + + function Has_Destroy_Listener + (This : in Client; + Func : in Listener_Function) + return Boolean; + + procedure Remove_Destroy_Listener + (This : in out Client; + Func : in Listener_Function); + + procedure Add_Resource_Created_Listener + (This : in out Client; + Func : in Listener_Function); + + function Has_Resource_Created_Listener + (This : in Client; + Func : in Listener_Function) + return Boolean; + + procedure Remove_Resource_Created_Listener + (This : in out Client; + Func : in Listener_Function); + + + + + -- Global + + function Create + (My_Display : in Display_Access; + My_Interface : in Protocol_Interface_Access; + Version : in Version_Number; + Bind_Func : in Global_Bind_Function) + return Global; + + function Get_Interface + (This : in Global_Access) + return Protocol_Interface_Reference; + + + + + -- Resource + + function Create + (My_Client : in Client_Access; + My_Interface : in Protocol_Interface_Access; + Version : in Version_Number; + ID : in ID_Number) + return Resource; + + procedure Post_Event + (This : in out Resource; + Op : in Opcode; + Args : in Argument_Array); + + procedure Queue_Event + (This : in out Resource; + Op : in Opcode; + Args : in Argument_Array); + + procedure Post_Error + (This : in out Resource; + Code : in Error_Code; + Msg : in String); + + procedure Post_No_Memory + (This : in out Resource); + + function Get_ID + (This : in Resource) + return ID_Number; + + function Get_Client + (This : in Resource) + return Client_Reference; + + function Get_Version + (This : in Resource) + return Version_Number; + + procedure Add_Destroy_Listener + (This : in out Resource; + Func : in Listener_Function); + + function Has_Destroy_Listener + (This : in Resource; + Func : in Listener_Function) + return Boolean; + + procedure Remove_Destroy_Listener + (This : in out Resource; + Func : in Listener_Function); + + + + + -- Shared_Memory + + function Create + (My_Client : in Client_Access; + ID : in ID_Number; + W, H : in Natural; + Stride : in Stride_Size; + Format : in Pixel_Format) + return Shared_Memory; + + function Get_Buffer + (From : in Resource) + return Shared_Memory; + + function Get_Pixel + (This : in Shared_Memory; + X, Y : in Natural) + return Pixel_Value; + + procedure Set_Pixel + (This : in out Shared_Memory; + X, Y : in Natural; + Value : in Pixel_Value); + + function Get_Stride + (This : in Shared_Memory) + return Stride_Size; + + function Get_Format + (This : in Shared_Memory) + return Pixel_Format; + + function Get_Width + (This : in Shared_Memory) + return Natural; + + function Get_Height + (This : in Shared_Memory) + return Natural; + + + + + -- Shared_Pool + + function Reference_Pool + (From : in Shared_Memory) + return Shared_Pool; + + procedure Unreference + (This : in out Shared_Pool); + + + + + -- Log + + procedure Set_Log_Handler + (Handler : in Log_Function); + + +private + + + type Signal is new Wayland_Object with null record; + + procedure Finalize + (This : in out Signal); + + + + + type Event_Source is new Wayland_Object with null record; + + procedure Finalize + (This : in out Event_Source); + + + + + type Event_Loop is new Wayland_Object with null record; + + procedure Finalize + (This : in out Event_Loop); + + type Event_Loop_Reference (Data : not null access Event_Loop) is limited null record + with Implicit_Dereference => Data; + + + + + type Client is new Wayland_Object with null record + with Variable_Indexing => Get_Object; + + procedure Finalize + (This : in out Client); + + type Client_Reference (Data : not null access Client) is limited null record + with Implicit_Dereference => Data; + + + + + type Display is new Wayland_Object with null record; + + procedure Finalize + (This : in out Display); + + type Display_Reference (Data : not null access Display) is limited null record + with Implicit_Dereference => Data; + + + + + type Global is new Wayland_Object with null record; + + procedure Finalize + (This : in out Global); + + + + + type Resource is new Wayland_Object with null record; + + procedure Finalize + (This : in out Resource); + + type Resource_Reference (Data : not null access Resource) is limited null record + with Implicit_Dereference => Data; + + + + + type Shared_Memory is new Wayland_Object with record + Needs_Dealloc : Boolean; + end record; + + procedure Finalize + (This : in out Shared_Memory); + + + + + type Shared_Pool is new Wayland_Object with null record; + + procedure Finalize + (This : in out Shared_Pool); + + + + + type Protocol_Logger is new Wayland_Object with null record; + + procedure Finalize + (This : in out Protocol_Logger); + + +end Wayland.Server; + diff --git a/src/wayland.ads b/src/wayland.ads new file mode 100644 index 0000000..bfab18d --- /dev/null +++ b/src/wayland.ads @@ -0,0 +1,113 @@ + + +private with + + Ada.Finalization, + System; + + +package Wayland is + + + type Unsigned_Integer is mod 2 ** 32; + + type Result is (Success, Failure); + type Error_Code is new Unsigned_Integer; + + type File_Descriptor is new Natural; + + type Version_Number is new Positive; + type Serial_Number is new Unsigned_Integer; + type ID_Number is new Unsigned_Integer; + + type Process_ID is new Natural; + type User_ID is new Natural; + type Group_ID is new Natural; + + + + + type Opcode is new Unsigned_Integer; + + type Argument_Kind is (Uint, Int, Fixed, Str, Arr, FD, ID, Obj); + type Argument (Kind : Argument_Kind) is private; + type Argument_Array is array (Integer range <>) of Argument; + + function Arg + (Of_Type : in Unsigned_Integer) + return Arg (Uint); + + function Arg + (Of_Type : in Integer) + return Arg (Int); + + function Arg + (Of_Type : in ) + return Arg (Fixed); + + function Arg + (Of_Type : in String) + return Arg (String); + + function Arg + (Of_Type : in ) + return Arg (Arr); + + function Arg + (Of_Type : in File_Descriptor) + return Arg (FD); + + function Arg + (Of_Type : in ID_Number) + return Arg (ID); + + function Arg + (Of_Type : in ) + return Arg (Obj); + + + + + type Protocol_Interface is private; + type Protocol_Interface_Access is access Protocol_Interface; + + type Protocol_Interface_Reference (Data : not null access Protocol_Interface) is limited private + with Implicit_Dereference => Data; + + + + + type Wayland_Object is limited tagged private; + + type Listener_Function is access procedure + (Obj : in out Wayland_Object); + + + + + type Log_Function is access procedure + (Msg : in String); + + +private + + + type Wayland_Object is new Ada.Finalization.Limited_Controlled with record + Void_Ptr : System.Address := System.Null_Address; + end record; + + procedure Initialize + (This : in out Wayland_Object); + + + + + type Protocol_Interface is record + end record; + + type Protocol_Interface_Reference (Data : not null access Protocol_Interface) is limited null record + with Implicit_Dereference => Data; + + +end Wayland; + -- cgit