Program Morse;

Var
   Choice      :  Char;
   N, M        :  Integer;
   CodeLine    :  String[72];
   Letter      :  Char;
   Key         :  Integer;
   I           :  Integer;
   F           :  Integer;
   Lines       :  Integer;
   WordsMin    :  Integer;
   LetterFlag  :  Integer;

Procedure ShowCode;

Var
   DT,DA   : String[4];

Begin
   DT    := #223+#32;
   DA    := #223+#223+#223+#32;
   GotoXY(1,12);
   ClrEOL;
   GotoXY(N,12);
   If N > 60 then GotoXY(60,12);
   Case Letter of
     'A':  Write(DT,DA);
     'B':  Write(DA,DT,DT,DT);
     'C':  Write(DA,DT,DA,DT);
     'D':  Write(DA,DT,DT);
     'E':  Write(DT);
     'F':  Write(DT,DT,DA,DT);
     'G':  Write(DA,DA,DT);
     'H':  Write(DT,DT,DT,DT);
     'I':  Write(DT,DT);
     'J':  Write(DT,DA,DA,DA);
     'K':  Write(DA,DT,DA);
     'L':  Write(DT,DA,DT,DT);
     'M':  Write(DA,DA);
     'N':  Write(DA,DT);
     'O':  Write(DA,DA,DA);
     'P':  Write(DT,DA,DA,DT);
     'Q':  Write(DA,DA,DT,DA);
     'R':  Write(DT,DA,DT);
     'S':  Write(DT,DT,DT);
     'T':  Write(DA);
     'U':  Write(DT,DT,DA);
     'V':  Write(DT,DT,DT,DA);
     'W':  Write(DT,DA,DA);
     'X':  Write(DA,DT,DT,DA);
     'Y':  Write(DA,DT,DA,DA);
     'Z':  Write(DA,DA,DT,DT);
     '0':  Write(DA,DA,DA,DA,DA);
     '1':  Write(DT,DA,DA,DA,DA);
     '2':  Write(DT,DT,DA,DA,DA);
     '3':  Write(DT,DT,DT,DA,DA);
     '4':  Write(DT,DT,DT,DT,DA);
     '5':  Write(DT,DT,DT,DT,DT);
     '6':  Write(DA,DT,DT,DT,DT);
     '7':  Write(DA,DA,DT,DT,DT);
     '8':  Write(DA,DA,DA,DT,DT);
     '9':  Write(DA,DA,DA,DA,DT);
     '.':  Write(DT,DA,DT,DA,DT,DA)
     End;

End;

Procedure Dit;
   Begin
      Sound(F);
      Delay(I);
      NoSound;
      Delay(I);
   End;

Procedure Dah;
   Begin
      Sound(F);
      Delay(3*I);
      NoSound;
      Delay(I);
   End;

Procedure LSpace;
   Begin
      NoSound;
      Delay(2*I);
   End;

Procedure WSpace;
   Begin
      NoSound;
      Delay(4*I);
   End;

Procedure SoundLtr;

Var
   Input          :   Integer;
   Z              :   Integer;

Procedure MakeLtr;

   Begin
      Key := Random(10000) mod 26;
         Case Key of
         1 :  Letter := 'A';
         2 :  Letter := 'B';
         3 :  Letter := 'C';
         4 :  Letter := 'D';
         5 :  Letter := 'E';
         6 :  Letter := 'F';
         7 :  Letter := 'G';
         8 :  Letter := 'H';
         9 :  Letter := 'I';
        10 :  Letter := 'J';
        11 :  Letter := 'K';
        12 :  Letter := 'L';
        13 :  Letter := 'M';
        14 :  Letter := 'N';
        15 :  Letter := 'O';
        16 :  Letter := 'P';
        17 :  Letter := 'Q';
        18 :  Letter := 'R';
        19 :  Letter := 'S';
        20 :  Letter := 'T';
        21 :  Letter := 'U';
        22 :  Letter := 'V';
        23 :  Letter := 'W';
        24 :  Letter := 'X';
        25 :  Letter := 'Y';
        26 :  Letter := 'Z';
        27 :  Letter := '0';
        28 :  Letter := '1';
        29 :  Letter := '2';
        30 :  Letter := '3';
        31 :  Letter := '4';
        32 :  Letter := '5';
        33 :  Letter := '6';
        34 :  Letter := '7';
        35 :  Letter := '8';
        36 :  Letter := '9';
        37 :  Letter := '.';
        End;
   End;

Procedure ShowLtr;

Var
   DT,DA   : String[4];

