Programmer 7500/MAX_PROGRAMMERS.iso/INFO/EDUCATON/TYPDR11.ZIP/TYPDRILL.PAS

Pascal/Delphi Source File | 1988-08-28 | 14.3 KB | 374 lines

{ TYPDRILL is a program that drills the user in typing speed and accuracy }

{$V-}    (* allow small strings to be passed to procedures *)
{$I screenio.pas}  (* handles function keys and command lines *)

type   string14 = string [14];
       string80 = string [80];
const  n_diff = 6;          { number of degrees of difficulty }
       time_incr = 100;     { 100 msec timer increments for measuring speed }
       keyboard : array [0..n_diff] of string80 = (
' ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789.,;:?/()-+=$"''',
               'asdfjkl;','asdfghjkl;',
               'asdfghjkl;qwertyuiop',
               'asdfghjkl;zxcvbnm,.',
               'asdfghjkl;qwertyuiopzxcvbnm,./',
               'asdfghjkl;qwertyuiopzxcvbnm,./ASDFGHJKL:QWERTYUIOPZXCVBNM<>?');
var    o_rand : boolean;          { random letters? (or read from file) }
       o_diff : integer;          { difficulty 1 to n_diff }
       o_file : text;             { if file source, this is file ID }
       o_disp : integer;          { 1=single character display, >1=whole line }
       o_rept : boolean;          { repeat same character after error? }
       index : integer;           { index into keyboard array if "random". }
       lindex: integer;           { index into input line if "file". }
       timer : integer;           { number of timer increments till keystroke }
       keyTime, keyErr, keyTot: array [1..80] of integer;
                                  { arrays of statistics counts: for the key in
                                    keyboard[i], keyTime[i] = total time,
                                    keyErr[i] = total errors, and
                                    keyTot[i] = number of times that key
                                       was called for. }
       in_line : string80;
       fline   : string80;
       infname : string14;        { name of input file }
       quitflag : boolean;        { true if we quit this pass }
       c : char;                  { current character }
       right, wrong, total, totTime : integer;
       ii,jj,kk : integer;

procedure setup; forward;
procedure statscreen; forward;

function nextchar : char;  { Return next character to be typed }
           { Also (sorry for lack of modularity) provides its index into
             keyboard string and, if necessary, the input line }
    begin
        if o_rand then
        begin
            index := random (length (keyboard[o_diff]) - 1) +1;
                                  { random index into keyboard array }
            nextchar := keyboard [o_diff][index];  { use it to get character }
        end
        else        { working from a file }
        begin
            while lindex>length(fline) do    { get next line from file }
            begin
                lindex := 1;
                if EOF(o_file) then   { back to beginning of file }
                begin
                    close (o_file);
                    reset (o_file);
                end;
                readln (o_file, in_line);
              (* Squeeze non-useful characters out before using *)
                fline := '';
                for ii:=1 to length (in_line) do
                    if pos (in_line[ii], keyboard[o_diff]) > 0
                    then  fline := concat (fline, in_line[ii]);
            end;
            nextchar := fline [lindex];
            index := pos (fline[lindex], keyboard[o_diff]);
            lindex := lindex+1;
        end;
    end;

procedure bannerchar (L :char; x,y :integer);
   { write letter "L" in banner style, with upper left at <x,y>  }
    const  bios = $F000;
           gchar= $FA6E;
    var    i,j : integer;
           mask : byte;
           blnk : char;  { blank character, underscore for base line }
    begin
        gotoXY (x-1,y-1);  write ('________________');
        gotoXY (x-1,y+6);  write ('________________');
        for i:=0 to 7 do
        begin
            gotoXY (x,y+i);
            mask := 128;   { set leftmost bit of mask }
            if i=6 then blnk:='_'  else blnk:=' ';
            for j:=1 to 8 do
            begin
                { index into the graphic char arry in BIOS }
                if (mem [bios: gchar+ (integer(L)*8) +i] and mask) =0
                        then write (blnk, blnk)                   { blank }
                        else write (char(219), char(219));  { solid }
                mask := mask shr 1;
            end;
        end;
    end;

