comment
  This program was orignally written by Steve Strommen 
  Repaired and modified by Ronald Mozer (comments to Mesilla 
  Valley RCP/M (505) 524-6920.)

  By the time I received it from the Thousand Oaks RCP/M the file
  was corrupt and needed fixing.  Also the program was too big to
  run on the Kaypro 10 due to the smaller TPA.  I therefore cleaned
  it up considerably, repaired the corrupt file, and added the two
  constants below such that it may be easily modified for your
  requirements.  For those of you who have never used Sbasic all
  that is required to compile the program is simple get your Sbasic
  disk, place it in drive A: and this disk in drive B.  Then simply
  enter:
  SBASIC GRADEBOK.BBZ
	end

$constant maxassignments=60
$constant maxstudents=40

	var ans=char
	var answer,answer2,password,clasname,aname,filename,outline=string:25
	var grade,number=string:5
	var i,j,k,l,m,x,y,icheck,numclass,numgrads,numasgn,qtr,ansnum=integer
	var numstdnt,asgnum,snum,linest,lineend,stdnt,cpos,printer=integer
	var zero,percent,score,gsum,wsum=real
	dim char answ(4)
	dim string:25; cnames(10) anames(maxassignments) 
	dim string:25; snames(maxstudents) snums(maxstudents)
	dim string:5; grades(10)
	dim integer quarter(maxassignments)
	dim real gpoints(10) ascores(maxstudents) scores(maxassignments) 
	dim real tpoints(maxassignments) weights(maxassignments) 
	dim real scale(maxassignments,10)
	procedure position
		print chr$(27);chr$(61);chr$(x+32);chr$(y+32);
	end
	procedure clear.screen
		print chr$(26)
	end
	procedure print.ascores
		print "Printing...."
		print #1;"Assignment: "+anames(asgnum)
		print #1;
		for i=1 to numstdnt
			print #1;snames(i),tab(26),snums(i),tab(51),ascores(i)
		next i
	end
	procedure read.class
		filename=clasname+".DAT"
		open #1;filename
		j=0
		read #1,j;numstdnt
		if numstdnt=0 then goto 10.rc
		for i=1 to numstdnt
			j=i
			read #1,j;snames(i),snums(i)
		next i
10.rc		close #1
	end
	procedure write.class
		filename=clasname+".DAT"
		open #1;filename
		j=0
		write #1,j;numstdnt
		if numstdnt=0 then begin
			close #1
			goto 10.wc
			end
		for i=1 to numstdnt
			j=i
			write #1,j;snames(i),snums(i)
		next i
		close #1
10.wc	end
	procedure check.snames
		icheck=0
		for i=1 to numstdnt
			if answer=snames(i) then icheck=i
		next i
	end
	procedure add.student
1.as		clear.screen
		input2 "Enter the student name: ";answer
		input2 "Enter the student number: ";answer2
		print answer,answer2
		input2 "Are the name and number correct? (y/n) ";ans
		if ans><"y" and ans><"Y" then goto 1.as
		check.snames
		if icheck><0 then begin
			input2 "Name is already in the class. Press any key.";ans
			goto 9.as
			end
		print "Updating file....."
		numstdnt=numstdnt+1
		snames(numstdnt)=answer
		snums(numstdnt)=answer2
		open #1;clasname+".DAT"
		write #1,0;numstdnt
		write #1,numstdnt;snames(numstdnt),snums(numstdnt)
		zero=0
		for i=1 to maxassignments
			write #1,numstdnt;zero
		next i
		close #1
9.as	end
	procedure delete.student
		clear.screen
		input2 "Enter the student name to delete: ",answer
		check.snames
		if icheck=0 then begin
			input2 "Name not found, not deleted. Press any key. ";ans
			goto 9.ds
			end
		print "Are you sure you want to delete ";snames(icheck);" (y/n)"
		input2 ans
		if ans><"y" and ans ><"Y" then goto 9.ds
		print
		print "Updating class file....."
		filename=clasname+".DAT"
		open #1;filename
		for i=icheck+1 to numstdnt
			read #1,i;snames(i),snums(i)
			snames(i-1)=snames(i)
			snums(i-1)=snums(i)
			for j=1 to maxassignments
				read #1,i;scores(j)
			next j
			write #1,i-1;snames(i-1),snums(i-1)
			for j=1 to maxassignments
				write #1,i-1;scores(j)
			next j
		next i
		numstdnt=numstdnt-1
		close #1			
