Je to program na prepísanie textu do morzeovky a jeho vypípanie

{ MORZEOVKA2.PAS                           Copyright (c) Jan Spacek }
{ Je to program na prepisanie textu do morzeovky a jeho vypipanie.  }
{                                                                   }
{ Datum:14.11.2007                             http://www.trsek.com }
 
program morzeovka;
uses crt;
const tab:array['A'..'Z'] of string[4] =('.-','-...','-.-.','-..','.','..-',
      '--.','....','..','.---','-.-','.-..','--','-.','---','.--.','--.-',
      '.-.','...','-','..-','...-','.--','-..-','-.--','--..');
var s{,a}: string;
    i: byte;
 
{Pipanie}
{begin
writeln('Napis znak');
readln(a);
for a:=1 to length(x) do
 if a='.' then
  begin
   sound(1000);
   delay(150);
   nosound;
  end;
 if a='-' then
  begin
   sound(1000);
   delay(500);
   nosound;
  end;
end.}
 
procedure ZVUK(s:string);
var i:byte;
begin
write(s);
 for i:=1 to length(s) do
  begin
   if s[i]='-'
    then delay(300)
    else
     begin
      sound(1000);
      if s[i]='.'
       then delay(100)
       else delay(300);
      nosound;
     end;
   delay(150);
  end;
end;
 
Begin
clrscr;
 writeln('PREVODNIK DO MORZEOVKY':50);
 writeln('Napiste text: ');
 readln(s);
  for i:=1 to length(s) do
   case s[i] of
     'A'..'Z','a'..'z' : zvuk( TAB[ UpCase(s[i]) ] + chr(179));
     ' '                  : writeln;
     ' ':write(chr(179));
     '.':write('stop');
   end;
readln;
End.