Begin
   DT    := #223+#32;
   DA    := #223+#223+#223+#32;
   GotoXY(25,10);
   ClrEOL;
   Write(Letter,'  ');
   Case Letter of
     'A':  Write(DT,DA);
     'B':  Write(DA,DT,DT,DT);
     'C':  Write(DA,DT,DA,DT);
     'D':  Write(DA,DT,DT);
     'E':  Write(DT);
     'F':  Write(DT,DT,DA,DT);
     'G':  Write(DA,DA,DT);
     'H':  Write(DT,DT,DT,DT);
     'I':  Write(DT,DT);
     'J':  Write(DT,DA,DA,DA);
     'K':  Write(DA,DT,DA);
     'L':  Write(DT,DA,DT,DT);
     'M':  Write(DA,DA);
     'N':  Write(DA,DT);
     'O':  Write(DA,DA,DA);
     'P':  Write(DT,DA,DA,DT);
     'Q':  Write(DA,DA,DT,DA);
     'R':  Write(DT,DA,DT);
     'S':  Write(DT,DT,DT);
     'T':  Write(DA);
     'U':  Write(DT,DT,DA);
     'V':  Write(DT,DT,DT,DA);
     'W':  Write(DT,DA,DA);
     'X':  Write(DA,DT,DT,DA);
     'Y':  Write(DA,DT,DA,DA);
     'Z':  Write(DA,DA,DT,DT);
     '0':  Write(DA,DA,DA,DA,DA);
     '1':  Write(DT,DA,DA,DA,DA);
     '2':  Write(DT,DT,DA,DA,DA);
     '3':  Write(DT,DT,DT,DA,DA);
     '4':  Write(DT,DT,DT,DT,DA);
     '5':  Write(DT,DT,DT,DT,DT);
     '6':  Write(DA,DT,DT,DT,DT);
     '7':  Write(DA,DA,DT,DT,DT);
     '8':  Write(DA,DA,DA,DT,DT);
     '9':  Write(DA,DA,DA,DA,DT);
     '.':  Write(DT,DA,DT,DA,DT,DA)
     End;
End;


Procedure BeepLtr;

   Begin
      Case Letter of
      'A':  Begin Dit;Dah;LSpace;End;
      'B':  Begin Dah;Dit;Dit;Dit;LSpace;End;
      'C':  Begin Dah;Dit;Dah;Dit;LSpace;End;
      'D':  Begin Dah;Dit;Dit;LSpace;End;
      'E':  Begin Dit;LSpace;End;
      'F':  Begin Dit;Dit;Dah;Dit;LSpace;End;
      'G':  Begin Dah;Dah;Dit;LSpace;End;
      'H':  Begin Dit;Dit;Dit;Dit;LSpace;End;
      'I':  Begin Dit;Dit;LSpace;End;
      'J':  Begin Dit;Dah;Dah;Dah;LSpace;End;
      'K':  Begin Dah;Dit;Dah;LSpace;End;
      'L':  Begin Dit;Dah;Dit;Dit;LSpace;End;
      'M':  Begin Dah;Dah;LSpace;End;
      'N':  Begin Dah;Dit;LSpace;End;
      'O':  Begin Dah;Dah;Dah;LSpace;End;
      'P':  Begin Dit;Dah;Dah;Dit;LSpace;End;
      'Q':  Begin Dah;Dah;Dit;Dah;LSpace;End;
      'R':  Begin Dit;Dah;Dit;LSpace;End;
      'S':  Begin Dit;Dit;Dit;LSpace;End;
      'T':  Begin Dah;LSpace;End;
      'U':  Begin Dit;Dit;Dah;LSpace;End;
      'V':  Begin Dit;Dit;Dit;Dah;LSpace;End;
      'W':  Begin Dit;Dah;Dah;LSpace;End;
      'X':  Begin Dah;Dit;Dit;Dah;LSpace;End;
      'Y':  Begin Dah;Dit;Dah;Dah;LSpace;End;
      'Z':  Begin Dah;Dah;Dit;Dit;LSpace;End;
      '0':  Begin Dah;Dah;Dah;Dah;Dah;LSpace;End;
      '1':  Begin Dit;Dah;Dah;Dah;Dah;LSpace;End;
      '2':  Begin Dit;Dit;Dah;Dah;Dah;LSpace;End;
      '3':  Begin Dit;Dit;Dit;Dah;Dah;LSpace;End;
      '4':  Begin Dit;Dit;Dit;Dit;Dah;LSpace;End;
      '5':  Begin Dit;Dit;Dit;Dit;Dit;LSpace;End;
      '6':  Begin Dah;Dit;Dit;Dit;Dit;LSpace;End;
      '7':  Begin Dah;Dah;Dit;Dit;Dit;LSpace;End;
      '8':  Begin Dah;Dah;Dah;Dit;Dit;LSpace;End;
      '9':  Begin Dah;Dah;Dah;Dah;Dit;LSpace;End;
      '.':  Begin Dit;Dah;Dit;Dah;Dit;Dah;LSpace;End;
      #32:  WSpace;
      End;
   For N := 1 to Input do
      Begin
         WSpace;
      End;
   End;