9.ds	end
	procedure change.sname
		clear.screen
		input2 "What name do you want to change? ";answer
		check.snames
		if icheck=0 then begin
			input2 "Name not found. Press any key. ";ans
			goto 10.cs
			end
		input2 "What is the new name? ";snames(icheck)
		print "Updating file....."
		open #1;clasname+".DAT"
		write #1,icheck;snames(icheck)
		close #1
10.cs	end
	procedure view.snames
		clear.screen
		print "Student names and numbers:"
		print "--------------------------"
		for i=1 to numstdnt
			print snames(i);"   ";snums(i)
		next i
		print
		input2 "Press any key to continue.";ans
	end
	procedure student.menu
1.sm		clear.screen
		text 0,&


			Student names menu

			A - Add a student
			D - Delete a student
			V - View all names
			C - Change a name
&
		input2 "			Enter your selection: ";ans
		ansnum=asc(ans)
		if ansnum>90 then ansnum=ansnum-32
		if ansnum=65 then add.student
		if ansnum=67 then change.sname
		if ansnum=68 then delete.student
		if ansnum=86 then view.snames
		if ansnum><27 then goto 1.sm
	end
	procedure read.clasnms
		open #0;"CLASNMS.DAT"
		read #0;password,numclass
		if numclass=0 then goto 10.clsnm
		for i=1 to numclass
			read #0; cnames(i)
		next i
10.clsnm 	close #0
	end
	procedure write.clasnms
		open #0;"CLASNMS.DAT"
		write #0;password,numclass
		for i=1 to numclass
			write #0;cnames(i)
		next i
		close #0
	end
	procedure display.clasnms
		clear.screen
		print "Class names:"
		print "------------"
		if numclass>0 then begin
			for i=1 to numclass
				print cnames(i)
			next i
			end
		print
	end
	procedure check.clasnms
		icheck=0
		for i=1 to numclass
			if cnames(i)=answer then icheck=i
		next i
	end
	procedure add.clasnms
		clear.screen
		input2 "Enter the class name you want to add: ";clasname
		filename=clasname+".DAT"
		create filename
		numstdnt=0
		write.class
		numclass=numclass+1
		cnames(numclass)=clasname
		write.clasnms
	end
	procedure delete.clasnms
		clear.screen
		input2 "What class do you want to delete? ";answer
		check.clasnms
		if icheck>0 then begin
			print "Updating files....."
			numclass=numclass-1
			if icheck>numclass then goto 5.dc
			for i=icheck to numclass
				cnames(i)=cnames(i+1)
			next i
5.dc			write.clasnms
			filename=answer+".DAT"
			delete filename
			end
		if icheck=0 then begin
			input2 "Class not found, not deleted.";ans
			goto 10.dc
			end
		clasname=cnames(1)
		read.class
10.dc	end
	procedure change.clasnms
		clear.screen
		input2 "What class name do you want to change? ";answer
		check.clasnms
		if icheck=0 then begin
			input2 "Name not found. Press any key. ";ans
			goto 10.cc
			end
		input2 "What is the new name? ";clasname
		print "Updating files....."
		cnames(icheck)=clasname
		write.clasnms
		rename (answer+".DAT") to (clasname+".DAT")		
10.cc	end
	procedure clasnms.menu
1.cm		clear.screen
		text 0,&


		     Class names menu:

		V - View class names
		A - Add class names
		D - Delete class names (warning - deletes file also!!!)
		C - Change a class name
