-- 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, 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;