Begin
   ClrScr;
   GotoXY(10,10);
   Write('How many spaces between letters (1 to 8)');
   GotoXY(10,11);
   Repeat
      Read(Kbd,Choice);
   Until Choice in ['1'..'8'];
   Val(Choice,Input,Z);
   ClrScr;
   Randomize;
   While Not Keypressed do
      Begin
         MakeLtr;
         ShowLtr;
         BeepLtr;
      End;
End;


{***********}
Procedure ReadCode;

Begin
   GotoXY(1,10);
   Write(Codeline);
   For N := 1 to Length(CodeLine) do
      Begin
         GotoXY(1,6);
         Write('Transmitting at ',WordsMin,' words per minute');
         GotoXY(1,8);
         Write('This will generate ',Lines,' Lines.  This is Line ',M);
         Delay(I);
         Letter := Copy(Codeline,N,1);
         ShowCode;
         GotoXY(N,10);
         Case Letter of
         'A':  Begin Dit;Dah;LSpace;End;
         'B':  Begin Dah;Dit;Dit;Dit;LSpace;End;
         'C':  Begin Dah;Dit;Dah;Dit;LSpace;End;
         'D':  Begin Dah;Dit;Dit;LSpace;End;
         'E':  Begin Dit;LSpace;End;
         'F':  Begin Dit;Dit;Dah;Dit;LSpace;End;
         'G':  Begin Dah;Dah;Dit;LSpace;End;
         'H':  Begin Dit;Dit;Dit;Dit;LSpace;End;
         'I':  Begin Dit;Dit;LSpace;End;
         'J':  Begin Dit;Dah;Dah;Dah;LSpace;End;
         'K':  Begin Dah;Dit;Dah;LSpace;End;
         'L':  Begin Dit;Dah;Dit;Dit;LSpace;End;
         'M':  Begin Dah;Dah;LSpace;End;
         'N':  Begin Dah;Dit;LSpace;End;
         'O':  Begin Dah;Dah;Dah;LSpace;End;
         'P':  Begin Dit;Dah;Dah;Dit;LSpace;End;
         'Q':  Begin Dah;Dah;Dit;Dah;LSpace;End;
         'R':  Begin Dit;Dah;Dit;LSpace;End;
         'S':  Begin Dit;Dit;Dit;LSpace;End;
         'T':  Begin Dah;LSpace;End;
         'U':  Begin Dit;Dit;Dah;LSpace;End;
         'V':  Begin Dit;Dit;Dit;Dah;LSpace;End;
         'W':  Begin Dit;Dah;Dah;LSpace;End;
         'X':  Begin Dah;Dit;Dit;Dah;LSpace;End;
         'Y':  Begin Dah;Dit;Dah;Dah;LSpace;End;
         'Z':  Begin Dah;Dah;Dit;Dit;LSpace;End;
         '0':  Begin Dah;Dah;Dah;Dah;Dah;LSpace;End;
         '1':  Begin Dit;Dah;Dah;Dah;Dah;LSpace;End;
         '2':  Begin Dit;Dit;Dah;Dah;Dah;LSpace;End;
         '3':  Begin Dit;Dit;Dit;Dah;Dah;LSpace;End;
         '4':  Begin Dit;Dit;Dit;Dit;Dah;LSpace;End;
         '5':  Begin Dit;Dit;Dit;Dit;Dit;LSpace;End;
         '6':  Begin Dah;Dit;Dit;Dit;Dit;LSpace;End;
         '7':  Begin Dah;Dah;Dit;Dit;Dit;LSpace;End;
         '8':  Begin Dah;Dah;Dah;Dit;Dit;LSpace;End;
         '9':  Begin Dah;Dah;Dah;Dah;Dit;LSpace;End;
         '.':  Begin Dit;Dah;Dit;Dah;Dit;Dah;LSpace;End;
         #32:  WSpace;
         End;
      If Keypressed then Halt;
      End;
   End;

Procedure LoadCode;

Type
   TxtType        =  Text;

Var
   Filename       :  String[12];
   TxtFile        :  TxtType;
   Item           :  Char;

