Source code in the ada programming language

package Morse is

   type Symbols is (Nul, '-', '.', ' ');
   -- Nul is the letter separator, space the word separator;
   Dash : constant Symbols := '-';
   Dot : constant Symbols := '.';
   type Morse_Str is array (Positive range <>) of Symbols;
   pragma Pack (Morse_Str);

   function Convert (Input : String) return Morse_Str;
   procedure Morsebeep (Input : Morse_Str);

private
   subtype Reschars is Character range ' ' .. 'Z';
   -- restricted set of characters from 16#20# to 16#60#
   subtype Length is Natural range 1 .. 5;
   subtype Codes is Morse_Str (Length);
   -- using the current ITU standard with 5 signs
   -- only alphanumeric characters  are taken into consideration

   type Codings is record
      L : Length;
      Code : Codes;
   end record;
   Table : constant array (Reschars) of Codings :=
     ('A' => (2, ".-   "), 'B' => (4, "-... "),  'C' => (4, "-.-. "),
      'D' => (3, "-..  "), 'E' => (1, ".    "),  'F' => (4, "..-. "),
      'G' => (3, "--.  "), 'H' => (4, ".... "),  'I' => (2, "..   "),
      'J' => (4, ".--- "), 'K' => (3, "-.-  "),  'L' => (4, ".-.. "),
      'M' => (2, "--   "), 'N' => (2, "-.   "),  'O' => (3, "---  "),
      'P' => (4, ".--. "), 'Q' => (4, "--.- "),  'R' => (3, ".-.  "),
      'S' => (3, "...  "), 'T' => (1, "-    "),  'U' => (3, "..-  "),
      'V' => (4, "...- "), 'W' => (3, ".--  "),  'X' => (4, "-..- "),
      'Y' => (4, "-.-- "), 'Z' => (4, "--.. "),  '1' => (5, ".----"),
      '2' => (5, "..---"), '3' => (5, "...--"),  '4' => (5, "....-"),
      '5' => (5, "....."), '6' => (5, "-...."),  '7' => (5, "--..."),
      '8' => (5, "---.."), '9' => (5, "----."),  '0' => (5, "-----"),
      others => (1, "     ")); -- Dummy => Other characters do not need code.

end Morse;


with Ada.Strings.Maps, Ada.Characters.Handling, Interfaces.C;
use  Ada, Ada.Strings, Ada.Strings.Maps, Interfaces;

package body Morse is

   Dit, Dah, Lettergap, Wordgap : Duration; -- in seconds
   Dit_ms, Dah_ms : C.unsigned; -- durations expressed in ms
   Freq : constant C.unsigned := 1280; -- in Herz

   Morse_Sequence : constant Character_Sequence :=
      " ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789";
   Morse_charset : constant Character_Set := To_Set (Morse_Sequence);

   function Convert (Input : String) return Morse_Str is
      Cap_String : constant String := Characters.Handling.To_Upper (Input);
      Result : Morse_Str (1 .. 7 * Input'Length); -- Upper Capacity
      First, Last : Natural := 0;
      Char_code : Codings;
   begin
      for I in Cap_String'Range loop
         if Is_In (Cap_String (I), Morse_charset) then
            First := Last + 1;
            if Cap_String (I) = ' ' then
               Result (First) := ' ';
               Last := Last + 1;
            else
               Char_code := Table (Reschars (Cap_String (I)));
               Last := First + Char_code.L - 1;
               Result (First .. Last) := Char_code.Code (1 .. Char_code.L);
               Last := Last + 1;
               Result (Last) := Nul;
            end if;
         end if;
      end loop;
      if Result (Last) /= ' ' then
         Last := Last + 1;
         Result (Last) := ' ';
      end if;
      return Result (1 .. Last);
   end Convert;

   procedure Morsebeep (Input : Morse_Str) is
      -- Beep is not portable : adapt to your OS/sound board
      -- Implementation for Windows XP / interface to fn in stdlib
      procedure win32xp_beep
        (dwFrequency : C.unsigned;
         dwDuration : C.unsigned);
      pragma Import (C, win32xp_beep, "_beep");
   begin
      for I in Input'Range loop
         case Input (I) is
            when Nul =>
               delay Lettergap;
            when Dot =>
               win32xp_beep (Freq, Dit_ms);
               delay Dit;
            when Dash =>
               win32xp_beep (Freq, Dah_ms);
               delay Dit;
            when ' ' =>
               delay Wordgap;
         end case;
      end loop;
   end Morsebeep;
begin
   Dit := 0.20;
   Lettergap := 2 * Dit;
   Dah := 3 * Dit;
   Wordgap := 4 * Dit;
   Dit_ms := C.unsigned (Integer (Dit * 1000));
   Dah_ms := C.unsigned (Integer (Dah * 1000));
end Morse;


with Morse;            use Morse;
procedure Morse_Tx is
begin
   Morsebeep (Convert ("Science sans Conscience"));
end Morse_Tx;