⟦a4e4e2daf⟧

TextFile

PROGRAM Student;

æ---------------------------------------------------------------å
æ PROGRAM TITLE:	STUDENT	version 2.0			å
æ WRITTEN BY:		Raymond E. Penley			å
æ DATE WRITTEN:		Dec 18, 1982				å
æ								å
æ INPUT/OUTPUT FILES:		   *** ACCESS METHOD ***	å
æ   STUDENT.NDX - Misc data		<sequential>		å
æ   STUDENT.DAT - Name & Address	<random>		å
æ   STUDENT.GDS	- Grade data		<sequential>		å
æ								å
æ COMMANDS:							å
æ  New student	- Adds a new entry if file not filled.		å
æ  Find		- Searches & displays a student			å
æ  Change	- Allows changes on address/grades		å
æ  List		- Displays data for all students		å
æ  Quit		- Terminate program/close all files		å
æ								å
æ SUMMARY:							å
æ Writes a name & address file and a grade file on all students.å
æ Also a file of misc. data; # of rcds on file and date file	å
æ was last updated.						å
æ								å
æ 01/29/83 -- EXTENSIVE ERROR CORRECTING ADDED:			å
æ								å
æ NOTES:							å
æ  utility procedures from the Pascal/Z User's Group		å
æ  Library diskette.						å
æ---------------------------------------------------------------å


CONST
  MaxStudents = 50; æ determines maximum # of data records in file å
  enter = 'ENTER NEW DATA OR PRESS RETURN TO KEEP PRESENT DATA';
  escape = 27;		æ ASCII escape character å

TYPE

   æ-------------------------------------------------------------å
   æ create a binary search tree in memory to hold our index	 å
   æ-------------------------------------------------------------å

   link = ^ip;			æ pointer to the B-tree å
   ip = RECORD			æ the B-tree record å
	  item : integer;	æ KEY FIELD. student's id number å
	  rcd  : integer;	æ data file record pointer å
	  left,right: link	æ pointers to left/right nodes å
	END;

  byte		= 0..255;
  charset	= SET OF CHAR;
  strng2	= string 2;
  strng5	= string 5;
  strng20	= string 20;
  strng		= string 20;


  æ-------------------------------------------------------------å
  æ sturec - identifies the data to be stored for each student	å
  æ-------------------------------------------------------------å

  sturec  = RECORD        æ field name, type, length		å
	       id    : integer;	æ id,     n,  5     <KEY FIELD>	å
	       name,		æ name,   c, 20			å
	       street,		æ street, c, 20			å
	       city   : strng20;æ city,   c, 20			å
	       state  : strng2;	æ state,  c,  2			å
	       zipcode: strng5	æ zipcode,c,  5			å
	    END;
  æ total number of bytes = 77 per record.
    72 bytes + 1 FOR each string å


  æ-------------------------------------------------------------å
  æ Allow for ten grades and the student ID. Please note that	å
  æ this may be changed to suit your particular requirements.	å
  æ NOTE: the enumerated type has been setup such that		å
  æ ORD(exam1) = 1.						å
  æ-------------------------------------------------------------å

  gradetype = ( id,	æ id field is link between all data files å
		exam1,	æ 1st exam grade å
		exam2,	æ 2nd exam grade å
		exam3,	æ 3rd exam grade å
		exam4,	æ 4th exam grade å
		exam5,	æ 5th exam grade å
		exam6,	æ 6th exam grade å
		exam7,	æ 7th exam grade å
		quiz1,	æ quiz 1 å
		quiz2,	æ quiz 2 å
		final);	æ FINAL grade å

  æ-------------------------------------------------------------å
  gradestore	= array ÆgradetypeÅ of integer;

  æ-------------------------------------------------------------å
  StuGds	= array Æ1..MaxStudentsÅ of gradestore;

  æ-------------------------------------------------------------å
  FTYPE		= FILE OF StuRec;

  string0	= string 0;
  string255	= string 255;

