Category : Science and Education
Archive   : GRADE3.ZIP
Filename : GRADE3.BAS

 
Output of file : GRADE3.BAS contained in archive : GRADE3.ZIP
'******************************************************************************
'* 03/05/89 VER 3.2 *
'* **** DR. FUNKEY'S COLLEGE GRADING PROGRAM **** *
'* Written in *
'* QUICKBASIC 4.5 *
'* *
'* (c) 1989 by DAVID WESSON, PhD. 238 S. Quaker La. W.Hartford, CT 06119 *
'******************************************************************************
'
' $INCLUDE: 'grade3.dec'
'
'************************* MAIN MODULE BEGINS HERE ***************************
initialize
readcommandline
menuroutine
goodbye
'************************** MAIN MODULE ENDS HERE ****************************

SUB calculate
IF numgrades = 0 THEN click: prompt "No grades to compute. Hit a key.": getkey: EXIT SUB
pagehead "COMPUTE GRADE"
prompt "Please wait, computing grades."
total = 0
totalweight = 0
FOR g = 1 TO numgrades
gradetotal(g) = 0
totalweight = totalweight + weight(g)
NEXT g
FOR s = 1 TO numstudents
studenttotal(s) = 0
FOR g = 1 TO numgrades
studenttotal(s) = studenttotal(s) + (grade(s, g) * (weight(g) / 100))
gradetotal(g) = gradetotal(g) + grade(s, g)
NEXT g
total = total + studenttotal(s)
NEXT s
adjust = 100 / totalweight
totalmean = (total * adjust) / numstudents
total = 0
FOR s = 1 TO numstudents
zscore(s) = (studenttotal(s) * adjust) - totalmean
studentrelfudge = relfudge * zscore(s)
final(s) = (studenttotal(s) * adjust) + absfudge + studentrelfudge
total = total + final(s)
NEXT s
totalmean = (total / numstudents)
END SUB

SUB checkdatafile
IF classname$ = "" THEN EXIT SUB
datafile$ = drive$ + classname$ + ".DAT"
OPEN datafile$ FOR RANDOM AS #1
IF LOF(1) = 0 THEN
CLOSE
KILL datafile$
click
prompt "No " + datafile$ + " file found. Create it now? ( Y / N ): "
askyn:
getkey
SELECT CASE UCASE$(in$)
CASE "Y"
setupfile
CASE "N"
datafile$ = ""
CASE ELSE
click
GOTO askyn
END SELECT
END IF
CLOSE
END SUB

SUB clearall
COLOR fore, back
VIEW PRINT 4 TO 24
CLS
VIEW PRINT
COLOR back, fore
END SUB

SUB click
IF freq > 0 THEN SOUND freq, 1
END SUB

SUB commentall
IF numstudents = 0 THEN click: prompt "No students entered yet. Hit a key.": getkey: EXIT SUB
prompt "[Return] Skip, [BackSpace] Backup one, [Tab] Erase or [Esc] EXIT."
d$(1) = "Comments may be entered for all students."
dialog 5, "COMMENTS"
x = 0
cursor 1
DO
x = x + 1
LOCATE 20, 16: PRINT student$(x)
getcomment (x)
LOOP UNTIL x = numstudents OR k$ = esc$
cursor 0
END SUB

SUB commentone
IF numstudents = 0 THEN click: prompt "No students entered yet. Hit a key.": getkey: EXIT SUB
cursor 1
DO
getname
IF k$ = esc$ THEN EXIT DO
getcomment (found)
LOOP UNTIL k$ = esc$
END SUB

SUB commentprint (type$)
IF classname$ = "" THEN click: prompt "No class file opened yet. Hit a key.": getkey: EXIT SUB
prompt "Please wait, creating comment output file."
cmtfile$ = drive$ + classname$ + ".CMT"
cmtfile = FREEFILE
OPEN cmtfile$ FOR OUTPUT AS cmtfile
PRINT #cmtfile, STRING$(79, 61)
PRINT #cmtfile, course$; SPC(3); term$; SPC(3); teacher$; SPC(3); section$; SPC(3); DATE$
PRINT #cmtfile, STRING$(79, 45)
PRINT #cmtfile, "STUDENT"; TAB(23); "ID#"; TAB(36); "COMMENT"
PRINT #cmtfile, STRING$(79, 61)
FOR x = 1 TO numstudents
PRINT #cmtfile, student$(x); SPC(2); id$(x); SPC(2); Comment$(x)
NEXT x
PRINT #cmtfile, STRING$(79, 61)
PRINT #cmtfile, "TOTAL STUDENTS:"; numstudents
CLOSE cmtfile
SELECT CASE type$
CASE "P"
outfile$ = cmtfile$
outputprinter
KILL cmtfile$
CASE "S"
outfile$ = cmtfile$
outputscreen
KILL cmtfile$
CASE "D"
p$ = "Comment file " + cmtfile$ + " created. Hit a key."
prompt p$
getkey
END SELECT
END SUB

FUNCTION convertgrade (k$)
saveline = CSRLIN
IF (grade(1, 1) <= 4.33 AND VAL(k$) > 4.33) OR (grade(1, 1) > 4.33 AND VAL(k$) <= 4.33) THEN
click
prompt "WARNING: Do not mix Raw Scores and real grades in one datafile. Hit a key."
getkey
LOCATE saveline, 10
k$ = "junk"
EXIT FUNCTION
END IF
SELECT CASE k$
CASE esc$
EXIT FUNCTION
CASE ""
grade = 0
CASE "A+"
grade = 4.33
CASE "A"
grade = 4
CASE "A-"
grade = 3.67
CASE "AB"
grade = 3.5
CASE "B+"
grade = 3.33
CASE "B"
grade = 3
CASE "B-"
grade = 2.67
CASE "BC"
grade = 2.5
CASE "C+"
grade = 2.33
CASE "C"
grade = 2
CASE "C-"
grade = 1.67
CASE "CD"
grade = 1.5
CASE "D+"
grade = 1.33
CASE "D"
grade = 1
CASE "D-"
grade = .67
CASE "DF"
grade = .5
CASE "F+"
grade = .33
CASE "F"
grade = 0
CASE "I"
grade = 0
CASE ELSE
grade = VAL(k$)
END SELECT
convertgrade = grade
END FUNCTION

SUB cursor (value)
IF value = 1 THEN 'turns cursor on
LOCATE , , 1, 6, 7
ELSEIF value = 0 THEN LOCATE , , 0, 0, 0 'turns cursor off
END IF
END SUB

SUB dialog (margin, head$)
COLOR high, fore
LOCATE 18, 10
PRINT SPACE$(30 - (LEN(head$) / 2)); head$; SPACE$(70 - POS(0))
COLOR back, fore
FOR x = 1 TO 4
LOCATE 18 + x, 9
PRINT CHR$(176); SPACE$(1 + margin); d$(x); SPACE$(70 - POS(0))
NEXT x
LOCATE 23, 9: PRINT STRING$(60, 176)
FOR x = 1 TO 4
d$(x) = ""
NEXT x
END SUB

SUB doscommand
pagehead "DOS SHELL"
prompt "Type DOS command, or [Esc] to EXIT."
d$(1) = "You may exit this program temporarily to issue"
d$(2) = "a DOS command. Do not attempt to run a very"
d$(3) = "large program from within this one. "
d$(4) = "DOS COMMAND: " + STRING$(35, 254)
dialog 5, "ISSUE DOS COMMAND"
COLOR back, fore
cursor 1
LOCATE 22, 29
keyin 35
IF k$ = esc$ THEN EXIT SUB
COLOR 7, 0
CLS
SHELL k$
cursor 0
prompt "Hit any key to continue."
getkey
makescreen
END SUB

SUB fudgea
IF numgrades = 0 THEN click: prompt "No grades entered yet. Hit a key.": getkey: EXIT SUB
pagehead "FUDGE ZONE"
prompt "ABSOLUTE FUDGE: "
d$(1) = "This number will be added to each final grade as well as"
d$(2) = "the class average. If a minus number is specified, the "
d$(3) = "number will be subtracted from the grades. "
d$(4) = "EX: .02 raises 2.74 to 2.76 -.04 lowers 2.74 to 2.70"
dialog 2, "ABSOLUTE FUDGE"
COLOR back, high
LOCATE 25, 48
PRINT STRING$(4, 254);
LOCATE 25, 48
keyin 4
absfudge = VAL(k$)
COLOR back, fore
END SUB

