From 049d2a9a337331295b4a2d4ad13061bc73536236 Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Sun, 2 Jul 2023 21:36:34 +1200 Subject: Initial commit --- src/libsndfile-virtual.adb | 162 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 162 insertions(+) create mode 100644 src/libsndfile-virtual.adb (limited to 'src/libsndfile-virtual.adb') 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; + + -- cgit