Port poly to example (#11)

Add `Transpose` function to utils, and a test program.

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;

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;
 

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;

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;

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

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 & ">");

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

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;