SUB fudger
IF numgrades = 0 THEN click: prompt "No grades entered yet. Hit a key.": getkey: EXIT SUB
prompt "RELATIVE FUDGE:"
d$(1) = "This number spreads the curve around the mean by the"
d$(2) = "specified percent. Grades closest to the mean change"
d$(3) = "least. Grades distant from the mean are affected more. "
d$(4) = ".8 spreads by .8 x mean -1.2 contracts by 1.2 x mean"
dialog 2, "RELATIVE FUDGE"
COLOR back, high
LOCATE 25, 48
PRINT STRING$(4, 254);
LOCATE 25, 48
keyin 4
relfudge = VAL(k$)
COLOR back, fore
END SUB

SUB getcomment (x)
prompt "[Return] Skip, [BackSpace] Backup one, [Tab] Erase or [Esc] EXIT."
COLOR back, fore
LOCATE 21, 16: PRINT "Enter or edit comment for this student."
comtop:
LOCATE 22, 16: PRINT STRING$(40, 254);
LOCATE , 16: PRINT Comment$(x);
keyin (40 - LEN(Comment$(x)))
SELECT CASE k$
CASE tab$
Comment$(x) = ""
GOTO comtop
CASE bksp$
Comment$(x) = LEFT$(Comment$(x), LEN(Comment$(x)) - 1)
GOTO comtop
CASE esc$
EXIT SUB
CASE ELSE
Comment$(x) = LEFT$((Comment$(x) + k$), 40)
END SELECT
END SUB

SUB getdirectory
clearall
cursor 0
pagehead "VIEW DIRECTORY"
filespec$ = drive$ + "*.DAT"
dir$ = "dir/p " + filespec$
LOCATE 5, 1
VIEW PRINT 5 TO 20
SHELL dir$
VIEW PRINT
END SUB

