diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/c_asndfile_command.c | 14 | ||||
| -rw-r--r-- | src/c_asndfile_command.h | 14 | ||||
| -rw-r--r-- | src/libsndfile-commands.adb | 608 | ||||
| -rw-r--r-- | src/libsndfile-commands.ads | 363 |
4 files changed, 710 insertions, 289 deletions
diff --git a/src/c_asndfile_command.c b/src/c_asndfile_command.c index 1d86b1c..2955d91 100644 --- a/src/c_asndfile_command.c +++ b/src/c_asndfile_command.c @@ -46,9 +46,14 @@ const int sfc_get_broadcast_info = SFC_GET_BROADCAST_INFO; const int sfc_set_broadcast_info = SFC_SET_BROADCAST_INFO; const int sfc_get_channel_map_info = SFC_GET_CHANNEL_MAP_INFO; const int sfc_set_channel_map_info = SFC_SET_CHANNEL_MAP_INFO; -// ... +const int sfc_get_cart_info = SFC_GET_CART_INFO; +const int sfc_set_cart_info = SFC_SET_CART_INFO; +const int sfc_get_loop_info = SFC_GET_LOOP_INFO; +const int sfc_get_instrument = SFC_GET_INSTRUMENT; +const int sfc_set_instrument = SFC_SET_INSTRUMENT; const int sfc_get_cue_count = SFC_GET_CUE_COUNT; -// ... +const int sfc_get_cue = SFC_GET_CUE; +const int sfc_set_cue = SFC_SET_CUE; const int sfc_rf64_auto_downgrade = SFC_RF64_AUTO_DOWNGRADE; const int sfc_get_original_samplerate = SFC_GET_ORIGINAL_SAMPLERATE; const int sfc_set_original_samplerate = SFC_SET_ORIGINAL_SAMPLERATE; @@ -58,6 +63,11 @@ const int sfc_set_bitrate_mode = SFC_SET_BITRATE_MODE; const int sf_ambisonic_none = SF_AMBISONIC_NONE; const int sf_ambisonic_b_format = SF_AMBISONIC_B_FORMAT; +const int sf_loop_none = SF_LOOP_NONE; +const int sf_loop_forward = SF_LOOP_FORWARD; +const int sf_loop_backward = SF_LOOP_BACKWARD; +const int sf_loop_alternating = SF_LOOP_ALTERNATING; + const int sf_bitrate_mode_constant = SF_BITRATE_MODE_CONSTANT; const int sf_bitrate_mode_average = SF_BITRATE_MODE_AVERAGE; const int sf_bitrate_mode_variable = SF_BITRATE_MODE_VARIABLE; diff --git a/src/c_asndfile_command.h b/src/c_asndfile_command.h index a9ed13e..41738f5 100644 --- a/src/c_asndfile_command.h +++ b/src/c_asndfile_command.h @@ -48,9 +48,14 @@ extern const int sfc_get_broadcast_info; extern const int sfc_set_broadcast_info; extern const int sfc_get_channel_map_info; extern const int sfc_set_channel_map_info; -// ... +extern const int sfc_get_cart_info; +extern const int sfc_set_cart_info; +extern const int sfc_get_loop_info; +extern const int sfc_get_instrument; +extern const int sfc_set_instrument; extern const int sfc_get_cue_count; -// ... +extern const int sfc_get_cue; +extern const int sfc_set_cue; extern const int sfc_rf64_auto_downgrade; extern const int sfc_get_original_samplerate; extern const int sfc_set_original_samplerate; @@ -60,6 +65,11 @@ extern const int sfc_set_bitrate_mode; extern const int sf_ambisonic_none; extern const int sf_ambisonic_b_format; +extern const int sf_loop_none; +extern const int sf_loop_forward; +extern const int sf_loop_backward; +extern const int sf_loop_alternating; + extern const int sf_bitrate_mode_constant; extern const int sf_bitrate_mode_average; extern const int sf_bitrate_mode_variable; diff --git a/src/libsndfile-commands.adb b/src/libsndfile-commands.adb index 0d3f767..364fa3e 100644 --- a/src/libsndfile-commands.adb +++ b/src/libsndfile-commands.adb @@ -135,12 +135,29 @@ package body Libsndfile.Commands is sfc_set_channel_map_info : constant Interfaces.C.int; pragma Import (C, sfc_set_channel_map_info, "sfc_set_channel_map_info"); - -- ... + sfc_get_cart_info : constant Interfaces.C.int; + pragma Import (C, sfc_get_cart_info, "sfc_get_cart_info"); + + sfc_set_cart_info : constant Interfaces.C.int; + pragma Import (C, sfc_set_cart_info, "sfc_set_cart_info"); + + sfc_get_loop_info : constant Interfaces.C.int; + pragma Import (C, sfc_get_loop_info, "sfc_get_loop_info"); + + sfc_get_instrument : constant Interfaces.C.int; + pragma Import (C, sfc_get_instrument, "sfc_get_instrument"); + + sfc_set_instrument : constant Interfaces.C.int; + pragma Import (C, sfc_set_instrument, "sfc_set_instrument"); sfc_get_cue_count : constant Interfaces.C.int; pragma Import (C, sfc_get_cue_count, "sfc_get_cue_count"); - -- ... + sfc_get_cue : constant Interfaces.C.int; + pragma Import (C, sfc_get_cue, "sfc_get_cue"); + + sfc_set_cue : constant Interfaces.C.int; + pragma Import (C, sfc_set_cue, "sfc_set_cue"); sfc_rf64_auto_downgrade : constant Interfaces.C.int; pragma Import (C, sfc_rf64_auto_downgrade, "sfc_rf64_auto_downgrade"); @@ -165,6 +182,19 @@ package body Libsndfile.Commands is pragma Import (C, sf_ambisonic_b_format, "sf_ambisonic_b_format"); + sf_loop_none : constant Interfaces.C.int; + pragma Import (C, sf_loop_none, "sf_loop_none"); + + sf_loop_forward : constant Interfaces.C.int; + pragma Import (C, sf_loop_forward, "sf_loop_forward"); + + sf_loop_backward : constant Interfaces.C.int; + pragma Import (C, sf_loop_backward, "sf_loop_backward"); + + sf_loop_alternating : constant Interfaces.C.int; + pragma Import (C, sf_loop_alternating, "sf_loop_alternating"); + + sf_bitrate_mode_constant : constant Interfaces.C.int; pragma Import (C, sf_bitrate_mode_constant, "sf_bitrate_mode_constant"); @@ -219,23 +249,59 @@ package body Libsndfile.Commands is function asfc_get_embed_file_info (File : in System.Address; - Info : in out Embedded_Info) + Info : in out C_Embedded_Info) return Interfaces.C.int; pragma Import (C, asfc_get_embed_file_info, "asfc_get_embed_file_info"); - ---------------------------------- - -- Data Structure Subprograms -- - ---------------------------------- + ------------------------ + -- Internal Utility -- + ------------------------ + + function To_Ada + (Num : in Interfaces.C.int) + return Loop_Mode is + begin + if Num = sf_loop_none then + return No_Loop; + elsif Num = sf_loop_forward then + return Loop_Forward; + elsif Num = sf_loop_backward then + return Loop_Backward; + elsif Num = sf_loop_alternating then + return Loop_Alternating; + else + raise Program_Error; + end if; + end To_Ada; + + function To_C + (Enum : in Loop_Mode) + return Interfaces.C.int is + begin + case Enum is + when No_Loop => return sf_loop_none; + when Loop_Forward => return sf_loop_forward; + when Loop_Backward => return sf_loop_backward; + when Loop_Alternating => return sf_loop_alternating; + end case; + end To_C; + + + + + --------------------------------- + -- Data Types and Structures -- + --------------------------------- function Major (Info : in Format_Info) return Major_Format is Raw : Interfaces.Unsigned_32 := - Interfaces.Unsigned_32 (Info.My_Format) and sf_format_typemask; + Interfaces.Unsigned_32 (Info.C_Data.My_Format) and sf_format_typemask; begin return To_Major (Interfaces.C.int (Raw)); end Major; @@ -245,7 +311,7 @@ package body Libsndfile.Commands is return Minor_Format is Raw : Interfaces.Unsigned_32 := - Interfaces.Unsigned_32 (Info.My_Format) and sf_format_submask; + Interfaces.Unsigned_32 (Info.C_Data.My_Format) and sf_format_submask; begin return To_Minor (Interfaces.C.int (Raw)); end Minor; @@ -255,7 +321,7 @@ package body Libsndfile.Commands is return Endianness is Raw : Interfaces.Unsigned_32 := - Interfaces.Unsigned_32 (Info.My_Format) and sf_format_endmask; + Interfaces.Unsigned_32 (Info.C_Data.My_Format) and sf_format_endmask; begin return To_Endian (Interfaces.C.int (Raw)); end Endian; @@ -264,172 +330,76 @@ package body Libsndfile.Commands is (Info : in Format_Info) return String is begin - return Interfaces.C.Strings.Value (Info.My_Name); + return Interfaces.C.Strings.Value (Info.C_Data.My_Name); end Name; function Extension (Info : in Format_Info) return String is begin - return Interfaces.C.Strings.Value (Info.My_Extension); + return Interfaces.C.Strings.Value (Info.C_Data.My_Extension); end Extension; - function Offset - (Info : in Embedded_Info) - return Count_Type is - begin - return Count_Type (Info.My_Offset); - end Offset; - - function Length - (Info : in Embedded_Info) - return Count_Type is - begin - return Count_Type (Info.My_Length); - end Length; - - function Create - (Description : in String; - Originator : in String; - Originator_Reference : in String; - Origination_Date : in String; - Origination_Time : in String; - Time_Reference_Low : in Interfaces.Unsigned_32; - Time_Reference_High : in Interfaces.Unsigned_32; - Version : in Short_Integer; - Umid : in String; - Reserved : in String; - Coding_History_Size : in Interfaces.Unsigned_32; - Coding_History : in String) - return Broadcast_Info - is - Buffer : String (1 .. 256); - - function Pad - (Input : in String; - Size : in Natural) - return String is - begin - Ada.Strings.Fixed.Move (Source => Input, Target => Buffer, Pad => Character'Val (0)); - return Buffer (1 .. Size); - end Pad; - begin - return - (My_Description => Interfaces.C.To_C (Pad (Description, 256), False), - My_Originator => Interfaces.C.To_C (Pad (Originator, 32), False), - My_Originator_Reference => Interfaces.C.To_C (Pad (Originator_Reference, 32), False), - My_Origination_Date => Interfaces.C.To_C (Pad (Origination_Date, 10), False), - My_Origination_Time => Interfaces.C.To_C (Pad (Origination_Time, 8), False), - My_Time_Reference_Low => Interfaces.C.unsigned (Time_Reference_Low), - My_Time_Reference_High => Interfaces.C.unsigned (Time_Reference_High), - My_Version => Interfaces.C.short (Version), - My_Umid => Interfaces.C.To_C (Pad (Umid, 64), False), - My_Reserved => Interfaces.C.To_C (Pad (Reserved, 190), False), - My_Coding_History_Size => Interfaces.C.unsigned (Coding_History_Size), - My_Coding_History => Interfaces.C.To_C (Pad (Coding_History, 256), False)); + (Base : in Instrument_Data; + Repeats : in Loop_Data_Array) + return Instrument_Info is + begin + return Result : Instrument_Info do + Result.C_Data.My_Gain := Interfaces.C.int (Base.Gain); + Result.C_Data.My_Basenote := Interfaces.C.char (Base.Basenote); + Result.C_Data.My_Detune := Interfaces.C.char (Base.Detune); + Result.C_Data.My_Velocity_Lo := Interfaces.C.char (Base.Velocity_Low); + Result.C_Data.My_Velocity_Hi := Interfaces.C.char (Base.Velocity_High); + Result.C_Data.My_Key_Lo := Interfaces.C.char (Base.Key_Low); + Result.C_Data.My_Key_Hi := Interfaces.C.char (Base.Key_High); + Result.C_Data.My_Loop_Count := Repeats'Length; + for Index in Repeats'Range loop + Result.C_Data.My_Loops (Index).My_Mode := + To_C (Repeats (Index).Mode); + Result.C_Data.My_Loops (Index).My_Start := + Interfaces.C.unsigned (Repeats (Index).Start); + Result.C_Data.My_Loops (Index).My_End := + Interfaces.C.unsigned (Repeats (Index).Finish); + Result.C_Data.My_Loops (Index).My_Count := + Interfaces.C.unsigned (Repeats (Index).Count); + end loop; + end return; end Create; - function Description - (Info : in Broadcast_Info) - return String is - begin - return Interfaces.C.To_Ada - (Info.My_Description, - Interfaces.C.Is_Nul_Terminated (Info.My_Description)); - end Description; - - function Originator - (Info : in Broadcast_Info) - return String is - begin - return Interfaces.C.To_Ada - (Info.My_Originator, - Interfaces.C.Is_Nul_Terminated (Info.My_Originator)); - end Originator; - - function Originator_Reference - (Info : in Broadcast_Info) - return String is - begin - return Interfaces.C.To_Ada - (Info.My_Originator_Reference, - Interfaces.C.Is_Nul_Terminated (Info.My_Originator_Reference)); - end Originator_Reference; - - function Origination_Date - (Info : in Broadcast_Info) - return String is - begin - return Interfaces.C.To_Ada - (Info.My_Origination_Date, - Interfaces.C.Is_Nul_Terminated (Info.My_Origination_Date)); - end Origination_Date; - - function Origination_Time - (Info : in Broadcast_Info) - return String is - begin - return Interfaces.C.To_Ada - (Info.My_Origination_Time, - Interfaces.C.Is_Nul_Terminated (Info.My_Origination_Time)); - end Origination_Time; - - function Time_Reference_Low - (Info : in Broadcast_Info) - return Interfaces.Unsigned_32 is - begin - return Interfaces.Unsigned_32 (Info.My_Time_Reference_Low); - end Time_Reference_Low; - - function Time_Reference_High - (Info : in Broadcast_Info) - return Interfaces.Unsigned_32 is - begin - return Interfaces.Unsigned_32 (Info.My_Time_Reference_High); - end Time_Reference_High; - - function Version - (Info : in Broadcast_Info) - return Short_Integer is - begin - return Short_Integer (Info.My_Version); - end Version; - - function Umid - (Info : in Broadcast_Info) - return String is - begin - return Interfaces.C.To_Ada - (Info.My_Umid, - Interfaces.C.Is_Nul_Terminated (Info.My_Umid)); - end Umid; - - function Reserved - (Info : in Broadcast_Info) - return String is - begin - return Interfaces.C.To_Ada - (Info.My_Reserved, - Interfaces.C.Is_Nul_Terminated (Info.My_Reserved)); - end Reserved; - - function Coding_History_Size - (Info : in Broadcast_Info) - return Interfaces.Unsigned_32 is - begin - return Interfaces.Unsigned_32 (Info.My_Coding_History_Size); - end Coding_History_Size; - - function Coding_History - (Info : in Broadcast_Info) - return String is - begin - return Interfaces.C.To_Ada - (Info.My_Coding_History, - Interfaces.C.Is_Nul_Terminated (Info.My_Coding_History)); - end Coding_History; + function Base + (Info : in Instrument_Info) + return Instrument_Data is + begin + return Result : Instrument_Data do + Result.Gain := Integer (Info.C_Data.My_Gain); + Result.Basenote := Character (Info.C_Data.My_Basenote); + Result.Detune := Character (Info.C_Data.My_Detune); + Result.Velocity_Low := Character (Info.C_Data.My_Velocity_Lo); + Result.Velocity_High := Character (Info.C_Data.My_Velocity_Hi); + Result.Key_Low := Character (Info.C_Data.My_Key_Lo); + Result.Key_High := Character (Info.C_Data.My_Key_Hi); + end return; + end Base; + + function Repeats + (Info : in Instrument_Info) + return Loop_Data_Array is + begin + return Result : Loop_Data_Array (1 .. Integer (Info.C_Data.My_Loop_Count)) do + for Index in Result'Range loop + Result (Index).Mode := + To_Ada (Info.C_Data.My_Loops (Index).My_Mode); + Result (Index).Start := + Interfaces.Unsigned_32 (Info.C_Data.My_Loops (Index).My_Start); + Result (Index).Finish := + Interfaces.Unsigned_32 (Info.C_Data.My_Loops (Index).My_End); + Result (Index).Count := + Interfaces.Unsigned_32 (Info.C_Data.My_Loops (Index).My_Count); + end loop; + end return; + end Repeats; @@ -714,7 +684,7 @@ package body Libsndfile.Commands is (Index : in Positive) return Format_Info is - Result : Format_Info := + Raw : C_Format_Info := (My_Format => Interfaces.C.int (Index) - 1, My_Name => Interfaces.C.Strings.Null_Ptr, My_Extension => Interfaces.C.Strings.Null_Ptr); @@ -723,12 +693,12 @@ package body Libsndfile.Commands is Code := sf_command (System.Null_Address, sfc_get_simple_format, - Result'Address, - Format_Info'Size / Interfaces.C.CHAR_BIT); + Raw'Address, + C_Format_Info'Size / Interfaces.C.CHAR_BIT); if Code /= 0 then raise Command_Error; else - return Result; + return (C_Data => Raw); end if; end Get_Simple_Format; @@ -736,7 +706,7 @@ package body Libsndfile.Commands is (Format : in Interfaces.C.int) return Format_Info is - Result : Format_Info := + Raw : C_Format_Info := (My_Format => Format, My_Name => Interfaces.C.Strings.Null_Ptr, My_Extension => Interfaces.C.Strings.Null_Ptr); @@ -745,12 +715,12 @@ package body Libsndfile.Commands is Code := sf_command (System.Null_Address, sfc_get_format_info, - Result'Address, - Format_Info'Size / Interfaces.C.CHAR_BIT); + Raw'Address, + C_Format_Info'Size / Interfaces.C.CHAR_BIT); if Code /= 0 then raise Command_Error; else - return Result; + return (C_Data => Raw); end if; end Do_Get_Format_Info; @@ -785,7 +755,7 @@ package body Libsndfile.Commands is (Index : in Positive) return Format_Info is - Result : Format_Info := + Raw : C_Format_Info := (My_Format => Interfaces.C.int (Index) - 1, My_Name => Interfaces.C.Strings.Null_Ptr, My_Extension => Interfaces.C.Strings.Null_Ptr); @@ -794,12 +764,12 @@ package body Libsndfile.Commands is Code := sf_command (System.Null_Address, sfc_get_format_major, - Result'Address, - Format_Info'Size / Interfaces.C.CHAR_BIT); + Raw'Address, + C_Format_Info'Size / Interfaces.C.CHAR_BIT); if Code /= 0 then raise Command_Error; else - return Result; + return (C_Data => Raw); end if; end Get_Format_Major; @@ -820,7 +790,7 @@ package body Libsndfile.Commands is (Index : in Positive) return Format_Info is - Result : Format_Info := + Raw : C_Format_Info := (My_Format => Interfaces.C.int (Index) - 1, My_Name => Interfaces.C.Strings.Null_Ptr, My_Extension => Interfaces.C.Strings.Null_Ptr); @@ -829,12 +799,12 @@ package body Libsndfile.Commands is Code := sf_command (System.Null_Address, sfc_get_format_subtype, - Result'Address, - Format_Info'Size / Interfaces.C.CHAR_BIT); + Raw'Address, + C_Format_Info'Size / Interfaces.C.CHAR_BIT); if Code /= 0 then raise Command_Error; else - return Result; + return (C_Data => Raw); end if; end Get_Format_Subtype; @@ -937,14 +907,16 @@ package body Libsndfile.Commands is (File : in Sound_File) return Embedded_Info is - Info : Embedded_Info; + Raw : C_Embedded_Info; Code : Interfaces.C.int; begin - Code := asfc_get_embed_file_info (File.Ptr, Info); + Code := asfc_get_embed_file_info (File.Ptr, Raw); if Code /= 0 then raise Command_Error; else - return Info; + return + (Offset => Count_Type (Raw.My_Offset), + Length => Count_Type (Raw.My_Length)); end if; end Get_Embedded_File_Info; @@ -1097,16 +1069,30 @@ package body Libsndfile.Commands is (File : in Sound_File) return Broadcast_Info is - Result : Broadcast_Info; + Raw : C_Broadcast_Info; Code : Interfaces.C.int; begin Code := sf_command (File.Ptr, sfc_get_broadcast_info, - Result'Address, - Broadcast_Info'Size / Interfaces.C.CHAR_BIT); + Raw'Address, + C_Broadcast_Info'Size / Interfaces.C.CHAR_BIT); if Code = sf_true then - return Result; + return Result : Broadcast_Info do + Result.Description := Interfaces.C.To_Ada (Raw.My_Description, False); + Result.Originator := Interfaces.C.To_Ada (Raw.My_Originator, False); + Result.Originator_Reference := + Interfaces.C.To_Ada (Raw.My_Originator_Reference, False); + Result.Origination_Date := Interfaces.C.To_Ada (Raw.My_Origination_Date, False); + Result.Origination_Time := Interfaces.C.To_Ada (Raw.My_Origination_Time, False); + Result.Time_Reference_Low := Interfaces.Unsigned_32 (Raw.My_Time_Reference_Low); + Result.Time_Reference_High := Interfaces.Unsigned_32 (Raw.My_Time_Reference_High); + Result.Version := Short_Integer (Raw.My_Version); + Result.Umid := Interfaces.C.To_Ada (Raw.My_Umid, False); + Result.Reserved := Interfaces.C.To_Ada (Raw.My_Reserved, False); + Result.Coding_History_Size := Interfaces.Unsigned_32 (Raw.My_Coding_History_Size); + Result.Coding_History := Interfaces.C.To_Ada (Raw.My_Coding_History, False); + end return; elsif Code = sf_false then raise Command_Error; else @@ -1118,13 +1104,26 @@ package body Libsndfile.Commands is (File : in Sound_File; Value : in Broadcast_Info) is + C_Data : C_Broadcast_Info := + (My_Description => Interfaces.C.To_C (Value.Description, False), + My_Originator => Interfaces.C.To_C (Value.Originator, False), + My_Originator_Reference => Interfaces.C.To_C (Value.Originator_Reference, False), + My_Origination_Date => Interfaces.C.To_C (Value.Origination_Date, False), + My_Origination_Time => Interfaces.C.To_C (Value.Origination_Time, False), + My_Time_Reference_Low => Interfaces.C.unsigned (Value.Time_Reference_Low), + My_Time_Reference_High => Interfaces.C.unsigned (Value.Time_Reference_High), + My_Version => Interfaces.C.short (Value.Version), + My_Umid => Interfaces.C.To_C (Value.Umid, False), + My_Reserved => Interfaces.C.To_C (Value.Reserved, False), + My_Coding_History_Size => Interfaces.C.unsigned (Value.Coding_History_Size), + My_Coding_History => Interfaces.C.To_C (Value.Coding_History, False)); Code : Interfaces.C.int; begin Code := sf_command (File.Ptr, sfc_set_broadcast_info, - Value'Address, - Broadcast_Info'Size / Interfaces.C.CHAR_BIT); + C_Data'Address, + C_Broadcast_Info'Size / Interfaces.C.CHAR_BIT); if Code = sf_false then raise Command_Error; elsif Code /= sf_true then @@ -1182,6 +1181,171 @@ package body Libsndfile.Commands is end if; end Set_Channel_Map_Info; + function Get_Cart_Info + (File : in Sound_File) + return Cart_Info + is + Raw : C_Cart_Info; + Code : Interfaces.C.int; + begin + Code := sf_command + (File.Ptr, + sfc_get_cart_info, + Raw'Address, + Raw'Size / Interfaces.C.CHAR_BIT); + if Code = sf_false then + raise Command_Error; + elsif Code = sf_true then + return Result : Cart_Info (Natural (Raw.My_Tag_Text_Size)) do + Result.Version := Interfaces.C.To_Ada (Raw.My_Version, False); + Result.Title := Interfaces.C.To_Ada (Raw.My_Title, False); + Result.Artist := Interfaces.C.To_Ada (Raw.My_Artist, False); + Result.Cut_ID := Interfaces.C.To_Ada (Raw.My_Cut_ID, False); + Result.Client_ID := Interfaces.C.To_Ada (Raw.My_Client_ID, False); + Result.Category := Interfaces.C.To_Ada (Raw.My_Category, False); + Result.Classification := Interfaces.C.To_Ada (Raw.My_Classification, False); + Result.Out_Cue := Interfaces.C.To_Ada (Raw.My_Out_Cue, False); + Result.Start_Date := Interfaces.C.To_Ada (Raw.My_Start_Date, False); + Result.Start_Time := Interfaces.C.To_Ada (Raw.My_Start_Time, False); + Result.End_Date := Interfaces.C.To_Ada (Raw.My_End_Date, False); + Result.End_Time := Interfaces.C.To_Ada (Raw.My_End_Time, False); + Result.Producer_App_ID := Interfaces.C.To_Ada (Raw.My_Producer_App_ID, False); + Result.Producer_App_Version := + Interfaces.C.To_Ada (Raw.My_Producer_App_Version, False); + Result.User_Defined := Interfaces.C.To_Ada (Raw.My_User_Def, False); + Result.Level_Reference := Long_Integer (Raw.My_Level_Reference); + for Index in Result.Post_Timers'Range loop + Result.Post_Timers (Index).Usage := + Interfaces.C.To_Ada (Raw.My_Post_Timers (Index).My_Usage, False); + Result.Post_Timers (Index).Value := Raw.My_Post_Timers (Index).My_Value; + end loop; + Result.Reserved := Interfaces.C.To_Ada (Raw.My_Reserved, False); + Result.URL := Interfaces.C.To_Ada (Raw.My_URL, False); + Result.Tag_Text := Interfaces.C.To_Ada + (Raw.My_Tag_Text (1 .. Interfaces.C.size_t (Raw.My_Tag_Text_Size)), False); + end return; + else + raise Program_Error; + end if; + end Get_Cart_Info; + + procedure Set_Cart_Info + (File : in Sound_File; + Info : in Cart_Info) + is + C_Data : C_Cart_Info := + (My_Version => Interfaces.C.To_C (Info.Version, False), + My_Title => Interfaces.C.To_C (Info.Title, False), + My_Artist => Interfaces.C.To_C (Info.Artist, False), + My_Cut_ID => Interfaces.C.To_C (Info.Cut_ID, False), + My_Client_ID => Interfaces.C.To_C (Info.Client_ID, False), + My_Category => Interfaces.C.To_C (Info.Category, False), + My_Classification => Interfaces.C.To_C (Info.Classification, False), + My_Out_Cue => Interfaces.C.To_C (Info.Out_Cue, False), + My_Start_Date => Interfaces.C.To_C (Info.Start_Date, False), + My_Start_Time => Interfaces.C.To_C (Info.Start_Time, False), + My_End_Date => Interfaces.C.To_C (Info.End_Date, False), + My_End_Time => Interfaces.C.To_C (Info.End_Time, False), + My_Producer_App_ID => Interfaces.C.To_C (Info.Producer_App_ID, False), + My_Producer_App_Version => Interfaces.C.To_C (Info.Producer_App_Version, False), + My_User_Def => Interfaces.C.To_C (Info.User_Defined, False), + My_Level_Reference => Interfaces.C.long (Info.Level_Reference), + My_Post_Timers => (others => (" ", 0)), + My_Reserved => Interfaces.C.To_C (Info.Reserved, False), + My_URL => Interfaces.C.To_C (Info.URL, False), + My_Tag_Text_Size => Interfaces.C.unsigned (Info.Tag_Size), + My_Tag_Text => (others => ' ')); + Code : Interfaces.C.int; + begin + for Index in C_Data.My_Post_Timers'Range loop + C_Data.My_Post_Timers (Index).My_Usage := Interfaces.C.To_C + (Info.Post_Timers (Index).Usage, False); + C_Data.My_Post_Timers (Index).My_Value := Info.Post_Timers (Index).Value; + end loop; + C_Data.My_Tag_Text (1 .. Interfaces.C.size_t (C_Data.My_Tag_Text_Size)) := + Interfaces.C.To_C (Info.Tag_Text, False); + Code := sf_command + (File.Ptr, + sfc_set_cart_info, + C_Data'Address, + C_Data'Size / Interfaces.C.CHAR_BIT); + if Code = sf_false then + raise Command_Error; + elsif Code /= sf_true then + raise Program_Error; + end if; + end Set_Cart_Info; + + function Get_Loop_Info + (File : in Sound_File) + return Loop_Info + is + Raw : C_Loop_Info; + Code : Interfaces.C.int; + begin + Code := sf_command + (File.Ptr, + sfc_get_loop_info, + Raw'Address, + C_Loop_Info'Size / Interfaces.C.CHAR_BIT); + if Code = sf_false then + raise Command_Error; + elsif Code = sf_true then + return Result : Loop_Info do + Result.Time_Sig_Num := Short_Integer (Raw.My_Time_Sig_Num); + Result.Time_Sig_Den := Short_Integer (Raw.My_Time_Sig_Den); + Result.Mode := To_Ada (Raw.My_Loop_Mode); + Result.Beats := Positive (Raw.My_Num_Beats); + Result.BPM := Beats_Per_Minute (Raw.My_BPM); + Result.Root_Key := MIDI_Note (Raw.My_Root_Key); + for Index in Result.Future'Range loop + Result.Future (Index) := Integer (Raw.My_Future (Index)); + end loop; + end return; + else + raise Program_Error; + end if; + end Get_Loop_Info; + + function Get_Instrument + (File : in Sound_File) + return Instrument_Info + is + Result : Instrument_Info; + Code : Interfaces.C.int; + begin + Code := sf_command + (File.Ptr, + sfc_get_instrument, + Result.C_Data'Address, + C_Instrument_Info'Size / Interfaces.C.CHAR_BIT); + if Code = sf_false then + raise Command_Error; + elsif Code = sf_true then + return Result; + else + raise Program_Error; + end if; + end Get_Instrument; + + procedure Set_Instrument + (File : in Sound_File; + Info : in Instrument_Info) + is + Code : Interfaces.C.int; + begin + Code := sf_command + (File.Ptr, + sfc_set_instrument, + Info.C_Data'Address, + C_Instrument_Info'Size / Interfaces.C.CHAR_BIT); + if Code = sf_false then + raise Command_Error; + elsif Code /= sf_true then + raise Program_Error; + end if; + end Set_Instrument; + function Get_Cue_Count (File : in Sound_File) return Interfaces.Unsigned_32 @@ -1203,6 +1367,74 @@ package body Libsndfile.Commands is end if; end Get_Cue_Count; + function Get_Cue + (File : in Sound_File) + return Cue_Marker_Array + is + Raw : C_Cue_Info; + Code : Interfaces.C.int; + begin + Code := sf_command + (File.Ptr, + sfc_get_cue, + Raw'Address, + C_Cue_Info'Size / Interfaces.C.CHAR_BIT); + if Code = sf_false then + raise Command_Error; + elsif Code = sf_true then + return Result : Cue_Marker_Array (1 .. Integer (Raw.My_Cue_Count)) do + for Index in Result'Range loop + Result (Index).Index := Integer (Raw.My_Cue_Points (Index).My_Indx); + Result (Index).Position := Raw.My_Cue_Points (Index).My_Position; + Result (Index).FCC_Chunk := Integer (Raw.My_Cue_Points (Index).My_FCC_Chunk); + Result (Index).Chunk_Start := + Integer (Raw.My_Cue_Points (Index).My_Chunk_Start); + Result (Index).Block_Start := + Integer (Raw.My_Cue_Points (Index).My_Block_Start); + Result (Index).Sample_Offset := Raw.My_Cue_Points (Index).My_Sample_Offset; + Result (Index).Name := + Interfaces.C.To_Ada (Raw.My_Cue_Points (Index).My_Name, False); + end loop; + end return; + else + raise Program_Error; + end if; + end Get_Cue; + + procedure Set_Cue + (File : in Sound_File; + Info : in Cue_Marker_Array) + is + C_Data : C_Cue_Info; + Code : Interfaces.C.int; + begin + C_Data.My_Cue_Count := Info'Length; + for Index in Info'Range loop + C_Data.My_Cue_Points (Index).My_Indx := + Interfaces.Integer_32 (Info (Index).Index); + C_Data.My_Cue_Points (Index).My_Position := Info (Index).Position; + C_Data.My_Cue_Points (Index).My_FCC_Chunk := + Interfaces.Integer_32 (Info (Index).FCC_Chunk); + C_Data.My_Cue_Points (Index).My_Chunk_Start := + Interfaces.Integer_32 (Info (Index).Chunk_Start); + C_Data.My_Cue_Points (Index).My_Block_Start := + Interfaces.Integer_32 (Info (Index).Block_Start); + C_Data.My_Cue_Points (Index).My_Sample_Offset := Info (Index).Sample_Offset; + C_Data.My_Cue_Points (Index).My_Name := + Interfaces.C.To_C (Info (Index).Name, False); + end loop; + Code := sf_command + (File.Ptr, + sfc_set_cue, + C_Data'Address, + C_Cue_Info'Size / Interfaces.C.CHAR_BIT); + if Code = sf_false then + raise Command_Error; + elsif Code /= sf_true then + raise Program_Error; + end if; + end Set_Cue; + procedure RF64_Auto_Downgrade (File : in Sound_File; Value : in Boolean) diff --git a/src/libsndfile-commands.ads b/src/libsndfile-commands.ads index 8540fdc..45e5098 100644 --- a/src/libsndfile-commands.ads +++ b/src/libsndfile-commands.ads @@ -23,7 +23,7 @@ package Libsndfile.Commands is type Long_Float_Array is array (Positive range <>) of Long_Float; - type Format_Info is private; + type Format_Info is tagged private; function Major (Info : in Format_Info) @@ -46,16 +46,10 @@ package Libsndfile.Commands is return String; - type Embedded_Info is private; - - function Offset - (Info : in Embedded_Info) - return Count_Type; - - function Length - (Info : in Embedded_Info) - return Count_Type; - + type Embedded_Info is record + Offset : Count_Type; + Length : Count_Type; + end record; type Ambisonic is (Ambisonic_Unsupported, @@ -64,81 +58,20 @@ package Libsndfile.Commands is subtype Compression is Long_Float range 0.0 .. 1.0; - - type Broadcast_Info is private; - - function Create - (Description : in String; - Originator : in String; - Originator_Reference : in String; - Origination_Date : in String; - Origination_Time : in String; - Time_Reference_Low : in Interfaces.Unsigned_32; - Time_Reference_High : in Interfaces.Unsigned_32; - Version : in Short_Integer; - Umid : in String; - Reserved : in String; - Coding_History_Size : in Interfaces.Unsigned_32; - Coding_History : in String) - return Broadcast_Info - with Pre => - Description'Length <= 256 and - Originator'Length <= 32 and - Originator_Reference'Length <= 32 and - Origination_Date'Length <= 10 and - Origination_Time'Length <= 8 and - Umid'Length <= 64 and - Reserved'Length <= 190 and - Coding_History'Length <= 256; - - function Description - (Info : in Broadcast_Info) - return String; - - function Originator - (Info : in Broadcast_Info) - return String; - - function Originator_Reference - (Info : in Broadcast_Info) - return String; - - function Origination_Date - (Info : in Broadcast_Info) - return String; - - function Origination_Time - (Info : in Broadcast_Info) - return String; - - function Time_Reference_Low - (Info : in Broadcast_Info) - return Interfaces.Unsigned_32; - - function Time_Reference_High - (Info : in Broadcast_Info) - return Interfaces.Unsigned_32; - - function Version - (Info : in Broadcast_Info) - return Short_Integer; - - function Umid - (Info : in Broadcast_Info) - return String; - - function Reserved - (Info : in Broadcast_Info) - return String; - - function Coding_History_Size - (Info : in Broadcast_Info) - return Interfaces.Unsigned_32; - - function Coding_History - (Info : in Broadcast_Info) - return String; - + type Broadcast_Info is record + Description : String (1 .. 256); + Originator : String (1 .. 32); + Originator_Reference : String (1 .. 32); + Origination_Date : String (1 .. 10); + Origination_Time : String (1 .. 8); + Time_Reference_Low : Interfaces.Unsigned_32; + Time_Reference_High : Interfaces.Unsigned_32; + Version : Short_Integer; + Umid : String (1 .. 64); + Reserved : String (1 .. 190); + Coding_History_Size : Interfaces.Unsigned_32; + Coding_History : String (1 .. 256); + end record; type Channel_Map is (Map_Invalid, @@ -172,6 +105,117 @@ package Libsndfile.Commands is type Channel_Map_Array is array (Positive range <>) of Channel_Map; + + type Cart_Timer is record + Usage : String (1 .. 4); + Value : Interfaces.Integer_32; + end record; + + type Cart_Timer_Array is array (Positive range <>) of Cart_Timer; + + -- Is 1024 enough? Who knows! I hate this API + Max_Cart_Tag_Size : constant Natural := 1024; + + type Cart_Info (Tag_Size : Natural) is record + Version : String (1 .. 4); + Title : String (1 .. 64); + Artist : String (1 .. 64); + Cut_ID : String (1 .. 64); + Client_ID : String (1 .. 64); + Category : String (1 .. 64); + Classification : String (1 .. 64); + Out_Cue : String (1 .. 64); + Start_Date : String (1 .. 10); + Start_Time : String (1 .. 8); + End_Date : String (1 .. 10); + End_Time : String (1 .. 8); + Producer_App_ID : String (1 .. 64); + Producer_App_Version : String (1 .. 64); + User_Defined : String (1 .. 64); + Level_Reference : Long_Integer; + Post_Timers : Cart_Timer_Array (1 .. 8); + Reserved : String (1 .. 276); + URL : String (1 .. 1024); + Tag_Text : String (1 .. Tag_Size); + end record; + + + type Loop_Mode is + (No_Loop, + Loop_Forward, + Loop_Backward, + Loop_Alternating); + + type Beats_Per_Minute is delta 10.0**(-2) digits 5 range 0.0 .. 655.0; + + subtype MIDI_Note is Integer range -1 .. 127; + No_Note : constant MIDI_Note := -1; + + type Integer_Array is array (Positive range <>) of Integer; + + type Loop_Info is record + Time_Sig_Num : Short_Integer; + Time_Sig_Den : Short_Integer; + Mode : Loop_Mode; + Beats : Positive; + BPM : Beats_Per_Minute; + Root_Key : MIDI_Note; + Future : Integer_Array (1 .. 6); + end record; + + + -- Many of these fields should likely be something more specific + -- However it is hard to tell exactly what would be best + type Instrument_Data is record + Gain : Integer; + Basenote : Character; + Detune : Character; + Velocity_Low : Character; + Velocity_High : Character; + Key_Low : Character; + Key_High : Character; + end record; + + type Loop_Data is record + Mode : Loop_Mode; + Start : Interfaces.Unsigned_32; + Finish : Interfaces.Unsigned_32; + Count : Interfaces.Unsigned_32; + end record; + + type Loop_Data_Array is array (Positive range <>) of Loop_Data; + + type Instrument_Info is tagged private; + + function Create + (Base : in Instrument_Data; + Repeats : in Loop_Data_Array) + return Instrument_Info + with Pre => Repeats'Length <= 16; + + function Base + (Info : in Instrument_Info) + return Instrument_Data; + + function Repeats + (Info : in Instrument_Info) + return Loop_Data_Array + with Post => Repeats'Result'Length <= 16; + + + type Cue_Marker is record + Index : Integer; + Position : Interfaces.Unsigned_32; + FCC_Chunk : Integer; + Chunk_Start : Integer; + Block_Start : Integer; + Sample_Offset : Interfaces.Unsigned_32; + Name : String (1 .. 256); + end record; + + type Cue_Marker_Array is array (Positive range <>) of Cue_Marker; + + type Bitrate_Mode is (Constant_Mode, Average_Mode, @@ -184,7 +228,6 @@ package Libsndfile.Commands is -- Exceptions -- ------------------ - -- May be raised by Get_Signal_Maximum, Get_Maximum_All_Channels Command_Error : exception; @@ -359,23 +402,41 @@ package Libsndfile.Commands is (File : in Sound_File; Value : in Channel_Map_Array); - -- Get_Cart_Info goes here + function Get_Cart_Info + (File : in Sound_File) + return Cart_Info + with Post => Get_Cart_Info'Result.Tag_Size <= Max_Cart_Tag_Size; - -- Set_Cart_Info goes here + procedure Set_Cart_Info + (File : in Sound_File; + Info : in Cart_Info) + with Pre => Info.Tag_Size <= Max_Cart_Tag_Size; - -- Get_Loop_Info goes here + function Get_Loop_Info + (File : in Sound_File) + return Loop_Info; - -- Get_Instrument goes here + function Get_Instrument + (File : in Sound_File) + return Instrument_Info; - -- Set_Instrument goes here + procedure Set_Instrument + (File : in Sound_File; + Info : in Instrument_Info); function Get_Cue_Count (File : in Sound_File) return Interfaces.Unsigned_32; - -- Get_Cue goes here + function Get_Cue + (File : in Sound_File) + return Cue_Marker_Array + with Post => Get_Cue'Result'Length <= 100; - -- Set_Cue goes here + procedure Set_Cue + (File : in Sound_File; + Info : in Cue_Marker_Array) + with Pre => Info'Length <= 100; -- Why the hell would you design this command in this way? -- You shouldn't have to intentionally try to set the thing after writing @@ -405,23 +466,27 @@ private -- This corresponds to the C-side SF_FORMAT_INFO - type Format_Info is record + type C_Format_Info is record My_Format : Interfaces.C.int; My_Name : Interfaces.C.Strings.chars_ptr; My_Extension : Interfaces.C.Strings.chars_ptr; end record with Convention => C; + type Format_Info is tagged record + C_Data : C_Format_Info; + end record; + -- This cannot correspond to the C-side SF_EMBED_FILE_INFO struct since -- sf_count_t can vary - type Embedded_Info is record + type C_Embedded_Info is record My_Offset : Interfaces.Integer_64; My_Length : Interfaces.Integer_64; end record with Convention => C; -- This corresponds to the C-side SF_BROADCAST_INFO - type Broadcast_Info is record + type C_Broadcast_Info is record My_Description : Interfaces.C.char_array (1 .. 256); My_Originator : Interfaces.C.char_array (1 .. 32); My_Originator_Reference : Interfaces.C.char_array (1 .. 32); @@ -437,6 +502,110 @@ private end record with Convention => C; + -- This corresponds to the C-side SF_CART_TIMER + type C_Cart_Timer is record + My_Usage : Interfaces.C.char_array (1 .. 4); + My_Value : Interfaces.Integer_32; + end record with Convention => C; + + type C_Cart_Timer_Array is array (Positive range <>) of C_Cart_Timer; + + -- This corresponds to the C-side SF_CART_INFO + type C_Cart_Info is record + My_Version : Interfaces.C.char_array (1 .. 4); + My_Title : Interfaces.C.char_array (1 .. 64); + My_Artist : Interfaces.C.char_array (1 .. 64); + My_Cut_ID : Interfaces.C.char_array (1 .. 64); + My_Client_ID : Interfaces.C.char_array (1 .. 64); + My_Category : Interfaces.C.char_array (1 .. 64); + My_Classification : Interfaces.C.char_array (1 .. 64); + My_Out_Cue : Interfaces.C.char_array (1 .. 64); + My_Start_Date : Interfaces.C.char_array (1 .. 10); + My_Start_Time : Interfaces.C.char_array (1 .. 8); + My_End_Date : Interfaces.C.char_array (1 .. 10); + My_End_Time : Interfaces.C.char_array (1 .. 8); + My_Producer_App_ID : Interfaces.C.char_array (1 .. 64); + My_Producer_App_Version : Interfaces.C.char_array (1 .. 64); + My_User_Def : Interfaces.C.char_array (1 .. 64); + My_Level_Reference : Interfaces.C.long; + My_Post_Timers : C_Cart_Timer_Array (1 .. 8); + My_Reserved : Interfaces.C.char_array (1 .. 276); + My_URL : Interfaces.C.char_array (1 .. 1024); + My_Tag_Text_Size : Interfaces.C.unsigned; + My_Tag_Text : Interfaces.C.char_array + (1 .. Interfaces.C.size_t (Max_Cart_Tag_Size)); + end record with Convention => C; + + + type C_Int_Array is array (Positive range <>) of Interfaces.C.int; + + -- This corresponds to the C-side SF_LOOP_INFO struct + type C_Loop_Info is record + My_Time_Sig_Num : Interfaces.C.short; + My_Time_Sig_Den : Interfaces.C.short; + My_Loop_Mode : Interfaces.C.int; + My_Num_Beats : Interfaces.C.int; + My_BPM : Interfaces.C.C_float; + My_Root_Key : Interfaces.C.int; + My_Future : C_Int_Array (1 .. 6); + end record with Convention => C; + + + type C_Loop_Data is record + My_Mode : Interfaces.C.int; + My_Start : Interfaces.C.unsigned; + My_End : Interfaces.C.unsigned; + My_Count : Interfaces.C.unsigned; + end record with Convention => C; + + type C_Loop_Data_Array is array (Positive range <>) of C_Loop_Data; + + -- This corresponds to the C-side SF_INSTRUMENT struct + type C_Instrument_Info is record + My_Gain : Interfaces.C.int; + My_Basenote : Interfaces.C.char; + My_Detune : Interfaces.C.char; + My_Velocity_Lo : Interfaces.C.char; + My_Velocity_Hi : Interfaces.C.char; + My_Key_Lo : Interfaces.C.char; + My_Key_Hi : Interfaces.C.char; + My_Loop_Count : Interfaces.C.int; + My_Loops : C_Loop_Data_Array (1 .. 16); + end record with Convention => C; + + type Instrument_Info is tagged record + C_Data : C_Instrument_Info; + end record; + + + type C_Cue is record + My_Indx : Interfaces.Integer_32; + My_Position : Interfaces.Unsigned_32; + My_FCC_Chunk : Interfaces.Integer_32; + My_Chunk_Start : Interfaces.Integer_32; + My_Block_Start : Interfaces.Integer_32; + My_Sample_Offset : Interfaces.Unsigned_32; + My_Name : Interfaces.C.char_array (1 .. 256); + end record with Convention => C; + + type C_Cue_Array is array (Positive range <>) of C_Cue; + + -- This corresponds to the C-side SF_CUES struct + type C_Cue_Info is record + My_Cue_Count : Interfaces.C.int; + My_Cue_Points : C_Cue_Array (1 .. 100); + end record with Convention => C; + + + function To_Ada + (Num : in Interfaces.C.int) + return Loop_Mode; + + function To_C + (Enum : in Loop_Mode) + return Interfaces.C.int; + + end Libsndfile.Commands; |