{~ Beeps letters in the alphabet of Morse ~}

uses un_str_m, {author's (Jan Hollan) own unit}
     crt;      {Borland Turbo Pascal unit}
 procedure help;
  const cl=#13#10;
  begin
   writeln(cl,
'Morse [<height of tone / 1 Hz (default 880)>',cl,
'      [<length of beep / 1 ms (default 100)>]]',cl,cl,

' translates keys into Morse codes.',cl,cl,

'Exits on <Esc> or any special key.',cl,cl,

'( (C) Jan Hollan, N.Copernicus Observatory and Planetarium in Brno, 1999;'+cl+
' subject to the GNU General Public License, http://www.gnu.org/copyleft;'+cl+
' source code available at http://astro.sci.muni.cz/pub/hollan/programmes)'
);
  end;



const
 len:byte=100; ht:word=880 {Hz};
 morse: array[48..90] of string[5]=(
   {0}'33333' ,
   {1}'13333' ,
   {2}'11333' ,
   {3}'11133' ,
   {4}'11113' ,
   {5}'11111' ,
   {6}'31111' ,
   {7}'33111' ,
   {8}'33311' ,
   {9}'33331' ,'','','','','','','',
   {A}'13   ' ,
   {B}'3111 ' ,
   {C}'3131 ' ,
   {D}'311  ' ,
   {E}'1    ' ,
   {F}'1131 ' ,
   {G}'331  ' ,
   {H}'1111 ' ,
   {Ch'3333 ' }
   {I}'11   ' ,
   {J}'1333 ' ,
   {K}'313  ' ,
   {L}'1311 ' ,
   {M}'33   ' ,
   {N}'31   ' ,
   {O}'333  ' ,
   {P}'1331 ' ,
   {Q}'3313 ' ,
   {R}'131  ' ,
   {S}'111  ' ,
   {T}'3    ' ,
   {U}'113  ' ,
   {V}'1113 ' ,
   {W}'133  ' ,
   {X}'3113 ' ,
   {Y}'3133 ' ,
   {Z}'3311 ' );

 Beginning= '31313131';

{ I am ready 1331
 I do understand 333 313
 Please wait  13 111 }

 mistake={OMYL} '111111111';

 {I repeat 11 11 11 11 11}

 EndOfTrans= '111313';

var c:char; b,i:byte; wc:integer;
procedure send(s:string);
begin
    for i:=1 to length(s) do
     if ord(s[i])>48 then
      begin
       sound(ht);
       delay(len+len*(ord(s[i])-49)*2);
       nosound;
       delay(len);
      end;
end;

begin
 if paramcount>0 then
  begin
   if (pos('?',paramstr(1))>0) or (pos('h',paramstr(1))>0) then
    begin help; halt; end;
   val(paramstr(1),ht,wc);
   if wc>0 then begin help; halt; end;
   if paramcount>1 then
    begin
     if (pos('?',paramstr(2))>0) or (pos('h',paramstr(2))>0) then help;
     val(paramstr(2),len,wc);
     if wc>0 then begin help; halt; end;
    end;
  end;
 help;
 for i:=48 to 90 do Morse[i]:=__cvtstr(Morse[i],_rem_white_str);
 send(Beginning);
 repeat
  c:=readkey;
  b:=ord(UpCase(c));
  case b of
   0,27 :
    begin
     send(EndOfTrans);
     halt
    end;
   13: writeln;
   else
    begin
     write(c);
     case b of
       8: send(mistake);
      32: delay(len*8);
      48..90:
         begin
          if length(Morse[b])>0 then
           send(Morse[b]);
          delay(len*3);
         end
     end
    end
  end
 until false;
end.