procedure move_cursor;
    { Highlight the next character to type }
    const  BOLD = $F;
           NORM = $7;
    begin
        if lindex>2 then     { continue this line }
        begin
            { Need speed.  We'll write directly in display. Sorry! }
            mem [DispTop: 795 + 2*(lindex)] := NORM; { 5*160 -2 -3 }
            mem [DispTop: 797 + 2*(lindex)] := BOLD; { 5*160 -2 -1 }
        end
        else       { display new line }
        begin
            LowVideo;
            gotoXY (1,6);  for ii:=1 to 80 do write (' ');
            gotoXY (1,6);  write (fline);
            gotoxy (1,6);  HighVideo; write (fline[1]); LowVideo;
            gotoXY (1,7);  for ii:=1 to 80 do write (' ');
            gotoxy (1,7);
        end;
    end;

procedure countdown;    (* screen countdown with BEEPs *)
    var    i : integer;
    begin
        gotoXY (1,2); write ('READY   ');
        for i:=5 downto 1 do
        begin
            gotoXY (7,2); write (i, ^G);
            delay (700);
        end;
        gotoXY (1,2); write ('        ');
    end;

procedure setup;    (* Initialize variables, read file if necessary *)
    const intromax = 16;
          intro : array [1..intromax] of string80 = (
'                    T Y P E D R I L L',
'                   -------------------',
'            Copyright  Dave Tutelman  -  1988',
'                   All rights reserved',
'',
' "TYPEDRILL" is a program to increase the speed and accuracy of your typing.',
' It presents you with letters to type, and monitors how quickly and',
' accurately you type them.  It gives you running totals of your progress,',
' and can give more detailed statistics if you request them with the STATS',
' function key.',
'',
' You can choose between two ways of using the program:',
'   (1)  Single letters are presented (with several levels of difficulty)',
'   (2)  Lines from a text file of your choice are presented.',
'',
' Make your selection now:');
    var    i : integer;
    begin
        clrscr;
        gotoxy (1,2);  HighVideo;
        for i:=1 to 3 do writeln (intro [i]);
        LowVideo;
        for i:=4 to intromax do writeln (intro [i]);
        repeat           { prompt for random or file }
            gotoxy (7,intromax+3);
            write ('Random letters (R) or lines from a file (F)?  ');
            read (kbd,c);
            write (c);
        until (c='r') or (c='R') or (c='f') or (c='F');
        if (c='r') or (c='R') then o_rand := TRUE
                              else o_rand := FALSE;
        if o_rand then
        begin
          repeat           { prompt for degree of difficulty }
              gotoxy (7,intromax+5);
              write ('How difficult, from 1 (easy) to ',n_diff,' (hard) ?  ');
              read (kbd,c);
              write (c);
              o_diff := integer(c) - 48;  { ASCII to int conversion }
          until (o_diff>=1) and (o_diff<=n_diff);
          o_disp := 1;
          o_rept := TRUE;
        end;

        if not o_rand then     { working from a file }
        begin
          repeat           { prompt for file name }
              gotoxy (7,intromax+5);
              write ('What file should we work from ?  ');
              readln (infname);
              assign (o_file, infname);
              {$I-}  reset (o_file);  {$I+}
              ii := IOresult;
              if ii=0 then write('  Reading file.              ')
                      else write('  Can''t open file. Try again!');
          until (ii=0);
          fline := ''; lindex := 100;   { force a new line to be read }
          o_diff := 0;
          o_disp := 2;
          o_rept := FALSE;
        end;

        clrscr;          { initialize screen with function key labels }
        OnKey (1,' QUIT ');
        OnKey (6,'STATS ');
        OnKey (8,'RESET ');
        quitflag := FALSE;
        right:=0; wrong:=0; total:=0; totTime:=0;
        for i:=1 to 80 do
        begin
            keyTot [i] := 0;
            keyErr [i] := 0;
            keyTime[i] := 0;
        end;
        c := nextchar;
        lowVideo;
        countdown;
    end;

procedure statscreen;      { Display current performance statistics }
    var    average, this : integer;
    begin
        clrscr;
        OnKey (6,'CONTIN');

        { Display error statistics }
        if total>0 then  average := (wrong * 1000) div total
                   else  average := 0;
        gotoXY (1,1); HighVideo;
        write ('BATTING AVERAGE = ', 1000-average);
        LowVideo;
        for ii:=1 to length (keyboard [o_diff]) do
            if keyTot[ii] > 0  then
            begin
                gotoXY(ii,11); write (keyboard [o_diff][ii]);
                this := (keyErr[ii] *1000) div keyTot[ii];
                if average>0 then  this := (this * 2) div average
                             else  this := 0;
                                  { number of segments to plot }
                if this>9 then this:=9;
                for jj:=1 to this do
                begin
                    gotoXY (ii, 11-jj);
                    write (char(179));
                end;
            end;
        gotoXY (1,12); for ii:=1 to 80 do write (char (196));

        { Display speed statistics }
        if total>0 then  average := totTime div total
                   else  average := 0;    { avg # of time increments }
        gotoXY (1,13); HighVideo;
        write ('AVERAGE SPEED = ', average*time_incr, ' MilliSeconds');
        LowVideo;
        gotoXY (1,23-5);  { horizontal line at the average }
        for ii:=1 to length (keyboard [o_diff]) do write ('-');
        for ii:=1 to length (keyboard [o_diff]) do
            if keyTot[ii] > 0 then
            begin
                if (ii mod 5)=0  then HighVideo  else LowVideo;
                gotoXY(ii,23); write (keyboard [o_diff][ii]);
                this := keyTime[ii] div keyTot[ii];
                if average>0 then  this := (this * 5) div average
                             else  this := 0;
                                         { number of segments to plot }
                if this>9 then this:=9;
                for jj:=1 to this do
                begin
                    gotoXY (ii, 23-jj);
                    write (char(179));
                end;
            end;
        gotoXY (1,24); for ii:=1 to 80 do write (char (196));
        gotoXY (1,1);  { get cursor out of the way }
        repeat until not GetKey;
        case inchar of
          ';' :  { F1 = quit }
              quitflag := TRUE;
          'B' :  { F8 = reset }
              setup;
          else   { F6 = continue, anything else treat as F6 }
              begin
                  clrscr;
                  OnKey (6,'STATS ');
                  lindex := 200;   { Force next line }
                  c := nextchar;
                  countdown;
              end;
          end;
    end;


(*   MAIN  *)
begin
    setup;
    repeat
        if o_disp=1 then   { single letter display }
        begin
            gotoXY (20,6);  write ('Please type');
            bannerchar (c,35,3);
        end
        else    { displaying lines }
            move_cursor;
        timer := 0;      { keystroke timing loop follows }
        repeat
            delay (time_incr);
            timer := timer + 1;
        until KeyPressed;
        if GetKey then
        begin
            keyTot [index] := keyTot[index] + 1;
            if c=inchar then
            begin
                right := right+1;
                keyTime[index] := keyTime[index] + timer;
                totTime := totTime + timer;
                c := nextchar;
            end
            else
            begin
                wrong := wrong+1;
                keyErr[index] := keyErr[index] + 1;
                if not o_rept  then  c:=nextchar;
                if o_disp=1 then  write (^G)       { beep if wrong }
                            else  HighVideo;    { or mistake in bold }
            end;
            total := total+1;

            { Display short form of stats }
            if o_disp=1  then      { every character, if single-char display }
            begin
                gotoXY (20,14);  write ('You typed');
                gotoXY (35,14);  write (inchar);
                gotoXY (1,18);
                writeln (right:4,' right.');
                writeln (wrong:4,' wrong.');
                writeln (total:4,' total.');
            end
            else     { Every line, if line display }
            begin
                { first echo typed character }
                if inchar>=' ' then write(inchar)
                               else write('@');
                LowVideo;
                if lindex<=2 then
                begin
                   gotoXY (1,20);
                   writeln (total,'  keystrokes so far.');
                   writeln ('        You got ',right,' right and ',
                                            wrong,' wrong.');
                   HighVideo; gotoXY (20,23);
                   write ('PRESS ANY KEY TO CONTINUE');
                   if not GetKey then
                   case inchar of
                     ';' :  { F1 = quit }
                         quitflag := TRUE;
                     'B' :  { F8 = reset }
                         setup;
                     '@' :  { F6 = statistics screen }
                         statscreen;
                   end;
                   LowVideo;  gotoXY (20,23);
                   write ('                         ');
                end;
            end;
        end
        else case inchar of
          ';' :  { F1 = quit }
              quitflag := TRUE;
          'B' :  { F8 = reset }
              setup;
          '@' :  { F6 = statistics screen }
              statscreen;
        end;
    until quitflag;
    clrscr;
end.