scorechk.pas v.6: read from file, write to file

October 1996

{ ============================================== }
{ Calc average of student scores, warn if < 60.  }
{ v.6: Handle lines of ID + 3 scores from file   }
{   - prompt for two file names to open          }
{   - retry or exit on bad file names            }
{   - loop until e-o-f, one student per line     }
{   - write scores, av, warning to output file   }

program avScores;
var
   SID, err: integer;
   Av, sc1, sc2, sc3: real;
   warnString: string;
   inFileID, outFileID: TEXT;


	  { ----------------------------------------------- }
          { use prompt string to prompt user for file name  }
          { - open file for mode r/w/a, return file ID      }
          { - allow retry or exit on bad file name          }

          procedure PromptOpenFile(prompt: string;
                                     mode: char;
                                 var fID: TEXT;
                                 var status: integer);
          var fName: string;
          begin
             status := 1; { 1 while file not opened, 0 if success }
             while (status <> 0) do
             begin
               write(prompt);
               readln(fName);
               if (fName = 'q') or (fName = 'Q') then
                 exit;
               assign(fID, fName);
               {$I-}      { compiler flag: don't crash on bad name }
               if mode = 'r' then
                 reset(fID)
               else if mode = 'w' then
                 rewrite(fID)
               else if mode = 'a' then
                 append(fID);
               {$I+}      { flag off }
               status := ioResult; { DOS call: did file open work? }
               if status <> 0 then
               begin
                 writeln;
                 writeln('Could not open file: ',fName);
                 write('Enter q to quit, or ');
               end;
             end;
          end; { proc promptOpenFile }


          { ------------------------------------------- }
          { open input and output files, return ID's    }
          { - exit cleanly w/ err<>0 if file-open fails }

          procedure openFiles(var inFileID, outFileID: TEXT;
                              var err: integer);
          begin
            promptOpenFile('Name of scores file: ','r',inFileID, err);
            if err <> 0 then
              exit;
            promptOpenFile('Name of output file: ','w',outFileID,err);
            if err <> 0 then
            begin
              close(inFileID);
              exit;
            end;
          end; { proc openFiles }


          { ----------------------------------------------- }
          { return avg of 3 scores + warning if < warnLevel }

          procedure calcAndCheck3(s1, s2, s3: real;
                                     var avg: real;
                                     var wstr: string);
          const warnLevel = 60;
          var Sum: real;
          begin
             Sum := s1 + s2 + s3;
             avg := Sum/3;
             if avg < warnLevel then
                wstr := ' Warning!'
             else
                wstr := '';
          end;  { proc calcAndCheck3 }

{ ========================================================== }
begin
   openFiles(inFileID,outFileID,err);
   if err <> 0 then
     exit;

   while not eof(inFileID) do
   begin
      readln(inFileID, SID, sc1, sc2, sc3);
      calcAndCheck3(sc1,sc2,sc3,av,warnString);
      writeln(outFileID, SID, sc1:4:0, sc2:4:0, sc3:4:0,
                   '   Average =', Av:6:1, warnString);
   end;

   close(inFileID);
   close(outFileID);

   writeln('Averages written to file.'); { announce completion }
end.