VAR
  bell		: char;		æ console bell å
  command	: char;		æ command character å
  console	: TEXT;		æ direct output to console å
  date		: packed array Æ1..8Å of char; æ date of last update å
  g		: gradetype;
  Grades	: StuGds;
  ioresult	: boolean;
  listhead	: link;
  more		: boolean;	æ done processing flag å
  R		: integer;	æ global var for record number å
  rof		: integer;	æ total Records On File å
  stucount	: integer;	æ # of students in class å
  Student	: StuRec;	æ A single student å
  StuFile	: FTYPE;	æ name & address file å
  taken		: integer;	æ # of tests taken thus far å
  updated	: boolean;	æ flag for updated items å

æ$R-å

æ$iPRIMS.PZ å


æ pause - allows one to stop until ready to continue å
PROCEDURE pause;
VAR	ch : char;
BEGIN
   writeln;
   write ('Press any key to continue ');
   keyin(ch); writeln
ENDæ pause å;


æ ClearScreen - routine to clear the console device å
PROCEDURE ClearScreen;
VAR	i: 1..25;
BEGIN
   FOR i:=1 TO 25 DO writeln
ENDæ ClearScreen å;


æ Q - prints a text message and accepts only the characters å
æ passed via goodchars. returns the char input in ch	    å

PROCEDURE Q( message: string255; goodchars: charset; VAR ch: char );
VAR	ctemp: char;
BEGIN
   write( message );
   REPEAT
     keyin(ctemp); ch := toupper(ctemp);
     IF ch IN goodchars
	THEN writeln(ctemp)
	ELSE write (bell)
   UNTIL ch in goodchars
ENDæ Q å;


æ readint - 						å

FUNCTION readint ( VAR i: integer; lower,upper: integer ): boolean;
VAR	answer: strng20;
BEGIN
      readint := true;
      readln(answer);
      IF length(answer) > 0 THEN BEGIN
	 i := ival ( answer,1 );
	 if (i < lower) OR (upper < i ) THEN ædo it againå
	    readint := false;
      END
ENDæ readint å;


æ gde - converts an integer to the enumerated type gradetype å

FUNCTION gde ( exam: integer ): gradetype;
BEGIN
     CASE exam OF
	0: gde := id;
	1: gde := exam1;
	2: gde := exam2;
	3: gde := exam3;
	4: gde := exam4;
	5: gde := exam5;
	6: gde := exam6;
	7: gde := exam7;
	8: gde := quiz1;
	9: gde := quiz2;
       10: gde := final
     END
ENDæ gde å;

æ$R+å

æ insert - adds a node TO the binary search tree, preserving the ordering å

PROCEDURE insert( VAR node: link; ident, R: integer );
BEGIN
  IF node=nil THEN BEGIN
     new(node);		æ create a new storage location å
     WITH node^ DO BEGIN
        left := nil;
        right := nil;
        item := ident;	æ store the student's ID å
        rcd := R	æ store the location record # å
     ENDæwithå
  END
  ELSE
     WITH node^ DO
        IF ident<item THEN
           insert ( left,ident,R )
        ELSE IF ident>item THEN
           insert ( right,ident,R )
        ELSE
	   æ DUPLICATE ENTRY åæ not handled å
ENDæ insert å;


æ search - returns a pointer TO a node in the tree containing
  the given data, or nil if there is no such node. å

FUNCTION search ( node: link; ident: integer ): link;
BEGIN
  IF node=nil THEN
     search := nil
  ELSE
     WITH node^ DO
        IF ident<item THEN
           search := search(left,ident)
        ELSE IF ident>item THEN
           search := search(right,ident)
        ELSE
           search := node
ENDæ search å;


  æ-------------------------------------------------------------å
  æ ListRange -							å
  æ	enter with first = lower bound; last = uppermost bound.	å
  æ	returns first/last per operator specifications		å
  æ-------------------------------------------------------------å

PROCEDURE ListRange ( VAR first, last: integer );
VAR
	ch: char;
	t1,t2: integer;
