home *** CD-ROM | disk | FTP | other *** search
- 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 }