MIDI implemenation and Sine_Generator changes

ada_synth_lib.gpr

@@ -21,9 +21,14 @@ project Ada_Synth_Lib is
    end case;
 
    package Builder is
-      for Global_Configuration_Pragmas use "./gnat.adc";
+      case Build_Type is
+         when "native" =>
+            for Global_Configuration_Pragmas use "./gnat.adc";
+         when "bareboard" =>
+            for Global_Configuration_Pragmas use "./gnat-ravenscar.adc";
+      end case;
    end Builder;
-
+   
    package Compiler is
       case Build is
          when "Debug" =>

examples/asl_examples.gpr

@@ -4,5 +4,5 @@ project ASL_Examples is
    for Object_Dir use "obj";
    for Source_Dirs use (".");
    for Main use ("simple_sine.adb", "simple_sine_2.adb", "audio.adb",
-                 "audio_2.adb", "audio_3.adb");
+                 "audio_2.adb", "audio_3.adb", "midi_test");
 end ASL_Examples;

examples/midi_synthesizer.adb

@@ -0,0 +1,113 @@
+with Ada.Text_IO; use Ada.Text_IO;
+
+package body MIDI_Synthesizer is
+   procedure Update_ADSR (Self : in out Synthesizer) is
+      Value : Float;
+   begin
+      for I in Self.ADSR_Config'Range loop
+         Value :=
+           Float (Self.ADSR_Config (I).Value) * Self.ADSR_Config (I).Factor;
+         Self.Env0.Set_Value (I, Value);
+         --Put_Line (Standard_Error, "index: " & Integer'Image(I) & " = " & Float'Image(Value));
+      end loop;
+   end Update_ADSR;
+
+   function Create_Synthesizer return access Synthesizer is
+      Ret    : constant access Synthesizer := new Synthesizer;
+      Base   : Float                       := 8.1757989156;  -- MIDI note C1 0
+      Freq0  : access Fixed_Gen            := Fixed;
+      Gen0   : access Sine_Generator       := Create_Sine (Freq0);
+      Env0   : access ADSR := Create_ADSR (5, 50, 800, 0.5, null);
+      Mixer0 : access Mixer := Create_Mixer ((0 => (Gen0, 0.5)), Env => Env0);
+   begin
+      Ret.MIDI_Parser := Create_Parser (Ret);
+      for I in Ret.MIDI_Notes'Range loop
+         Ret.MIDI_Notes (I) := Base;
+         Base               := Base * 1.059463094359;  -- 2^(1/12)
+      end loop;
+      Ret.Freq0       := Freq0;
+      Ret.Env0        := Env0;
+      Ret.Mixer0      := Mixer0;
+      Ret.ADSR_Config :=
+        ((16#66#, 1, 1, 100, 0.05),
+         (16#67#, 1, 1, 100, 0.05),
+         (16#68#, 10, 1, 100, 0.05),
+         (16#69#, 20, 1, 100, 0.05));
+      Ret.Update_ADSR;
+      return Ret;
+   end Create_Synthesizer;
+
+   procedure Parse_MIDI_Byte
+     (Self     : in out Synthesizer;
+      Received : in     Unsigned_8)
+   is
+   begin
+      Self.MIDI_Parser.Parse (Received);
+   end Parse_MIDI_Byte;
+
+   procedure Note_On
+     (Self     : in out Synthesizer;
+      Channel  : in     Unsigned_8;
+      Note     : in     Unsigned_8;
+      Velocity : in     Unsigned_8)
+   is
+   begin
+      Self.Env0.Gate_On;
+      Self.Freq0.Set_Value (0, Self.MIDI_Notes (Integer (Note mod 128)));
+   end Note_On;
+
+   procedure Note_Off
+     (Self     : in out Synthesizer;
+      Channel  : in     Unsigned_8;
+      Note     : in     Unsigned_8;
+      Velocity : in     Unsigned_8)
+   is
+   begin
+      Self.Env0.Gate_Off;
+   end Note_Off;
+
+   -- Testing with an Arturia Beatstep Pro:
+   -- The 16 rotary encoders are configured for relative mode.
+   -- For increasing, the following sequence is sent:
+   -- B0 66 40
+   -- B0 66 41
+   -- For decreasing the following sequence:
+   -- B0 66 40
+   -- B0 66 3F
+   -- where 66 specifies the encoder number, and goes up to 75 (all value hex).
+   procedure Control_Change
+     (Self              : in out Synthesizer;
+      Channel           : in     Unsigned_8;
+      Controller_Number : in     Unsigned_8;
+      Controller_Value  : in     Unsigned_8)
+   is
+      Encoder : Integer := 0;
+      Incr    : Integer := 0;
+   begin
+      if Controller_Value = 16#41# then
+         Incr := 1;
+      elsif Controller_Value = 16#3f# then
+         Incr := -1;
+      end if;
+      if Incr /= 0 then
+         for I in Self.ADSR_Config'Range loop
+            if Self.ADSR_Config (I).Controller_Index = Controller_Number then
+               Self.ADSR_Config (I).Value := Self.ADSR_Config (I).Value + Incr;
+               if Self.ADSR_Config (I).Value <
+                 Self.ADSR_Config (I).Min_Value
+               then
+                  Self.ADSR_Config (I).Value := Self.ADSR_Config (I).Min_Value;
+               end if;
+               if Self.ADSR_Config (I).Value >
+                 Self.ADSR_Config (I).Max_Value
+               then
+                  Self.ADSR_Config (I).Value := Self.ADSR_Config (I).Max_Value;
+               end if;
+               Self.Update_ADSR;
+               exit;
+            end if;
+         end loop;
+      end if;
+   end Control_Change;
+
+end MIDI_Synthesizer;

examples/midi_synthesizer.ads

@@ -0,0 +1,51 @@
+with Interfaces; use Interfaces;
+with Waves;      use Waves;
+with Effects;    use Effects;
+with MIDI;       use MIDI;
+
+package MIDI_Synthesizer is
+
+   type Freq_Table is array (0 .. 127) of Float;
+
+   type ADSR_Config_Entry is record
+      Controller_Index : Unsigned_8;
+      Value            : Integer;
+      Min_Value        : Integer;
+      Max_Value        : Integer;
+      Factor           : Float;
+   end record;
+
+   type ADSR_Config_Array is array (0 .. 3) of ADSR_Config_Entry;
+
+   type Synthesizer is new I_Event_Listener with record
+      MIDI_Parser : access Parser'Class;
+      MIDI_Notes  : Freq_Table;
+      Freq0       : access Fixed_Gen;
+      Env0        : access ADSR;
+      Mixer0      : access Mixer;
+      ADSR_Config : ADSR_Config_Array;
+   end record;
+
+   function Create_Synthesizer return access Synthesizer;
+
+   procedure Parse_MIDI_Byte
+     (Self     : in out Synthesizer;
+      Received : in     Unsigned_8);
+
+   overriding procedure Note_On
+     (Self     : in out Synthesizer;
+      Channel  : in     Unsigned_8;
+      Note     : in     Unsigned_8;
+      Velocity : in     Unsigned_8);
+   overriding procedure Note_Off
+     (Self     : in out Synthesizer;
+      Channel  : in     Unsigned_8;
+      Note     : in     Unsigned_8;
+      Velocity : in     Unsigned_8);
+   overriding procedure Control_Change
+     (Self              : in out Synthesizer;
+      Channel           : in     Unsigned_8;
+      Controller_Number : in     Unsigned_8;
+      Controller_Value  : in     Unsigned_8);
+
+end MIDI_Synthesizer;

examples/midi_test.adb

@@ -0,0 +1,59 @@
+-- This sample program receives MIDI events from a keyboard and from
+-- rotary encoders and outputs audio, like a synthesizer.
+-- Call it like this from Linux:
+--
+-- amidi -p "hw:1,0,0" -r >(./obj/midi_test | aplay -f S16_LE -c1 -r44100 --buffer-size=4096)
+--
+-- The BASH syntax ">(program)" creates a temporary FIFO file, because amidi
+-- needs a file where it writes the received MIDI events. In case of problems,
+-- you can also create a named FIFO with "mkfifo", then start amidi in the
+-- background writing to this file, and then the midi_test program like this:
+--
+-- cat midi | ./obj/midi_test | aplay -f S16_LE -c1 -r44100 --buffer-size=4096)
+--
+-- where "midi" is the named FIFO file. If it keeps playing a tone when you stop
+-- the program with ctrl-c, try this command:
+--
+-- killall amidi aplay
+--
+-- You can see the list of available MIDI devices with "amidi -l".
+-- For testing it is useful to use the AMIDI "--dump" option.
+-- For lower latency, you might need to change the Linux pipe size:
+--
+-- sudo sysctl fs.pipe-max-size=4096
+
+with GNAT.OS_Lib;
+with Interfaces;       use Interfaces;
+with MIDI_Synthesizer; use MIDI_Synthesizer;
+with Write_To_Stdout_Once;
+
+procedure MIDI_Test is
+   Data   : Unsigned_8;
+   Ignore : Integer;
+
+   Main_Synthesizer : access Synthesizer'Class := Create_Synthesizer;
+
+   task Main_Task is
+      entry Data_Received (Data : in Unsigned_8);
+   end Main_Task;
+
+   task body Main_Task is
+   begin
+      loop
+         select
+            accept Data_Received (Data : in Unsigned_8) do
+               Main_Synthesizer.Parse_MIDI_Byte (Data);
+            end Data_Received;
+         else
+            Write_To_Stdout_Once (Main_Synthesizer.Mixer0);
+         end select;
+      end loop;
+   end Main_Task;
+
+begin
+   loop
+      Ignore :=
+        GNAT.OS_Lib.Read (GNAT.OS_Lib.Standin, Data'Address, Data'Size / 8);
+      Main_Task.Data_Received (Data);
+   end loop;
+end MIDI_Test;

gnat-ravenscar.adc

@@ -0,0 +1,2 @@
+pragma Profile (Ravenscar);
+pragma Warnings (Off, "pragma Restrictions (No_Exception_Propagation) in effect");

gnat.adc

@@ -1,2 +1 @@
-pragma Profile (Ravenscar);
 pragma Warnings (Off, "pragma Restrictions (No_Exception_Propagation) in effect");

src/blit.adb

@@ -142,7 +142,8 @@ package body BLIT is
             Impulse_Time := Self.Next_Impulse_Time;
             Impulse_Phase := Self.Next_Impulse_Phase;
 
-            Delta_Time := Float (Self.P_Buffer (I)) / 2.0 + Self.Next_Impulse_Phase;
+            Delta_Time := Float (Self.P_Buffer (I)) / 2.0
+              + Self.Next_Impulse_Phase;
 
             Self.Next_Impulse_Time := Self.Next_Impulse_Time +
               Natural (Float'Floor (Delta_Time));

src/midi.adb

@@ -0,0 +1,80 @@
+package body MIDI is
+
+   procedure Test_Note_Command (Self : in out Parser; Received : Unsigned_8) is
+   begin
+      if ((Received and 16#80#) = 16#80#) or
+        ((Received and 16#f0#) = 16#90#) or
+        ((Received and 16#f0#) = 16#b0#)
+      then
+         Self.Wait_For_Event := False;
+         Self.Byte_Counter   := 0;
+         Self.Last_Command   := Received;
+      else
+         Self.Wait_For_Event := True;
+      end if;
+   end Test_Note_Command;
+
+   function Create_Parser
+     (Event_Listener : access I_Event_Listener'Class) return access Parser
+   is
+      Ret : constant access Parser :=
+        new Parser'
+          (Event_Listener => Event_Listener,
+           Wait_For_Event => True,
+           others         => 0);
+   begin
+      return Ret;
+   end Create_Parser;
+
+   procedure Parse (Self : in out Parser; Received : Unsigned_8) is
+   begin
+      --  ignore system real time messages
+      if Received >= 16#f8# then
+         return;
+      end if;
+
+      --  parse note-on or note-off message
+      if Self.Wait_For_Event then
+         Test_Note_Command (Self, Received);
+      else
+         --  if a command byte is received, test for note command
+         if (Received and 16#80#) > 0 then
+            Test_Note_Command (Self, Received);
+            return;
+         end if;
+
+         --  otherwise read the next 2 bytes
+         Self.Byte0        := Self.Byte1;
+         Self.Byte1        := Received;
+         Self.Byte_Counter := Self.Byte_Counter + 1;
+         if Self.Byte_Counter = 2 then
+            if (Self.Last_Command and 16#f0#) = 16#90# then
+               --  test for note-on message
+               if Self.Byte1 = 0 then
+                  --  special case: note-on message with velocity 0 is used
+                  --  as noteOff by some instruments
+                  Self.Event_Listener.Note_Off
+                  (Self.Last_Command and 16#f#, Self.Byte0, 0);
+               else
+                  Self.Event_Listener.Note_On
+                  (Self.Last_Command and 16#f#, Self.Byte0, Self.Byte1);
+               end if;
+            elsif (Self.Last_Command and 16#f0#) = 16#80# then
+               --  test for note-off message
+               Self.Event_Listener.Note_Off
+               (Self.Last_Command and 16#f#, Self.Byte0, Self.Byte1);
+            elsif (Self.Last_Command and 16#f0#) = 16#b0# then
+               --  test for control change message
+               Self.Event_Listener.Control_Change
+               (Self.Last_Command and 16#f#, Self.Byte0, Self.Byte1);
+            end if;
+            --  otherwise it is an unknown message and we ignore it
+
+            --  reset byte counter only, not the waitForNoteCommand flag,
+            --  to handle "running status"
+            Self.Byte_Counter := 0;
+         end if;
+      end if;
+   end Parse;
+
+end MIDI;

src/midi.ads

@@ -0,0 +1,43 @@
+with Interfaces; use Interfaces;
+
+package MIDI is
+
+   type Parser is tagged private;
+
+   type I_Event_Listener is interface;
+   procedure Note_On
+     (Self     : in out I_Event_Listener;
+      Channel  :        Unsigned_8;
+      Note     :        Unsigned_8;
+      Velocity :        Unsigned_8) is abstract;
+   procedure Note_Off
+     (Self     : in out I_Event_Listener;
+      Channel  :        Unsigned_8;
+      Note     :        Unsigned_8;
+      Velocity :        Unsigned_8) is abstract;
+   procedure Control_Change
+     (Self              : in out I_Event_Listener;
+      Channel           :        Unsigned_8;
+      Controller_Number :        Unsigned_8;
+      Controller_Value  :        Unsigned_8) is abstract;
+
+   --  creates a new parser with a listener for receiving MIDI events
+   function Create_Parser
+     (Event_Listener : access I_Event_Listener'Class) return access Parser;
+
+   --  parses one incoming byte and calls the listener for received MIDI events
+   procedure Parse (Self : in out Parser; Received : Unsigned_8);
+
+private
+   procedure Test_Note_Command (Self : in out Parser; Received : Unsigned_8);
+
+   type Parser is tagged record
+      Event_Listener : access I_Event_Listener'Class;
+      Wait_For_Event : Boolean;
+      Last_Command   : Unsigned_8;
+      Byte_Counter   : Unsigned_8;
+      Byte0          : Unsigned_8;
+      Byte1          : Unsigned_8;
+   end record;
+
+end MIDI;