BEGIN
  t1 := first;
  t2 := last;
  writeln;
  Q( 'ENTER LIST RANGE: A(ll, O(ne, R(ange ->', Æ'A','O','R'Å, ch );
  CASE ch of
     'A':
	BEGIN
	  first := t1;
	  last := t2
	END
     'O':
	REPEAT
	  write ( 'WHICH ONE? '); readln(first);
	  last := first;
	UNTIL (first<=t2) or (first>=t1);
     'R':
	REPEAT
	   write ( 'Enter lower bound ->'); readln(first);
	   write ( 'Enter upper bound ->'); readln(last)
	UNTIL first <= last
  endæCASEå
ENDæ ListRange å;


æ fread - reads the address file and sets the global record pointer å

PROCEDURE fread ( VAR StuFile: FTYPE; VAR node: link );
BEGIN
   R := node^.rcd;		æ returns the record # in "R" å
   read ( StuFile:R, student )	æ read student record "R" å
ENDæ fread å;


PROCEDURE ChangeAddress ( VAR student: sturec; VAR goodstatus: boolean );
LABEL
   1;	æ early exit å
CONST
   ok = true;
VAR
   answer: strng20;
   i	 : integer;
   node  : link;
   valid : boolean;

	PROCEDURE disp ( message, value: string255 );
	BEGIN
	   writeln;
	   IF length(value) > 0 THEN BEGIN
	      writeln ( message, value );
	      write ( ' ':19 )
	   END
	   ELSE
	      write ( message );
	ENDæ disp å;

BEGIN æChangeAddresså
   goodstatus := ok;
   IF command = 'C' THEN BEGIN
      writeln;
      writeln ( enter )
   END;	
   writeln;writeln;
   WITH student DO BEGIN
	IF id=0
	   THEN setlength ( answer,0 )
	   ELSE STR ( id,answer );

        æ NOTE: do not allow ID TO be changed after initial input å
	IF command = 'N' THEN BEGIN æ adding New records å
	   REPEAT
	      disp ( 'ID Number      ... ', answer )
	   UNTIL readint ( id,1,9999 );

	   node := search ( listhead,id );	æ id already on file? å
	   IF node<>nil THEN BEGIN æ already on file å
	      fread ( StuFile, node );	æ read record FOR show & tell å
	      ClearScreen;
	      writeln ( bell, id, ' already on file!');
	      goodstatus := not ok;
	      æEXITågoto 1;
	   END
	ENDæIF command='N'...å
	ELSE
	   writeln ( 'ID Number      ... ', answer );

	disp ( 'Name           ... ', name ); readln(answer);
	IF length(answer)>0 THEN
	   name := answer;
	disp ( 'Street Address ... ', street ); readln(answer);
	IF length(answer)>0 THEN
	   street := answer;
	disp ( 'City           ... ', city ); readln(answer);
	IF length(answer)>0 THEN
	   city := answer;
	disp ( 'State          ... ', state ); readln(answer);
	IF length(answer)>0 THEN BEGIN
	   stateÆ1Å := toupper ( answerÆ1Å );
	   stateÆ2Å := toupper ( answerÆ2Å );
	   setlength ( state,2 )
	END;
	REPEAT
	   valid := true;
	   disp ( 'Zip code       ... ', zipcode ); readln(answer);
	   IF length(answer)>0 THEN BEGIN
	      zipcode := '     ';æ insure no garbage in answer å
	      IF isdigit(answerÆ1Å) THEN æ good chance is digit å
	         FOR i:=1 TO 5 DO
		    zipcodeÆiÅ := answerÆiÅ
	      ELSE BEGIN
		 write(bell); valid := false
	      END
	   END
	UNTIL valid;
   END;
   updated := true;
1:æearly exitå
ENDæ ChangeAddress å;


PROCEDURE ChangeGrades ( VAR student: sturec );
CONST
   low = 0;	æ lowest grade acceptable å
   high = 110;	æ highest grade acceptable å
VAR
   answer	: strng20;
   first,last	: gradetype;
   lower,upper	: integer;