Begin
   ClrScr;
   Window(15,5,65,20);
   Writeln;
   Writeln('CHOOSE A FILE FROM THIS LIST');
   Writeln;
   Writeln('      1.  Code1');
   Writeln('      2.  Code2');
   Writeln('      3.  Code3');
   Writeln('      4.  Code4');
   Repeat
      Read(Kbd,Item);
   Until Item in ['1','2','3','4'];
   Window(1,1,80,25);
   ClrScr;
   Writeln;
      Case Item of
         '1': Filename := 'Code1.TXT';
         '2': Filename := 'Code2.TXT';
         '3': Filename := 'Code3.TXT';
         '4': Filename := 'Code4.TXT';
      End;
   Assign(TxtFile, Filename);
   Reset(TxtFile);
   While Not EOF(TxtFile) do
      Begin
         Readln(TxtFile,CodeLine);
         ReadCode;
      End;
End;

Procedure Generator;

   Begin
      ClrScr;
      Writeln('How many lines');
      ReadLn(Lines);
      For M := 1 to lines do
         Begin
            CodeLine := '';
            Randomize;
            For N := 1 to 66 do
               Begin
                  Key := Random(10000) mod LetterFlag;
                  Case Key of
                  1 :  Letter := 'A';
                  2 :  Letter := 'B';
                  3 :  Letter := 'C';
                  4 :  Letter := 'D';
                  5 :  Letter := 'E';
                  6 :  Letter := 'F';
                  7 :  Letter := 'G';
                  8 :  Letter := 'H';
                  9 :  Letter := 'I';
                 10 :  Letter := 'J';
                 11 :  Letter := 'K';
                 12 :  Letter := 'L';
                 13 :  Letter := 'M';
                 14 :  Letter := 'N';
                 15 :  Letter := 'O';
                 16 :  Letter := 'P';
                 17 :  Letter := 'Q';
                 18 :  Letter := 'R';
                 19 :  Letter := 'S';
                 20 :  Letter := 'T';
                 21 :  Letter := 'U';
                 22 :  Letter := 'V';
                 23 :  Letter := 'W';
                 24 :  Letter := 'X';
                 25 :  Letter := 'Y';
                 26 :  Letter := 'Z';
                 27 :  Letter := '0';
                 28 :  Letter := '1';
                 29 :  Letter := '2';
                 30 :  Letter := '3';
                 31 :  Letter := '4';
                 32 :  Letter := '5';
                 33 :  Letter := '6';
                 34 :  Letter := '7';
                 35 :  Letter := '8';
                 36 :  Letter := '9';
                 37 :  Letter := '.';
                 End;
                 If Length(Codeline) mod 6 = 0 then Letter := #32;
                 CodeLine := Codeline + Letter;
               End;
            ClrScr;
            ReadCode;
         End;
   End;

Procedure Menu;

   Begin
      Window(15,5,65,25);
      ClrScr;
      Writeln('        MORSE CODE PRACTICE');
      Writeln;
      Writeln('This program will:');
      Writeln;
      Writeln('1. Generate random text groups of 5 characters');
      Writeln('   each, then send them in morse code with the');
      Writeln('   cursor underlining each word as it is sent.');
      Writeln;
      Writeln('2. Read text files prepared by your word processor');
      Writeln('   in capitals, then send the text line by line');
      Writeln;
      Writeln('3. Sound individual random letters well spaced');
      Writeln;
      Writeln('"Frequency" sets the oscillator frequency');
      Writeln;
      Writeln('     *** Press any key to continue ** ');
      Repeat until keypressed;
      ClrScr;
      Writeln('MORSE CODE PRACTICE');
      Writeln;
      Writeln('What Speed? (Enter Words Per Minute)');
      Readln(WordsMin);
      I := Round(800/WordsMin);
      Writeln('What Frequency');
      Readln(F);
      Writeln('Do you want to :');
      Writeln;
      Writeln('1. Generate Random Code?');
      Writeln('2. Read Code From a File?');
      Writeln('3. Sound individual letters?');
      Writeln('4. End Program');
      Repeat
         Read(Kbd, Choice);
      Until Choice in ['1','2','3','4'];
      Window(1,1,80,25);
   End;


BEGIN
   Repeat
      ClrScr;
      Menu;
      If Choice = '1'then
         Begin
            ClrScr;
            GotoXY(15,5);
            Write('Include numerals in code groups? (Y/N)');
            GotoXY(15,6);
            Read(Kbd,Choice);
               If Choice in ['y','Y'] then LetterFlag := 37
                  Else LetterFlag := 26;
            Generator;
         End;
      If Choice = '2' then LoadCode;
      If Choice = '3' then SoundLtr;
   Until Choice = '4';
END.