--  Programmed by Jedidiah Barber
--  Released into the public domain


pragma Ada_2012;


with

    Interfaces.C,
    System.Address_To_Access_Conversions;

use type

    Interfaces.C.int;


package body Libsndfile.Virtual is


    package Virt_Conversions is new System.Address_To_Access_Conversions (Virtual_Data);




    ------------------------
    --  Functions From C  --
    ------------------------

    function asf_open_virtual
           (Mode   : in     Interfaces.C.int;
            Sfinfo : in out C_File_Info;
            Data   : in     Storage.Integer_Address)
        return Storage.Integer_Address;
    pragma Import (C, asf_open_virtual, "asf_open_virtual");




    ----------------------
    --  Callback Hooks  --
    ----------------------

    function Ada_Filelen_Hook
           (Data : in Storage.Integer_Address)
        return Interfaces.Integer_64
    is
        Virtual : Virt_Conversions.Object_Pointer :=
            Virt_Conversions.To_Pointer (Storage.To_Address (Data));
    begin
        return Interfaces.Integer_64 (Virtual.My_Length.all);
    end Ada_Filelen_Hook;


    function Ada_Seek_Hook
           (Offset : in Interfaces.Integer_64;
            Whence : in Interfaces.C.int;
            Data   : in Storage.Integer_Address)
        return Interfaces.Integer_64
    is
        Virtual : Virt_Conversions.Object_Pointer :=
            Virt_Conversions.To_Pointer (Storage.To_Address (Data));
        My_Whence : Seek_From;
    begin
        if Whence = sf_seek_set then
            My_Whence := From_Start;
        elsif Whence = sf_seek_cur then
            My_Whence := From_Current;
        elsif Whence = sf_seek_end then
            My_Whence := From_End;
        else
            raise Program_Error;
        end if;
        return Interfaces.Integer_64 (Virtual.My_Seek.all (Count_Type (Offset), My_Whence));
    end Ada_Seek_Hook;


    function Ada_Read_Hook
           (Ptr   : in Storage.Integer_Address;
            Count : in Interfaces.Integer_64;
            Data  : in Storage.Integer_Address)
        return Interfaces.Integer_64
    is
        Virtual : Virt_Conversions.Object_Pointer :=
            Virt_Conversions.To_Pointer (Storage.To_Address (Data));
        Buffer : Raw_Data (1 .. Integer (Count));
        for Buffer'Address use Storage.To_Address (Ptr);
        pragma Import (Ada, Buffer);
    begin
        return Interfaces.Integer_64 (Virtual.My_Read (Buffer, Count_Type (Count)));
    end Ada_Read_Hook;


    function Ada_Write_Hook
           (Ptr   : in Storage.Integer_Address;
            Count : in Interfaces.Integer_64;
            Data  : in Storage.Integer_Address)
        return Interfaces.Integer_64
    is
        Virtual : Virt_Conversions.Object_Pointer :=
            Virt_Conversions.To_Pointer (Storage.To_Address (Data));
        Buffer : Raw_Data (1 .. Integer (Count));
        for Buffer'Address use Storage.To_Address (Ptr);
        pragma Import (Ada, Buffer);
    begin
        return Interfaces.Integer_64 (Virtual.My_Write (Buffer, Count_Type (Count)));
    end Ada_Write_Hook;


    function Ada_Tell_Hook
           (Data : in Storage.Integer_Address)
        return Interfaces.Integer_64
    is
        Virtual : Virt_Conversions.Object_Pointer :=
            Virt_Conversions.To_Pointer (Storage.To_Address (Data));
    begin
        return Interfaces.Integer_64 (Virtual.My_Tell.all);
    end Ada_Tell_Hook;




    ---------------------
    --  API Interface  --
    ---------------------

    procedure Open
           (File   : in out Virtual_Sound_File;
            Mode   : in     File_Mode;
            Info   : in out File_Info'Class;
            Length : in     File_Length_Function;
            Seek   : in     Seek_Function;
            Read   : in     Read_Function;
            Write  : in     Write_Function;
            Tell   : in     Tell_Function)
    is
        Mode_Int : Interfaces.C.int := (case Mode is
            when Read_Only  => sfm_read,
            when Write_Only => sfm_write,
            when Read_Write => sfm_rdwr);
        Result : Storage.Integer_Address;
    begin
        File.My_Virtual.My_Length := Length;
        File.My_Virtual.My_Seek   := Seek;
        File.My_Virtual.My_Read   := Read;
        File.My_Virtual.My_Write  := Write;
        File.My_Virtual.My_Tell   := Tell;
        Result := asf_open_virtual
           (Mode_Int, Info.Data, Storage.To_Integer (File.My_Virtual'Address));
        if Result = Null_Pointer then
            Raise_Error (sf_error (Result));
            raise Program_Error;
        else
            File.Ptr   := Result;
            File.FMode := Mode;
            File.Chans := Info.Data.My_Channels;
        end if;
    end Open;


end Libsndfile.Virtual;