BEGIN
   lower := 1;
   upper := taken;
   ListRange ( lower,upper );
   first := gde(lower);
   last := gde(upper);
   writeln;
   writeln ( enter );
   writeln;writeln;
   writeln ( 'STUDENT: ', student.name );
   writeln;
   FOR g:=first TO last DO BEGIN
      REPEAT
	 write ( ord(g):3, gradesÆR,gÅ:6, ' ?' )
      UNTIL readint ( gradesÆR,gÅ,low,high )
   END
ENDæ ChangeGrades å;


PROCEDURE display ( VAR output: TEXT; VAR student: sturec );
æ GLOBAL	R : integer; <record #>   å
CONST
   width = 35;
BEGIN
   writeln ( output);
   writeln ( output);
   WITH student DO BEGIN
	writeln (output, 'STUDENT ID: ', id:1 );
	writeln (output, name, ' ':width-length(name), street );
	writeln (output, ' ':width, city, ', ', state, ' ', zipcode );
	writeln ( output, 'GRADES');
	writeln ( output, ' < first half year >< second half year >');
	FOR g:=exam1 TO final DO BEGIN
	   write(output, gradesÆR,gÅ:4 )
	END;
	writeln ( output);
	writeln ( output);
	writeln ( output)
   END
ENDæ display å;


PROCEDURE MODIFY;
VAR
	node : link;
	ident: integer;
	ch	: char;
	goodstatus	: boolean;
BEGIN
   IF command='N' THEN BEGIN æ arrived here from ADD å
      command := 'C';	     æ so, switch to CHANGE  å
      ident := student.id æ already in memory å
   END
   ELSE BEGIN
      writeln;
      REPEAT
	 write ('Enter student id number ... ')
      UNTIL readint ( ident,1,9999 )
   END;

   node := search ( listhead,ident );
   IF node<>nil THEN BEGIN
      fread ( StuFile, node );
      CASE command of
	'C':
	   BEGIN æCHANGEå
	   writeln;
	   Q( 'Do you wish to change A(ddress, or G(rades? <escape=quit> ',
			Æchr(escape),'A','G'Å, ch );
	   if ord(ch)=escape then
	      æall doneå
	   else begin
	      CASE ch of
		 'A':
		    ChangeAddress ( student,goodstatus );
		'G':
		   ChangeGrades ( student )
	      ENDæCASEå;
	      display ( console,student );
	      if ch='A' THEN æ update address file å
		 write ( StuFile:R, student )
	   end
	   ENDæ CHANGE å;
	'F':
	    display ( console,student );æ send the picture to the console å
      ENDæCASEå
   END
   ELSE
      writeln ( bell, ident:1,' not on file!')
ENDæ MODIFY å;


PROCEDURE ADD;
VAR	goodstatus: boolean;
BEGIN
   IF rof >= MaxStudents THEN
      writeln ( 'Sorry can''t add file is full.' )
   ELSE BEGIN æ OK to add more records å
      IF rof=0
	 THEN R := 1
	 ELSE R := rof + 1;
      WITH student DO BEGIN æ initialize all fields to zero å
	 id := 0;
	 setlength ( name,0 );
	 setlength ( street,0 );
	 setlength ( city,0 );
	 setlength ( state,0 );
	 setlength ( zipcode,0 )
      END;
      writeln;
      writeln ( 'RECORD #', R:1 );
      ChangeAddress ( student,goodstatus );
      display ( console, student );

      IF goodstatus THEN BEGIN
	 gradesÆR,idÅ := student.id;	æ update grades matrix å
	 insert ( listhead,student.id,R );
	 write ( StuFile:R, student );	æ update address file å
	 updated := true;		æ flag we updated the file å
	 rof := R;			æ increment records on file å
	 stucount := rof;		æ and student count         å
	 æ move right into edit mode...change address/grades å
	 MODIFY
      ENDæIF goodstatus then...å;
      pause
   ENDæELSEå
ENDæ ADD å;