&
		input2 ans
		ansnum=asc(ans)
		if ansnum>90 then ansnum=ansnum-32
		if ansnum=65 then add.clasnms
		if ansnum=68 then delete.clasnms
		if ansnum=67 then change.clasnms
		if ansnum=86 then begin
			display.clasnms
			input2 "Press any key to continue";ans
			end
		if ansnum<>27 then goto 1.cm
	end		
	procedure read.gpoints
		open #0;"GPOINTS.DAT"
		read #0;numgrads
		for i=1 to numgrads
			read #0;grades(i),gpoints(i)
		next i
		close #0
	end
	procedure write.gpoints
		open #0;"GPOINTS.DAT"
		write #0;numgrads
		for i=1 to numgrads
			write #0;grades(i),gpoints(i)
		next i
		close #0
	end
	procedure display.gpoints
		clear.screen
		print "Grade","Points"
		print "-----","------"
		for i=1 to numgrads
			print grades(i),gpoints(i)
		next i
	end
	procedure edit.gpoints
		display.gpoints
		print
		input2 "Do you want to change the grade system? (y/n) ";ans
		if ans><"Y" and ans><"y" then goto 9.eg
		clear.screen
		input2 "How many different grades do you want to use? ";numgrads
		for i=1 to numgrads
			print "Enter the grade notation for grade ";i;"  ex. A+"
			input2 grades(i)
			input2 "Enter the grade points: ";gpoints(i)
		next i
		display.gpoints
		print
		print "Updating file....."
		write.gpoints
		input2 "Press any key to continue.";ans
9.eg	end
	procedure read.asgn
		open #0;"ASGN.DAT"
		read #0;numasgn
		if numasgn=0 then goto 10.asgn
		for i=1 to numasgn
			read #0;anames(i),quarter(i),tpoints(i),weights(i),scale(i,1),scale(i,2),scale(i,3),scale(i,4),scale(i,5),scale(i,6),scale(i,7),scale(i,8),scale(i,9),scale(i,10)
		next i
10.asgn		close #0
	end
	procedure write.asgn
		open #0;"ASGN.DAT"
		write #0;numasgn
		for i=1 to numasgn
			write #0;anames(i),quarter(i),tpoints(i),weights(i),scale(i,1),scale(i,2),scale(i,3),scale(i,4),scale(i,5),scale(i,6),scale(i,7),scale(i,8),scale(i,9),scale(i,10)
		next i
		close #0
	end
	procedure display.anames
		clear.screen
		print "Assignment","Points","Weight"
		for i=1 to numasgn
			if quarter(i)=qtr then print anames(i),tpoints(i),weights(i)
		next i
		print
		input2 "Press any key to continue. ";ans
	end
	procedure check.asgn
		icheck=0
		for i=1 to numasgn
			if quarter(i)=qtr and aname=anames(i) then icheck=i
		next i
	end
	procedure fmt.asgn
		clear.screen
		x=0
		y=0
		position
		print "Assignment name: "
		print "Quarter:"
		print "Total points:"
		print "Weight:"
		print
		for i=1 to numgrads
			print grades(i)+" score:"
		next i
	end
	procedure display.asgn
		fmt.asgn
		x=0
		y=20
		position
		print anames(icheck)
		x=1
		position
		print quarter(icheck)
		x=2
		position
		print tpoints(icheck)
		x=3
		position
		print weights(icheck)
		for i=1 to numgrads
			x=4+i
			position
			print scale(icheck,i)
		end
	end
	procedure add.asgn
		clear.screen
		numasgn=numasgn+1
		input2 "Assignment name to add: ";aname
		check.asgn
		if icheck><0 then begin
			print "Assignment already exists."
			goto 9.add
			end
		anames(numasgn)=aname
		fmt.asgn
		x=0
		y=20
		position
		print aname
		x=1
		position
		input2 quarter(numasgn)
		x=2
		position
		input2 tpoints(numasgn)
		x=3
		position
		input2 weights(numasgn)
		for i=1 to numgrads
			x=4+i
			position
			input2 scale(numasgn,i)
		next i
		print
		print "Updating assignment file......."
		write.asgn
9.add	end
	procedure delete.asgn
		clear.screen
		input2 "Assignment name to delete:";aname
		check.asgn
		if icheck=0 then begin
			print "Assignment not found, not deleted."
			input2 "Press any letter to continue.";ans
			goto 9.del
			end
		numasgn=numasgn-1
		for i=icheck to numasgn
			anames(i)=anames(i+1)
			quarter(i)=quarter(i+1)
			tpoints(i)=tpoints(i+1)
			weights(i)=weights(i+1)
			for j=1 to 10
				scale(i,j)=scale(i+1,j)
			next j
		next i
		print
		print "Updating assignment file......."
		write.asgn