SUB getdirname
clearall
pagehead "FILE ROUTINES"
d$(1) = "Where is the DATAFILE stored, or to be stored?"
d$(2) = "A: for A: drive"
d$(3) = " \subdirectory\ for subdirectory on hard drive"
d$(4) = "Hit [Return] to use current drive or directory"
dialog 5, "SET DIRECTORY"
getdir:
prompt "Drive or directory name: "
cursor 1
keyin 30
cursor 0
IF k$ = esc$ THEN classname$ = "": goodbye
IF LEN(k$) = 1 AND RIGHT$(k$, 1) <> ":" THEN k$ = k$ + ":"
IF k$ <> "" AND (RIGHT$(k$, 1) <> "\" OR RIGHT$(k$, 1) <> ":") THEN k$ = k$ + "\"
drive$ = k$
END SUB

SUB getfilename
d$(2) = "CLASS NAME can be up to 8 characters with no spaces."
d$(3) = " Example: CMM200 SPANISH"
dialog 4, "SET FILENAME"
p$ = "What is the CLASS NAME? ( no .DAT ): " + STRING$(8, 254) + ".DAT"
prompt p$
LOCATE 25, 52
keyin 8
IF k$ = esc$ OR k$ = "" THEN EXIT SUB
classname$ = LEFT$(k$, 8)
END SUB

SUB getgrade
prompt "Enter grades (ex: A- 3.67 95 ), I or 0 for no grade, or [Esc] to EXIT."
top:
d$(1) = "Enter grade" + STR$(numgrades) + " for student."
d$(3) = student$(s) + ": " + STRING$(4, 254)
dialog 12, "ENTER GRADES"
LOCATE 21, 45
keyin 4
IF k$ = esc$ THEN
EXIT SUB
ELSEIF LEFT$(k$, 1) > CHR$(73) OR LEFT$(k$, 1) = "E" OR LEFT$(k$, 1) < CHR$(47) THEN
click
GOTO top
END IF
grade(s, numgrades) = convertgrade(k$)
END SUB

SUB getkey
i: in$ = UCASE$(INKEY$): IF in$ = "" THEN GOTO i
END SUB

SUB getname
found = 0
d$(1) = "Enter name or unique first several letters of name."
d$(2) = "STUDENT NAME: " + STRING$(20, 254)
dialog 5, "GET NAME"
prompt "Enter enough letters to make name unique, or [Esc] to EXIT."
LOCATE 20, 30
keyin 20
IF k$ = esc$ THEN EXIT SUB
namelen = LEN(k$)
name$ = k$
IF name$ = "" THEN GOTO nofound
FOR s = 1 TO numstudents
IF LEFT$(student$(s), namelen) = name$ THEN
found = s
name$ = student$(s)
LOCATE 20, 30: PRINT name$
EXIT SUB
END IF
NEXT s
nofound:
IF found = 0 THEN
prompt "No entry by that name found. Hit a key."
getkey
getname
END IF
END SUB

SUB goodbye
click
prompt "[A] ABORT WITHOUT SAVE [C] CONTINUE or any other key EXIT WITH SAVE."
getkey
SELECT CASE in$
CASE "A"
dummy = 0
CASE "C"
IF classname$ = "" THEN openfile
EXIT SUB
CASE ELSE
writedatafile
END SELECT
COLOR 7, 0
numberpad 0
CLS
IF classname$ <> "" THEN
l$(5) = "HELPFUL SHORTCUT:"
l$(6) = " Type GRADE " + drive$ + classname$
l$(7) = " and it'll take you right into the file."
l$(8) = " "
l$(9) = "Thank you for using FUNKEY GRADER."
writescreen 1
END
ELSE PRINT "Thank you for visiting FUNKEY GRADER.": END
END IF
END SUB

SUB gradechange
IF numgrades = 0 THEN click: prompt "No grades entered yet. Hit a key.": getkey: EXIT SUB
DO
getname
IF k$ = esc$ OR k$ = "" THEN EXIT DO
LOCATE 21, 16: PRINT "Enter grade number and new grade."
LOCATE 22, 16: PRINT "GRADE NUMBER: "; STRING$(2, 254)
prompt "Enter the NUMBER of the grade to be changed, not the grade."
LOCATE 22, 30
COLOR back, fore
keyin 2
g = VAL(k$)
IF k$ = esc$ OR k$ = "" THEN EXIT DO
IF g < 1 OR g > numgrades THEN
click
prompt "No grade matches that GRADE NUMBER. Hit a key."
getkey
EXIT DO
END IF
LOCATE 22, 45: PRINT "NEW GRADE: "; STRING$(4, 254)
LOCATE 22, 56
keyin 4
IF k$ = esc$ THEN EXIT DO
grade(found, g) = convertgrade(k$)
LOOP
END SUB

SUB gradedelete
IF numgrades = 0 THEN click: prompt "No grades entered yet. Hit a key.": getkey: EXIT SUB
d$(1) = "This command will delete an entire grade column"
d$(2) = "from the grade datafile. Proceed carefully."
d$(3) = "Enter grade NUMBER to be deleted: " + STRING$(2, 254)
dialog 5, "DELETE GRADE"
prompt "Enter grade NUMBER or [Esc] to EXIT."
LOCATE 21, 50
COLOR back, fore
keyin 2
IF k$ = esc$ OR k$ = "" THEN EXIT SUB
gradenum = VAL(k$)
LOCATE 22, 16: PRINT "Confirm deletion of grade column:"; gradenum
getkey
IF in$ = esc$ THEN EXIT SUB
FOR g = gradenum TO numgrades
SWAP gradetype$(g), gradetype$(g + 1)
SWAP description$(g), description$(g + 1)
FOR s = 1 TO numstudents
SWAP grade(g, s), grade(g + 1, s)
NEXT s
NEXT g
numgrades = numgrades - 1
writedatafile
END SUB

SUB gradesenter
IF numstudents = 0 THEN openfile
DO
numgrades = numgrades + 1
pagehead "ENTER GRADES"
numberpad 1
d$(1) = "Enter initial letter of grade type for grade " + LTRIM$(STR$(numgrades))
d$(2) = "Test Exam Quiz Assignment Paper Report Other: "
d$(3) = "Enter full description for this grade."
d$(4) = "DESCRIPTION: " + STRING$(29, 254)
dialog 5, "GRADE TYPE"
prompt "Type initial, [O] Other gets prompt, [Esc] to EXIT."

asktype:
LOCATE 20, 62
cursor 1
getkey
COLOR back, fore
cursor 0
PRINT in$
SELECT CASE in$
CASE esc$
numgrades = numgrades - 1
EXIT DO
CASE "T"
gradetype$(numgrades) = "TEST"
CASE "E"
gradetype$(numgrades) = "EXAM"
CASE "Q"
gradetype$(numgrades) = "QUIZ"
CASE "A"
gradetype$(numgrades) = "ASSN"
CASE "P"
gradetype$(numgrades) = "PAPR"
CASE "R"
gradetype$(numgrades) = "RPRT"
CASE "O"
LOCATE 20, 62
PRINT STRING$(4, 254)
LOCATE 20, 62
keyin 4
IF k$ = esc$ THEN numgrades = numgrades - 1: EXIT SUB
gradetype$(numgrades) = k$ + STRING$(4 - LEN(k$), 32)
CASE ELSE
click
GOTO asktype
END SELECT
LOCATE 22, 29
keyin 29
description$(numgrades) = k$ + STRING$(29 - LEN(k$), 32)
FOR s = 1 TO numstudents
getgrade
IF k$ = esc$ THEN EXIT DO
NEXT s
LOOP UNTIL numgrades = grades + 1
gradeweight
numberpad 0
END SUB

SUB gradetypechange
IF numgrades = 0 THEN click: prompt "No grades entered yet. Hit a key.": getkey: EXIT SUB
asknum:
d$(1) = "Enter grade number to be changed."
d$(2) = "GRADE NUMBER: " + STRING$(2, 254)
dialog 5, "CHANGE GRADE TYPE"
prompt "Enter the NUMBER of the grade to be changed, not the type."
LOCATE 20, 30
keyin 2
g = VAL(k$)
IF k$ = "" OR k$ = esc$ THEN EXIT SUB
IF g < 1 OR g > numgrades THEN click: GOTO asknum
COLOR back, fore
LOCATE 21, 16: PRINT "Enter initial letter of new grade type."
LOCATE 22, 16: PRINT "Test Exam Quiz Assignment Paper Report Other: "
prompt "Type initial, [O] gets prompt, [Esc] to EXIT."
askgtype:
COLOR back, fore
LOCATE 22, 62
cursor 1
getkey
cursor 0
SELECT CASE in$
CASE esc$
EXIT SUB
CASE "T"
gradetype$(g) = "TEST"
CASE "E"
gradetype$(g) = "EXAM"
CASE "Q"
gradetype$(g) = "QUIZ"
CASE "A"
gradetype$(g) = "ASSN"
CASE "P"
gradetype$(g) = "PAPR"
CASE "R"
gradetype$(g) = "RPRT"
CASE "O"
LOCATE 22, 62
PRINT STRING$(4, 254)
LOCATE 22, 62
keyin 4
IF k$ = esc$ THEN EXIT SUB
gradetype$(g) = LEFT$(k$, 4)
CASE ELSE
click
GOTO askgtype
END SELECT
PRINT in$
LOCATE 19, 16: PRINT "Enter NEW description for this grade."
LOCATE 20, 16: PRINT "NEW DESCRIPTION: "; STRING$(29, 254)
LOCATE 20, 33
keyin 29
IF k$ = esc$ THEN EXIT SUB
description$(g) = k$
END SUB

SUB gradeweight
k$ = ""
IF numstudents = 0 THEN openfile
IF numgrades = 0 THEN click: prompt "No grades entered yet. Hit a key.": getkey: EXIT SUB
d$(1) = "WEIGHT each grade by entering the PERCENT each grade"
d$(2) = "contributes to FINAL. [=] gives all grades EQUAL WEIGHT."
d$(3) = "[Return] leaves weight as is. Do not use . or % here."
d$(4) = ""
dialog 2, "WEIGHT GRADES"
prompt "Enter NUMBER, [Return] to leave same, [=] for EQUAL, or [Esc] EXIT."
COLOR back, fore
FOR x = 1 TO numgrades
getweight:
x$ = SPACE$(2)
RSET x$ = LTRIM$(STR$(x))
LOCATE 22, 13: PRINT "Enter WEIGHT for GRADE "; x$; " "; gradetype$(x); ":"; SPACE$(6);
LOCATE 22, 44: PRINT weight(x)
LOCATE 22, 45
keyin 3
IF k$ = esc$ THEN
EXIT SUB
ELSEIF k$ = "=" THEN
FOR g = 1 TO numgrades
weight(g) = (100 / numgrades)
NEXT g
EXIT SUB
ELSEIF k$ = "" THEN weight(g) = weight(g)
ELSEIF VAL(k$) < 0 OR VAL(k$) > 100 THEN GOTO getweight
ELSE weight(x) = VAL(k$)
END IF
NEXT x
END SUB

SUB header
LOCATE 1, 1: COLOR back, high
PRINT SPACE$(32); "FUNKEY GRADER 3"; SPACE$(33)
COLOR fore, back
END SUB

SUB helpscreen
clearall
pagehead "HELP"
l$(6) = "TO EXECUTE COMMANDS:"
l$(7) = ""
l$(8) = " Use [LeftArrow] or [RightArrow] and hit [Return]"
l$(9) = " or hit any of the highlighted initial letters"
l$(10) = ""
l$(11) = "TO MOVE AROUND IN THE DISPLAY WINDOW"
l$(12) = ""
l$(13) = " [PgDn] Moves DOWN 15 lines"
l$(14) = " [DnArrow] Moves DOWN 1 line "
l$(15) = " [PgUp] Moves UP 15 lines"
l$(16) = " [UpArrow] Moves UP 1 line "
l$(17) = " [Tab] or [+] Moves RIGHT 50 columns"
l$(18) = ""
l$(19) = " [<--] or [-] Backspace LEFT 50 columns"
l$(20) = ""
l$(21) = " [Home] Returns to beginning position"
l$(22) = ""
l$(23) = " [End] Moves to bottom of file "
writescreen 20
prompt "Hit any key to continue, or [Esc] to EXIT."
getkey
clearall
pagehead "HELP"
l$(5) = "FILE: Open an existing file, start a new file and save current file."
l$(6) = " View and change disk directory. Set default drive or directory."
l$(7) = " Quit program with option to save current session or abort."
l$(8) = ""
l$(9) = "NAMES: Enter, sort, change, and delete student names and ID#."
l$(10) = ""
l$(11) = "GRADES: Enter, change, weight, and delete grades, types and descriptions."
l$(12) = ""
l$(13) = "Z-SCORE: Compute and output Z-scores (distance for the mean) for students."
l$(14) = ""
l$(15) = "ARFUDGE: Absolute adjusts grades equally, Relative Fudge adjusts by Z-Score."
l$(16) = ""
l$(17) = "COMMENT: Add, edit and output comments for all or selected students."
l$(18) = ""
l$(19) = "RECALC: Recalculate grades, setting default to Manual or Automatic."
l$(20) = ""
l$(21) = "OUTPUT: Output grade sheet to disk or printer."
l$(22) = ""
l$(23) = "HELP: Help screen; set default colors and beep frequency. Set default"
l$(24) = " to hide or unhide ID#s. Issue DOS command."
writescreen 3
prompt "Hit any key to continue, or [Esc] to EXIT."
getkey
END SUB

SUB hideid
IF id = 1 THEN
id = 0
id1$ = SPACE$(7)
id2$ = SPACE$(1)
ELSE id1$ = SPACE$(17) + "ID#"
id2$ = SPACE$(14)
id = 1
END IF
END SUB

SUB initialize
cursor 0 'turn cursor off
CLS
menuarrays
readinifile
setnames
IF id = 0 THEN
id = 1
ELSE id = 0
END IF
hideid
IF mouseon = 0 THEN
mouseon = 1
ELSE mouseon = 0
END IF
mouse
END SUB

'---------------------- INPUT ANSWER FROM KEYBOARD ----------------------------
SUB keyin (length)
cursor 1
COLOR back, fore
k$ = ""
inrow = CSRLIN: incol = POS(0): inlen = 78 - incol
DO
dummy = 0
getkey
SELECT CASE in$
CASE enter$
EXIT DO
CASE tab$
k$ = tab$
EXIT DO
CASE esc$
k$ = esc$
EXIT DO
CASE bksp$
IF k$ = "" THEN
k$ = bksp$
EXIT DO
ELSE PRINT CHR$(29); CHR$(254); CHR$(29);
k$ = LEFT$(k$, LEN(k$) - 1)
END IF
CASE IS < CHR$(32), IS > CHR$(122)
dummy = 1
CASE ELSE
IF LEN(k$) = length OR LEN(k$) = inlen THEN
click
dummy = 1
END IF
IF dummy <> 1 THEN
LOCATE inrow, incol + LEN(k$): PRINT in$;
k$ = k$ + in$
END IF
END SELECT
LOOP
cursor 0
END SUB

SUB mainscreen
header
LOCATE 4, 1
COLOR back, fore
ms$ = SPACE$(80)
LSET ms$ = ms$(1)
PRINT ms$;
COLOR fore, back
FOR x = 2 TO 5
ms$ = SPACE$(80)
LSET ms$ = LEFT$(ms$(x), 21) + MID$(ms$(x), 21 + leftset + 1, 60)
PRINT ms$;
NEXT x
FOR x = 6 + downset TO 21 + downset
ms$ = SPACE$(80)
LSET ms$ = LEFT$(ms$(x), 21) + MID$(ms$(x), 21 + leftset + 1, 60)
PRINT ms$;
NEXT x
prompt "[H] HELP [Up] [Dn] [PgDn] [PgUp] [Tab] [<--] [Home] [End] [Esc] EXIT"
END SUB

SUB makescreen
IF numstudents = 0 THEN EXIT SUB
IF autocalc = 1 THEN calculate
FOR x = 1 TO numstudents + 10
ms$(x) = ""
NEXT x
prompt "Initializing student: "

ms$(1) = course$ + SPACE$(1) + teacher$ + SPACE$(1) + term$ + SPACE$(1) + section$ + SPACE$(1) + DATE$

ms$(2) = "NAME" + id1$ + SPACE$(3) + "GRADE#"
FOR a = 1 TO numgrades
num$ = SPACE$(4)
LSET num$ = STR$(a)
ms$(2) = ms$(2) + num$ + SPACE$(2)
NEXT a
ms$(2) = ms$(2) + SPACE$(1) + "FINAL COMMENT"

ms$(3) = id2$ + SPACE$(13) + "TYPE "
FOR t = 1 TO numgrades
ms$(3) = ms$(3) + gradetype$(t) + SPACE$(2)
NEXT t

ms$(4) = id2$ + SPACE$(13) + "WEIGHT "
FOR g = 1 TO numgrades
ms$(4) = ms$(4) + strg$(weight(g)) + SPACE$(2)
totalweight = totalweight + weight(g)
NEXT g
ms$(4) = ms$(4) + SPACE$(1) + strg$(totalweight)

ms$(5) = STRING$(202, 196)

COLOR back, fore
FOR s = 1 TO numstudents
LOCATE 25, 49: PRINT s;
ms$(5 + s) = ms$(5 + s) + student$(s)
IF id = 1 THEN ms$(5 + s) = ms$(5 + s) + SPACE$(1) + id$(s) + SPACE$(1)
FOR g = 1 TO numgrades
ms$(5 + s) = ms$(5 + s) + SPACE$(1) + strg$(grade(s, g)) + SPACE$(1)
NEXT g
ms$(5 + s) = ms$(5 + s) + SPACE$(2) + strg$(final(s)) + SPACE$(3) + Comment$(s)
NEXT s

ms$(5 + s) = STRING$(202, 196)

ms$(5 + s + 1) = "TOTAL:" + STR$(numstudents) + id2$ + SPACE$(3) + "AVERAGE" + SPACE$(1)
FOR g = 1 TO numgrades
ms$(5 + s + 1) = ms$(5 + s + 1) + strg$(gradetotal(g) / numstudents) + SPACE$(2)
NEXT g
ms$(5 + s + 1) = ms$(5 + s + 1) + SPACE$(1) + strg$(totalmean)

ms$(7 + s) = STRING$(202, 196)

ms$(8 + s) = "GRADE TYPE DESCRIPTION"

FOR x = 1 TO numgrades
num$ = SPACE$(3)
RSET num$ = STR$(x)
ms$(8 + s + x) = num$ + SPACE$(4) + gradetype$(x) + SPACE$(2) + description$(x)
NEXT x
END SUB

SUB menuarrays

sel$(1, 0) = " File "
sel$(2, 0) = " Names "
sel$(3, 0) = " Grades "
sel$(4, 0) = " Z-score "
sel$(5, 0) = " AR-Fudge "
sel$(6, 0) = " Comment "
sel$(7, 0) = " Recalculate "
sel$(8, 0) = " Output "
sel$(9, 0) = " Help "

'===== Define Help messages for line 3

sel$(1, 10) = "Open, start new and save files; view, change and set directory; quit program "
sel$(2, 10) = "Enter, sort, change, and delete student names and ID# "
sel$(3, 10) = "Enter, change, weight, and delete grades and grade type and description "
sel$(4, 10) = "Compute and output Z-scores for all students "
sel$(5, 10) = "Adjust final grades for all students summarily "
sel$(6, 10) = "Add, edit and output comments for students "
sel$(7, 10) = "Recalculate grades for all students, set to Manual or Automatic "
sel$(8, 10) = "Output grade sheet to disk or printer "
sel$(9, 10) = "Help screen, set colors and beep, hide/unhide ID#s, issue DOS command "

'===== Define Sub Selections For File

sel$(1, 1) = " Open file "
sel$(1, 2) = " New file "
sel$(1, 3) = " View dir "
sel$(1, 4) = " Change dir "
sel$(1, 5) = " Default dir "
sel$(1, 6) = " Save file "
sel$(1, 7) = " Quit + save "

'===== Define Sub Selections For Names

sel$(2, 1) = " Enter names "
sel$(2, 2) = " Sort names "
sel$(2, 3) = " Change names "
sel$(2, 4) = " New ID# "
sel$(2, 5) = " ID# sort "
sel$(2, 6) = " Delete name "

'===== Define Sub Selections For Grades

sel$(3, 1) = " Enter grades "
sel$(3, 2) = " Change grade "
sel$(3, 3) = " Weight grade "
sel$(3, 4) = " Delete grade "
sel$(3, 5) = " Revise type "

'===== Define Sub Selections For Z-scores

sel$(4, 1) = " Disk output "
sel$(4, 2) = " Screen output "
sel$(4, 3) = " Printer output "

'===== Define Sub Selections For Fudge

sel$(5, 1) = " Absolute fudge "
sel$(5, 2) = " Relative fudge "


'===== Define Sub Selections For Comments

sel$(6, 1) = " One comment "
sel$(6, 2) = " All comment "
sel$(6, 3) = " Disk output "
sel$(6, 4) = " Screen output "
sel$(6, 5) = " Printer output "

'===== Define Sub Selections For Recalculate

sel$(7, 1) = " Manual Recalc "
sel$(7, 2) = " Auto Recalc "

'===== Define Sub Selections For Output

sel$(8, 1) = " Disk output "
sel$(8, 2) = " Printer output "

'===== Define Sub Selections For Exit

sel$(9, 1) = " Help "
sel$(9, 2) = " Color "
sel$(9, 3) = " Sound "
sel$(9, 4) = " ID hide "
sel$(9, 5) = " Mouse "
sel$(9, 6) = " DOS "

END SUB

SUB menufindcol
col = 1
FOR x = 1 TO sel - 1
col = col + LEN(sel$(x, 0))
NEXT x
END SUB

SUB menuhighlight
COLOR high, fore
LOCATE lin, col
PRINT LEFT$(sel$(sel, subsel), 2);
COLOR back, fore
PRINT MID$(sel$(sel, subsel), 3);
COLOR fore, back
LOCATE 3, 1: PRINT sel$(sel, 10)
END SUB

SUB menuinput
col = 1
sel = 1
subsel = 0
lin = 2
FOR x = 1 TO 10
sel = x
menuunhighlight
col = col + LEN(sel$(sel, 0))
NEXT
col = 1
sel = 1
menuhighlight
menutoploop
IF sel = 0 THEN EXIT SUB
DO
subsel = 1
DO UNTIL sel$(sel, subsel) = ""
lin = subsel + 3
GOSUB subhighlight
subsel = subsel + 1
LOOP
totsubs = subsel - 1
LOCATE lin + 1, col + 1: PRINT STRING$(LEN(sel$(sel, 1)), 176)
maxsubsel = subsel - 1
subsel = 1
DO
lin = subsel + 3
GOSUB high
getkey
menuhighlight
GOSUB subletter
SELECT CASE in$
CASE esc$
mainscreen
EXIT SUB
CASE enter$
mainscreen
sel = (sel * 10) + subsel
EXIT SUB
CASE lft$
mainscreen
subsel = 1
sel = sel - 1
IF sel < 1 THEN sel = items
menufindcol
EXIT DO
CASE rght$
mainscreen
subsel = 1
sel = sel + 1
IF sel > items THEN sel = 1
menufindcol
EXIT DO
CASE up$
subsel = subsel - 1
IF subsel < 1 THEN subsel = maxsubsel
lin = subsel + 3
GOSUB high
CASE down$
subsel = subsel + 1
IF subsel > maxsubsel THEN subsel = 1
lin = subsel + 3
GOSUB high
CASE end$
subsel = totsubs
lin = subsel + 3
GOSUB high
CASE home$
subsel = 1
lin = subsel + 3
GOSUB high
END SELECT
LOOP
LOOP
'-------------------- Menu Subroutines -------------------------------------
subletter:
FOR x = 1 TO 10
IF in$ = MID$(sel$(sel, x), 2, 1) THEN
subsel = x
in$ = enter$
RETURN
END IF
NEXT x
RETURN
subhighlight:
COLOR high, fore
LOCATE lin, col
PRINT LEFT$(sel$(sel, subsel), 2);
COLOR back, fore
PRINT MID$(sel$(sel, subsel), 3);
COLOR fore, back
PRINT CHR$(176);
LOCATE 3, 1: PRINT sel$(sel, 10)
RETURN
high:
COLOR high, back
LOCATE lin, col
PRINT LEFT$(sel$(sel, subsel), 2);
COLOR fore, back
PRINT MID$(sel$(sel, subsel), 3);
RETURN
END SUB

SUB menuletter
FOR x = 1 TO items
IF in$ = MID$(sel$(x, 0), 2, 1) THEN
sel = x
in$ = enter$
END IF
NEXT x
menufindcol
END SUB

SUB menuroutine
header
makescreen
DO
mainscreen
IF numstudents = 0 THEN openingscreen
menuinput
SELECT CASE sel
CASE 0 'escape key
goodbye
CASE 11
openfile
makescreen
CASE 12
openfile
setupfile
makescreen
CASE 13
getdirectory
prompt "Hit any key to continue."
getkey
CASE 14
switchdirectory
CASE 15
switchdirectory
writeinifile
CASE 16
writedatafile
CASE 17
goodbye
CASE 21
namesenter
makescreen
CASE 22
namesort
makescreen
CASE 23
namechange
makescreen
CASE 24
nameidchange
makescreen
CASE 25
nameidsort
makescreen
CASE 26
namedelete
makescreen
CASE 31
gradesenter
makescreen
CASE 32
gradechange
makescreen
CASE 33
gradeweight
makescreen
CASE 34
gradedelete
makescreen
CASE 35
gradetypechange
makescreen
CASE 41
zscoresoutput "D"
CASE 42
zscoresoutput "S"
CASE 43
zscoresoutput "P"
CASE 51
fudgea
makescreen
CASE 52
fudger
makescreen
CASE 61
commentone
makescreen
CASE 62
commentall
makescreen
CASE 63
commentprint "D"
CASE 64
commentprint "S"
CASE 65
commentprint "P"
CASE 71
autocalc = 0
writeinifile
calculate
makescreen
CASE 72
autocalc = 1
writeinifile
calculate
makescreen
CASE 81
outputbusiness "D"
CASE 82
outputbusiness "P"
CASE 91
helpscreen
CASE 92
setcolor
writeinifile
CASE 93
setsound
writeinifile
CASE 94
hideid
writeinifile
makescreen
CASE 95
mouse
CASE 96
doscommand
CASE ELSE
click
END SELECT
LOOP
END SUB

SUB menutoploop
DO
getkey
menuunhighlight
menuletter
SELECT CASE in$
CASE esc$
sel = 0
EXIT SUB
CASE enter$
EXIT DO
CASE rght$
col = col + LEN(sel$(sel, 0))
sel = sel + 1
IF sel > items THEN sel = 1: col = 1
CASE lft$
col = col - LEN(sel$(sel - 1, 0))
sel = sel - 1
IF sel < 1 THEN sel = items: menufindcol
CASE home$
downset = 0: leftset = 0
mainscreen
CASE pgdn$
downset = downset + 15
IF downset > numstudents + numgrades - 10 THEN
click
downset = numstudents + numgrades - 10
END IF
IF numgrades + numstudents < 15 THEN downset = 0
mainscreen
CASE pgup$
downset = downset - 15
IF downset < 0 THEN click: downset = 0
mainscreen
CASE tab$, plus$
SELECT CASE leftset
CASE 0
leftset = 42
CASE 42
leftset = 84
CASE 84
leftset = 120
CASE 120
click
END SELECT
mainscreen
CASE bksp$, bktab$, minus$
SELECT CASE leftset
CASE 0
click
CASE 42
leftset = 0
CASE 84
leftset = 42
CASE 120
leftset = 84
END SELECT
mainscreen
CASE down$
IF downset > numstudents + numgrades - 10 THEN
click
ELSE downset = downset + 1
END IF
mainscreen
CASE end$
downset = numstudents + numgrades - 10
IF numgrades + numstudents < 15 THEN downset = 0
mainscreen
CASE up$
IF downset < 1 THEN
click
ELSE downset = downset - 1
END IF
mainscreen
CASE ELSE
helpscreen
mainscreen
END SELECT
menuhighlight
LOOP
END SUB

SUB menuunhighlight
LOCATE lin, col
COLOR high, back
PRINT LEFT$(sel$(sel, subsel), 2);
COLOR fore, back
PRINT MID$(sel$(sel, subsel), 3);
END SUB

SUB mouse
LOCATE 2, 1
IF mouseon = 0 THEN
SHELL "AMENU GRADE3 > nul"
mouseon = 1
ELSE mouseon = 0
SHELL "AMENU OFF > nul"
END IF
writeinifile
END SUB

SUB namechange
IF numstudents = 0 THEN openfile
pagehead "NAME ROUTINES"
getname
prompt " Enter NEW NAME or [Esc] to leave the same."
COLOR back, fore
LOCATE 21, 16: PRINT "Enter full new name, LAST NAME FIRST."
LOCATE 22, 16: PRINT "NEW FULL NAME: " + STRING$(20, 254)
LOCATE 22, 31
keyin 20
IF k$ = esc$ OR k$ = "" THEN EXIT SUB
student$(found) = SPACE$(20)
LSET student$(found) = k$
END SUB

SUB namedelete
IF numstudents = 0 THEN openfile
getname
prompt "Hit any key to confirm deletion, or [Esc] to ABORT."
getkey
IF in$ = esc$ THEN EXIT SUB
writedatafile
numstudents = numstudents - 1
OPEN "grade.tmp" FOR OUTPUT AS #1
OPEN datafile$ FOR INPUT AS #2
writeheader
FOR x = 1 TO 3
LINE INPUT #2, l$
NEXT x
FOR x = 1 TO found - 1
LINE INPUT #2, l$
PRINT #1, l$
NEXT x
LINE INPUT #2, l$
WHILE NOT EOF(2)
LINE INPUT #2, l$
PRINT #1, l$
WEND
CLOSE
KILL datafile$
NAME "grade.tmp" AS datafile$
readdatafile
END SUB

SUB nameidchange
IF numstudents = 0 THEN openfile
getname
COLOR back, fore
prompt "Enter NEW ID# or [Esc] to leave the same."
COLOR back, fore
LOCATE 21, 16: PRINT "Enter new ID# or [Return] for #"; LTRIM$(STR$(found))
LOCATE 22, 16: PRINT "NEW ID#: "; STRING$(11, 254)
LOCATE 22, 25
keyin 11
IF k$ = esc$ THEN EXIT SUB
IF k$ = "" THEN k$ = LTRIM$(STR$(found))
id$(found) = SPACE$(11)
LSET id$(found) = k$
END SUB

SUB nameidsort
IF numstudents = 0 THEN openfile
pagehead "NAME ROUTINES"
d$(1) = "Students will be sorted by ID#s. Please note"
d$(2) = "that sort proceeds from left column and treats"
d$(3) = "all input as letters, not numerical values."
dialog 7, "SORT ID#s"
sortroutine 25, 35
END SUB

SUB namesenter
IF k$ = esc$ THEN EXIT SUB
IF datafile$ = "" THEN openfile
pagehead "NAME ROUTINES"
prompt "Hit [Esc] to finish entering names."
NameIn:
s = 0
DO
numstudents = numstudents + 1
d$(1) = "NAME may be up to 20 characters, LAST NAME FIRST."
d$(2) = "NAME for student " + LTRIM$(STR$(numstudents)) + ": " + STRING$(20, 254)
d$(3) = "[Return] automatically enters a numerical sequence."
d$(4) = "ID NUMBER or [Return] for #" + LTRIM$(STR$(numstudents)) + ": " + STRING$(11, 254)
dialog 5, "ENTER NAMES "
IF numstudents < 10 THEN
LOCATE 20, 36
ELSEIF numstudents > 9 AND numstudents < 100 THEN
LOCATE 20, 37
ELSE LOCATE 20, 38
END IF
keyin 20
IF k$ = "" OR k$ = esc$ THEN EXIT DO
student$(numstudents) = SPACE$(20)
LSET student$(numstudents) = k$
IF numstudents < 10 THEN
LOCATE 22, 46
ELSEIF numstudents > 9 AND numstudents < 100 THEN
LOCATE 22, 47
ELSE LOCATE 22, 48
END IF
keyin 11
id$(numstudents) = SPACE$(11)
IF k$ = "" THEN
LSET id$(numstudents) = LTRIM$(STR$(numstudents))
ELSE LSET id$(numstudents) = k$
END IF
LOOP UNTIL numstudents = 200
numstudents = numstudents - 1
END SUB

SUB namesort
IF numstudents = 0 THEN EXIT SUB
pagehead "NAME ROUTINES"
d$(2) = "Student names will be sorted alphabetically"
d$(3) = "by the first 5 letters of the name as entered."
dialog 7, "SORT NAMES"
sortroutine 2, 6
END SUB

SUB numberpad (value)
IF value = 0 THEN 'turns numberpad off
DEF SEG = &H40
POKE &H17, PEEK(&H17) AND 223
ELSEIF value = 1 THEN 'turns numberpad on
DEF SEG = &H40
POKE &H17, PEEK(&H17) OR 32
END IF
END SUB

SUB openfile
IF classname$ <> "" THEN writedatafile
restart
pagehead "OPEN FILE"
getdirectory
getfilename
checkdatafile
readdatafile
END SUB

SUB openingscreen
pagehead "DR. FUNKEY'S COLLEGE GRADE COMPUTATION PROGRAM v3.0"
l$(7) = "This program records and computes grades for up to 200 students."
l$(8) = "It accepts up to 20 grades per student. If you need to exceed"
l$(9) = "these limits, contact the author and I'll customize to suit."
l$(10) = "You may enter either letter grades or number grades on a four"
l$(11) = "point scale or raw scores of any size. Comments are also recorded."
l$(12) = "Grades may be weighted before totals and Z-scores are computed."
l$(16) = " (c) 1989 David A. Wesson "
l$(17) = " 238 South Quaker Lane "
l$(18) = " W. Hartford, CT 06119 "
l$(19) = " 203-523-1873"
l$(21) = " Written for the public domain in QuickBASIC 4.5"
writescreen 10
COLOR high, back
LOCATE 23, 32: PRINT "Hit [H] for HELP."
COLOR fore, back
END SUB

SUB outputbusiness (type$)
outputdirect
IF in$ = esc$ THEN EXIT SUB
p$ = "Please wait, creating output file " + outfile$
prompt p$
OPEN outfile$ FOR OUTPUT AS #1
IF numgrades > 10 THEN
l = 130
s = 13
ELSE l = 79
s = 1
END IF
PRINT #1, STRING$(l, 61)
PRINT #1, course$; SPC(s); term$; SPC(s); teacher$; SPC(s); section$; SPC(s); DATE$
PRINT #1, STRING$(l, 61)
IF ofile$ = "N" THEN
PRINT #1, "NAME";
ELSEIF ofile$ = "I" THEN PRINT #1, "ID #";
END IF
PRINT #1, TAB(13); "GRADE#";
x = 20
FOR a = 1 TO numgrades
PRINT #1, TAB(x); a;
x = x + 5
NEXT a
PRINT #1, TAB(l - 7); "FINAL"
PRINT #1, TAB(13); "TYPE ";
FOR t = 1 TO numgrades
PRINT #1, gradetype$(t); SPC(1);
NEXT t
PRINT #1, ""
PRINT #1, TAB(13); "WEIGHT";
x = 21
FOR g = 1 TO numgrades
PRINT #1, TAB(x);
PRINT #1, strg$(weight(g));
totalweight = totalweight + weight(g)
x = x + 5
NEXT g
PRINT #1, TAB(l - 7);
PRINT #1, strg$(totalweight)
PRINT #1, STRING$(l, 45)
FOR s = 1 TO numstudents
IF ofile$ = "N" THEN
PRINT #1, student$(s);
ELSEIF ofile$ = "I" THEN PRINT #1, id$(s);
END IF
Y = 21
FOR g = 1 TO numgrades
PRINT #1, TAB(Y); strg$(grade(s, g));
Y = Y + 5
NEXT g
PRINT #1, TAB(l - 7); strg$(final(s))
NEXT s
PRINT #1, STRING$(l, 45)
PRINT #1, "TOTAL:"; numstudents; TAB(13); "AVERAGE";
v = 21
FOR g = 1 TO numgrades
PRINT #1, TAB(v); strg$(gradetotal(g) / numstudents);
v = v + 5
NEXT g
PRINT #1, TAB(l - 7); strg$(totalmean)
PRINT #1, STRING$(l, 61)
PRINT #1, ""
PRINT #1, "NUM TYPE WEIGHT DESCRIPTION"
FOR x = 1 TO numgrades
PRINT #1, USING "##"; x;
PRINT #1, SPACE$(2); gradetype$(x); SPACE$(2); strg$(weight(x)); "%"; SPACE$(2); description$(x)
NEXT x
CLOSE
IF type$ = "P" THEN outputprinter
END SUB

SUB outputdirect
pagehead "OUTPUT GRADES"
namefile$ = drive$ + classname$ + ".NAM"
numberfile$ = drive$ + classname$ + ".NUM"
d$(1) = "Select file with NAMES called " + LEFT$(namefile$, 20) + ","
d$(2) = "or file with ID NUMBERS called " + LEFT$(numberfile$, 20) + "."
d$(3) = "Either can be edited and printed at your discretion."
dialog 5, "OUTPUT FILES"
askout:
prompt "Select NAME or ID# ( N or I ): "
LOCATE 25, 57
cursor 1
getkey
cursor 0
totalweight = 0
SELECT CASE in$
CASE esc$
EXIT SUB
CASE "N"
outfile$ = namefile$
ofile$ = "N"
CASE "I"
outfile$ = numberfile$
ofile$ = "I"
CASE ELSE
GOTO askout
END SELECT
END SUB

SUB outputprinter
IF outfile$ = "" THEN EXIT SUB
prompt "Make sure your printer is ON, then hit any key, or [Esc] to EXIT."
getkey
IF in$ = esc$ THEN EXIT SUB
prompt "Hit [Esc] to TERMINATE PRINTING (except what's already in the buffer)."
IF numgrades > 10 AND outfile$ <> zfile$ THEN
WIDTH LPRINT 132
LPRINT compress$
ELSE LPRINT reset$
END IF
OPEN outfile$ FOR INPUT AS #1
LPRINT skip$
DO WHILE NOT EOF(1)
IF INKEY$ = esc$ THEN
LPRINT cancel$
EXIT DO
END IF
LINE INPUT #1, l$
LPRINT l$
LOOP
CLOSE
LPRINT form$
WIDTH LPRINT 80
LPRINT reset$
END SUB

SUB outputscreen
IF numgrades > 10 AND outfile$ <> zfile$ THEN

prompt "Can't display files with more than 10 grades. Hit key to continue."
getkey
EXIT SUB
END IF
COLOR fore, back
CLS
OPEN outfile$ FOR INPUT AS #1
FOR h = 1 TO 7
LINE INPUT #1, l$
PRINT l$
NEXT h
ShowNames:
DO WHILE NOT EOF(1)
FOR l = 8 TO 24
IF EOF(1) THEN EXIT DO
LINE INPUT #1, l$
LOCATE l, 1: PRINT l$;
NEXT l
prompt "Hit any key to continue."
getkey
IF in$ = esc$ THEN EXIT SUB
VIEW PRINT 8 TO 24
CLS
VIEW PRINT
LOOP
CLOSE
prompt "Hit any key to continue."
getkey
END SUB

SUB pagehead (page$)
LOCATE 4, 1
COLOR back, fore
PRINT STRING$(80, 32);
LOCATE 4, 41 - (LEN(page$) / 2)
COLOR high, fore
PRINT page$;
COLOR fore, back
END SUB

SUB prompt (msg$)
LOCATE 25, 1
COLOR back, high
PRINT SPACE$(80);
t = INT((80 - LEN(msg$)) / 2)
LOCATE 25, t: PRINT msg$;
COLOR fore, back
END SUB

SUB qsort (srt$(), srtn(), n, mid)
DIM newsrt$(n), newsrtn(n)
Y = 0: Z = 1
FOR s = 1 TO n
IF srtn(s) > mid THEN
newsrtn(n - Y) = srtn(s)
newsrt$(n - Y) = srt$(s)
Y = Y + 1
ELSE newsrtn(Z) = srtn(s)
newsrt$(Z) = srt$(s)
Z = Z + 1
END IF
NEXT s

Y = Y - 1
Z = Z - 1

FOR t = 1 TO n
srt$(t) = newsrt$(t)
srtn(t) = newsrtn(t)
NEXT t
ERASE newsrt$, newsrtn

COLOR back, fore
LOCATE 25, 65: PRINT "Sorting #";
FOR x = 1 TO Z
FOR w = 1 TO Z - x
IF srtn(x) > srtn(x + w) THEN
SWAP srtn(x), srtn(x + w)
SWAP srt$(x), srt$(x + w)
END IF
NEXT w
LOCATE 25, 74: PRINT x;
NEXT x
FOR x = Y + 1 TO n
FOR v = 1 TO n - x
IF srtn(x) > srtn(x + v) THEN
SWAP srtn(x + v), srtn(x)
SWAP srt$(x + v), srt$(x)
END IF
NEXT v
LOCATE 25, 74: PRINT x;
NEXT x
END SUB

SUB readcommandline
classname$ = UCASE$(COMMAND$)
IF classname$ <> "" THEN
header
openingscreen
checkdatafile
readdatafile
END IF
END SUB

SUB readdatafile
IF datafile$ = "" THEN EXIT SUB
prompt "Please wait, loading student: "
OPEN datafile$ FOR INPUT AS #1
readheader
COLOR back, fore
FOR s = 1 TO numstudents
LOCATE 25, 52: PRINT s;
INPUT #1, student$(s), id$(s)
FOR g = 1 TO numgrades
INPUT #1, grade(s, g)
NEXT g
INPUT #1, Comment$(s)
NEXT s
FOR x = 1 TO numgrades
INPUT #1, description$(x)
NEXT x
CLOSE #1
END SUB

SUB readheader
INPUT #1, course$, teacher$, term$, section$, filedate$, numstudents, numgrades
IF numgrades = 0 THEN
INPUT #1, DUMMY1$
INPUT #1, DUMMY2$
ELSE
FOR k = 1 TO numgrades
INPUT #1, gradetype$(k)
NEXT k
FOR v = 1 TO numgrades
INPUT #1, weight(v)
NEXT v
END IF
END SUB

SUB readinifile
inifile = FREEFILE

OPEN "grade.ini" FOR RANDOM AS inifile
IF LOF(inifile) = 0 THEN
CLOSE inifile
drive$ = ""
id = 1 'sets hide id# to on
freq = 3000 'sets beep frequencey
fore = 7
high = 15
back = 0
autocalc = 1 'sets autocalc to ON
writeinifile
EXIT SUB
END IF
CLOSE inifile
OPEN "grade.ini" FOR INPUT AS inifile
INPUT #inifile, drive$, fore, back, high, freq, id, autocalc, mouseon
CLOSE inifile
END SUB

SUB restart
numstudents = 0
numgrades = 0
absfudge = 0
relfudge = 0
items = 9
students = 201
grades = 20
classname$ = ""
FOR x = 1 TO students
ms$(x) = ""
Comment$(x) = ""
NEXT x
FOR x = 1 TO grades
gradetype$(x) = ""
weight(x) = 0
description$(x) = ""
NEXT x
END SUB

SUB setcolor
prompt "Hit [Return] to reset entry to original setting."
d$(1) = " Enter number for each color selection."
d$(3) = " 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15"
d$(4) = " FOREGROUND: " + STRING$(2, 254) + " BACKGROUND: " + STRING$(2, 254) + " HIGHLIGHT: " + STRING$(2, 254)
dialog 2, "SET COLORS"
LOCATE 20, 13
FOR x = 0 TO 9
COLOR x, 0: PRINT STRING$(3, 254);
NEXT x
FOR x = 10 TO 15
COLOR x, 0: PRINT STRING$(4, 254);
NEXT x
COLOR back, fore
cursor 1
LOCATE 22, 28
keyin 2
fore = VAL(k$)
IF fore = 0 THEN fore = 7
LOCATE 22, 45
keyin 2
back = VAL(k$)
IF back = fore THEN back = 0
LOCATE 22, 61
keyin 2
high = VAL(k$)
IF high = back THEN high = 15
header
mainscreen
END SUB

SUB setnames
esc$ = CHR$(27)
bksp$ = CHR$(8)
tab$ = CHR$(9)
bktab$ = CHR$(0) + CHR$(15)
pgup$ = CHR$(0) + CHR$(73)
plus$ = CHR$(43)
minus$ = CHR$(45)
pgdn$ = CHR$(0) + CHR$(81)
end$ = CHR$(0) + CHR$(79)
enter$ = CHR$(13)
home$ = CHR$(0) + CHR$(71)
up$ = CHR$(0) + CHR$(72)
lft$ = CHR$(0) + CHR$(75)
rght$ = CHR$(0) + CHR$(77)
down$ = CHR$(0) + CHR$(80)
quote$ = CHR$(34)
delimiter$ = CHR$(34) + CHR$(44) + CHR$(34)
EPSONprintercodes:
compress$ = CHR$(27) + CHR$(15) 'printer compress code
reset$ = CHR$(27) + CHR$(64) 'printer cancel compress
skip$ = CHR$(27) + CHR$(78) + CHR$(3) 'printer skip perforation
form$ = CHR$(12) 'printer formfeed
cancel$ = CHR$(24) 'printer cancel buffer
END SUB

SUB setsound
prompt "Enter NUMBER for desired sound frequency of beep."
d$(1) = "Select a sound frequency for the beep."
d$(2) = "HIGH MEDIUM LOW OFF"
d$(3) = " 1 2 3 4"
d$(4) = "NEW FREQUENCY: " + CHR$(254)
dialog 5, "SET SOUND"
LOCATE 22, 31
COLOR back, fore
getfreq:
cursor 1
getkey
cursor 0
SELECT CASE VAL(in$)
CASE 1
freq = 3000
CASE 2
freq = 750
CASE 3
freq = 150
CASE 4
freq = 0
CASE ELSE
GOTO getfreq
END SELECT
PRINT in$
click
COLOR , fore, back
END SUB

SUB setupfile
clearall
IF course$ <> "" THEN
click
prompt "File already exists. Do you want to replace it? ( Y / N ): "
askrep:
cursor 1
getkey
cursor 0
SELECT CASE in$
CASE "Y"
dummy = 1
CASE "N", esc$
in$ = esc$
datafile$ = ""
EXIT SUB
CASE ELSE
GOTO askrep
END SELECT
END IF
pagehead "NEW FILE"
prompt "[BackSpace] to edit [Esc] to EXIT"
COLOR back, fore
LOCATE 6, 6: PRINT STRING$(30, 32); : COLOR high, fore: PRINT "SETUP FILE"; : COLOR back, fore: PRINT STRING$(29, 32);
FOR x = 7 TO 18
LOCATE x, 5: PRINT CHR$(176) + STRING$(69, 32);
NEXT x
LOCATE 19, 5: PRINT STRING$(69, 176);
COLOR back, fore
LOCATE 7, 8: PRINT "COURSE TITLE may be up to 25 characters, but with no quotemarks"
LOCATE 8, 8: PRINT "What is the COURSE TITLE? "; STRING$(25, 254);
LOCATE 8, 34
keyin 25
IF k$ = esc$ THEN EXIT SUB
course$ = LEFT$(k$, 25)
LOCATE 10, 8: PRINT "TEACHER NAME may be up to 15 characters, but with no quotemarks"
LOCATE 11, 8: PRINT "What is the TEACHER'S NAME? "; STRING$(15, 254);
LOCATE 11, 36
keyin 15
IF k$ = esc$ THEN EXIT SUB
teacher$ = LEFT$(k$, 15)
LOCATE 13, 8: PRINT "TERM is the semester and year, ex: FALL 1987"
LOCATE 14, 8: PRINT "What is the TERM? "; STRING$(15, 254);
LOCATE 14, 26
keyin 15
IF k$ = esc$ THEN EXIT SUB
term$ = LEFT$(k$, 20)
LOCATE 16, 8: PRINT "SECTION is any number or name up to 10 characters, ex: 12345"
LOCATE 17, 8: PRINT "What is the SECTION? "; STRING$(10, 254);
LOCATE 17, 29
keyin 10
IF k$ = esc$ THEN EXIT SUB
section$ = LEFT$(k$, 10)
END SUB

SUB sortroutine (leftcol, rightcol)
IF in$ = esc$ THEN EXIT SUB
writedatafile
OPEN datafile$ FOR INPUT AS #1
readheader
prompt "Sorting your file."
FOR w = 1 TO numstudents
LINE INPUT #1, srt$(w)
srtn(w) = 1
FOR x = leftcol TO rightcol
letter$ = MID$(srt$(w), x, 1)
IF letter$ = "-" THEN letter$ = ""
IF letter$ = "" OR letter$ < CHR$(48) OR letter$ > CHR$(90) THEN
srtn(w) = srtn(w)
ELSEIF letter$ > CHR$(47) AND letter$ < CHR$(58) THEN srtn(w) = (srtn(w) * 10) + VAL(letter$)
ELSE srtn(w) = (srtn(w) * 100) + (ASC(letter$) - 64)
END IF
NEXT x
stotal = stotal + srtn(w)
NEXT w
CLOSE
mid = stotal / 2
CALL qsort(srt$(), srtn(), numstudents, mid)
OPEN datafile$ FOR OUTPUT AS #1
prompt "Please wait, saving your file."
writeheader
FOR s = 1 TO numstudents
PRINT #1, srt$(s)
NEXT s
FOR x = 1 TO numgrades
WRITE #1, description$(x)
NEXT x
CLOSE
readdatafile
makescreen
END SUB

FUNCTION strg$ (in)
in$ = LTRIM$(STR$(ABS(in)))
SELECT CASE in
CASE IS = 0
in$ = "0.00"
CASE IS < 0
in$ = "-0" + in$
CASE IS < 1
in$ = "0" + in$
CASE IS > 99
in$ = SPACE$(1) + in$
CASE IS > 999
in$ = RIGHT$(in$, 2)
END SELECT
IF INSTR(in$, ".") = 0 THEN in$ = in$ + "."
st$ = in$ + "00"
strg$ = LEFT$(st$, 4)
END FUNCTION

SUB switchdirectory
pagehead "SWITCH DIRECTORY"
getdirname
getdirectory
prompt "Hit any key to continue."
getkey
END SUB

SUB writedatafile

IF numstudents = 0 THEN EXIT SUB
prompt "Please wait, saving your file."
OPEN datafile$ FOR OUTPUT AS #1
writeheader
FOR s = 1 TO numstudents
PRINT #1, quote$; student$(s); delimiter$; id$(s); quote$; SPACE$(1);
FOR g = 1 TO numgrades
IF grade(s, g) > 4.33 THEN
PRINT #1, USING "####"; grade(s, g);
ELSE PRINT #1, USING "#.##"; grade(s, g);
END IF
PRINT #1, SPACE$(1);
NEXT g
PRINT #1, quote$; Comment$(s); quote$
NEXT s
FOR x = 1 TO numgrades
WRITE #1, description$(x)
NEXT x
CLOSE #1
END SUB

SUB writeheader
WRITE #1, course$, teacher$, term$, section$, DATE$, numstudents, numgrades
IF numgrades = 0 THEN
PRINT #1, "TYPES"
PRINT #1, "WEIGHTS"
ELSE
PRINT #1, quote$;
FOR m = 1 TO numgrades - 1
PRINT #1, gradetype$(m); delimiter$;
NEXT m
PRINT #1, gradetype$(numgrades); quote$; SPACE$(1)
FOR n = 1 TO numgrades
PRINT #1, USING "###.#"; weight(n);
PRINT #1, SPC(2);
NEXT n
PRINT #1, ""
END IF
END SUB

SUB writeinifile
inifile = FREEFILE
OPEN "grade.ini" FOR OUTPUT AS inifile
WRITE #inifile, drive$, fore, back, high, freq, hide, autocalc, mouseon
CLOSE inifile
END SUB

SUB writescreen (indent)
cursor 0
FOR x = 5 TO 24
IF NOT l$(x) = "" THEN
LOCATE x, indent: PRINT l$(x)
l$(x) = ""
END IF
NEXT x
END SUB

SUB zscores
IF numgrades = 0 THEN click: prompt "No grades entered yet. Hit a key.": getkey: in$ = esc$: EXIT SUB
pagehead "COMPUTE Z-SCORES"
d$(2) = "Z-Scores are the distance of individual scores"
d$(3) = "from the mean for the whole class."
dialog 5, "Z-SCORES"
calculate
END SUB

SUB zscoresoutput (zout$)
zscores
IF in$ = esc$ THEN EXIT SUB
cursor 1
prompt "Would you like output sorted by NAME or ZSCORES? ( N / Z ): "
cursor 0
Asknz:
getkey
SELECT CASE in$
CASE "N"
srtz$ = "N"
CASE "Z"
srtz$ = "Z"
CASE ELSE
GOTO Asknz
END SELECT
MakeZfile:
prompt "Please wait, creating Z-Score file."
zfile$ = drive$ + classname$ + ".ZSC"
tempfile$ = drive$ + classname$ + ".TMP"
OPEN zfile$ FOR OUTPUT AS #1
Zoutput:
PRINT #1, STRING$(79, 61)
PRINT #1, STRING$(79, 61)
PRINT #1, STRING$(79, 45)
PRINT #1, course$; SPC(3); term$; SPC(3); teacher$; SPC(3); section$
PRINT #1, STRING$(79, 61)
PRINT #1, "NAME"; TAB(25); "TOTAL GRADE"; TAB(48); "ZSCORE"
PRINT #1, STRING$(79, 45)
FOR s = 1 TO numstudents
PRINT #1, student$(s); TAB(28);
PRINT #1, strg$(final(s));
PRINT #1, TAB(45);
PRINT #1, USING "+#####.##"; zscore(s)
NEXT s
PRINT #1, STRING$(79, 45)
PRINT #1, "CLASS MEAN"; TAB(28);
PRINT #1, strg$(totalmean)
PRINT #1, STRING$(79, 61)
CLOSE
IF srtz$ = "Z" THEN
OPEN zfile$ FOR INPUT AS #1
OPEN tempfile$ FOR OUTPUT AS #2
FOR Z = 1 TO 7
LINE INPUT #1, l$
PRINT #2, l$
NEXT Z
FOR b = 1 TO numstudents
LINE INPUT #1, srt$(b)
srtn(b) = zscore(b)
NEXT b
mid = 0
CALL qsort(srt$(), srtn(), numstudents, mid)
FOR c = 1 TO numstudents
PRINT #2, srt$(c)
NEXT c
FOR d = 1 TO 3
LINE INPUT #1, l$
PRINT #2, l$
NEXT d
CLOSE
KILL zfile$
NAME tempfile$ AS zfile$
END IF
CLOSE
outfile$ = zfile$
IF zout$ = "S" THEN outputscreen
IF zout$ = "P" THEN outputprinter
IF zout$ <> "D" THEN KILL outfile$
END SUB



  3 Responses to “Category : Science and Education
Archive   : GRADE3.ZIP
Filename : GRADE3.BAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/