home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / cw / cw212 / cw.pas < prev    next >
Pascal/Delphi Source File  |  1987-01-22  |  37KB  |  1,164 lines
  1. program cw;
  2.  
  3. type
  4.   line = string[80];
  5.   names = string[80];
  6.   screen_array = array[1..4000] of byte;
  7.   regpack     = record
  8.                    ax,bx,cx,dx,bp,si,ds,es,flags:integer;
  9.                  end;
  10.  
  11.   cfgtype = record
  12.               tone_freq_str  : string[4];
  13.               send_speed_str : string[2];
  14.               char_speed_str : string[2];
  15.               main_fg        : integer;
  16.               main_bg        : integer;
  17.               box_fg         : integer;
  18.               box_bg         : integer;
  19.               hilite         : integer;
  20.             end;
  21.  
  22. const
  23.   version      = '2.12';
  24.   min_speed    = 3;
  25.   max_speed    = 50;
  26.   blink_yes    = true;
  27.   blink_no     = false;
  28.   echo_yes     = true;
  29.   echo_no      = false;
  30.  
  31.   numberchars = 35; {1 less than actual number}
  32.  
  33.   characters : array[0..numberchars] of char =
  34.                'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789';
  35.  
  36.   number_letters = 25; {1 less than actual}
  37.  
  38.   letters    : array[0..number_letters] of char = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  39.  
  40.   numbers    : array[0..9] of char = '0123456789';
  41.  
  42.   {Additional words can be added to the list below if the constant numberwords
  43.    is increased accordingly}
  44.  
  45.   numberwords = 272; {This is 1 less than the actual number}
  46.  
  47.   words      : array[0..numberwords] of string[10] =
  48.                ('ADD','ADVICE','ADVISE','AFTER','AGAIN','AIM','AIR',
  49.                 'ALL','ALWAYS','ALSO','AM','AMONG','AN','AND','ANY',
  50.                 'ARE','AROUND','AS','ASK','ASKED','AWAY',
  51.                 'AT','BACK','BAD','BAND','BE','BEEN','BEFORE','BEST',
  52.                 'BETTER','BID','BIG','BIT','BOTH','BRING','BUT',
  53.                 'BUY','BY','CALL','CAME','CAN','CAR','CENT','CITY',
  54.                 'COLD','COME','COULD','DAY','DEAR','DID','DIE',
  55.                 'DO','DOES','DONE','DONT','DOWN','DRAW','DUE','EACH',
  56.                 'EAT','END','ES','EVEN','EVERY','FACT',
  57.                 'FALL','FAR','FAST','FB','FEW','FIND','FIRST','FIVE','FOR',
  58.                 'FOUND','FROM','FRONT','FULL','FUNNY','GAVE','GET',
  59.                 'GIVE','GO','GOES','GOING','GOOD','GOT','GROW',
  60.                 'HAD','HALF','HAM','HAND','HAS','HAVE','HE','HEAR',
  61.                 'HELP','HER','HERE','HIM','HIS','HOME','HOT','HOUSE',
  62.                 'HOW','IF','IN','INTO','IS','IT','JUMP','JUST',
  63.                 'KEEP','KEY','KNEW','KNOW','LAST','LAW','LEFT','LESS',
  64.                 'LET','LIE','LIGHT','LIKE','LITTLE','LIVE',
  65.                 'LONG','LOOK','LOT','LOVE','LOW','MADE','MAKE','MAN',
  66.                 'MANY','MATTER','MAY','ME','MIGHT','MIND','MORE','MUCH','MUST',
  67.                 'MY','MYSELF','NAME','NET','NEW','NEXT','NO','NOR','NOT','NOW',
  68.                 'OF','OFF','OIL','OLD','OM','ON','ONCE','ONLY',
  69.                 'OPEN','OR','OTHER','OUT','OVER','OWE','OWN','PART',
  70.                 'PAY','PER','PLAY','POWER','PULL','PUT',
  71.                 'QRM','QRN','QRX','QST','QTH','RADIO','RAIN',
  72.                 'RAN','READ','RIGHT','ROUND','RST','RUN','SAID','SAME',
  73.                 'SAT','SAW','SAY','SEA','SEE','SHALL','SHE','SHOULD',
  74.                 'SHOW','SMALL','SO','SOME','SOON','START','STOP','SUCH',
  75.                 'TAKE','TAKEN','TELL','THAN','THANK','THAT','THE','THEM','THEN','THERE',
  76.                 'THEY','THING','THINK','THIS','THOSE','TIME','TO','TODAY',
  77.                 'TOO','TRY','UNDER','UNTIL','UP','UPON',
  78.                 'UR','US','USE','VERY','VY','WALK','WANT','WAS',
  79.                 'WAY','WE','WELL','WENT','WERE','WHAT','WHEN','WHERE',
  80.                 'WHICH','WHILE','WHO','WHOLE','WHOSE','WHY',
  81.                 'WILL','WITH','WISH','WORK','WORLD','WOULD','WRITE','WRONG',
  82.                 'WX','W1AW','YEARS','YET','YL','YOU','YOUR','YOURS',
  83.                 '559','569','579','589','599');
  84.  
  85.   quit_msg = 'To Abort Press Any Key';
  86.  
  87. var
  88.   cfgfile: file of cfgtype;
  89.   cfgrec : cfgtype;
  90.   real_screen : screen_array Absolute $b800:$0000;
  91.   tmp_screen : screen_array;
  92.   main_fg,main_bg,box_fg,box_bg,xpos,ypos:integer;
  93.   code,freq,i,marktime,space_marktime,q,textpos,x,xx,yy : integer;
  94.   bit,menu_choice : char;
  95.   send_speed,char_speed : real;
  96.   text: line;
  97.   abort,firstpass,inrange : boolean;
  98.   exit_msg : string[22];
  99.   mode : string[10];
  100.  
  101. procedure beep; begin write(chr(7));end;
  102.  
  103. procedure blip;begin sound(400);delay(25);nosound;delay(300);end;
  104.  
  105. procedure buzz;begin
  106.   for i:=1 to 7 do begin
  107.    sound(100);delay(10);sound(200);delay(10);nosound;
  108.   end;
  109. end;
  110.  
  111. procedure drawbox_ibm (x1,y1,x2,y2,fg,bg : integer; boxname : names; blnk : boolean);
  112. begin
  113.   window (x1,y1,x2,y1+1);
  114.   textbackground(cfgrec.box_bg);
  115.   gotoxy(1,1);
  116.   x := x2-x1;
  117.   if length(boxname) > x then boxname[0] := chr(x-4);
  118.   textcolor(cfgrec.box_fg);
  119.   write('╔');
  120.   if blnk then textcolor(cfgrec.box_fg + blink) else textcolor(cfgrec.box_fg);
  121.   write (boxname);
  122.   textcolor(cfgrec.box_fg);
  123.   for q := x1+length(boxname)+1 TO x2-1 do write('═');
  124.   write('╗');
  125.   for q := 2 to y2-y1 DO
  126.     begin
  127.       window (x1,y1,x2,y1+q+1);
  128.       gotoxy(1,q); write('║');
  129.       if blnk then clreol;
  130.       gotoxy(x2-x1+1,q); write('║');
  131.     end;
  132.   window(x1,y1,x2,y2+1);
  133.   gotoxy(1,y2-y1+1);
  134.   write('╚');
  135.   for q := x1+1 to x2-1 do write('═');
  136.   write('╝');
  137. end;
  138.  
  139. procedure drawbox (x1,y1,x2,y2,fg,bg : integer; boxname : names; blnk : boolean);
  140. begin
  141.   drawbox_ibm (x1,y1,x2,y2,fg,bg,boxname,blnk);
  142.   window (x1+1,y1+1,x2-1,y2-1);
  143.   clrscr;
  144. end;
  145.  
  146. procedure nowindow;begin window(1,1,80,23);end;
  147.  
  148. procedure scrn_off;
  149. begin
  150.      inline($52/$50/$ba/$d8/$03/$b0/$21/$ee/$58/$5a)
  151. end;
  152.  
  153. procedure scrn_on;
  154. begin
  155.      inline($52/$50/$ba/$d8/$03/$b0/$29/$ee/$58/$5a)
  156. end;
  157.  
  158. procedure save_screen;
  159. begin
  160.     xx := wherex;
  161.     yy := wherey;
  162.     scrn_off;
  163.     move(real_screen, tmp_screen, 4000);
  164.     scrn_on;
  165. end;
  166.  
  167. procedure restore_screen;
  168. var
  169.    numline : integer;
  170. begin
  171.     clrscr;
  172.     window(1,1,80,23);
  173.     scrn_off;
  174.     move(tmp_screen, real_screen, 4000);
  175.     scrn_on;
  176.     gotoxy(xx,yy);
  177.     textcolor(cfgrec.main_fg);
  178.     textbackground(cfgrec.main_bg);
  179. end;
  180.  
  181. procedure statusline;
  182. begin
  183.   window(1,1,80,25);
  184.   xpos:=wherex;ypos:=wherey;
  185.   gotoxy(1,25);clreol;
  186.   gotoxy(1,25);write(mode);
  187.   gotoxy(14,25);write('Spd : ',cfgrec.send_speed_str);
  188.   gotoxy(27,25);write('ChrSpd : ',cfgrec.char_speed_str);
  189.   gotoxy(43,25);write('Tone : ',cfgrec.tone_freq_str);
  190.   gotoxy(58,25);write(exit_msg);
  191.   gotoxy(xpos,ypos);
  192.   window(1,1,80,23);
  193. end;
  194.  
  195. procedure dot;begin
  196.   if keypressed then abort:=true else abort:=false;
  197.   sound(freq);
  198.   delay(marktime);
  199.   nosound;
  200. end;
  201.  
  202. procedure dash;begin
  203.   if keypressed then abort:=true else abort:=false;
  204.   sound(freq);
  205.   delay(3*marktime);
  206.   nosound;
  207. end;
  208.  
  209. procedure bitspace;begin
  210.   if keypressed then abort:=true else abort:=false;
  211.   delay(marktime);
  212. end;
  213.  
  214. procedure charspace;begin
  215.   if keypressed then abort:=true else abort:=false;
  216.   delay(2*space_marktime);
  217. end;
  218.  
  219. procedure wordspace;begin
  220.   if keypressed then abort:=true else abort:=false;
  221.   delay(6*space_marktime);
  222. end;
  223.  
  224. procedure sendchrx(ch:char);   {character sent without charspace}
  225. var
  226.   mch : string[8];
  227.  
  228. begin
  229.   ch:=upcase(ch);
  230.   case ch of
  231.     ' ':mch:=' ';
  232.     'A':mch:='01';
  233.     'B':mch:='1000';
  234.     'C':mch:='1010';
  235.     'D':mch:='100';
  236.     'E':mch:='0';
  237.     'F':mch:='0010';
  238.     'G':mch:='110';
  239.     'H':mch:='0000';
  240.     'I':mch:='00';
  241.     'J':mch:='0111';
  242.     'K':mch:='101';
  243.     'L':mch:='0100';
  244.     'M':mch:='11';
  245.     'N':mch:='10';
  246.     'O':mch:='111';
  247.     'P':mch:='0110';
  248.     'Q':mch:='1101';
  249.     'R':mch:='010';
  250.     'S':mch:='000';
  251.     'T':mch:='1';
  252.     'U':mch:='001';
  253.     'V':mch:='0001';
  254.     'W':mch:='011';
  255.     'X':mch:='1001';
  256.     'Y':mch:='1011';
  257.     'Z':mch:='1100';
  258.     '1':mch:='01111';
  259.     '2':mch:='00111';
  260.     '3':mch:='00011';
  261.     '4':mch:='00001';
  262.     '5':mch:='00000';
  263.     '6':mch:='10000';
  264.     '7':mch:='11000';
  265.     '8':mch:='11100';
  266.     '9':mch:='11110';
  267.     '0':mch:='11111';
  268.     '-':mch:='10001';
  269.     '/':mch:='10010';
  270.     '?':mch:='001100';
  271.     ',':mch:='110011';
  272.     '.':mch:='01010';
  273.     '$':mch:='000101';
  274.     '*':mch:='10001';
  275.     else mch:='\ ';
  276.   end;
  277.   for i:=1 to length(mch) do begin
  278.     bit:=copy(mch,i,1);
  279.     case bit of
  280.       '\':bitspace;
  281.       ' ':wordspace;
  282.       '0':dot;
  283.       '1':dash;
  284.     end;
  285.     bitspace;
  286.   end;
  287.   charspace;
  288. end;
  289.  
  290. procedure sendchr(ch:char);
  291. begin
  292.   sendchrx(ch);
  293.   charspace;
  294. end;
  295.  
  296. procedure sendstr(text:line;withecho:boolean);
  297. label endit;
  298. begin
  299.   for textpos:=1 to length(text) do begin
  300.     sendchr(text[textpos]);
  301.     if withecho then write(text[textpos]);
  302.     if abort then goto endit;
  303.   end;
  304.   endit:
  305. end;
  306.  
  307. procedure sendline(text:line;withecho:boolean);
  308. begin
  309.   sendstr(text,withecho);
  310.   writeln;
  311. end;
  312.  
  313. procedure disk;
  314. var
  315.   ch       : char;
  316.   filename : string[14];
  317.   sendfile : text;
  318.   select   : char;
  319.   goodfile : boolean;
  320. begin
  321.   abort:=false;
  322.   mode:='DISK';
  323.   exit_msg:=quit_msg;
  324.   statusline;
  325.   if firstpass then clrscr;
  326.   textcolor(cfgrec.hilite);
  327.   writeln('Disk File');
  328.   for i:=1 to 9 do write(chr(196));writeln;
  329.   textcolor(cfgrec.main_fg);
  330.   repeat
  331.     goodfile:=false;writeln;
  332.     write('* Enter Disk File Name > ');readln(filename);writeln;
  333.     assign(sendfile,filename);
  334.     {$I-} reset(sendfile) {$I+};
  335.     if ioresult=0 then goodfile:=true;
  336.     if not goodfile then begin
  337.       beep;
  338.       writeln;writeln('* File Does Not Exist');
  339.     end;
  340.   until goodfile;
  341.   write('* Display Text ? [Y] > ');readln(select);writeln;
  342.   if not (select in ['Y','y','N','n']) then select:='Y';
  343.   while (not abort) and (not eof(sendfile)) do begin
  344.     read(sendfile,ch);ch:=upcase(ch);
  345.     sendchr(ch);
  346.     if select in ['Y','y'] then write(ch);
  347.   end;
  348.   writeln;writeln;write('* Press Any Key to Continue...');
  349.   repeat until keypressed;
  350.   writeln;writeln;
  351.   close(sendfile);
  352. end;
  353.  
  354. procedure qso;
  355. const
  356.  
  357.   number_antennas = 13;  {1 less than the acutal number}
  358.  
  359.   antennas    : array[0..number_antennas] of string[15] =
  360.                 ('DELTA LOOP','DIPOLE','FOLDED DIPOLE','HORIZONTAL LOOP',
  361.                  'INVERTED VEE','LOG PERIODIC','LONGWIRE',
  362.                  'PHASED VERTICAL ARRAY','QUAD','TRAP VERTICAL',
  363.                  'TRIBAND YAGI','VERTCAL','WINDOM','ZEPP');
  364.  
  365.   number_names = 26; {1 less than the acutal number}
  366.  
  367.   names       : array[0..number_names] of string[6] =
  368.                 ('AL','ANN','BETTY','BILL','BOB','CARL','DON',
  369.                  'EARL','FRED','JACK','JIM','JOAN','JOE','KEN','LEE',
  370.                  'LIZ','MARY','MIKE','PAT','PAUL','RON','SAM','SUE',
  371.                  'TIM','TED','TOM','VERN');
  372.  
  373.   number_rigs = 12; {1 less than the actual number}
  374.  
  375.   rigs        : array[0..number_rigs] of string[15] =
  376.                 ('COLLINS S-LINE','COLLINS KWM-380','HEATH SB-102',
  377.                  'MOMEBREW','ICOM IC-720A','ICOM IC-745','ICOM IC-751',
  378.                  'KENWOOD TS-520E','KENWOOD TS-820S','KENWOOD TS940S',
  379.                  'TEMPO ONE','YAESU FT-101E','YAESU FT-757GX');
  380.  
  381.   number_cities = 22; {1 less than the actual number}
  382.  
  383.   cities      : array[0..number_cities] of string[15] =
  384.                 ('BEDROCK','CAPITAL CITY','CENTERVILLE','COLUMBIA',
  385.                  'EASTVALE','GREEN VALLEY','GREENVILLE','HIGHLANDS',
  386.                  'HILLSDALE','INDEPENDENCE','JONESTOWN','LAKE CITY',
  387.                  'MAYBERRY','OAK FALLS','ROCK SPRINGS','SMITHVILLE',
  388.                  'SOUTHLAKE','SPRINGFIELD','STONE CITY','TIMBERVIEW',
  389.                  'UNIVERSITY PARK','VALLEY CENTER','WEST BAY');
  390.  
  391.   states      : array[0..49] of string[2] =
  392.                 ('AL','AK','AZ','AR','CA','CO','CT','DE','FL','GA',
  393.                  'HI','ID','IL','IN','IA','KS','KY','LA','ME','MD',
  394.                  'MA','MI','MN','MS','MO','MT','NE','NV','NH','NJ',
  395.                  'NM','NY','NC','ND','OH','OK','OR','PA','RI','SC',
  396.                  'SD','TN','TX','UT','VT','VA','WA','WV','WI','WY');
  397.  
  398.   number_prefixes = 5; {1 less than actual}
  399.  
  400.   prefixes    : array[0..number_prefixes] of string[2] =
  401.                 ('W','K','WA','WB','WD','KA');
  402.  
  403.   number_wxs = 6; {1 less than actual}
  404.  
  405.   wxs         : array[0..number_wxs] of string[5] =
  406.                 ('COLD','COOL','HOT','WARM','RAIN','SNOW','CLEAR');
  407.  
  408. var
  409.   age, height, readability, strength, temp, years : integer;
  410.   ant_str, city, rig_str : string[15];
  411.   age_str,prefix,temp_str,years_str : string[2];
  412.   height_str,state : string[2];
  413.   callfrom, callto : string[6];
  414.   name : string[6];
  415.   rst,suffix  : string[3];
  416.   readability_str, region, strength_str : string[1];
  417.   wx : string[5];
  418.  
  419.   procedure getdata;
  420.   begin
  421.     randomize;
  422.     prefix:=prefixes[random(number_prefixes)];
  423.     region:=numbers[random(9)];
  424.     suffix:='';for i:=1 to 3 do suffix:=suffix+letters[random(25)];
  425.     callfrom:=prefix+region+suffix;
  426.     prefix:=prefixes[random(number_prefixes)];
  427.     region:=numbers[random(9)];
  428.     suffix:='';for i:=1 to 3 do suffix:=suffix+letters[random(25)];
  429.     callto:=prefix+region+suffix;
  430.     age:=random(60)+10;str(age,age_str);
  431.     years:=random(age-9);if years=0 then years:=1;str(years,years_str);
  432.     rig_str:=rigs[random(number_rigs)];
  433.     ant_str:=antennas[random(number_antennas)];
  434.     height:=random(50)+20;str(height,height_str);
  435.     name:=names[random(number_names)];
  436.     randomize;
  437.     readability:=4+random(2);str(readability,readability_str);
  438.     strength:=3+random(6);str(strength,strength_str);
  439.     rst:=readability_str+strength_str+'9';
  440.     wx:=wxs[random(number_wxs)];
  441.     if wx='HOT' then temp:=85+random(15)
  442.     else if wx='WARM' then temp:=70+random(15)
  443.     else if wx='COOL' then temp:=40+random(20)
  444.     else if wx='COLD' then temp:=random(40)
  445.     else if wx='SNOW' then temp:=20+random(12)
  446.     else if wx='RAIN' then temp:=32+random(50)
  447.     else temp:=random(100);
  448.     str(temp,temp_str);
  449.     city:=cities[random(number_cities)];
  450.     state:=states[random(49)];
  451.   end;
  452.  
  453. begin
  454.   mode:='QSO';
  455.   exit_msg:=quit_msg;
  456.   statusline;
  457.   abort:=false;
  458.   if firstpass then clrscr;
  459.   textcolor(cfgrec.hilite);
  460.   writeln('Simulated QSO');
  461.   for i:=1 to 13 do write(chr(196));writeln;writeln;
  462.   textcolor(cfgrec.main_fg);
  463.   getdata;
  464.   if not abort then begin
  465.     sendline('CQ CQ CQ DE '+callfrom+' K',echo_yes);delay(1500);writeln;
  466.   end;
  467.   if not abort then sendline(callto+' DE '+callfrom+' ',echo_yes);
  468.   if not abort then sendline('TNX FER CALL OM - UR RST IS '+rst+' - ',echo_yes);
  469.   if not abort then sendline('NAME HR IS '+name+' ES QTH IS '+city+', '+state+' - ',echo_yes);
  470.   if not abort then sendline('AGE IS '+age_str+' ES HAVE BIN A HAM FER '+years_str+' YRS - ',echo_yes);
  471.   if not abort then sendline('RIG IS '+rig_str+' ES ANT IS '+ant_str+' AT '+height_str+' FEET - ',echo_yes);
  472.   if not abort then sendline('WX IS '+wx+'.  TEMP IS '+temp_str+'F - ',echo_yes);
  473.   if not abort then sendline('TNX FER NICE QSO OM - ',echo_yes);
  474.   if not abort then sendline('73 ES CUL '+callto+' DE '+callfrom+' $',echo_yes);
  475.   writeln;write('* Press Any Key to Continue...');
  476.   repeat until keypressed;
  477.   writeln;writeln;
  478. end;
  479.  
  480. procedure type_test;
  481. var
  482.   tstr : string[2];
  483.   recv_speed,send_speed,denominator,no_sent,adj_no_sent,no_correct,
  484.   adj_no_correct,numerator,time,treal,wdspaces : real;
  485.   hour,min,sec,hsec : byte {string[2]};
  486.   hour1,min1,sec1,hsec1,hour2,min2,sec2,hsec2,
  487.   code,ehour,emin,esec,ehsec: integer;
  488.  
  489.   bit,cwch,ch   : char;
  490.   correct,exit      : boolean;
  491.   i,marktime, speed : integer;
  492.  
  493.   procedure gettime;
  494.   var register:regpack;
  495.   begin
  496.     with register do begin
  497.       ax:=$2c00;
  498.       msdos(register);
  499.       hour:=hi(cx);
  500.       min:=lo(cx);
  501.       sec:=hi(dx);
  502.       hsec:=lo(dx);
  503.     end;
  504.   end;
  505.  
  506.   procedure calc_time;
  507.   begin
  508.     if min1>min2 then begin hour2:=hour2-1;min2:=min2+60;end;
  509.     if sec1>sec2 then begin min2:=min2-1;sec2:=sec2+60;end;
  510.     if hsec1>hsec2 then begin sec2:=sec2-1;hsec2:=hsec2+100;end;
  511.     ehour:=hour2-hour1;emin:=min2-min1;esec:=sec2-sec1;ehsec:=hsec2-hsec1;
  512.     str(ehour,tstr);val(tstr,treal,code);time:=3600*treal;
  513.     str(emin,tstr);val(tstr,treal,code);time:=time+60*treal;
  514.     str(esec,tstr);val(tstr,treal,code);time:=time+treal;
  515.     str(ehsec,tstr);val(tstr,treal,code);time:=time+treal/100;
  516.   end;
  517.  
  518.   procedure get_chr;
  519.   var chno : integer;
  520.   begin
  521.     repeat chno:=random(numberchars);until chno>0;
  522.     cwch:=characters[chno];
  523.   end;
  524.  
  525. begin
  526.   mode:='TYPETEST';
  527.   exit_msg:='To Exit Press <ESC>';
  528.   statusline;
  529.   if firstpass then clrscr;
  530.   textcolor(cfgrec.hilite);
  531.   writeln('Type Test');
  532.   for i:=1 to 9 do write(chr(196));writeln;writeln;
  533.   textcolor(cfgrec.main_fg);
  534.   writeln;writeln('* Press Correct Key When Character Sent.');writeln;
  535.   exit:=false;no_sent:=0;no_correct:=0;
  536.   randomize;
  537.   gettime;
  538.   hour1:=hour;min1:=min;sec1:=sec;hsec1:=hsec;
  539.   repeat
  540.     get_chr;
  541.     correct:=false;
  542.     repeat
  543.       gettime;                {do not time "exit" character}
  544.       sendchrx(cwch);
  545.       no_sent:=no_sent+1;
  546.       repeat until keypressed;
  547.       read(kbd,ch);ch:=upcase(ch);
  548.       if (ch=cwch) then begin
  549.         correct:=true;
  550.         no_correct:=no_correct+1;
  551.         write(upcase(ch));
  552.       end
  553.       else if not (ch=#27) then blip;
  554.     until correct or (ch=#27);
  555.     if ch=#27 then abort:=true;
  556.   until abort;
  557.   hour2:=hour;min2:=min;sec2:=sec;hsec2:=hsec;
  558.   calc_time;if time=0 then time:=1.0;
  559.   no_sent:=no_sent-1;                     {last character is ignored}
  560.   wdspaces:=no_sent/5;wdspaces:=0.71*wdspaces;
  561.   adj_no_sent:=no_sent+wdspaces;
  562.   send_speed:=adj_no_sent/time;
  563.   writeln;writeln;
  564.   writeln('* Send Speed         = ',1.58*12*send_speed:5:1,' wpm');
  565.   wdspaces:=no_correct/5;wdspaces:=0.71*wdspaces;
  566.   adj_no_correct:=no_correct+wdspaces;
  567.   recv_speed:=adj_no_correct/time;
  568.   writeln('* Receive Speed      = ',1.58*12*recv_speed:5:1,' wpm');
  569.   if no_correct>0 then numerator:=100*(no_correct)
  570.   else numerator:=0;
  571.   denominator:=no_sent;if denominator=0 then denominator:=1;
  572.   writeln('* Percentage Correct = ',numerator/denominator:4:0);
  573.   writeln;write('* Press Any Key to Continue...');
  574.   repeat until keypressed;
  575.   writeln;writeln;
  576. end;
  577.  
  578. procedure groups;
  579. label endit;
  580. var chr2send,i,j:integer;
  581. begin
  582.   mode:='GROUPS';
  583.   exit_msg:=quit_msg;
  584.   statusline;
  585.   if firstpass then clrscr;
  586.   textcolor(cfgrec.hilite);
  587.   writeln('Random Code Groups');
  588.   for i:=1 to 19 do write(chr(196));writeln;writeln;
  589.   textcolor(cfgrec.main_fg);
  590.   repeat
  591.     randomize;
  592.     for i:=1 to 13 do
  593.       begin
  594.         for j:=1 to 5 do begin
  595.           repeat chr2send:=random(numberchars);until chr2send>0;
  596.           sendchr(characters[chr2send]);write(characters[chr2send]);
  597.           if abort then goto endit;
  598.         end;
  599.         sendchr(' ');
  600.         write(' ');;
  601.       end;
  602.     writeln;
  603.   until keypressed;
  604.   endit:
  605.   writeln;writeln;write('* Press Any Key to Continue...');
  606.   repeat until keypressed;
  607.   writeln;writeln;
  608. end;
  609.  
  610. procedure help;
  611. begin
  612.   save_screen;
  613.   drawbox(1,4,80,19,cfgrec.box_fg,cfgrec.box_bg,'[ Help ]',blink_no);
  614.   window(3,5,78,18);
  615.   writeln;writeln('COMMANDS:');writeln;
  616.   writeln('<D>isk          - Sends disk text file.  Enter name of file when prompted.');
  617.   writeln('<E>nter Message - Sends message entered by user when prompted.');
  618.   writeln('<G>roups        - Sends 5 letter groups of random letters.');
  619.   writeln('<I>nformation   - Information on program and author.');
  620.   writeln('<P>armeters     - Set code speed and oscillator tone.');
  621.   writeln('<Q>SO           - Simulated QSO (radio contact) with another station.');
  622.   writeln('<T>ype Test     - Type correct key when character sent.');
  623.   writeln('<U>tilities     - Set screen colors, test code speed.');
  624.   writeln('<W>ords         - Sends random words of up to 6 letters in length.');
  625.   writeln;write('Press Any Key to Continue...');
  626.   repeat until keypressed;
  627.   restore_screen;
  628. end;
  629.  
  630. procedure info;
  631. begin
  632.   save_screen;
  633.   drawbox(8,1,72,23,cfgrec.box_fg,cfgrec.box_bg,'[ CW Information ]',blink_no);
  634.   textcolor(cfgrec.box_fg);
  635.   window(10,2,70,22);
  636.   writeln;
  637.   writeln('CW was written to help prospective hams learn the Morse Code');
  638.   writeln('and existing hams to increase their code speed.  If you have');
  639.   writeln('any comments, suggestions for improvement, or corrections,');
  640.   writeln('please contact me as shown below.  The Turbo Pascal code is');
  641.   writeln('included with the command file.  You may make changes to the');
  642.   writeln('source code and distribute it so long as you (1) retain my');
  643.   writeln('copyright notices, (2) note your changes in the source file,');
  644.   writeln('and send me a copy of the altered code along with your per-');
  645.   writeln('mission to incorporate your changes into my next version.');
  646.   writeln('Shareware contributions are welcomed but are not required.');
  647.   writeln;
  648.   writeln('               M. Lee Murrah');
  649.   writeln('               10 Cottage Grove Woods, S.E.');
  650.   writeln('               Cedar Rapids, IA 52403');
  651.   writeln('               Tel.: 319-365-6530');
  652.   writeln('               BBS : 319-365-0470');
  653.   writeln('               Compuserve ID: 71016,1355');
  654.   writeln('               GENIE Address: L.MURRAH');
  655.   writeln;
  656.   write('               Press Any Key to Continue...');
  657.   repeat until keypressed;
  658.   restore_screen;
  659. end;
  660.  
  661. procedure learn;
  662. label endit;
  663. var exit : boolean;
  664. begin
  665.   mode:='LEARN';
  666.   exit_msg:=quit_msg;
  667.   statusline;
  668.   if firstpass then clrscr;
  669.   textcolor(cfgrec.hilite);
  670.   writeln('Learn Character Sounds');
  671.   for i:=1 to 22 do write(chr(196));writeln;writeln;
  672.   textcolor(cfgrec.main_fg);
  673.   repeat
  674.     writeln('The DIT (short) sound : ');writeln;sendchr(' ');
  675.     for i:=1 to 5 do begin
  676.       sendstr('E  ',echo_no);
  677.       if abort then goto endit;
  678.       write('DIT ');
  679.     end;
  680.     writeln;writeln;
  681.     writeln('The DAH (long) sound :');writeln;sendchr(' ');
  682.     for i:=1 to 5 do begin
  683.       sendstr('T  ',echo_no);
  684.       if abort then goto endit;
  685.       write('DAH ');
  686.     end;
  687.     writeln;writeln;
  688.     writeln('Group 1 :');writeln;sendchr(' ');
  689.     sendline('EEEEE IIIII SSSSS HHHHH 55555 EISH5',echo_yes);
  690.     if abort then goto endit;
  691.     writeln;writeln('Group 2 :');writeln;sendchr(' ');
  692.     sendline('TTTTT MMMMM OOOOO 00000 TMO0',echo_yes);
  693.     if abort then goto endit;
  694.     writeln;writeln('Group 3 :');writeln;sendchr(' ');
  695.     sendline('AAAAA RRRRR LLLLL WWWWW JJJJJ 11111 PPPPP ARLWJ1P',echo_yes);
  696.     if abort then goto endit;
  697.     writeln;writeln('Group 4 :');writeln;sendchr(' ');
  698.     sendline('UUUUU FFFFF 22222 VVVVV 33333 44444 UF2V34',echo_yes);
  699.     if abort then goto endit;
  700.     writeln;writeln('Group 5 :');writeln;sendchr(' ');
  701.     sendline('NNNNN DDDDD BBBBB 66666 88888 99999 XXXXX NDB689X',echo_yes);
  702.     if abort then goto endit;
  703.     writeln;writeln('Group 6 :');writeln;sendchr(' ');
  704.     sendline('GGGGG QQQQQ ZZZZZ 77777 KKKKK CCCCC YYYYY GQZ7KCY',echo_yes);
  705.     if abort then goto endit;
  706.     writeln;writeln('Punctuation :');writeln;sendchr(' ');
  707.     sendline('..... ,,,,, ????? ///// ----- .,?/-',echo_yes);
  708.     if abort then goto endit;
  709.     writeln;writeln('All the characters :');writeln;sendchr(' ');
  710.     sendline('ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789.,?/-',echo_yes);
  711.     if abort then goto endit;
  712.     writeln;write('Repeat [Y/N] ? > ');
  713.     readln(menu_choice);
  714.     if menu_choice in ['Y','y'] then exit:=false else exit:=true;
  715.     if not exit then writeln;
  716.   until exit;
  717.   endit:
  718.   writeln;writeln;write('* Press Any Key to Continue...');
  719.   repeat until keypressed;
  720.   writeln;writeln;
  721. end;
  722.  
  723. procedure enter_message;
  724. begin
  725.   mode:='ENTER';
  726.   exit_msg:='';
  727.   statusline;
  728.   if firstpass then clrscr;
  729.   textcolor(cfgrec.hilite);
  730.   writeln('Enter Message');
  731.   for i:=1 to 13 do write(chr(196));writeln;writeln;
  732.   textcolor(cfgrec.main_fg);
  733.   writeln('* Enter message to be typed');writeln;
  734.   write('* > ');readln(text);writeln('  ');
  735.   sendline(text,echo_yes);
  736.   writeln;writeln('* Press Any Key to Continue');
  737.   repeat until keypressed;
  738.   writeln;writeln;
  739. end;
  740.  
  741. procedure sendwords;
  742. begin
  743.   mode:='WORDS';
  744.   exit_msg:=quit_msg;
  745.   statusline;
  746.   abort:=false;
  747.   if firstpass then clrscr;
  748.   textcolor(cfgrec.hilite);
  749.   writeln('Random Words');
  750.   for i:=1 to 12 do write(chr(196));writeln;writeln;
  751.   textcolor(cfgrec.main_fg);
  752.   randomize;
  753.   while not abort do begin
  754.     text:=words[random(numberwords)]+' ';
  755.     if wherex>78-length(text) then writeln;
  756.     sendstr(text,echo_no);
  757.     write(text);
  758.   end;
  759.   writeln;writeln;write('* Press Any Key to Continue...');
  760.   repeat until keypressed;
  761.   writeln;writeln;
  762. end;
  763.  
  764. function real2int(input:real):integer;
  765. var
  766.   number : integer;
  767. begin
  768.   number:=0;
  769.   input:=int(input);
  770.   while input>0 do begin input:=input-1; number:=number+1;end;
  771.   real2int:=number;
  772. end;
  773.  
  774. procedure enterspeed(send_spd,char_spd:real);
  775. var
  776.   dummy,space_spd : real;
  777. begin
  778.   dummy:=int(1170/char_spd);
  779.   marktime:=real2int(dummy);
  780.   space_spd:=(send_spd*char_spd)/(2*char_spd-send_spd);
  781.   dummy:=int(1170/space_spd);
  782.   space_marktime:=real2int(dummy);
  783. end;
  784.  
  785. procedure set_speed;
  786. var
  787.   char_spd_str,send_spd_str : string[2];
  788.  
  789. begin
  790.   save_screen;
  791.     drawbox(27,7,51,16,cfgrec.box_fg,cfgrec.box_bg,'[ Set Speed ]',blink_no);
  792.     textcolor(cfgrec.box_fg);
  793.     window(29,8,49,15);
  794.   repeat
  795.     clrscr;writeln;
  796.     writeln('Send Speed:');writeln;
  797.     writeln('Range   = ',min_speed,'-',max_speed,' WPM.');
  798.     writeln('Default = ',cfgrec.send_speed_str,' WPM.');
  799.     writeln;
  800.     write('Enter > ');
  801.     inrange:=false;
  802.     read(send_spd_str);
  803.     if length(send_spd_str)=0 then send_spd_str:=cfgrec.send_speed_str;
  804.     val(send_spd_str,send_speed,code);
  805.     if (send_speed>min_speed-1) and (send_speed<max_speed+1) then inrange:=true;
  806.     if not inrange then buzz;
  807.   until inrange;
  808.   repeat
  809.     clrscr;writeln;
  810.     writeln('Character Speed:');writeln;
  811.     writeln('Range   = ',cfgrec.send_speed_str,'-',max_speed,' WPM.');
  812.     writeln('Default = ',cfgrec.char_speed_str,' WPM.');
  813.     writeln;
  814.     write('Enter > ');
  815.     inrange:=false;
  816.     read(char_spd_str);
  817.     if length(char_spd_str)=0 then char_spd_str:=cfgrec.char_speed_str;
  818.     val(char_spd_str,char_speed,code);
  819.     if (char_speed>send_speed-1) and (char_speed<max_speed+1) then inrange:=true;
  820.     if not inrange then buzz;
  821.   until inrange;
  822.   enterspeed(send_speed,char_speed);
  823.   assign(cfgfile,'CW.CFG');
  824.   reset(cfgfile);
  825.   read(cfgfile,cfgrec);
  826.   cfgrec.send_speed_str:=send_spd_str;
  827.   cfgrec.char_speed_str:=char_spd_str;
  828.   rewrite(cfgfile);
  829.   write(cfgfile,cfgrec);
  830.   close(cfgfile);
  831.   restore_screen;
  832.   statusline;
  833. end;
  834.  
  835. procedure tone;
  836. var
  837.   freq_str : string[4];
  838. begin
  839.   save_screen;
  840.   repeat
  841.     inrange:=false;
  842.     drawbox(28,8,52,15,cfgrec.box_fg,cfgrec.box_bg,'[ Set Tone ]',blink_no);
  843.     textcolor(cfgrec.box_fg);
  844.     window(30,9,50,14);
  845.     writeln;writeln('Range = 400-1200 Hz.');
  846.     writeln('Default = ',cfgrec.tone_freq_str,' Hz.');
  847.     writeln;
  848.     write('Enter > ');
  849.     read(freq_str);
  850.     if length(freq_str)=0 then freq_str:=cfgrec.tone_freq_str;
  851.     val(freq_str,freq,code);
  852.     if (freq>399) and (freq<1201) then inrange:=true;
  853.     if not inrange then buzz;
  854.   until inrange;
  855.   assign(cfgfile,'CW.CFG');
  856.   reset(cfgfile);
  857.   read(cfgfile,cfgrec);
  858.   cfgrec.tone_freq_str:=freq_str;
  859.   rewrite(cfgfile);
  860.   write(cfgfile,cfgrec);
  861.   close(cfgfile);
  862.   restore_screen;
  863. end;
  864.  
  865. procedure parameters;
  866. var
  867.   param_choice : char;
  868. begin
  869.   save_screen;
  870.   repeat
  871.     drawbox(29,7,51,17,cfgrec.box_fg,cfgrec.box_bg,'[ Set Parameters ]',blink_no);
  872.     textcolor(cfgrec.box_fg);
  873.     window(31,8,49,15);
  874.     writeln;
  875.     writeln('<S>peed');
  876.     writeln('<T>one');
  877.     writeln;
  878.     writeln('<Q>uit');
  879.     writeln;
  880.     write('Choice > ');read(param_choice);
  881.     if length(param_choice)=0 then param_choice:='Q';
  882.     param_choice:=upcase(param_choice);
  883.     restore_screen;
  884.     case param_choice of
  885.       'S':set_speed;
  886.       'T':tone;
  887.     end;
  888.   until param_choice in ['Q','S','T'];
  889. end;
  890.  
  891. procedure color_set;
  892. var
  893.   choice     : char;
  894.   saveint    : integer;
  895.   savestr    : line;
  896.   select     : integer;
  897.   select_str : string[1];
  898.   temp       : string[40];
  899.  
  900. begin
  901.   assign(cfgfile,'CW.CFG');
  902.   reset(cfgfile);
  903.   read(cfgfile,cfgrec);
  904.   rewrite(cfgfile);
  905.   save_screen;
  906.   drawbox(10,7,70,18,cfgrec.box_fg,cfgrec.box_bg,'[ Color Set ]',blink_no);
  907.   textcolor(cfgrec.box_fg);
  908.   window(12,8,68,17);
  909.   writeln;
  910.   writeln('0 - Black  4 - Red       8 - Dk. Gray  12 - Lt. Red');
  911.   writeln('1 - Blue   5 - Magenta   9 - Lt. Blue  13 - Lt. Magenta');
  912.   writeln('2 - Green  6 - Brown    10 - Lt. Green 14 - Yellow');
  913.   writeln('3 - Cyan   7 - Lt. Gray 11 - Lt. Cyan  15 - White');
  914.   window(12,14,68,17);
  915.   repeat
  916.     clrscr;
  917.     select:=cfgrec.main_bg;
  918.     writeln('Enter main background color (0-7):');
  919.     writeln('Current : ',cfgrec.main_bg);
  920.     write('New     : ');readln(select_str);
  921.     val(select_str,select,code);
  922.     if select in [0..7] then inrange:=true else inrange:=false;
  923.     if not inrange then buzz;
  924.   until inrange;
  925.   cfgrec.main_bg:=select;
  926.   repeat
  927.     clrscr;
  928.     select:=cfgrec.main_fg;
  929.     writeln('Enter main foreground color (0-15):');
  930.     writeln('Current : ',cfgrec.main_fg);
  931.     write('New     : ');readln(select_str);
  932.     val(select_str,select,code);
  933.     if select in [0..15] then inrange:=true else inrange:=false;
  934.     if not inrange then buzz;
  935.   until inrange;
  936.   cfgrec.main_fg:=select;
  937.   repeat
  938.     clrscr;
  939.     select:=cfgrec.box_bg;
  940.     writeln('Enter box background color (0-7):');
  941.     writeln('Current : ',cfgrec.box_bg);
  942.     write('New     : ');readln(select);
  943.     val(select_str,select,code);
  944.     if select in [0..7] then inrange:=true else inrange:=false;
  945.     if not inrange then buzz;
  946.   until inrange;
  947.   cfgrec.box_bg:=select;
  948.   repeat
  949.     clrscr;
  950.     select:=cfgrec.box_fg;
  951.     writeln('Enter box foreground color (0-15):');
  952.     writeln('Current : ',cfgrec.box_fg);
  953.     write('New       ');readln(select);
  954.     val(select_str,select,code);
  955.     if select in [0..15] then inrange:=true else inrange:=false;
  956.     if not inrange then buzz;
  957.   until inrange;
  958.   cfgrec.box_fg:=select;
  959.   repeat
  960.     clrscr;
  961.     select:=cfgrec.hilite;
  962.     writeln('Enter text highlight color (0-15):');
  963.     writeln('Current : ',cfgrec.hilite);
  964.     write('New     : ');readln(select);
  965.     val(select_str,select,code);
  966.     if select in [0..15] then inrange:=true else inrange:=false;
  967.     if not inrange then buzz;
  968.   until inrange;
  969.   cfgrec.hilite:=select;
  970.   restore_screen;
  971.   write(cfgfile,cfgrec);
  972.   close(cfgfile);
  973. end;
  974.  
  975. procedure speed_test;
  976. var
  977.   wordcount : integer;
  978. begin
  979.   wordcount:=1;abort:=false;
  980.   save_screen;
  981.   drawbox(8,5,71,19,cfgrec.box_fg,cfgrec.box_bg,'[ Test Speed ]',blink_no);
  982.   textcolor(cfgrec.box_fg);
  983.   window(10,6,69,18);
  984.   writeln;
  985.   writeln('Count number of words sent in 60 seconds = WPM');
  986.   writeln;
  987.   writeln('Press any key to stop test');
  988.   writeln;
  989.   while not abort and (wordcount<61) do begin
  990.     sendstr('PARIS ',echo_yes);
  991.     wordcount:=wordcount+1;
  992.   end;
  993.   writeln;writeln;
  994.   write('Press any key to continue...');
  995.   repeat until keypressed;
  996.   restore_screen;
  997. end;
  998.  
  999. procedure utilities;
  1000. var
  1001.   util_choice : char;
  1002. begin
  1003.   save_screen;
  1004.   repeat
  1005.     drawbox(30,7,50,16,cfgrec.box_fg,cfgrec.box_bg,'[ CW Utilities ]',blink_no);
  1006.     textcolor(cfgrec.box_fg);
  1007.     window(32,8,48,15);
  1008.     writeln;
  1009.     writeln('<C>olors');
  1010.     writeln('<S>peed Test');
  1011.     writeln;
  1012.     writeln('<Q>uit');
  1013.     writeln;
  1014.     write('Choice > ');read(util_choice);
  1015.     if length(util_choice)=0 then util_choice:='Q';
  1016.     util_choice:=upcase(util_choice);
  1017.     restore_screen;
  1018.     case util_choice of
  1019.       'C':color_set;
  1020.       'S':speed_test;
  1021.     end;
  1022.   until util_choice in ['Q','C','S'];
  1023. end;
  1024.  
  1025. procedure cwscreen;
  1026. begin
  1027.   window(1,1,80,25);
  1028.   clrscr;
  1029.   for i:=1 to 24 do
  1030.     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');
  1031.   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');
  1032. end;
  1033.  
  1034. procedure config;
  1035. begin
  1036.   assign(cfgfile,'CW.CFG');
  1037.   {$I-} reset(cfgfile) {$I+};
  1038.   if ioresult<>0 then
  1039.     begin
  1040.       assign(cfgfile,'CW.CFG');
  1041.       rewrite(cfgfile);
  1042.       cfgrec.tone_freq_str:='500';
  1043.       cfgrec.send_speed_str:='14';
  1044.       cfgrec.char_speed_str:='14';
  1045.       cfgrec.main_bg:=0;
  1046.       cfgrec.main_fg:=15;
  1047.       cfgrec.box_bg:=0;
  1048.       cfgrec.box_fg:=15;
  1049.       write(cfgfile,cfgrec);
  1050.     end;
  1051.   reset(cfgfile);
  1052.   read(cfgfile,cfgrec);
  1053.   close(cfgfile);
  1054. end;
  1055.  
  1056. procedure init_variables;
  1057. begin
  1058.   val(cfgrec.tone_freq_str,freq,code);
  1059.   val(cfgrec.send_speed_str,send_speed,code);
  1060.   val(cfgrec.char_speed_str,char_speed,code);
  1061.   firstpass:=true;
  1062. end;
  1063.  
  1064. begin
  1065.   config;
  1066.   init_variables;
  1067.   enterspeed(send_speed,char_speed);
  1068.   textcolor(cfgrec.main_fg);
  1069.   textbackground(cfgrec.main_bg);
  1070.   cwscreen;
  1071.   save_screen;
  1072.   drawbox(15,5,65,20,cfgrec.box_fg,cfgrec.box_bg,'',blink_no);
  1073.   window(16,7,64,19);
  1074.   clrscr;
  1075.   writeln('                       CW');
  1076.   writeln('                    Ver. ',version);
  1077.   writeln('         A Morse Code Generator Program');
  1078.   writeln('                       by');
  1079.   writeln('                 M. Lee Murrah');
  1080.   writeln('                     WD5CID');
  1081.   writeln;
  1082.   writeln(' Copyright 1986,87 M. Lee Murrah.  May be copied');
  1083.   writeln(' and used for private, non-commercial purposes');
  1084.   writeln(' without further permission of the author.');
  1085.   writeln;write('           Press Any Key to Continue...');
  1086.   nowindow;
  1087.   repeat until keypressed;
  1088.   restore_screen;
  1089.   window(1,1,80,25);clrscr;
  1090.   gotoxy(1,24);for i:=1 to 80 do write(chr(196));
  1091.   window(1,1,80,23);
  1092.   save_screen;
  1093.   repeat
  1094.     mode:='CW '+version;
  1095.     exit_msg:='';
  1096.     statusline;
  1097.     save_screen;
  1098.     repeat
  1099.       drawbox(23,2,57,22,cfgrec.box_fg,cfgrec.box_bg,'',blink_no);
  1100.       textcolor(cfgrec.box_fg);
  1101.       window(25,3,55,21);
  1102.       writeln;
  1103.       writeln('          CW MAIN MENU');
  1104.       writeln;
  1105.       writeln('        <D>isk File');
  1106.       writeln('        <E>nter Message');
  1107.       writeln('        <G>roups');
  1108.       writeln('        <L>earn Chars');
  1109.       writeln('        <Q>SO');
  1110.       writeln('        <T>ype Test');
  1111.       writeln('        <W>ords');
  1112.       writeln;
  1113.       writeln('        <H>elp');
  1114.       writeln('        <I>nformation');
  1115.       writeln('        <P>arameters');
  1116.       writeln('        <U>tilities');
  1117.       writeln('       e<X>it CW');writeln;
  1118.       write('         Select > ');
  1119.       readln(menu_choice);menu_choice:=upcase(menu_choice);
  1120.     until menu_choice in ['D','E','F','G','H','I','L','P','Q','T','U','W','X'];
  1121.     restore_screen;
  1122.     case menu_choice of
  1123.       'D':disk;
  1124.       'E':enter_message;
  1125.       'G':groups;
  1126.       'H':help;
  1127.       'I':info;
  1128.       'L':learn;
  1129.       'P':parameters;
  1130.       'Q':qso;
  1131.       'T':type_test;
  1132.       'U':utilities;
  1133.       'W':sendwords;
  1134.     end;
  1135.     if not (menu_choice in ['H','I','P','U']) then firstpass:=false;
  1136.   until menu_choice in ['F','X'];
  1137.   if menu_choice='X' then begin
  1138.     cwscreen;
  1139.     drawbox(28,9,51,15,cfgrec.box_fg,cfgrec.box_bg,'',blink_no);
  1140.     textcolor(cfgrec.box_fg);
  1141.     window(29,10,50,14);
  1142.     clrscr;writeln;writeln(' Thanks for using CW');
  1143.     enterspeed(21,21);
  1144.     writeln;write('    ');
  1145.     sendline('73 DE WD5CID $',echo_yes);
  1146.     nowindow;
  1147.   end;
  1148.   gotoxy(1,24);
  1149. end.
  1150.  
  1151. {speed calculation assumptions for type test function:
  1152.  
  1153.  o One bit is defined as one dot time.
  1154.  o A dot=1 bit, a dash=3 bits, a space between dots and dashes=1 bit,
  1155.    a space between characters=3 bits, and a space between words=7 bits.
  1156.  o The standard word PARIS has 31 bits or avg of 6.2 bits/character.
  1157.  o The average number of bits per character in the numbers and letters
  1158.    is 9.83.
  1159.  o The average character takes 9.83/6.2=1.58 times as long to send as the
  1160.    average character in the standard word.
  1161.  o A word is assumed to be 5 characters in length.
  1162.  o A 7 bit wordspace is added for every 5 characters --.71 character lengths
  1163.  o Thus, wpm can be estimated as recv_speed*60/5*1.58
  1164.  o Spaces between characters are ignored }