9.del	end
	procedure edit.asgn
		clear.screen
		input2 "What assignment do you want to edit? ";aname
		check.asgn
		if icheck=0 then begin
			input2 "Assignment not found. Press any key to continue.";ans
			goto 9.ed
			end
5.ed		display.asgn
		text 0,&
        Enter your selection:
N - Change assignment name and quarter
P - Change total points and weight
G - Change grade scale
R - Return to assignments menu
&
		input2 ans
		ansnum=asc(ans)
		if ansnum>90 then ansnum=ansnum-32
		if ansnum=82 then goto 9.ed
		clear.screen
		if ansnum=78 then begin
			input2 "Enter the assignment name: ";aname
			input2 "Enter the quarter: (1-4): ";qtr
			j=icheck
			check.asgn
			if icheck=0 then begin
				anames(j)=aname
				quarter(j)=qtr
				print "Updating file......"
				icheck=j
				write.asgn
				goto 5.ed
				end
			icheck=j
			input2 "Name already exists. Press any key to continue. ";ans
			goto 5.ed
			end
		if ansnum=80 then begin
			input2 "Enter the total points: ";tpoints(icheck)
			input2 "Enter the weight:       ";weights(icheck)
			print "Updating file....."
			write.asgn
			goto 5.ed
			end
		if ansnum=71 then begin
			for i=1 to numgrads
				print "Enter the score needed for an "+grades(i)
				input2 scale(icheck,i)
			next i
			print "Updating file......"
			write.asgn
			goto 5.ed
			end
		if ansnum><27 then goto 5.ed
9.ed	end
	procedure asgn.menu
1.ed		clear.screen
		text 0,&


			     Assignments Menu

			A - Add an assignment
			E - Edit an existing assignment
			V - View assignment names
&
		input2 "			Enter your selection: ";ans
		ansnum=asc(ans)
		if ansnum>90 then ansnum=ansnum-32
		if ansnum=65 then add.asgn
		if ansnum=69 then edit.asgn
		if ansnum=86 then display.anames
		if ansnum<>27 then goto 1.ed
	end
	procedure read.sgrades
		open #1;clasname+".DAT"
		read #1,snum;answer,answer2
		for i=1 to maxassignments
			read #1,snum;scores(i)
		next i
		close #1
	end
	procedure write.sgrades
		open #1;clasname+".DAT"
		write #1,snum;snames(snum),snums(snum)
		for i=1 to maxassignments
			write #1,snum;scores(i)
		next i
		close #1
	end
	procedure set.sname
		clear.screen
1.ss		input2 "What student's grades do you want to edit? ";answer
		check.snames
		if icheck=0 then begin
			input2 "Name not found. Press any key to view name list. ";ans
			view.snames
			goto 1.ss
			end
		snum=icheck
		read.sgrades
	end
	procedure display.sgrades
		clear.screen
		print "Grades for "+snames(snum)
		print
		print "Assignment","Score","Percent","Grade"
		if printer=1 then begin
			print #1;"Grades for "+snames(snum)
			print #1
			print #1;"Assignment","Score","Percent","Grade"
			end
		gsum=0
		wsum=0
		for i=1 to numasgn
			if quarter(i)><qtr then goto 5.dsg
			percent=100*scores(i)/tpoints(i)
			grade=grades(numgrads)
			for j=1 to numgrads
				k=numgrads+1-j
				if scores(i)>=scale(i,k) then begin
					grade=grades(k)
					l=k
					end
			next j
			print anames(i),scores(i),percent,grade
			if printer=1 then print #1;anames(i),scores(i),percent,grade
			gsum=gsum+gpoints(l)*weights(i)
			wsum=wsum+weights(i)
5.dsg		next i
		gsum=gsum/wsum
		print
		print "The average grade point is: ";gsum
		if printer=1 then begin
			print #1
			print #1;"The average grade point is";gsum
			end
		printer=0
		print
		input2 "Display complete. Press any key to continue. ";ans
	end
	procedure edit.sgrades
