Initial commit

1 files changed, 162 insertions, 0 deletions

diff --git a/src/libsndfile-virtual.adb b/src/libsndfile-virtual.adb
new file mode 100644
index 0000000..2e8f438
--- /dev/null
+++ b/src/libsndfile-virtual.adb
@@ -0,0 +1,162 @@
+
+
+--  Programmed by Jedidiah Barber
+--  Released into the public domain
+
+
+with
+
+    Interfaces.C,
+    System.Address_To_Access_Conversions;
+
+use type
+
+    Interfaces.C.int,
+    System.Address;
+
+
+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 File_Info;
+            Data   : in     System.Address)
+        return System.Address;
+    pragma Import (C, asf_open_virtual, "asf_open_virtual");
+
+
+
+
+    ----------------------
+    --  Callback Hooks  --
+    ----------------------
+
+    function Ada_Filelen_Hook
+           (Data : in System.Address)
+        return Interfaces.Integer_64
+    is
+        Virtual : Virt_Conversions.Object_Pointer :=
+            Virt_Conversions.To_Pointer (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 System.Address)
+        return Interfaces.Integer_64
+    is
+        Virtual : Virt_Conversions.Object_Pointer :=
+            Virt_Conversions.To_Pointer (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 System.Address;
+            Count : in Interfaces.Integer_64;
+            Data  : in System.Address)
+        return Interfaces.Integer_64
+    is
+        Virtual : Virt_Conversions.Object_Pointer :=
+            Virt_Conversions.To_Pointer (Data);
+        Buffer : Raw_Data (1 .. Integer (Count));
+        for Buffer'Address use 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 System.Address;
+            Count : in Interfaces.Integer_64;
+            Data  : in System.Address)
+        return Interfaces.Integer_64
+    is
+        Virtual : Virt_Conversions.Object_Pointer :=
+            Virt_Conversions.To_Pointer (Data);
+        Buffer : Raw_Data (1 .. Integer (Count));
+        for Buffer'Address use 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 System.Address)
+        return Interfaces.Integer_64
+    is
+        Virtual : Virt_Conversions.Object_Pointer :=
+            Virt_Conversions.To_Pointer (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;
+            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 : System.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, File.My_Virtual'Address);
+        if Result = System.Null_Address then
+            Raise_Error (sf_error (Result));
+            raise Program_Error;
+        else
+            File.Ptr   := Result;
+            File.FMode := Mode;
+            File.Chans := Info.My_Channels;
+        end if;
+    end Open;
+
+
+end Libsndfile.Virtual;
+
+