From 1b804c13a6641626e8a2efa767bc921fd45be526 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20AMIARD?= Date: Thu, 28 May 2020 18:01:53 +0200 Subject: [PATCH] Port poly to example (#11) Add `Transpose` function to utils, and a test program. --- examples/asl_examples.ads | 50 +++++++++++++++++++++++++++++++ examples/asl_examples_soundio.gpr | 2 +- examples/example.adb | 6 ++-- examples/poly.adb | 7 ----- examples/poly_demo.ads | 48 ----------------------------- src/polyphony.adb | 24 ++++++++++----- src/polyphony.ads | 3 ++ src/sound_gen_interfaces.ads | 2 ++ src/utils.adb | 15 ++++++++++ src/utils.ads | 5 +++- 10 files changed, 96 insertions(+), 66 deletions(-) delete mode 100644 examples/poly.adb delete mode 100644 examples/poly_demo.ads diff --git a/examples/asl_examples.ads b/examples/asl_examples.ads index 81fcdf9..e9c5025 100644 --- a/examples/asl_examples.ads +++ b/examples/asl_examples.ads @@ -4,6 +4,7 @@ with Sound_Gen_Interfaces; use Sound_Gen_Interfaces; with Effects; use Effects; with Waves; use Waves; with BLIT; +with Polyphony; use Polyphony; package ASL_Examples is @@ -409,4 +410,53 @@ package ASL_Examples is procedure Init; end Programmatic_Drums; + package Poly_Synth is + BPM : constant := 120; + + SNL : constant Sample_Period := 4000; + S1 : constant Sequencer_Note := ((C, 3), SNL); + S2 : constant Sequencer_Note := ((F, 4), SNL); + S3 : constant Sequencer_Note := ((D_Sh, 4), SNL); + S4 : constant Sequencer_Note := ((A_Sh, 4), SNL); + S5 : constant Sequencer_Note := ((G, 4), SNL); + S6 : constant Sequencer_Note := ((D_Sh, 4), SNL); + + function Create_Voice + (Note_Gen : Note_Generator_Access) return Generator_Access + is + (Create_LP + (Create_Mixer + ((1 => (BLIT.Create_Saw (Create_Pitch_Gen (0, Note_Gen)), 0.5), + 2 => (BLIT.Create_Square + (Create_Pitch_Gen (0, Note_Gen)), 0.5)), + Volume_Mod => Create_ADSR (100, 1000, 100, 0.2, Note_Gen)), + Cut_Freq => Fixed + (200.0, + Modulator => new Attenuator' + (Level => 4500.0, + Source => Create_ADSR + (10, 1500, 200, 0.005, Note_Gen), + others => <>)), + Q => 0.4)); + + function Chord + (Base : Note_T; Base_Time : Sample_Period) return Note_Array + is + ((Base, 50_000, Base_Time), + (Transpose (Base, 3), 50_000, Base_Time + 100), + (Transpose (Base, 7), 50_000, Base_Time + 200), + (Transpose (Base, 14), 50_000, Base_Time + 400)); + + Synth : constant Poly := + Create_Polyphonic (8, Create_Voice'Unrestricted_Access) + .Add_Notes (Chord ((C, 2), 1)) + .Add_Notes (Chord ((F, 2), 50_000)) + .Add_Notes (Chord ((C, 3), 100_000)); + + Main : constant Generator_Access := + Create_Mixer (( + 0 => (Synth, 0.45) + )); + end Poly_Synth; + end ASL_Examples; diff --git a/examples/asl_examples_soundio.gpr b/examples/asl_examples_soundio.gpr index a552a5d..f95c0f9 100644 --- a/examples/asl_examples_soundio.gpr +++ b/examples/asl_examples_soundio.gpr @@ -11,7 +11,7 @@ project ASL_Examples_Soundio is package Linker renames Soundio.Linker; package Compiler renames Ada_Synth_Lib_Soundio.Compiler; - for Main use ("example.adb"); + for Main use ("example.adb", "transpose_test.adb"); end ASL_Examples_Soundio; diff --git a/examples/example.adb b/examples/example.adb index 753a80d..61c9625 100644 --- a/examples/example.adb +++ b/examples/example.adb @@ -17,7 +17,7 @@ procedure Example is (Help => "Run an example for ada-synth-lib"); type Example_Kind is (Full_Demo, Full_Demo_2, Trippy_Demo, Simple_Sine, - Programmatic_Drums); + Programmatic_Drums, Poly_Synth); type Backend_Kind is (Pulse_Audio, Stdout); package Example is new Parse_Enum_Option @@ -36,7 +36,9 @@ procedure Example is when Full_Demo_2 => ASL_Examples.Full_Demo_2.Main_Mixer, when Trippy_Demo => ASL_Examples.Trippy_Demo.Main, when Simple_Sine => ASL_Examples.Simple_Sine.Main, - when Programmatic_Drums => ASL_Examples.Programmatic_Drums.Main); + when Programmatic_Drums => ASL_Examples.Programmatic_Drums.Main, + when Poly_Synth => ASL_Examples.Poly_Synth.Main + ); end Arg; IO : constant access Soundio.SoundIo := Create; diff --git a/examples/poly.adb b/examples/poly.adb deleted file mode 100644 index be78b36..0000000 --- a/examples/poly.adb +++ /dev/null @@ -1,7 +0,0 @@ -with Poly_Demo; -with Write_To_Stdout; - -procedure Poly is -begin - Write_To_Stdout (Poly_Demo.Main_Mixer); -end Poly; diff --git a/examples/poly_demo.ads b/examples/poly_demo.ads deleted file mode 100644 index ba74e5f..0000000 --- a/examples/poly_demo.ads +++ /dev/null @@ -1,48 +0,0 @@ -with Utils; use Utils; -with Sound_Gen_Interfaces; use Sound_Gen_Interfaces; -with Effects; use Effects; -with Waves; use Waves; -with BLIT; -with Polyphony; use Polyphony; - -package Poly_Demo is - - BPM : constant := 120; - - SNL : constant Sample_Period := 4000; - S1 : constant Sequencer_Note := ((C, 3), SNL); - S2 : constant Sequencer_Note := ((F, 4), SNL); - S3 : constant Sequencer_Note := ((D_Sh, 4), SNL); - S4 : constant Sequencer_Note := ((A_Sh, 4), SNL); - S5 : constant Sequencer_Note := ((G, 4), SNL); - S6 : constant Sequencer_Note := ((D_Sh, 4), SNL); - - function Create_Voice - (Note_Gen : Note_Generator_Access) return Generator_Access - is - (Create_LP - (Create_Mixer - ((1 => (BLIT.Create_Saw (Create_Pitch_Gen (0, Note_Gen)), 0.5), - 2 => (BLIT.Create_Square (Create_Pitch_Gen (0, Note_Gen)), 0.5)), - Volume_Mod => Create_ADSR (100, 1000, 100, 0.2, Note_Gen)), - Cut_Freq => Fixed - (1000.0, - Modulator => new Attenuator' - (Level => 1500.0, - Source => Create_ADSR - (10, 150, 200, 0.005, Note_Gen), - others => <>)), - Q => 0.2)); - - Synth : constant Poly := - Create_Polyphonic (4, Create_Voice'Unrestricted_Access) - .Add_Note (((C, 2), 100_000, 1)) - .Add_Note (((E, 2), 100_000, 5000)) - .Add_Note (((G, 2), 100_000, 10000)) - .Add_Note (((C, 3), 100_000, 15000)); - - Main_Mixer : constant access Mixer := - Create_Mixer (( - 0 => (Synth, 0.45) - )); -end Poly_Demo; diff --git a/src/polyphony.adb b/src/polyphony.adb index 7f60a84..2d0378d 100644 --- a/src/polyphony.adb +++ b/src/polyphony.adb @@ -1,5 +1,5 @@ -with Effects; use Effects; with Ada.Text_IO; use Ada.Text_IO; +with Effects; use Effects; package body Polyphony is @@ -37,7 +37,6 @@ package body Polyphony is -- While we have notes, assign them to voices while Has_Element (Note_Cursor) loop N := Element (Note_Cursor); - Put_Line ("HAS NOTE ! " & N.Time'Image & " " & N.Duration'Image); exit when N.Time > Last_Sample; Self.Notes_Generators (Self.Current_Voice + 1) := Simple_Command' @@ -83,13 +82,24 @@ package body Polyphony is (Self : access Polyphonic_Instrument; N : Note) return Poly is begin - Put_Line ("Adding note, " & Img (N)); Self.Notes.Insert (N); - for El of Self.Notes loop - Put_Line (Img (El)); - end loop; - + Put_Line ("Adding note " & Img (N)); return Poly (Self); end Add_Note; + --------------- + -- Add_Notes -- + --------------- + + function Add_Notes + (Self : access Polyphonic_Instrument; N : Note_Array) return Poly + is + begin + for Note of N loop + Put_Line ("Adding note " & Img (Note)); + Self.Notes.Insert (Note); + end loop; + return Poly (Self); + end Add_Notes; + end Polyphony; diff --git a/src/polyphony.ads b/src/polyphony.ads index 82870ed..885d7d7 100644 --- a/src/polyphony.ads +++ b/src/polyphony.ads @@ -20,6 +20,9 @@ package Polyphony is function Add_Note (Self : access Polyphonic_Instrument; N : Note) return Poly; + function Add_Notes + (Self : access Polyphonic_Instrument; N : Note_Array) return Poly; + private function "<" (L, R : Note) return Boolean is (L.Time < R.Time); diff --git a/src/sound_gen_interfaces.ads b/src/sound_gen_interfaces.ads index fb1f33a..48fb87e 100644 --- a/src/sound_gen_interfaces.ads +++ b/src/sound_gen_interfaces.ads @@ -160,6 +160,8 @@ package Sound_Gen_Interfaces is Time : Sample_Period; end record; + type Note_Array is array (Positive range <>) of Note; + function Img (N : Note) return String is ("<" & Note_Img (N.Note) & " " & N.Time'Image & " " & N.Duration'Image & ">"); diff --git a/src/utils.adb b/src/utils.adb index a168155..65dc35d 100644 --- a/src/utils.adb +++ b/src/utils.adb @@ -92,6 +92,21 @@ package body Utils is + Rel_Pitch); end Note_To_Freq; + --------------- + -- Transpose -- + --------------- + + function Transpose (Note : Note_T; Semitones : Integer := 0) return Note_T + is + Degree : constant Integer := Scale_Degree_T'Pos (Note.Scale_Degree); + Oct_Shift : constant Integer := + Integer (Float'Floor (Float (Degree + Semitones) / 12.0)); + begin + return + (Octave => Note.Octave + Octave_T (Oct_Shift), + Scale_Degree => Scale_Degree_T'Val ((Degree + Semitones) mod 12)); + end Transpose; + --------- -- Sin -- --------- diff --git a/src/utils.ads b/src/utils.ads index 6f8e42e..8c4aa80 100644 --- a/src/utils.ads +++ b/src/utils.ads @@ -28,7 +28,7 @@ package Utils is G => White, G_Sh => Black); - type Octave_T is range -1 .. 10; + subtype Octave_T is Integer range -1 .. 10; type Note_T is record Scale_Degree : Scale_Degree_T; @@ -45,6 +45,9 @@ package Utils is No_Note : constant Note_T := (A, -1); + function Transpose (Note : Note_T; Semitones : Integer := 0) return Note_T; + -- Transpose `Note` by `Semitones` semitones. + function Note_To_Freq (N : Note_T; Rel_Pitch : Integer := 0) return Frequency;