æ list - lists ALL records on file å

PROCEDURE LIST;
VAR	output : TEXT;

	æ printlist - writes the entire tree recursively å
	PROCEDURE PrintList ( node: link );
	BEGIN
	   IF node<>nil THEN
	      WITH node^ DO BEGIN
	         PrintList (left);
		 fread ( StuFile, node ); æ read address file å
		 display ( output, student );
		 IF command<>'P' THEN pause;
	         PrintList ( right )
	      ENDæwithå
	ENDæ PrintList å;

BEGIN
   writeln;
   Q('Output to C(onsole or P(rinter? <escape=quit> ',
		Æchr(escape),'C','P'Å, command );
   IF ord(command)=escape THEN
      æall doneå
   ELSE BEGIN 
      CASE command OF
	 'P': æ direct output to the list device å
	    REWRITE( 'LST:',output );
	 'C': æ direct output to the console device å
  	    REWRITE( 'CON:',output )
      endæCASEå;
      PrintList(listhead)
   END
ENDæ LIST åæ CLOSE(output); å;


PROCEDURE mathmult;
LABEL
	1; æquick exitå
CONST
	fw = 6;
TYPE
	etype = (total,avg);
VAR
	g,first,last: gradetype;
	a : integer;
	accum : array Ætotal..avg,gradetypeÅ of integer;
	output : TEXT;

	PROCEDURE print ( message: string255; i: etype );
	BEGIN
	   write( output,message );
	   FOR g:=first TO last DO
	      write( output,accumÆi,gÅ:fw );
	   writeln ( output)
	END;

BEGINæ mathmult å
   writeln;
   Q('Output to C(onsole or P(rinter? <escape=quit> ',
		Æchr(escape),'C','P'Å, command );
   IF ord(command)=escape THEN
      goto 1; æall doneå
   CASE command OF
      'P': æ direct output to the list device å
         REWRITE( 'LST:',output );
      'C': æ direct output to the console device å
         REWRITE( 'CON:',output )
   ENDæCASEå;

   first := exam1;	æ first = 1st exam grade, last = last exam taken å
   last := gde(taken);

   writeln ( output);
   write(output,' STUDENT');
   FOR g:=first TO last DO BEGIN
      write( output,ord(g):fw );
      accumÆtotal,gÅ := 0;	æ zero accumulators å
      accumÆavg,gÅ := 0
   END;
   writeln ( output,'  AVERAGE');

   FOR r:=1 TO stucount DO BEGIN
      write(output,gradesÆr,idÅ:fw,' :'); æ print the student's id number å
      a := 0;	   			æ "a" = grade accumulator å
      FOR g:=first TO last DO BEGIN
         write(output,gradesÆr,gÅ:fw);
         a := a + gradesÆr,gÅ;
         accumÆtotal,gÅ := accumÆtotal,gÅ + gradesÆr,gÅ
      ENDæFOR gå;
      æ print the rounded average of this student's grades å
      writeln (output, round(a/taken):fw )
   ENDæFOR rå;

   æ compute the average FOR all the student's grades & underline å
   write(output,'        ');
   FOR g:=first TO last DO BEGIN
	accumÆavg,gÅ := accumÆtotal,gÅ DIV stucount;
	write(output,'   ---');
   end;
   write(output,'   ---');
   writeln ( output);

   print ( '  TOTAL:', total );æ for each graded exam å
   print ( '    AVG:', avg );æ for each graded exam å
   writeln ( output);
1:æquick exitå
ENDæ mathmult åæ CLOSE(output); å;


PROCEDURE STATS;
VAR
	answer	: strng20;
	valid	: boolean;
BEGIN
   writeln;
   writeln ( 'NUMBER OF STUDENTS ... ', stucount:3 );
   REPEAT
	write  ('NUMBER OF TESTS ...... ', taken:3,' ?' );
	readln ( answer );
	IF length(answer)>0 THEN
	   taken := ival ( answer,1 );
	valid := (taken>=0)
   UNTIL valid
