Localize file www.TrSek.com/cover/spacek/morzeovka2.pas{ 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.