1.esg		clear.screen
		input2 "Enter the assignment name: ";aname
		check.asgn
		if icheck=0 then begin
			print "No such assignment."
			goto 9.esg
			end
		asgnum=icheck
		print "Score is now: ";scores(asgnum);"    Max. score: ";tpoints(asgnum)
		input2 "Enter the new score: ";scores(asgnum)
9.esg		input2 "Want to change any more grades? (y/n) ";ans
		if ans="y" or ans="Y" then goto 1.esg
		print "Updating file....."
		write.sgrades
	end
	procedure sgrades.menu
		set.sname
0.sgm		clear.screen
		text 0,&


			Student grades menu:

		V - View all grades for a student
		C - Change the grade for an assignment
		N - Change to a different student
&
		input2 "		Enter your selection: ";ans
		ansnum=asc(ans)
		if ansnum>90 then ansnum=ansnum-32
		if ansnum=67 then edit.sgrades
		if ansnum=86 then display.sgrades
		if ansnum=78 then set.sname
		if ansnum><27 then goto 0.sgm
	end
	procedure set.asgn
		clear.screen
1.sas		input2 "What assignment do you want? ";aname
		check.asgn
		if icheck=0 then begin
			input2 "No such assignment.  Press any key to see list. ";ans
			display.anames
			goto 1.sas
			end
		asgnum=icheck
		print "Loading existing grades..."
		open #1;clasname+".DAT"
		for i=1 to numstdnt
			read #1,i;snames(i),snums(i)
			for j=1 to asgnum
				if j=asgnum then read #1,i;ascores(i)
				if j><asgnum then read #1,i;zero
			next j
		next i
		close #1
	end
	procedure grader
		percent=100*ascores(i)/tpoints(asgnum)
		y=37
		position
		print spc(20)
		position
		print percent
		grade=grades(numgrads)
		for l=1 to numgrads
			m=1+numgrads-l
			if ascores(i)>=scale(asgnum,m) then grade=grades(m)
		next l
		y=50
		position
		print grade
	end
	procedure write.screen
		clear.screen
		x=21
		y=0
		position
		print "Current Score:               New Score:"
		x=0
		position
		print "Assignment: ";anames(asgnum);"   Quarter:";qtr;"    Class: ";clasname
		x=2
		position
		print "Name                    Score       Percent      Grade"
		for i=linest to lineend
			x=i-linest+4
			y=0
			position
			print snames(i)
			y=27
			position
			print ascores(i)
			grader
		next i
	end
	procedure write.line
		x=cpos+3
		y=26
		position
		print chr$(31)
		y=27
		position
		print ascores(stdnt)
		x=21
		y=16
		position
		print spc(8)
		position
		print ascores(stdnt)
		y=40		
		position
		print spc(8)
		position
		input2 ans
		ansnum=asc(ans)
		if ansnum>90 then ansnum=ansnum-32
	end
	procedure edit.ascores
		set.asgn
		linest=1
1.eas		if linest<1 then linest=1
		lineend=linest+15
		if linest>numstdnt then linest=numstdnt
		if lineend>numstdnt then lineend=numstdnt
		cpos=1
		stdnt=linest
		write.screen
2.eas		write.line
		x=cpos+3
		y=26
		position
		print " "
		if ansnum=10 then begin
			if cpos=(1+lineend-linest) then goto 4.eas
			stdnt=stdnt+1
			cpos=cpos+1
4.eas			goto 2.eas
			end
		if ansnum=11 then begin
			if cpos=1 then goto 5.eas
			stdnt=stdnt-1
			cpos=cpos-1
5.eas			goto 2.eas
			end
		if ansnum=70 then begin
			linest=linest+15
			goto 1.eas
			end
		if ansnum=66 then begin
			linest=linest-15
			goto 1.eas
			end
		if ansnum=27 then goto 10.eas
		if ansnum>47 and ansnum<58 then begin
			l=0
			number=ans
			for i=1 to 4
				x=21
				y=40+i
				position
				input2 answ(i)
				ansnum=asc(answ(i))
				if ansnum=13 then begin
					ascores(stdnt)=val(number)
					i=4
					goto 6.eas
					end
				if ansnum>57 or ansnum<48 then begin
					l=1
					i=4
					goto 6.eas
					end
				number=number+answ(i)
