{$M $450,0,0}
uses crt,dos;
label
main,endpro,output,message,startmessage,
speedselect,fileiput,dosshell,start;
var
s:array[1..14] of string[76];
pause,x,y,i,b:integer;
s1:string[1];
ch:char;
procedure color(a,b:integer);
begin
textcolor(a);
textbackground(b);
end;
procedure di;
begin
port[$378]:=2;
delay(pause);
port[$378]:=0;
delay(pause);
end;
procedure da;
begin
port[$378]:=2;
delay(pause*3);
port[$378]:=0;
delay(pause);
end;
begin
pause:=100;
START:
clrscr;
color(11,1);
gotoxy(15,4);
write('Chandigarh college of Chandigarh-160026');
gotoxy(1,7);
color(10,3);
gotoxy(10,18);
write('======================');
gotoxy(10,19);
write('F1=Increase Speed ');
gotoxy(10,20);
write('F2=Decrease Speed ');
gotoxy(10,21);
write('F3=Output to Device ');
gotoxy(10,22);
write('F4=Message Input ');
gotoxy(10,23);
write('F5=Dos Shell ');
gotoxy(10,24);
write('F6=Quit ');
gotoxy(10,25);
write('======================');
color(14,1);
gotoxy(25,2);
write('Programmed by');
gotoxy(21,3);
write('Blulehzar');
color(10,3);
gotoxy(26,17);
write('CONTROLS');
gotoxy(35,19);
write('SPEED');
color(10,3);
gotoxy(35,20);
write(pause);
MAIN:
window(1,1,80,25);
gotoxy(2,25);
color(0,7);
write('Waiting for the command......');
ch:=readkey;
if ch=#0 then
begin
ch:=readkey;
if(ch=#59)or(ch=#60) then goto speedselect else
if ch=#61 then goto output else
if ch=#62 then goto startmessage else
if ch=#63 then goto dosshell else
if ch=#64 then goto endpro;
end;
goto main;
STARTMESSAGE:
begin
gotoxy(2,25);
write('Enter the message and press ENTER KEY...');
color(12,1);
window(3,2,78,15);
clrscr;
for x:=1 to 14 do s[x]:='';
i:=0;x:=1;y:=1;b:=0;
end;
MESSAGE:
begin
x:=wherex;
y:=wherey;
ch:=readkey;
if ch=#13 then goto main;
if ch=#8 then
begin
if x=1 then
begin
if y=1 then goto message;
y:=y-1;
x:=76;
end
else
x:=x-1;
delete(s[y],length(s[y]),1);
gotoxy(x,y);
write('');
gotoxy(x,y);
goto message;
end;
if (x=76) and (y=14) then goto message;
write(ch);
s[y]:=(s[y]+ch);
goto message;
end;
OUTPUT:
begin gotoxy(2,25);
write('Sending output to the Morse Device ...Press any key to Stop...');
color(12,1);
window(3,2,78,15);
clrscr;
for i:=1 to y do
begin
for x:=1 to length(s[i]) do
begin
s1:=(copy(s[i],x,1));
ch:=upcase(s1[1]);
delay(pause*2);
write(ch);
if ch='A' then begin di; da; end else
if ch='B' then begin da; di; di; di; end else
if ch='C' then begin da; di; da; di; end else
if ch='D' then begin da; di; di; end else
if ch='E' then begin di; end else
if ch='F' then begin di; di; da; di; end else
if ch='G' then begin da; da; di; end else
if ch='H' then begin di; di; di; di; end else
if ch='I' then begin di; di; end else
if ch='J' then begin di; da; da; da; end else
if ch='K' then begin da; di; da; end else
if ch='L' then begin di; da; di; di; end else
if ch='M' then begin da; da; end else
if ch='N' then begin da; di; end else
if ch='O' then begin da; da; da; end else
if ch='P' then begin di; da; da; di; end else
if ch='Q' then begin da; da; di; da; end else
if ch='R' then begin di; da; di; end else
if ch='S' then begin di; di; di; end else
if ch='T' then begin da; end else
if ch='U' then begin di; di; da; end else
if ch='V' then begin di; di; di; da; end else
if ch='W' then begin di; da; da; end else
if ch='X' then begin da; di; di; da; end else
if ch='Y' then begin da; di; da; da; end else
if ch='Z' then begin da; da; di; di; end else
if ch='1' then begin di; da; da; da; da; end else
if ch='2' then begin di; di; da; da; da; end else
if ch='3' then begin di; di; di; da; da; end else
if ch='4' then begin di; di; di; di; da; end else
if ch='5' then begin di; di; di; di; di; end else
if ch='6' then begin da; di; di; di; di; end else
if ch='7' then begin da; da; di; di; di; end else
if ch='8' then begin da; da; da; di; di; end else
if ch='9' then begin da; da; da; da; di; end else
if ch='0' then begin da; da; da; da; da; end else
if ch='.' then begin di; da; di; da; di; da; end else
if ch=';' then begin da; di; da; di; da; di; end else
if ch=':' then begin da; da; da; di; di; di; end else
if ch=',' then begin da; da; di; di; da; da; end else
if ch='"' then begin di; da; di; di; da; di; end else
if ch='?' then begin di; di; da; da; di; di; end else
if ch='-' then begin da; di; di; di; di; da; end else
if ch='_' then begin di; di; da; da; di; da; end else
if ch='/' then begin da; di; di; da; di; end else
if(ch=#39)or(ch=#96) then begin di; da; da; da; da; di; end else
if(ch='(')or(ch=')') then begin da; di; da; da; di; da; end else
if ch=' ' then delay(pause*6);
if keypressed then goto main;
end;
end;
goto main;
end;
SPEEDSELECT:
begin
if(ch=#59)and(pause>50) then pause:=pause+2;
if(ch=#60)and(pause<190) then pause:=pause-2;
color(10,3);
gotoxy(35,20);
writeln(pause,' ');
goto main;
end;
DOSSHELL:
begin
color(7,0);
clrscr;
writeln('Type EXIT to return to programme.....');
swapvectors;
exec(getenv('comspec'),'');
swapvectors;
goto start;
end;
ENDPRO:
color(7,0);
clrscr;
end.