From 79c1381d198f5b4ae1b75210971a8ccea1049bad Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Wed, 26 Jul 2023 16:43:15 +1200 Subject: File_Info now a tagged type for ease of use --- src/libsndfile-commands.adb | 4 ++-- src/libsndfile-virtual.adb | 8 ++++---- src/libsndfile-virtual.ads | 5 +---- src/libsndfile.adb | 46 ++++++++++++++++++++++----------------------- src/libsndfile.ads | 22 +++++++--------------- 5 files changed, 37 insertions(+), 48 deletions(-) (limited to 'src') diff --git a/src/libsndfile-commands.adb b/src/libsndfile-commands.adb index 4ccfb28..61e5f48 100644 --- a/src/libsndfile-commands.adb +++ b/src/libsndfile-commands.adb @@ -234,7 +234,7 @@ package body Libsndfile.Commands is function asfc_get_current_sf_info (File : in System.Address; - Info : out File_Info) + Info : out C_File_Info) return Interfaces.C.int; pragma Import (C, asfc_get_current_sf_info, "asfc_get_current_sf_info"); @@ -441,7 +441,7 @@ package body Libsndfile.Commands is Result : File_Info; Code : Interfaces.C.int; begin - Code := asfc_get_current_sf_info (File.Ptr, Result); + Code := asfc_get_current_sf_info (File.Ptr, Result.Data); if Code /= 0 then Raise_Error (Code); raise Program_Error; diff --git a/src/libsndfile-virtual.adb b/src/libsndfile-virtual.adb index 260be7d..db0bb6e 100644 --- a/src/libsndfile-virtual.adb +++ b/src/libsndfile-virtual.adb @@ -32,7 +32,7 @@ package body Libsndfile.Virtual is function asf_open_virtual (Mode : in Interfaces.C.int; - Sfinfo : in out File_Info; + Sfinfo : in out C_File_Info; Data : in System.Address) return System.Address; pragma Import (C, asf_open_virtual, "asf_open_virtual"); @@ -130,7 +130,7 @@ package body Libsndfile.Virtual is procedure Open (File : in out Virtual_Sound_File; Mode : in File_Mode; - Info : in out File_Info; + Info : in out File_Info'Class; Length : in File_Length_Function; Seek : in Seek_Function; Read : in Read_Function; @@ -148,14 +148,14 @@ package body Libsndfile.Virtual is 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); + Result := asf_open_virtual (Mode_Int, Info.Data, 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; + File.Chans := Info.Data.My_Channels; end if; end Open; diff --git a/src/libsndfile-virtual.ads b/src/libsndfile-virtual.ads index 98f88da..7c4319a 100644 --- a/src/libsndfile-virtual.ads +++ b/src/libsndfile-virtual.ads @@ -53,7 +53,7 @@ package Libsndfile.Virtual is procedure Open (File : in out Virtual_Sound_File; Mode : in File_Mode; - Info : in out File_Info; + Info : in out File_Info'Class; Length : in File_Length_Function; Seek : in Seek_Function; Read : in Read_Function; @@ -74,14 +74,11 @@ private My_Tell : Tell_Function; end record with Convention => C; - type Virtual_Sound_File is new Sound_File with record My_Virtual : Virtual_Data; end record; - - function Ada_Filelen_Hook (Data : in System.Address) return Interfaces.Integer_64; diff --git a/src/libsndfile.adb b/src/libsndfile.adb index 6d12273..e5b76b0 100644 --- a/src/libsndfile.adb +++ b/src/libsndfile.adb @@ -280,12 +280,12 @@ package body Libsndfile is function asf_open (Path : in Interfaces.C.char_array; Mode : in Interfaces.C.int; - Sfinfo : in out File_Info) + Sfinfo : in out C_File_Info) return System.Address; pragma Import (C, asf_open, "asf_open"); function asf_format_check - (Sfinfo : in File_Info) + (Sfinfo : in C_File_Info) return Interfaces.C.int; pragma Import (C, asf_format_check, "asf_format_check"); @@ -702,14 +702,14 @@ package body Libsndfile is return File_Info is begin return This : File_Info do - This.My_Frames := 0; - This.My_Sample_Rate := Interfaces.C.int (Rate); - This.My_Channels := Interfaces.C.int (Channels); - This.My_Major := To_Cint (Major); - This.My_Minor := To_Cint (Minor); - This.My_Endian := To_Cint (Endian); - This.My_Sections := 0; - This.My_Seekable := 0; + This.Data.My_Frames := 0; + This.Data.My_Sample_Rate := Interfaces.C.int (Rate); + This.Data.My_Channels := Interfaces.C.int (Channels); + This.Data.My_Major := To_Cint (Major); + This.Data.My_Minor := To_Cint (Minor); + This.Data.My_Endian := To_Cint (Endian); + This.Data.My_Sections := 0; + This.Data.My_Seekable := 0; end return; end Create; @@ -717,58 +717,58 @@ package body Libsndfile is (Info : in File_Info) return Count_Type is begin - return Count_Type (Info.My_Frames); + return Count_Type (Info.Data.My_Frames); end Frames; function Rate (Info : in File_Info) return Natural is begin - return Natural (Info.My_Sample_Rate); + return Natural (Info.Data.My_Sample_Rate); end Rate; function Channels (Info : in File_Info) return Natural is begin - return Natural (Info.My_Channels); + return Natural (Info.Data.My_Channels); end Channels; function Major (Info : in File_Info) return Major_Format is begin - return To_Major (Info.My_Major); + return To_Major (Info.Data.My_Major); end Major; function Minor (Info : in File_Info) return Minor_Format is begin - return To_Minor (Info.My_Minor); + return To_Minor (Info.Data.My_Minor); end Minor; function Endian (Info : in File_Info) return Endianness is begin - return To_Endian (Info.My_Endian); + return To_Endian (Info.Data.My_Endian); end Endian; function Sections (Info : in File_Info) return Natural is begin - return Natural (Info.My_Sections); + return Natural (Info.Data.My_Sections); end Sections; function Seekable (Info : in File_Info) return Boolean is begin - if Info.My_Seekable = sf_false then + if Info.Data.My_Seekable = sf_false then return False; - elsif Info.My_Seekable = sf_true then + elsif Info.Data.My_Seekable = sf_true then return True; else raise Program_Error; @@ -800,7 +800,7 @@ package body Libsndfile is (File : in out Sound_File; Name : in String; Mode : in File_Mode; - Info : in out File_Info) + Info : in out File_Info'Class) is Mode_Int : Interfaces.C.int := (case Mode is when Read_Only => sfm_read, @@ -808,14 +808,14 @@ package body Libsndfile is when Read_Write => sfm_rdwr); Result : System.Address; begin - Result := asf_open (Interfaces.C.To_C (Name), Mode_Int, Info); + Result := asf_open (Interfaces.C.To_C (Name), Mode_Int, Info.Data); 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; + File.Chans := Info.Data.My_Channels; end if; end Open; @@ -823,7 +823,7 @@ package body Libsndfile is (Info : in File_Info) return Boolean is - Result : Interfaces.C.int := asf_format_check (Info); + Result : Interfaces.C.int := asf_format_check (Info.Data); begin if Result = sf_true then return True; diff --git a/src/libsndfile.ads b/src/libsndfile.ads index d88c06d..ad82d0c 100644 --- a/src/libsndfile.ads +++ b/src/libsndfile.ads @@ -51,7 +51,7 @@ package Libsndfile is Track_Number_String, Genre_String); - type File_Info is private; + type File_Info is tagged private; type Major_Format is (Format_Unknown, @@ -222,7 +222,7 @@ package Libsndfile is (File : in out Sound_File; Name : in String; Mode : in File_Mode; - Info : in out File_Info) + Info : in out File_Info'Class) with Pre => not Is_Open (File), Post => Is_Open (File); @@ -352,8 +352,6 @@ private pragma Inline (Version_String); - - type Sound_File is tagged limited record Ptr : System.Address := System.Null_Address; FMode : File_Mode := Read_Only; @@ -368,7 +366,7 @@ private -- This cannot correspond to the C-side SF_INFO since sf_count_t can vary - type File_Info is record + type C_File_Info is record My_Frames : Interfaces.Integer_64; My_Sample_Rate : Interfaces.C.int; My_Channels : Interfaces.C.int; @@ -379,10 +377,12 @@ private My_Seekable : Interfaces.C.int; end record with Convention => C; - - Blank_Info : constant File_Info := (My_Frames => 0, others => 0); + type File_Info is tagged record + Data : C_File_Info; + end record; + Blank_Info : constant File_Info := (Data => (My_Frames => 0, others => 0)); procedure Raise_Error @@ -413,8 +413,6 @@ private return Interfaces.C.int; - - sf_false : constant Interfaces.C.int; pragma Import (C, sf_false, "sf_false"); @@ -422,8 +420,6 @@ private pragma Import (C, sf_true, "sf_true"); - - sfm_read : constant Interfaces.C.int; pragma Import (C, sfm_read, "sfm_read"); @@ -434,8 +430,6 @@ private pragma Import (C, sfm_rdwr, "sfm_rdwr"); - - sf_seek_set : constant Interfaces.C.int; pragma Import (C, sf_seek_set, "sf_seek_set"); @@ -446,8 +440,6 @@ private pragma Import (C, sf_seek_end, "sf_seek_end"); - - function sf_error (File : in System.Address) return Interfaces.C.int; -- cgit