path: root/src/wayland-client.adb

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;