ENDæ STATS å;


PROCEDURE fclose;
VAR
	StuGrades: FILE OF gradestore;	æ grade data on each student å
	StuNdx   : TEXT;		æ index file å
BEGIN
   rewrite('STUDENT.NDX',StuNdx);
   writeln ( StuNdx, rof );
   writeln ( StuNdx, date );
   writeln ( StuNdx, stucount ); æ # of students in class å
   writeln ( StuNdx, taken );	æ # of tests taken thus far å

   rewrite('STUDENT.GDS',StuGrades);
   FOR R:=1 TO rof DO
      write ( StuGrades, gradesÆRÅ )
ENDæ fclose åæ CLOSE(StuNdx); CLOSE(StuGrades); å;


PROCEDURE Initialize;
VAR
	i	: integer;
	ch	: char;
	StuGrades: FILE OF gradestore;	æ grade data on each student å
	StuNdx   : TEXT;		æ index file å
BEGIN
   ClearScreen;
   writeln ( ' ':32, 'STUDENT SYSTEM');
   writeln;
   writeln;
   bell := chr(7);
   listhead := nil;	æ make the list empty å
   updated := false;	æ say file has not been updated å
   
   æ insure that all cells in grades matrix are 0 å
   FOR g:=id TO final DO
      gradesÆ1,gÅ := 0;
   FOR R:=2 TO MaxStudents DO
      gradesÆRÅ := gradesÆ1Å;
   rewrite('CON:',console);
   reset('STUDENT.NDX',StuNdx);

   IF eof(StuNdx) THEN BEGIN æcreate all fileså
	writeln ( 'Please standby while I create data files ...' );
   	rewrite('STUDENT.NDX',StuNdx);
   	rewrite('STUDENT.DAT',StuFile);
   	rewrite('STUDENT.GDS',StuGrades);

	rof := 0;
	stucount := 0;
	taken := 10;	æ setup to 10 then can lower at any time å
	date := 'MM/DD/YY'
   END
   ELSE BEGIN æ finish opening files and read record count å
	reset('STUDENT.DAT',StuFile);
	reset('STUDENT.GDS',StuGrades);
	readln ( StuNdx, rof );
	readln ( StuNdx, date );
	readln ( StuNdx, stucount );	æ # of students in class å
	readln ( StuNdx, taken );	æ # of tests taken thus far å
	writeln;
	FOR R:=1 TO rof DO BEGIN
	   write( chr(13), 'RECORD #', R:1 );
	   read ( StuGrades, gradesÆRÅ );
	   read ( StuFile:R,student ); 	   æ create the B-tree in memory å
	   insert ( listhead,student.id,R )
	END;
	writeln
   END;

   IF rof>0 THEN BEGIN
      writeln;
      writeln ( 'There are ',rof:1,' records on file as of ', date )
   END;
   writeln;
   write ( 'ENTER TODAY''S DATE <MM/DD/YY>  ->');
   FOR i:=1 TO 8 DO BEGIN
      IF (i=3) or (i=6)
	 THEN ch := '/'
	 ELSE keyin(ch);
       write(ch);
       dateÆiÅ := ch
   END;
   writeln
ENDæ Initialize åæ CLOSE(StuNdx); CLOSE(StuGrades); å;


BEGIN	(*** MAIN PROGRAM ***)
   Initialize;
   more := true;
   WHILE more DO BEGIN
	writeln;
	Q('N(ew student, F(ind, C(hange, G(rades, L(ist, S(tats, Q(uit ...?',
		Æ'N','C','F','G','L','S','Q'Å, command );
	CASE command of
	   'N':
	      ADD;
	   'C','F':
	      MODIFY;
	   'G':
	      mathmult;
	   'L':
	      LIST;
	   'S':
	      STATS;
	   'Q':
	      more := false
	endæCASEå
   ENDæwhileå;
   IF updated THEN fclose
END.
«eof»
DataMuseum.dk

CP/M

⟦a4e4e2daf⟧ TextFile

Derivation

TextFile