6.eas			next i
			if l=1 then goto 7.eas
			i=stdnt
			x=cpos+3
			grader
7.eas			end
		goto 2.eas
10.eas	end
	procedure write.ascores
		clear.screen
		print "Updating file...."
		open #1;clasname+".DAT"
		for i=1 to numstdnt
			read #1,i;snames(i),snums(i)
			for j=1 to maxassignments
				read #1,i;scores(j)
			next j
			scores(asgnum)=ascores(i)
			write #1,i;snames(i),snums(i)
			for j=1 to maxassignments
				write #1,i;scores(j)
			next j
		next i
		close #1
	end
	procedure print.report
1.pr		clear.screen
		text 0,&


			Choose your report:

			S - Grades for a student
			A - All scores on an assignment

&
		input2 ans
		ansnum=asc(ans)
		if ansnum>90 then ansnum=ansnum-32
		if ansnum=83 then begin
			input2 "What student do you want? ";answer
			check.snames
			if icheck=0 then begin
				input2 "No such student. Press any key.";ans
				goto 1.pr
				end
			snum=icheck
			read.sgrades
			printer=1
			display.sgrades
			end
		if ansnum=65 then begin
			set.asgn
			print.ascores
			end
		if ansnum><27 then goto 1.pr
	end
	files s(1),r(768)
	clear.screen
	print "		Gradebook program loading....."
	on error goto 1
	read.clasnms
	goto 2
1	create "CLASNMS.DAT"
	open #0;"CLASNMS.DAT"
	numclass=0
	password="gradebook"
	write #0;password,numclass
	close #0
	on error off
2	on error goto 3
	read.gpoints
	goto 4
3	create "GPOINTS.DAT"
	open #0;"GPOINTS.DAT"
	numgrads=1
	grades(1)="A"
	gpoints(1)=4.
	write #0;numgrads
	write #0;grades(1),gpoints(1)
	close #0
	on error off
4	on error goto 5
	read.asgn
	goto 6
5	create "ASGN.DAT"
	open #0;"ASGN.DAT"
	numasgn=0
	write #0;numasgn
	close #0
	on error off
6	on error off
	clear.screen
	print
	print
10	input2 "Enter the password: ";answer
	if answer<>password then begin
		print "Password incorrect."
		goto 10
		end
	if numclass=0 then begin
		clear.screen
		print "No class names on disk.  You must enter one to begin."
		input2 "Press any key to continue.";ans
		add.clasnms
		clear.screen
	end
	display.clasnms
20	input2 "Enter the class name you want: ";answer
	check.clasnms
	if icheck=0 then goto 20
	clasname=answer
22	print
	input2 "Enter the quarter (1-4): ";qtr
	read.class
30	clear.screen
	text 0,&


			GRADEBOOK - MAIN MENU

		      A - Edit assignments
		      G - Edit grades for an assignment
		      E - Edit grades for a student
		      N - Add/delete student names
		      C - Add/delete class names
		      R - Print a report
		      Q - Change quarters
		      O - Change to another class
		      P - Edit grade point system
                      S - Quit
&
	print "		      Class: ";clasname;"       Quarter: ";qtr
	print
	input2 "		      Enter your selection: ";ans
	if asc(ans)>90 then ans=chr(asc(ans)-32)
	case ans of
	'R':	begin
		print.report
		goto 30
		end
	'G':	begin
		edit.ascores
		write.ascores
		goto 30
		end
	'P':	begin
		edit.gpoints
		goto 30
		end
	'A':	begin
		asgn.menu
		goto 30
		end
	'E':	begin
		sgrades.menu
		goto 30
		end
	'C':	begin
		clasnms.menu
		goto 30
		end
	'Q':	begin
		clear.screen
		input2 "Enter the new quarter:  (1-4) ";qtr
		goto 30
		end
	'N':	begin
		student.menu
		goto 30
		end
	'O':	begin
		clear.screen
		goto 20
		end
	'S':	stop
	end
end