home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HAM Radio 1
/
HamRadio.cdr
/
cw
/
cw212
/
cw.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1987-01-22
|
37KB
|
1,164 lines
program cw;
type
line = string[80];
names = string[80];
screen_array = array[1..4000] of byte;
regpack = record
ax,bx,cx,dx,bp,si,ds,es,flags:integer;
end;
cfgtype = record
tone_freq_str : string[4];
send_speed_str : string[2];
char_speed_str : string[2];
main_fg : integer;
main_bg : integer;
box_fg : integer;
box_bg : integer;
hilite : integer;
end;
const
version = '2.12';
min_speed = 3;
max_speed = 50;
blink_yes = true;
blink_no = false;
echo_yes = true;
echo_no = false;
numberchars = 35; {1 less than actual number}
characters : array[0..numberchars] of char =
'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789';
number_letters = 25; {1 less than actual}
letters : array[0..number_letters] of char = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
numbers : array[0..9] of char = '0123456789';
{Additional words can be added to the list below if the constant numberwords
is increased accordingly}
numberwords = 272; {This is 1 less than the actual number}
words : array[0..numberwords] of string[10] =
('ADD','ADVICE','ADVISE','AFTER','AGAIN','AIM','AIR',
'ALL','ALWAYS','ALSO','AM','AMONG','AN','AND','ANY',
'ARE','AROUND','AS','ASK','ASKED','AWAY',
'AT','BACK','BAD','BAND','BE','BEEN','BEFORE','BEST',
'BETTER','BID','BIG','BIT','BOTH','BRING','BUT',
'BUY','BY','CALL','CAME','CAN','CAR','CENT','CITY',
'COLD','COME','COULD','DAY','DEAR','DID','DIE',
'DO','DOES','DONE','DONT','DOWN','DRAW','DUE','EACH',
'EAT','END','ES','EVEN','EVERY','FACT',
'FALL','FAR','FAST','FB','FEW','FIND','FIRST','FIVE','FOR',
'FOUND','FROM','FRONT','FULL','FUNNY','GAVE','GET',
'GIVE','GO','GOES','GOING','GOOD','GOT','GROW',
'HAD','HALF','HAM','HAND','HAS','HAVE','HE','HEAR',
'HELP','HER','HERE','HIM','HIS','HOME','HOT','HOUSE',
'HOW','IF','IN','INTO','IS','IT','JUMP','JUST',
'KEEP','KEY','KNEW','KNOW','LAST','LAW','LEFT','LESS',
'LET','LIE','LIGHT','LIKE','LITTLE','LIVE',
'LONG','LOOK','LOT','LOVE','LOW','MADE','MAKE','MAN',
'MANY','MATTER','MAY','ME','MIGHT','MIND','MORE','MUCH','MUST',
'MY','MYSELF','NAME','NET','NEW','NEXT','NO','NOR','NOT','NOW',
'OF','OFF','OIL','OLD','OM','ON','ONCE','ONLY',
'OPEN','OR','OTHER','OUT','OVER','OWE','OWN','PART',
'PAY','PER','PLAY','POWER','PULL','PUT',
'QRM','QRN','QRX','QST','QTH','RADIO','RAIN',
'RAN','READ','RIGHT','ROUND','RST','RUN','SAID','SAME',
'SAT','SAW','SAY','SEA','SEE','SHALL','SHE','SHOULD',
'SHOW','SMALL','SO','SOME','SOON','START','STOP','SUCH',
'TAKE','TAKEN','TELL','THAN','THANK','THAT','THE','THEM','THEN','THERE',
'THEY','THING','THINK','THIS','THOSE','TIME','TO','TODAY',
'TOO','TRY','UNDER','UNTIL','UP','UPON',
'UR','US','USE','VERY','VY','WALK','WANT','WAS',
'WAY','WE','WELL','WENT','WERE','WHAT','WHEN','WHERE',
'WHICH','WHILE','WHO','WHOLE','WHOSE','WHY',
'WILL','WITH','WISH','WORK','WORLD','WOULD','WRITE','WRONG',
'WX','W1AW','YEARS','YET','YL','YOU','YOUR','YOURS',
'559','569','579','589','599');
quit_msg = 'To Abort Press Any Key';
var
cfgfile: file of cfgtype;
cfgrec : cfgtype;
real_screen : screen_array Absolute $b800:$0000;
tmp_screen : screen_array;
main_fg,main_bg,box_fg,box_bg,xpos,ypos:integer;
code,freq,i,marktime,space_marktime,q,textpos,x,xx,yy : integer;
bit,menu_choice : char;
send_speed,char_speed : real;
text: line;
abort,firstpass,inrange : boolean;
exit_msg : string[22];
mode : string[10];
procedure beep; begin write(chr(7));end;
procedure blip;begin sound(400);delay(25);nosound;delay(300);end;
procedure buzz;begin
for i:=1 to 7 do begin
sound(100);delay(10);sound(200);delay(10);nosound;
end;
end;
procedure drawbox_ibm (x1,y1,x2,y2,fg,bg : integer; boxname : names; blnk : boolean);
begin
window (x1,y1,x2,y1+1);
textbackground(cfgrec.box_bg);
gotoxy(1,1);
x := x2-x1;
if length(boxname) > x then boxname[0] := chr(x-4);
textcolor(cfgrec.box_fg);
write('╔');
if blnk then textcolor(cfgrec.box_fg + blink) else textcolor(cfgrec.box_fg);
write (boxname);
textcolor(cfgrec.box_fg);
for q := x1+length(boxname)+1 TO x2-1 do write('═');
write('╗');
for q := 2 to y2-y1 DO
begin
window (x1,y1,x2,y1+q+1);
gotoxy(1,q); write('║');
if blnk then clreol;
gotoxy(x2-x1+1,q); write('║');
end;
window(x1,y1,x2,y2+1);
gotoxy(1,y2-y1+1);
write('╚');
for q := x1+1 to x2-1 do write('═');
write('╝');
end;
procedure drawbox (x1,y1,x2,y2,fg,bg : integer; boxname : names; blnk : boolean);
begin
drawbox_ibm (x1,y1,x2,y2,fg,bg,boxname,blnk);
window (x1+1,y1+1,x2-1,y2-1);
clrscr;
end;
procedure nowindow;begin window(1,1,80,23);end;
procedure scrn_off;
begin
inline($52/$50/$ba/$d8/$03/$b0/$21/$ee/$58/$5a)
end;
procedure scrn_on;
begin
inline($52/$50/$ba/$d8/$03/$b0/$29/$ee/$58/$5a)
end;
procedure save_screen;
begin
xx := wherex;
yy := wherey;
scrn_off;
move(real_screen, tmp_screen, 4000);
scrn_on;
end;
procedure restore_screen;
var
numline : integer;
begin
clrscr;
window(1,1,80,23);
scrn_off;
move(tmp_screen, real_screen, 4000);
scrn_on;
gotoxy(xx,yy);
textcolor(cfgrec.main_fg);
textbackground(cfgrec.main_bg);
end;
procedure statusline;
begin
window(1,1,80,25);
xpos:=wherex;ypos:=wherey;
gotoxy(1,25);clreol;
gotoxy(1,25);write(mode);
gotoxy(14,25);write('Spd : ',cfgrec.send_speed_str);
gotoxy(27,25);write('ChrSpd : ',cfgrec.char_speed_str);
gotoxy(43,25);write('Tone : ',cfgrec.tone_freq_str);
gotoxy(58,25);write(exit_msg);
gotoxy(xpos,ypos);
window(1,1,80,23);
end;
procedure dot;begin
if keypressed then abort:=true else abort:=false;
sound(freq);
delay(marktime);
nosound;
end;
procedure dash;begin
if keypressed then abort:=true else abort:=false;
sound(freq);
delay(3*marktime);
nosound;
end;
procedure bitspace;begin
if keypressed then abort:=true else abort:=false;
delay(marktime);
end;
procedure charspace;begin
if keypressed then abort:=true else abort:=false;
delay(2*space_marktime);
end;
procedure wordspace;begin
if keypressed then abort:=true else abort:=false;
delay(6*space_marktime);
end;
procedure sendchrx(ch:char); {character sent without charspace}
var
mch : string[8];
begin
ch:=upcase(ch);
case ch of
' ':mch:=' ';
'A':mch:='01';
'B':mch:='1000';
'C':mch:='1010';
'D':mch:='100';
'E':mch:='0';
'F':mch:='0010';
'G':mch:='110';
'H':mch:='0000';
'I':mch:='00';
'J':mch:='0111';
'K':mch:='101';
'L':mch:='0100';
'M':mch:='11';
'N':mch:='10';
'O':mch:='111';
'P':mch:='0110';
'Q':mch:='1101';
'R':mch:='010';
'S':mch:='000';
'T':mch:='1';
'U':mch:='001';
'V':mch:='0001';
'W':mch:='011';
'X':mch:='1001';
'Y':mch:='1011';
'Z':mch:='1100';
'1':mch:='01111';
'2':mch:='00111';
'3':mch:='00011';
'4':mch:='00001';
'5':mch:='00000';
'6':mch:='10000';
'7':mch:='11000';
'8':mch:='11100';
'9':mch:='11110';
'0':mch:='11111';
'-':mch:='10001';
'/':mch:='10010';
'?':mch:='001100';
',':mch:='110011';
'.':mch:='01010';
'$':mch:='000101';
'*':mch:='10001';
else mch:='\ ';
end;
for i:=1 to length(mch) do begin
bit:=copy(mch,i,1);
case bit of
'\':bitspace;
' ':wordspace;
'0':dot;
'1':dash;
end;
bitspace;
end;
charspace;
end;
procedure sendchr(ch:char);
begin
sendchrx(ch);
charspace;
end;
procedure sendstr(text:line;withecho:boolean);
label endit;
begin
for textpos:=1 to length(text) do begin
sendchr(text[textpos]);
if withecho then write(text[textpos]);
if abort then goto endit;
end;
endit:
end;
procedure sendline(text:line;withecho:boolean);
begin
sendstr(text,withecho);
writeln;
end;
procedure disk;
var
ch : char;
filename : string[14];
sendfile : text;
select : char;
goodfile : boolean;
begin
abort:=false;
mode:='DISK';
exit_msg:=quit_msg;
statusline;
if firstpass then clrscr;
textcolor(cfgrec.hilite);
writeln('Disk File');
for i:=1 to 9 do write(chr(196));writeln;
textcolor(cfgrec.main_fg);
repeat
goodfile:=false;writeln;
write('* Enter Disk File Name > ');readln(filename);writeln;
assign(sendfile,filename);
{$I-} reset(sendfile) {$I+};
if ioresult=0 then goodfile:=true;
if not goodfile then begin
beep;
writeln;writeln('* File Does Not Exist');
end;
until goodfile;
write('* Display Text ? [Y] > ');readln(select);writeln;
if not (select in ['Y','y','N','n']) then select:='Y';
while (not abort) and (not eof(sendfile)) do begin
read(sendfile,ch);ch:=upcase(ch);
sendchr(ch);
if select in ['Y','y'] then write(ch);
end;
writeln;writeln;write('* Press Any Key to Continue...');
repeat until keypressed;
writeln;writeln;
close(sendfile);
end;
procedure qso;
const
number_antennas = 13; {1 less than the acutal number}
antennas : array[0..number_antennas] of string[15] =
('DELTA LOOP','DIPOLE','FOLDED DIPOLE','HORIZONTAL LOOP',
'INVERTED VEE','LOG PERIODIC','LONGWIRE',
'PHASED VERTICAL ARRAY','QUAD','TRAP VERTICAL',
'TRIBAND YAGI','VERTCAL','WINDOM','ZEPP');
number_names = 26; {1 less than the acutal number}
names : array[0..number_names] of string[6] =
('AL','ANN','BETTY','BILL','BOB','CARL','DON',
'EARL','FRED','JACK','JIM','JOAN','JOE','KEN','LEE',
'LIZ','MARY','MIKE','PAT','PAUL','RON','SAM','SUE',
'TIM','TED','TOM','VERN');
number_rigs = 12; {1 less than the actual number}
rigs : array[0..number_rigs] of string[15] =
('COLLINS S-LINE','COLLINS KWM-380','HEATH SB-102',
'MOMEBREW','ICOM IC-720A','ICOM IC-745','ICOM IC-751',
'KENWOOD TS-520E','KENWOOD TS-820S','KENWOOD TS940S',
'TEMPO ONE','YAESU FT-101E','YAESU FT-757GX');
number_cities = 22; {1 less than the actual number}
cities : array[0..number_cities] of string[15] =
('BEDROCK','CAPITAL CITY','CENTERVILLE','COLUMBIA',
'EASTVALE','GREEN VALLEY','GREENVILLE','HIGHLANDS',
'HILLSDALE','INDEPENDENCE','JONESTOWN','LAKE CITY',
'MAYBERRY','OAK FALLS','ROCK SPRINGS','SMITHVILLE',
'SOUTHLAKE','SPRINGFIELD','STONE CITY','TIMBERVIEW',
'UNIVERSITY PARK','VALLEY CENTER','WEST BAY');
states : array[0..49] of string[2] =
('AL','AK','AZ','AR','CA','CO','CT','DE','FL','GA',
'HI','ID','IL','IN','IA','KS','KY','LA','ME','MD',
'MA','MI','MN','MS','MO','MT','NE','NV','NH','NJ',
'NM','NY','NC','ND','OH','OK','OR','PA','RI','SC',
'SD','TN','TX','UT','VT','VA','WA','WV','WI','WY');
number_prefixes = 5; {1 less than actual}
prefixes : array[0..number_prefixes] of string[2] =
('W','K','WA','WB','WD','KA');
number_wxs = 6; {1 less than actual}
wxs : array[0..number_wxs] of string[5] =
('COLD','COOL','HOT','WARM','RAIN','SNOW','CLEAR');
var
age, height, readability, strength, temp, years : integer;
ant_str, city, rig_str : string[15];
age_str,prefix,temp_str,years_str : string[2];
height_str,state : string[2];
callfrom, callto : string[6];
name : string[6];
rst,suffix : string[3];
readability_str, region, strength_str : string[1];
wx : string[5];
procedure getdata;
begin
randomize;
prefix:=prefixes[random(number_prefixes)];
region:=numbers[random(9)];
suffix:='';for i:=1 to 3 do suffix:=suffix+letters[random(25)];
callfrom:=prefix+region+suffix;
prefix:=prefixes[random(number_prefixes)];
region:=numbers[random(9)];
suffix:='';for i:=1 to 3 do suffix:=suffix+letters[random(25)];
callto:=prefix+region+suffix;
age:=random(60)+10;str(age,age_str);
years:=random(age-9);if years=0 then years:=1;str(years,years_str);
rig_str:=rigs[random(number_rigs)];
ant_str:=antennas[random(number_antennas)];
height:=random(50)+20;str(height,height_str);
name:=names[random(number_names)];
randomize;
readability:=4+random(2);str(readability,readability_str);
strength:=3+random(6);str(strength,strength_str);
rst:=readability_str+strength_str+'9';
wx:=wxs[random(number_wxs)];
if wx='HOT' then temp:=85+random(15)
else if wx='WARM' then temp:=70+random(15)
else if wx='COOL' then temp:=40+random(20)
else if wx='COLD' then temp:=random(40)
else if wx='SNOW' then temp:=20+random(12)
else if wx='RAIN' then temp:=32+random(50)
else temp:=random(100);
str(temp,temp_str);
city:=cities[random(number_cities)];
state:=states[random(49)];
end;
begin
mode:='QSO';
exit_msg:=quit_msg;
statusline;
abort:=false;
if firstpass then clrscr;
textcolor(cfgrec.hilite);
writeln('Simulated QSO');
for i:=1 to 13 do write(chr(196));writeln;writeln;
textcolor(cfgrec.main_fg);
getdata;
if not abort then begin
sendline('CQ CQ CQ DE '+callfrom+' K',echo_yes);delay(1500);writeln;
end;
if not abort then sendline(callto+' DE '+callfrom+' ',echo_yes);
if not abort then sendline('TNX FER CALL OM - UR RST IS '+rst+' - ',echo_yes);
if not abort then sendline('NAME HR IS '+name+' ES QTH IS '+city+', '+state+' - ',echo_yes);
if not abort then sendline('AGE IS '+age_str+' ES HAVE BIN A HAM FER '+years_str+' YRS - ',echo_yes);
if not abort then sendline('RIG IS '+rig_str+' ES ANT IS '+ant_str+' AT '+height_str+' FEET - ',echo_yes);
if not abort then sendline('WX IS '+wx+'. TEMP IS '+temp_str+'F - ',echo_yes);
if not abort then sendline('TNX FER NICE QSO OM - ',echo_yes);
if not abort then sendline('73 ES CUL '+callto+' DE '+callfrom+' $',echo_yes);
writeln;write('* Press Any Key to Continue...');
repeat until keypressed;
writeln;writeln;
end;
procedure type_test;
var
tstr : string[2];
recv_speed,send_speed,denominator,no_sent,adj_no_sent,no_correct,
adj_no_correct,numerator,time,treal,wdspaces : real;
hour,min,sec,hsec : byte {string[2]};
hour1,min1,sec1,hsec1,hour2,min2,sec2,hsec2,
code,ehour,emin,esec,ehsec: integer;
bit,cwch,ch : char;
correct,exit : boolean;
i,marktime, speed : integer;
procedure gettime;
var register:regpack;
begin
with register do begin
ax:=$2c00;
msdos(register);
hour:=hi(cx);
min:=lo(cx);
sec:=hi(dx);
hsec:=lo(dx);
end;
end;
procedure calc_time;
begin
if min1>min2 then begin hour2:=hour2-1;min2:=min2+60;end;
if sec1>sec2 then begin min2:=min2-1;sec2:=sec2+60;end;
if hsec1>hsec2 then begin sec2:=sec2-1;hsec2:=hsec2+100;end;
ehour:=hour2-hour1;emin:=min2-min1;esec:=sec2-sec1;ehsec:=hsec2-hsec1;
str(ehour,tstr);val(tstr,treal,code);time:=3600*treal;
str(emin,tstr);val(tstr,treal,code);time:=time+60*treal;
str(esec,tstr);val(tstr,treal,code);time:=time+treal;
str(ehsec,tstr);val(tstr,treal,code);time:=time+treal/100;
end;
procedure get_chr;
var chno : integer;
begin
repeat chno:=random(numberchars);until chno>0;
cwch:=characters[chno];
end;
begin
mode:='TYPETEST';
exit_msg:='To Exit Press <ESC>';
statusline;
if firstpass then clrscr;
textcolor(cfgrec.hilite);
writeln('Type Test');
for i:=1 to 9 do write(chr(196));writeln;writeln;
textcolor(cfgrec.main_fg);
writeln;writeln('* Press Correct Key When Character Sent.');writeln;
exit:=false;no_sent:=0;no_correct:=0;
randomize;
gettime;
hour1:=hour;min1:=min;sec1:=sec;hsec1:=hsec;
repeat
get_chr;
correct:=false;
repeat
gettime; {do not time "exit" character}
sendchrx(cwch);
no_sent:=no_sent+1;
repeat until keypressed;
read(kbd,ch);ch:=upcase(ch);
if (ch=cwch) then begin
correct:=true;
no_correct:=no_correct+1;
write(upcase(ch));
end
else if not (ch=#27) then blip;
until correct or (ch=#27);
if ch=#27 then abort:=true;
until abort;
hour2:=hour;min2:=min;sec2:=sec;hsec2:=hsec;
calc_time;if time=0 then time:=1.0;
no_sent:=no_sent-1; {last character is ignored}
wdspaces:=no_sent/5;wdspaces:=0.71*wdspaces;
adj_no_sent:=no_sent+wdspaces;
send_speed:=adj_no_sent/time;
writeln;writeln;
writeln('* Send Speed = ',1.58*12*send_speed:5:1,' wpm');
wdspaces:=no_correct/5;wdspaces:=0.71*wdspaces;
adj_no_correct:=no_correct+wdspaces;
recv_speed:=adj_no_correct/time;
writeln('* Receive Speed = ',1.58*12*recv_speed:5:1,' wpm');
if no_correct>0 then numerator:=100*(no_correct)
else numerator:=0;
denominator:=no_sent;if denominator=0 then denominator:=1;
writeln('* Percentage Correct = ',numerator/denominator:4:0);
writeln;write('* Press Any Key to Continue...');
repeat until keypressed;
writeln;writeln;
end;
procedure groups;
label endit;
var chr2send,i,j:integer;
begin
mode:='GROUPS';
exit_msg:=quit_msg;
statusline;
if firstpass then clrscr;
textcolor(cfgrec.hilite);
writeln('Random Code Groups');
for i:=1 to 19 do write(chr(196));writeln;writeln;
textcolor(cfgrec.main_fg);
repeat
randomize;
for i:=1 to 13 do
begin
for j:=1 to 5 do begin
repeat chr2send:=random(numberchars);until chr2send>0;
sendchr(characters[chr2send]);write(characters[chr2send]);
if abort then goto endit;
end;
sendchr(' ');
write(' ');;
end;
writeln;
until keypressed;
endit:
writeln;writeln;write('* Press Any Key to Continue...');
repeat until keypressed;
writeln;writeln;
end;
procedure help;
begin
save_screen;
drawbox(1,4,80,19,cfgrec.box_fg,cfgrec.box_bg,'[ Help ]',blink_no);
window(3,5,78,18);
writeln;writeln('COMMANDS:');writeln;
writeln('<D>isk - Sends disk text file. Enter name of file when prompted.');
writeln('<E>nter Message - Sends message entered by user when prompted.');
writeln('<G>roups - Sends 5 letter groups of random letters.');
writeln('<I>nformation - Information on program and author.');
writeln('<P>armeters - Set code speed and oscillator tone.');
writeln('<Q>SO - Simulated QSO (radio contact) with another station.');
writeln('<T>ype Test - Type correct key when character sent.');
writeln('<U>tilities - Set screen colors, test code speed.');
writeln('<W>ords - Sends random words of up to 6 letters in length.');
writeln;write('Press Any Key to Continue...');
repeat until keypressed;
restore_screen;
end;
procedure info;
begin
save_screen;
drawbox(8,1,72,23,cfgrec.box_fg,cfgrec.box_bg,'[ CW Information ]',blink_no);
textcolor(cfgrec.box_fg);
window(10,2,70,22);
writeln;
writeln('CW was written to help prospective hams learn the Morse Code');
writeln('and existing hams to increase their code speed. If you have');
writeln('any comments, suggestions for improvement, or corrections,');
writeln('please contact me as shown below. The Turbo Pascal code is');
writeln('included with the command file. You may make changes to the');
writeln('source code and distribute it so long as you (1) retain my');
writeln('copyright notices, (2) note your changes in the source file,');
writeln('and send me a copy of the altered code along with your per-');
writeln('mission to incorporate your changes into my next version.');
writeln('Shareware contributions are welcomed but are not required.');
writeln;
writeln(' M. Lee Murrah');
writeln(' 10 Cottage Grove Woods, S.E.');
writeln(' Cedar Rapids, IA 52403');
writeln(' Tel.: 319-365-6530');
writeln(' BBS : 319-365-0470');
writeln(' Compuserve ID: 71016,1355');
writeln(' GENIE Address: L.MURRAH');
writeln;
write(' Press Any Key to Continue...');
repeat until keypressed;
restore_screen;
end;
procedure learn;
label endit;
var exit : boolean;
begin
mode:='LEARN';
exit_msg:=quit_msg;
statusline;
if firstpass then clrscr;
textcolor(cfgrec.hilite);
writeln('Learn Character Sounds');
for i:=1 to 22 do write(chr(196));writeln;writeln;
textcolor(cfgrec.main_fg);
repeat
writeln('The DIT (short) sound : ');writeln;sendchr(' ');
for i:=1 to 5 do begin
sendstr('E ',echo_no);
if abort then goto endit;
write('DIT ');
end;
writeln;writeln;
writeln('The DAH (long) sound :');writeln;sendchr(' ');
for i:=1 to 5 do begin
sendstr('T ',echo_no);
if abort then goto endit;
write('DAH ');
end;
writeln;writeln;
writeln('Group 1 :');writeln;sendchr(' ');
sendline('EEEEE IIIII SSSSS HHHHH 55555 EISH5',echo_yes);
if abort then goto endit;
writeln;writeln('Group 2 :');writeln;sendchr(' ');
sendline('TTTTT MMMMM OOOOO 00000 TMO0',echo_yes);
if abort then goto endit;
writeln;writeln('Group 3 :');writeln;sendchr(' ');
sendline('AAAAA RRRRR LLLLL WWWWW JJJJJ 11111 PPPPP ARLWJ1P',echo_yes);
if abort then goto endit;
writeln;writeln('Group 4 :');writeln;sendchr(' ');
sendline('UUUUU FFFFF 22222 VVVVV 33333 44444 UF2V34',echo_yes);
if abort then goto endit;
writeln;writeln('Group 5 :');writeln;sendchr(' ');
sendline('NNNNN DDDDD BBBBB 66666 88888 99999 XXXXX NDB689X',echo_yes);
if abort then goto endit;
writeln;writeln('Group 6 :');writeln;sendchr(' ');
sendline('GGGGG QQQQQ ZZZZZ 77777 KKKKK CCCCC YYYYY GQZ7KCY',echo_yes);
if abort then goto endit;
writeln;writeln('Punctuation :');writeln;sendchr(' ');
sendline('..... ,,,,, ????? ///// ----- .,?/-',echo_yes);
if abort then goto endit;
writeln;writeln('All the characters :');writeln;sendchr(' ');
sendline('ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789.,?/-',echo_yes);
if abort then goto endit;
writeln;write('Repeat [Y/N] ? > ');
readln(menu_choice);
if menu_choice in ['Y','y'] then exit:=false else exit:=true;
if not exit then writeln;
until exit;
endit:
writeln;writeln;write('* Press Any Key to Continue...');
repeat until keypressed;
writeln;writeln;
end;
procedure enter_message;
begin
mode:='ENTER';
exit_msg:='';
statusline;
if firstpass then clrscr;
textcolor(cfgrec.hilite);
writeln('Enter Message');
for i:=1 to 13 do write(chr(196));writeln;writeln;
textcolor(cfgrec.main_fg);
writeln('* Enter message to be typed');writeln;
write('* > ');readln(text);writeln(' ');
sendline(text,echo_yes);
writeln;writeln('* Press Any Key to Continue');
repeat until keypressed;
writeln;writeln;
end;
procedure sendwords;
begin
mode:='WORDS';
exit_msg:=quit_msg;
statusline;
abort:=false;
if firstpass then clrscr;
textcolor(cfgrec.hilite);
writeln('Random Words');
for i:=1 to 12 do write(chr(196));writeln;writeln;
textcolor(cfgrec.main_fg);
randomize;
while not abort do begin
text:=words[random(numberwords)]+' ';
if wherex>78-length(text) then writeln;
sendstr(text,echo_no);
write(text);
end;
writeln;writeln;write('* Press Any Key to Continue...');
repeat until keypressed;
writeln;writeln;
end;
function real2int(input:real):integer;
var
number : integer;
begin
number:=0;
input:=int(input);
while input>0 do begin input:=input-1; number:=number+1;end;
real2int:=number;
end;
procedure enterspeed(send_spd,char_spd:real);
var
dummy,space_spd : real;
begin
dummy:=int(1170/char_spd);
marktime:=real2int(dummy);
space_spd:=(send_spd*char_spd)/(2*char_spd-send_spd);
dummy:=int(1170/space_spd);
space_marktime:=real2int(dummy);
end;
procedure set_speed;
var
char_spd_str,send_spd_str : string[2];
begin
save_screen;
drawbox(27,7,51,16,cfgrec.box_fg,cfgrec.box_bg,'[ Set Speed ]',blink_no);
textcolor(cfgrec.box_fg);
window(29,8,49,15);
repeat
clrscr;writeln;
writeln('Send Speed:');writeln;
writeln('Range = ',min_speed,'-',max_speed,' WPM.');
writeln('Default = ',cfgrec.send_speed_str,' WPM.');
writeln;
write('Enter > ');
inrange:=false;
read(send_spd_str);
if length(send_spd_str)=0 then send_spd_str:=cfgrec.send_speed_str;
val(send_spd_str,send_speed,code);
if (send_speed>min_speed-1) and (send_speed<max_speed+1) then inrange:=true;
if not inrange then buzz;
until inrange;
repeat
clrscr;writeln;
writeln('Character Speed:');writeln;
writeln('Range = ',cfgrec.send_speed_str,'-',max_speed,' WPM.');
writeln('Default = ',cfgrec.char_speed_str,' WPM.');
writeln;
write('Enter > ');
inrange:=false;
read(char_spd_str);
if length(char_spd_str)=0 then char_spd_str:=cfgrec.char_speed_str;
val(char_spd_str,char_speed,code);
if (char_speed>send_speed-1) and (char_speed<max_speed+1) then inrange:=true;
if not inrange then buzz;
until inrange;
enterspeed(send_speed,char_speed);
assign(cfgfile,'CW.CFG');
reset(cfgfile);
read(cfgfile,cfgrec);
cfgrec.send_speed_str:=send_spd_str;
cfgrec.char_speed_str:=char_spd_str;
rewrite(cfgfile);
write(cfgfile,cfgrec);
close(cfgfile);
restore_screen;
statusline;
end;
procedure tone;
var
freq_str : string[4];
begin
save_screen;
repeat
inrange:=false;
drawbox(28,8,52,15,cfgrec.box_fg,cfgrec.box_bg,'[ Set Tone ]',blink_no);
textcolor(cfgrec.box_fg);
window(30,9,50,14);
writeln;writeln('Range = 400-1200 Hz.');
writeln('Default = ',cfgrec.tone_freq_str,' Hz.');
writeln;
write('Enter > ');
read(freq_str);
if length(freq_str)=0 then freq_str:=cfgrec.tone_freq_str;
val(freq_str,freq,code);
if (freq>399) and (freq<1201) then inrange:=true;
if not inrange then buzz;
until inrange;
assign(cfgfile,'CW.CFG');
reset(cfgfile);
read(cfgfile,cfgrec);
cfgrec.tone_freq_str:=freq_str;
rewrite(cfgfile);
write(cfgfile,cfgrec);
close(cfgfile);
restore_screen;
end;
procedure parameters;
var
param_choice : char;
begin
save_screen;
repeat
drawbox(29,7,51,17,cfgrec.box_fg,cfgrec.box_bg,'[ Set Parameters ]',blink_no);
textcolor(cfgrec.box_fg);
window(31,8,49,15);
writeln;
writeln('<S>peed');
writeln('<T>one');
writeln;
writeln('<Q>uit');
writeln;
write('Choice > ');read(param_choice);
if length(param_choice)=0 then param_choice:='Q';
param_choice:=upcase(param_choice);
restore_screen;
case param_choice of
'S':set_speed;
'T':tone;
end;
until param_choice in ['Q','S','T'];
end;
procedure color_set;
var
choice : char;
saveint : integer;
savestr : line;
select : integer;
select_str : string[1];
temp : string[40];
begin
assign(cfgfile,'CW.CFG');
reset(cfgfile);
read(cfgfile,cfgrec);
rewrite(cfgfile);
save_screen;
drawbox(10,7,70,18,cfgrec.box_fg,cfgrec.box_bg,'[ Color Set ]',blink_no);
textcolor(cfgrec.box_fg);
window(12,8,68,17);
writeln;
writeln('0 - Black 4 - Red 8 - Dk. Gray 12 - Lt. Red');
writeln('1 - Blue 5 - Magenta 9 - Lt. Blue 13 - Lt. Magenta');
writeln('2 - Green 6 - Brown 10 - Lt. Green 14 - Yellow');
writeln('3 - Cyan 7 - Lt. Gray 11 - Lt. Cyan 15 - White');
window(12,14,68,17);
repeat
clrscr;
select:=cfgrec.main_bg;
writeln('Enter main background color (0-7):');
writeln('Current : ',cfgrec.main_bg);
write('New : ');readln(select_str);
val(select_str,select,code);
if select in [0..7] then inrange:=true else inrange:=false;
if not inrange then buzz;
until inrange;
cfgrec.main_bg:=select;
repeat
clrscr;
select:=cfgrec.main_fg;
writeln('Enter main foreground color (0-15):');
writeln('Current : ',cfgrec.main_fg);
write('New : ');readln(select_str);
val(select_str,select,code);
if select in [0..15] then inrange:=true else inrange:=false;
if not inrange then buzz;
until inrange;
cfgrec.main_fg:=select;
repeat
clrscr;
select:=cfgrec.box_bg;
writeln('Enter box background color (0-7):');
writeln('Current : ',cfgrec.box_bg);
write('New : ');readln(select);
val(select_str,select,code);
if select in [0..7] then inrange:=true else inrange:=false;
if not inrange then buzz;
until inrange;
cfgrec.box_bg:=select;
repeat
clrscr;
select:=cfgrec.box_fg;
writeln('Enter box foreground color (0-15):');
writeln('Current : ',cfgrec.box_fg);
write('New ');readln(select);
val(select_str,select,code);
if select in [0..15] then inrange:=true else inrange:=false;
if not inrange then buzz;
until inrange;
cfgrec.box_fg:=select;
repeat
clrscr;
select:=cfgrec.hilite;
writeln('Enter text highlight color (0-15):');
writeln('Current : ',cfgrec.hilite);
write('New : ');readln(select);
val(select_str,select,code);
if select in [0..15] then inrange:=true else inrange:=false;
if not inrange then buzz;
until inrange;
cfgrec.hilite:=select;
restore_screen;
write(cfgfile,cfgrec);
close(cfgfile);
end;
procedure speed_test;
var
wordcount : integer;
begin
wordcount:=1;abort:=false;
save_screen;
drawbox(8,5,71,19,cfgrec.box_fg,cfgrec.box_bg,'[ Test Speed ]',blink_no);
textcolor(cfgrec.box_fg);
window(10,6,69,18);
writeln;
writeln('Count number of words sent in 60 seconds = WPM');
writeln;
writeln('Press any key to stop test');
writeln;
while not abort and (wordcount<61) do begin
sendstr('PARIS ',echo_yes);
wordcount:=wordcount+1;
end;
writeln;writeln;
write('Press any key to continue...');
repeat until keypressed;
restore_screen;
end;
procedure utilities;
var
util_choice : char;
begin
save_screen;
repeat
drawbox(30,7,50,16,cfgrec.box_fg,cfgrec.box_bg,'[ CW Utilities ]',blink_no);
textcolor(cfgrec.box_fg);
window(32,8,48,15);
writeln;
writeln('<C>olors');
writeln('<S>peed Test');
writeln;
writeln('<Q>uit');
writeln;
write('Choice > ');read(util_choice);
if length(util_choice)=0 then util_choice:='Q';
util_choice:=upcase(util_choice);
restore_screen;
case util_choice of
'C':color_set;
'S':speed_test;
end;
until util_choice in ['Q','C','S'];
end;
procedure cwscreen;
begin
window(1,1,80,25);
clrscr;
for i:=1 to 24 do
writeln('CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW');
write('CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW');
end;
procedure config;
begin
assign(cfgfile,'CW.CFG');
{$I-} reset(cfgfile) {$I+};
if ioresult<>0 then
begin
assign(cfgfile,'CW.CFG');
rewrite(cfgfile);
cfgrec.tone_freq_str:='500';
cfgrec.send_speed_str:='14';
cfgrec.char_speed_str:='14';
cfgrec.main_bg:=0;
cfgrec.main_fg:=15;
cfgrec.box_bg:=0;
cfgrec.box_fg:=15;
write(cfgfile,cfgrec);
end;
reset(cfgfile);
read(cfgfile,cfgrec);
close(cfgfile);
end;
procedure init_variables;
begin
val(cfgrec.tone_freq_str,freq,code);
val(cfgrec.send_speed_str,send_speed,code);
val(cfgrec.char_speed_str,char_speed,code);
firstpass:=true;
end;
begin
config;
init_variables;
enterspeed(send_speed,char_speed);
textcolor(cfgrec.main_fg);
textbackground(cfgrec.main_bg);
cwscreen;
save_screen;
drawbox(15,5,65,20,cfgrec.box_fg,cfgrec.box_bg,'',blink_no);
window(16,7,64,19);
clrscr;
writeln(' CW');
writeln(' Ver. ',version);
writeln(' A Morse Code Generator Program');
writeln(' by');
writeln(' M. Lee Murrah');
writeln(' WD5CID');
writeln;
writeln(' Copyright 1986,87 M. Lee Murrah. May be copied');
writeln(' and used for private, non-commercial purposes');
writeln(' without further permission of the author.');
writeln;write(' Press Any Key to Continue...');
nowindow;
repeat until keypressed;
restore_screen;
window(1,1,80,25);clrscr;
gotoxy(1,24);for i:=1 to 80 do write(chr(196));
window(1,1,80,23);
save_screen;
repeat
mode:='CW '+version;
exit_msg:='';
statusline;
save_screen;
repeat
drawbox(23,2,57,22,cfgrec.box_fg,cfgrec.box_bg,'',blink_no);
textcolor(cfgrec.box_fg);
window(25,3,55,21);
writeln;
writeln(' CW MAIN MENU');
writeln;
writeln(' <D>isk File');
writeln(' <E>nter Message');
writeln(' <G>roups');
writeln(' <L>earn Chars');
writeln(' <Q>SO');
writeln(' <T>ype Test');
writeln(' <W>ords');
writeln;
writeln(' <H>elp');
writeln(' <I>nformation');
writeln(' <P>arameters');
writeln(' <U>tilities');
writeln(' e<X>it CW');writeln;
write(' Select > ');
readln(menu_choice);menu_choice:=upcase(menu_choice);
until menu_choice in ['D','E','F','G','H','I','L','P','Q','T','U','W','X'];
restore_screen;
case menu_choice of
'D':disk;
'E':enter_message;
'G':groups;
'H':help;
'I':info;
'L':learn;
'P':parameters;
'Q':qso;
'T':type_test;
'U':utilities;
'W':sendwords;
end;
if not (menu_choice in ['H','I','P','U']) then firstpass:=false;
until menu_choice in ['F','X'];
if menu_choice='X' then begin
cwscreen;
drawbox(28,9,51,15,cfgrec.box_fg,cfgrec.box_bg,'',blink_no);
textcolor(cfgrec.box_fg);
window(29,10,50,14);
clrscr;writeln;writeln(' Thanks for using CW');
enterspeed(21,21);
writeln;write(' ');
sendline('73 DE WD5CID $',echo_yes);
nowindow;
end;
gotoxy(1,24);
end.
{speed calculation assumptions for type test function:
o One bit is defined as one dot time.
o A dot=1 bit, a dash=3 bits, a space between dots and dashes=1 bit,
a space between characters=3 bits, and a space between words=7 bits.
o The standard word PARIS has 31 bits or avg of 6.2 bits/character.
o The average number of bits per character in the numbers and letters
is 9.83.
o The average character takes 9.83/6.2=1.58 times as long to send as the
average character in the standard word.
o A word is assumed to be 5 characters in length.
o A 7 bit wordspace is added for every 5 characters --.71 character lengths
o Thus, wpm can be estimated as recv_speed*60/5*1.58
o Spaces between characters are ignored }