at Amazon.com.
Keywords: computer source code for study hall cai computer assisted instruction course authoring software instructional software free public domain
This page provides the computer source code for the program STUDY HALL - CAI, version 4.0. Full details about Study Hall are found at http://www.loveallpeople.org/studyhall-cai.html
STUDY HALL is a system for developing and running Computer-Assisted Instruction. It is the least expensive, least complicated, most widely-usable way for you to create and use Computer-Assisted Instruction. STUDY HALL is in the Public Domain, so it is totally free, and there are no licensing fees or copyright legalities to worry about. You only need to learn thirteen control characters to write tutorials. And STUDY HALL should run on any Windows or DOS-compatible system in the world, even minimal ones. STUDY HALL is intended not only for professional educators and course developers, but also for students and hobbyists, such as myself. Even writers of fiction can use STUDY HALL, to create interactive text adventures, where the development of the plot depends on the reader's responses to situations in the story. SOURCE CODE is included, so you can make whatever changes in the program you may desire.Study Hall - CAI was written using Microsoft QuickBasic 4.5 during the period 1989 - 1994. At that time, its usefulness was limited because it is a text-only program, with no built-in capability to run its own photos, graphics, and other non-text files. So it was widely ignored, and I put it away and forgot about it until just recently.
Now, however, we have the Internet and we have Internet Explorer built in to the Windows operating system. And Study Hall contains a very powerful "doscommand" function which can invoke Internet Explorer (or other outside software) to run almost any photo, graphics, music, video, etc. file you could desire. So Study Hall is now much more useful than it was during 1989 - 1994. Same program: much more useful now! And, of course, because it is written for the Microsoft DOS operating system, it runs perfectly well under the Microsoft Windows operating system.
That's why I am re-releasing it now. Free. Public Domain.
The complete Study Hall - CAI release file can be downloaded at any of these three locations:
http://www.patriot.net/users/bmcgin/study40.zip
http://www.loveallpeople.org/study40.zip
Information and download =>
http://www.loveallpeople.org/quickbasic45.html
NOTE: If you have a copy of QuickBasic 4.5 and want to run this source code on it, you need to invoke QuickBasic with this command:
qb45 /ah or qb /ah (The "/ah" is necessary to enable "huge
arrays.")
And you need to have the file AUTH.BMS also residing on the same
directory. AUTH.BMS is included in the Study Hall release file, and you
can download it separately from
http://www.patriot.net/users/bmcgin/AUTH.BMS (The "AUTH" stands for
"authorization," and the "BMS" stands for "Bill McGinnis Software.)
Then you can load the source code file into your QuickBasic 4.5, and
Study Hall should run. All of these, plus the compiled .exe file version
of Study Hall, are included in the release file (download above), along
with several
Study Files to run. To run the Study Hall .exe file under Windows, you
just click on it.
Begin source code . . .
REM mod slightly August 21, 2007 to change URL of home study all home
page
REM study_60.bas begun 6-26-06 to update the texts
REM This file is now in the PUBLIC DOMAIN, free for all to use and
modify.
REM Used QuickBasic 4.5 to write this program.
REM Must invoke as qb45 /ah to enable huge arrays
REM study_56.bas 3-23-94 Eliminate a clrcd problem re doscommand/dir
REM study_55.bas 3-18-94 SUPPRESSED THE Q: ! See line 13220
REM 3-21-94
REM study_54.bas 3-16-94 Trying to solve problem (again) of not being
REM able to avoid screen 1 of an initial invoked study file.
REM
REM study_53.bas 2-2-94, 2-3-94
REM 1-29-94 Have combined into one module now. Have added color.
REM * * * STUDY HALL - Computer-Assisted Instruction * * *
REM Introduction and instructions begin at lines 1000 and 2000, below.
REM study_48.bas 2-25-93 To Be Released as Ver. 3.0 Feb., 1993
REM Fine tuning now for release ASAP
REM Invoke MicroSoft QuickBASIC 4.5 like this: qb/b/ah or this qb/ah
REM The /ah is needed to enable "huge arrays."
REM Please see your QuickBASIC 4.5 (for DOS) manual for details.
REM Written by Bill McGinnis
REM P. O. Box 2543
REM Alexandria, VA 22301
REM U. S. A.
REM This computer program is in the public domain.
REM Please send self-addressed stamped envelope for latest software
catalog.
start: REM target of resume
DEFINT I-L
DECLARE SUB strip (mnat$, stripflag$, doscommand$)
DECLARE SUB browse (d$, a, q, sln(), eln())
DECLARE SUB clrmenu (cplet!)
DECLARE SUB border ()
DECLARE SUB box (Row1!, Col1!, Row2!, Col2!)
DECLARE SUB dblbox (Row1!, Col1!, Row2!, Col2!)
DECLARE SUB loadcolors ()
DECLARE SUB clrcd (c$)
DECLARE SUB centerline (l$)
DECLARE SUB trimnprint (l$, printrow%)
DECLARE SUB box (Row1!, Col1!, Row2!, Col2!)
DECLARE SUB dblbox (Row1!, Col1!, Row2!, Col2!)
DECLARE SUB loadcolors ()
DECLARE SUB clrcd (c$)
DECLARE SUB centerline (l$)
DECLARE SUB trimnprint (l$, printrow%)
COMMON studyfile() AS STRING * 80
COMMON SHARED plet, clr(), openflag$
CLEAR
n% = 1200: REM Twelve hundred lines seems to be about the largest
REM comfortable size for one ASCII text file, to me.
DIM SHARED studyfile(n%) AS STRING * 80
DIM SHARED clr(10, 12)
menuflag$ = "no": REM means have not yet reached the main menu
DEFINT I-K
REM Preliminaries
CLS
LOCATE 1, 1, 1, 0, 7
REM SCREEN 0, 1
REM COLOR 14, 0: REM yellow on black NO! Make it mono for universality
10 ON ERROR GOTO errhandle: REM to error handling
menuflag$ = "no"
DIM s$(22): REM screen array
DIM p$(66): REM array for lines for printed page
DIM Lst(1200): REM line status, re control characters
DIM nm$(200): REM name of screen, squeezed spelling
DIM nma$(200): REM name of screen, natural spelling
DIM tp$(200): REM type of screen , like S, D, Q
DIM sln(200): REM start line for screen, ref to fl$ line numbers
DIM eln(200): REM end line for screen, ref to fl$ line numbers
DIM dpl$(50): DIM dpr$(50): DIM dpc(50): REM DRILL PAIR RIGHT, LEFT,
COUNTER
DIM dps$(50): REM drill pair status: correct, missed, virgin
DIM dpr(51): REM array for random drill pair numbers=dpc NEED 51 to
stay in range
DIM qfl$(200): REM quiz file array
DIM pa$(90): REM authorization file
DIM ch$(80): REM number of characters in a line
DIM bch$(9): REM branch control character bodies, squeezed
DIM bchnat$(9): REM branch control character bodies, natural
bl$ = SPACE$(80)
shellflag = 0
CALL loadcolors
plet = 6
clrcd "a"
GOSUB invokedfile: REM test to see if a Study File was invoked
IF invokedfile$ <> "" THEN
menuflag$ = "yes": REM for error trapping
REM swc = 1: REM for loading a new Study File
jn$ = invokedfile$: REM pass name of file to be loaded
GOSUB 49000: REM load auth file
aa = VAL(pa$(10)): REM last screen studied
sfn$ = pa$(11): REM name of study file last time
GOTO 3130: REM load the invoked Study File
END IF
200 REM
menuflag$ = "no"
FOR i = 1 TO 12
studyfile(i) = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
NEXT i
300 REM
GOTO altitle
FOR j = 1 TO 22: s$(j) = "": NEXT j: REM null out screen array
s$(5) = "STUDY HALL - Computer-Assisted Instruction"
s$(9) = "Bill McGinnis Software"
s$(10) = "P. O. Box 2543"
s$(11) = "Alexandria, VA 22301"
s$(12) = "U. S. A."
s$(15) = "Version 4.0, Released July, 2006"
s$(17) = "See http://www.loveallpeople.org/studyhall-cai.html for
latest information."
s$(20) = "This Computer Program Is Freeware, In The Public Domain"
FOR j = 1 TO 22
IF s$(j) <> "" THEN l$ = s$(j): GOSUB 43610: s$(j) = l$: REM
center text
NEXT j
GOSUB 48100: REM print screen
altitle:
LOCATE 1, 1, 0
CALL border
FOR j% = 1 TO 22: s$(j%) = "": NEXT j%: REM null out screen array
s$(5) = "STUDY HALL - Computer-Assisted Instruction"
s$(9) = "Bill McGinnis Software"
s$(10) = "P. O. Box 2543"
s$(11) = "Alexandria, VA 22301"
s$(12) = "U. S. A."
s$(15) = "Version 4.0, Released July, 2006"
s$(17) = "See http://www.loveallpeople.org/studyhall-cai.html for
latest information."
s$(20) = "This Computer Program Is Freeware, In The Public Domain"
clrcd "a"
REM COLOR clr(plet, 1), clr(plet, 2), clr(plet, 3): REM fora, baka, brdr
FOR j% = 1 TO 22
IF s$(j%) <> "" THEN
l$ = s$(j%)
GOSUB 43610
CALL trimnprint(l$, j%)
END IF
NEXT j%
GOSUB 60010
GOSUB 49000: REM load the file
aa = VAL(pa$(10)): REM last screen studied
sfn$ = pa$(11): REM name of study file last time
CLS
REM Main Menu
905 menuflag$ = "yes": GOTO 42000: REM to main menu. TARGET!
REM Return From Menu At 42000+
910 IF d$ = "1" THEN 6000: REM STUDY!
IF d$ = "A" THEN 1000: REM Introduction
IF d$ = "B" THEN 2000: REM Instructions
IF d$ = "C" THEN 3000: REM Load A Study File
IF d$ = "D" THEN 7000: REM Shell To DOS
IF d$ = "E" THEN CALL clrmenu(plet)
IF d$ = "X" THEN 10000
GOTO 905: REM back to main menu
1000 REM Introduction To STUDY HALL
CLS : LOCATE 1, 1, 0
l$ = "a. Introduction To STUDY HALL": GOSUB 43610: PRINT l$: PRINT
: PRINT
PRINT "STUDY HALL is the least expensive, least complicated, most
widely-"
PRINT "usable way for you to create and use Computer-Assisted
Instruction."
PRINT
PRINT "The STUDY HALL system consists of the Run Module (which is a
computer"
PRINT "program) and one or more Study Files (which are text files).
The Study"
PRINT "Files contain the educational content. Study Files are
loaded into"
PRINT "the Run Module, which processes them and presents them to
the user."
PRINT
PRINT "The Run Module is in the Public Domain, so it is free, and"
PRINT "there are no licensing fees or copyright legalities to worry
about."
PRINT "Study Files may be written by anyone who wants to do so.
Some Study"
PRINT "Files may copyrighted, and some not, depending on their
author."
PRINT
GOSUB 48520
IF d$ = "M" THEN 905
GOTO 905: REM back to main menu
2000 REM choice #2 (subs at 22k, 32k)
CLS : LOCATE 1, 1, 0
l$ = "b. Instructions For Running STUDY HALL"
GOSUB 43610: PRINT l$: PRINT
PRINT "STUDY HALL is a DOS program which runs under the Command
Prompt within"
PRINT "the Windows operating system."
PRINT "First, make sure all of the needed files are on the same
directory."
PRINT "You need these files: study.exe, auth.bms, and any Study
Files you want"
PRINT "to use, particularly the demonstration Study Files named
demo and demo2."
PRINT "Then navigate to that directory in Windows and click on
STUDY."
PRINT "That will launch Study Hall under Windows. Or you can go to
the"
PRINT "Command Prompt, then, type STUDY and press Or you
may"
PRINT "start at the beginning of a particular Study File by
entering"
PRINT "STUDY/filename. You may start at a particular screen within
a Study"
PRINT "File by entering STUDY/filename/screen-name or
STUDY/filename/screen-number."
PRINT "After that, just follow the prompts and menu selections."
PRINT
PRINT "IF YOU WANT TO CREATE YOUR OWN STUDY FILES, please see the
text file named"
PRINT "instr.doc, which contains full instructions, and/or run the
Study File"
PRINT "named tutor. "
PRINT
PRINT "For all the latest information and updates, please see our"
PRINT "website at http://www.StudyHall-CAI.com."
GOSUB 48520
IF QA$ = "m" THEN GOTO 905
GOTO 905: REM back to main menu
3000 REM choice #3 (subs at 23k, 33k)
CLS : LOCATE 1, 1, 0
REM l$ = "c. Load A Study File Into STUDY HALL": GOSUB 43610: PRINT
l$
clrcd "B"
PRINT
PRINT " These are the Study Files on the current directory .
. . "
PRINT "Please type in the exact name of the Study File you want."
PRINT : PRINT
PRINT
clrcd "A"
FILES "*.txt"
PRINT
3060 swc = 0: REM reset switch from <* load xxx *> instruction: rem
target
REM PRINT "NOTE: The demonstration Study File is named demo. If
you merely press"
REM PRINT " the ENTER key, demo will load automatically."
LOCATE 15, 1
clrcd "B"
LOCATE 23, 1: PRINT bl$: LOCATE 23, 1
PRINT "(Or ENTER m for main menu.)"
LOCATE 22, 1: PRINT bl$:
LOCATE 22, 1: LINE INPUT "ENTER the name of the Study File you
want: "; qj$
IF qj$ = "m" THEN GOTO 905
jn$ = qj$
IF jn$ = "" THEN jn$ = "DEMO"
LOCATE 22, 1, 0: PRINT bl$:
CLS
jn$ = UCASE$(jn$)
REM Load Study File From Disk Into Studyfile Array
3130 : REM target!
CLS
clrcd "A"
GOSUB loadscreentoo: REM check to see if "/screename" inside jn$
LOCATE 1, 1, 0: PRINT "This is STUDY HALL - Computer-Assisted
Instruction"
LOCATE 3, 1, 0: PRINT "Status: Loading " + jn$ + ".": REM TARGET of
16320 "load"
LOCATE 5, 1, 0: PRINT "Status: Loading line number . . . ";
ERASE Lst
f$ = jn$: REM name of file is f$
f$ = UCASE$(f$)
nm$(1) = "*": REM set name of first screen to "*" for filetest,
later
OPEN "i", 1, f$: REM f$ is file name, ascii file
openflag$ = "yes"
FOR i = 1 TO 1200
LOCATE 5, 35, 0: PRINT i;
LINE INPUT #1, fl$
studyfile(i) = fl$
IF EOF(1) THEN GOTO 3192
NEXT i
3192 CLOSE 1
openflag$ = "no"
fln = i: REM file length
LOCATE 7, 1: PRINT SPACE$(80): LOCATE 7, 1
PRINT "Status: "; f$; " is loaded into STUDY HALL."
REM Process The Lines
LOCATE 9: PRINT SPACE$(80): LOCATE 9: PRINT "Status: Processing ";
f$; "."
PRINT
c = 1
REM set counter for nm$, nma$, tp$, sln, eln arrays: c is number of
screens
REM Start main loop to process all the lines in studyfile(1200)
FOR i = 1 TO fln: REM file length
fl$ = studyfile(i): REM This appears to be a BASIC case
mismatch,
REM but it isn't. Peculiarity of huge
arrays (?)
REM Filter out some bad files at this point
IF i > 60 AND c < 2 THEN
REM Should have done the first screen by now
PRINT
PRINT "Sorry. " + f$ + " is not a proper Study File."
PRINT "It cannot be processed. Please try again."
GOSUB 60010: REM hit any key
CLEAR
GOTO start
END IF
REM If line is not a null, send it down to 23000 for processing
IF fl$ <> "" THEN
l$ = fl$
GOSUB 23000: REM demark text, categorize
REM above provides l$, which is a text line, not a null
END IF
NEXT i: REM Now have cycled through every line
c = c - 1: REM Reset after extra increment during processing
eln(c) = fln: REM end line of last screen = last line in file
FOR i = 1 TO (c)
IF eln(i) - sln(i) > 20 THEN
PRINT "Status: Too many lines in screen "; nma$(i); ". Please
fix, then try again.":
GOSUB 60010: CLS : CLEAR : GOTO start
END IF
NEXT i
q = c: REM number of screens c gets changed
IF c > 200 THEN
PRINT "Too many screens in Study File - limit 200."
GOSUB 60010
CLEAR
GOTO start
END IF
SWA = 1: REM switch indicates program ready.
FOR j = 1 TO c
nma$(j) = nm$(j)
l$ = nm$(j)
GOSUB 55100: REM squeeze nm$ array
nm$(j) = l$
l = LEN(l$)
tp$(j) = RIGHT$(l$, 1)
NEXT: REM squeeze nm$() and correct the type
LOCATE 11, 1
REM CLS
REM Filetest
REM File OK to use as far as we now know? !!!
IF nm$(1) <> "*" THEN
REM If first screen has obtained a name, file presumed OK here.
PRINT "Status: "; f$; " is loaded properly and ready to use."
ELSE
PRINT
PRINT "Sorry. " + f$ + " is not a proper Study File."
PRINT "It cannot be processed. Please try again."
GOSUB 60010: REM hit any key
CLEAR
GOTO start
END IF
REM drill screen controls, initial settings
CNA$ = "OFF": CNB$ = "0": CNC$ = "ON": CND$ = "LEFT": cne$ = "ALL":
cnf$ = "A"
IF invokedscreenswitch$ <> "yes" THEN GOSUB 48520
IF invokedscreenswitch$ = "yes" THEN GOTO 26511
IF swc = 1 THEN 16340: REM responding to a load branch instruction
IF d$ = "M" THEN 905
GOTO 6000: REM to Study Menu
5200 REM Study File Not In Memory
REM
PRINT : PRINT "Status: There is no Study File presently loaded
into the computer."
PRINT " Please load a Study File (Main Menu, Selection c),
then continue."
GOSUB 48520
IF d$ = "M" THEN 905
5999 GOTO 905: REM back to main menu
6000 REM choice #6 (subs at 26k, 36k)
CLS : LOCATE 1, 1, 0
IF SWA <> 1 THEN
clrcd "B": PRINT : PRINT
PRINT " These are the Study Files Files on the current
directory . . . "
PRINT "Please type in the exact name of the Study File you want."
PRINT : PRINT : clrcd "A"
FILES "*.txt"
PRINT
GOTO 3060
REM if not in memory
END IF
CLS
PRINT : PRINT
clrcd "A"
REM l$ = "1. STUDY!": GOSUB 43610: PRINT l$: PRINT
l$ = "Study Menu": GOSUB 43600
PRINT l$
PRINT
PRINT TAB(15); "1. START STUDYING AT THE BEGINNING OF THE STUDY
FILE"
PRINT TAB(15); "2. START STUDYING AT A PARTICULAR SCREEN"
PRINT TAB(15); "3. RESUME STUDYING AT SCREEN LAST STUDIED"
PRINT TAB(15); "4. LOAD A DIFFERENT STUDY FILE"
PRINT
PRINT TAB(15); "a. Display A Numerical Listing Of Screens"
PRINT TAB(15); "b. Display A Particular Screen"
PRINT TAB(15); "c. Display The Screen Last Studied"
PRINT TAB(15); "d. Browse Through The Screens Sequentially"
PRINT TAB(15); "e. Shell To DOS"
PRINT : PRINT
PRINT TAB(15); "m. Go To Main Menu"
clrcd "B"
LOCATE 23, 1, 1: PRINT " (Select by letter
or number) ";
6205 d$ = INKEY$: d$ = UCASE$(d$)
IF d$ = "" THEN GOTO 6205
CLS : LOCATE 1, 1, 0
clrcd "A"
IF d$ = "A" THEN GOTO 26100
IF d$ = "B" THEN GOTO 26200
IF d$ = "C" THEN GOTO 26700
IF d$ = "D" THEN GOTO 26300
IF d$ = "1" THEN GOTO 26400
IF d$ = "2" THEN GOTO 26500
IF d$ = "3" THEN GOTO 26600
IF d$ = "4" THEN GOTO 3000
IF d$ = "M" THEN GOTO 905
IF d$ = "E" THEN GOTO 26800
GOTO 6000
GOSUB 48520
IF d$ = "M" THEN 905
GOTO 905: REM back to main menu
7000 REM choice #7 Shell To DOS from main menu
COLOR 7, 0, 0
CLS
PRINT "Type EXIT to return to STUDY HALL."
shellflag = 1
SHELL
shellflag = 0
LOCATE 1, 1, 1, 0, 7
clrcd "A"
GOTO 905: REM back to main menu
8000 REM choice #6 (subs at 28k, 38k)
GOTO 905: REM back to main menu
9000 REM choice #9 (subs at 29k, 39k)
GOTO 905: REM back to main menu
10000 REM choice #10 ( subs at 30k, 40k)
CLS
l$ = "x. Exit": GOSUB 43610
PRINT l$: PRINT : PRINT : PRINT
PRINT " Thank you for using STUDY HALL - Computer-Assisted
Instruction."
PRINT : PRINT
PRINT " "
clrcd "B"
LOCATE 20, 1, 1: PRINT "Are you sure you want to Exit now (y/n)?
";
10040 d$ = INKEY$: d$ = UCASE$(d$): IF d$ = "" THEN 10040
clrcd "A"
LOCATE 1, 1, 0
IF d$ = "Y" THEN 10050
IF d$ <> "Y" THEN 905
10050 fullexit$ = "yes"
GOTO exitroutine
GOTO 905: REM back to main menu
11000 REM study screen type "R" GETS HERE ONLY FROM 26522
IF tp$(a) <> "R" THEN CLS : PRINT "Status: Screen type not R":
GOTO 11020
CLS
aa = a: sfn$ = jn$: REM screen last studied, also make it keep
track
FOR j = (sln(a)) + 1 TO eln(a)
IF Lst(j) <> 1 THEN
fl$ = studyfile(j)
PRINT fl$
END IF
NEXT
11020 GOSUB 55250
IF d$ = "M" THEN 905
IF d$ = "S" THEN 6000
GOTO 26532: REM read control character from bottom of screen
GOTO 6000
12000 REM study screen type "D" GETS HERE ONLY FROM 26524
GOTO 12900: REM to Drill into/menu
REM drill screen educational content consists of paired groups of
words, separated by /, like cow/mammal. Call these drill pairs, a
left side and a right side.
12020 REM start drill
CLS : PRINT "Status: Processing . . . "
aa = a: sfn$ = jn$: REM SCREEN LAST STUDIED
lastdrillscreen = a
lastfilename$ = sfn$
ERASE dpr$: ERASE dpl$
dpc = 0: REM drill pair counter
FOR i = sln(a) TO eln(a)
l$ = studyfile(i)
IF (Lst(i) <> 1) AND (fl$ <> "") THEN GOSUB 12150
NEXT i
GOTO 12700: REM do the drill
12150 REM find /
FOR j = 1 TO LEN(l$)
IF MID$(l$, j, 1) = "/" THEN GOSUB 12200
NEXT j
RETURN
12200 REM receives l$ with slash at j to be examined for pairs
ln = LEN(l$): k = j: REM location of / in l$
12215 REM: here find right boundary of pair (end of line or " ")
IF k > ln THEN 12230: REM right end of line
IF MID$(l$, k, 2) <> " " THEN k = k + 1: GOTO 12215
12230 dpr$ = MID$(l$, j + 1, (k - j))
ln = LEN(dpr$): IF RIGHT$(dpr$, 1) = " " THEN dpr$ = LEFT$(dpr$,
ln - 1)
REM: STOP
k = j: REM reset; j is position of / within l$
12245 IF k = 1 THEN 12260: REM bumped left margin of l$
IF k - 2 < 1 THEN k = 1: GOTO 12260
IF MID$(l$, k - 2, 2) <> " " THEN k = k - 1: GOTO 12245
12260 dpl$ = MID$(l$, k, j - k): REM cast in stone
ln = LEN(dpl$): IF LEFT$(dpl$, 1) = " " THEN dpl$ = RIGHT$(dpl$,
ln - 1)
REM: STOP
dpc = dpc + 1: dpl$(dpc) = dpl$: dpr$(dpc) = dpr$
IF dpc > 50 THEN
PRINT "Too many drill pairs - limit is 50."
GOSUB 60010
CLEAR
GOTO start
END IF
RETURN
12300 REM drill screen controls
CLS : LOCATE 1, 1, 0
l$ = "Drill Screen Controls": GOSUB 43600: PRINT l$: PRINT
PRINT " 1. TIMER - Do you want timer ON or OFF (ON/OFF)?"
PRINT " (Present setting is . . . "; CNA$; ".)"
PRINT " 2. AMOUNT OF TIME - If timer is on, how many seconds do
you want for each drill pair?"
PRINT " (Present setting is . . . "; CNB$; " seconds.)"
IF CNA$ = "OFF" THEN LOCATE 7, 50: PRINT "(Timer is OFF.)"
PRINT " 3. SCOREKEEPER - Do you want scorekeeper ON or OFF
(ON/OFF)?"
PRINT " (Present setting is . . . "; CNC$; ".)"
PRINT " 4. FIRST SIDE - Do you want the left side of the drill
pair to"
PRINT " be shown first, or the right (LEFT/RIGHT)?"
PRINT " (Present setting is . . . "; CND$; " side first.)"
PRINT " 5. INCLUSION - Do you want to include all drill pairs, or
only the "
PRINT " ones you missed on your last attempt (ALL/MISSED)?"
PRINT " (Present setting is . . . "; cne$; ".)"
PRINT " 6. ORDER - Do you want the drill pairs to be presented
randomly, or in"
PRINT " ascending order, or in descending order (R/A/D)?"
PRINT " (Present setting is . . . "; cnf$; ".)"
LOCATE 21, 1, 0: PRINT bl$; : LOCATE 21, 1, 1: PRINT "For changes,
select by number";
LOCATE 22, 1: PRINT "Or hit m (Main Menu) or s (Study Menu)"
LOCATE 23, 1, 1: PRINT "Or hit c or to continue without
change . . . ";
12355 k$ = INKEY$: k$ = UCASE$(k$): IF k$ = "" THEN 12355
LOCATE 1, 1, 0
IF VAL(k$) > 0 AND VAL(k$) < 7 THEN LOCATE 21, 1: PRINT bl$; :
LOCATE 21, 1: PRINT bl$;
IF k$ = "1" THEN LOCATE 20: LINE INPUT "Setting 1 should be . . .
"; CNA$
CNA$ = UCASE$(CNA$): IF CNA$ <> "ON" THEN CNA$ = "OFF"
IF k$ = "2" THEN LOCATE 20: LINE INPUT "Setting 2 should be . . .
"; CNB$
IF CNA$ = "OFF" THEN CNB$ = "0"
IF k$ = "3" THEN LOCATE 20: LINE INPUT "Setting 3 should be . . .
"; CNC$
CNC$ = UCASE$(CNC$): IF CNC$ <> "OFF" THEN CNC$ = "ON"
IF k$ = "4" THEN LOCATE 20: LINE INPUT "Setting 4 should be . . .
"; CND$
CND$ = UCASE$(CND$): IF CND$ <> "RIGHT" THEN CND$ = "LEFT"
IF k$ = "5" THEN LOCATE 20: LINE INPUT "Setting 5 should be . . .
"; cne$
cne$ = UCASE$(cne$): IF cne$ <> "MISSED" THEN cne$ = "ALL"
IF k$ = "6" THEN LOCATE 20: LINE INPUT "Setting 6 should be . . .
"; cnf$
cnf$ = UCASE$(cnf$)
IF cnf$ = "R" THEN cnf$ = cnf$: GOTO 12386
IF cnf$ = "D" THEN cnf$ = cnf$: GOTO 12386
IF cnf$ = "A" THEN cnf$ = cnf$: GOTO 12386
cnf$ = "A"
12386 REM target
IF k$ = "M" THEN 905
IF k$ = "S" THEN 6000
IF k$ = "C" THEN GOTO 12930
IF k$ = CHR$(27) THEN GOTO 12930
GOTO 12300: REM to drill screen controls
12600 REM subroutine for computing score of drill screens
IF CNC$ = "ON" THEN PRINT " Score is "; PAC; " out of ";
PAT; ", or "; sco$; " percent correct."
RETURN
12700 REM do the drill
k = 0: REM initialize counter for random drill pairs
IF cnf$ = "A" THEN DPN = 0: REM ascending order
IF cnf$ = "D" THEN DPN = dpc + 1: REM descending order
12710 REM order of presentation TARGET of 12720-, 12730-, 12740-
IF cnf$ = "R" THEN GOTO 12720: REM random order generator
IF cnf$ = "A" THEN GOTO 12730: REM ascending order generator
IF cnf$ = "D" THEN GOTO 12740: REM descending order generator
GOTO 905: REM should not ever get here
12720 CLS : PRINT "Status: Computing . . . ": REM random selection.
Create array dpr(dpc) containing mutually exclusisive/exhaustive random
number from 1 to dpc
dpr(1) = 1 + INT(dpc * RND): REM set first item without opposition
FOR i = 2 TO dpc: dpr(i) = 1 + INT(dpc * RND)
12723 FOR j = 1 TO i - 1
IF dpr(j) = dpr(i) THEN dpr(i) = 1 + INT(dpc * RND): GOTO 12723
NEXT j: NEXT i
12726 k = k + 1: DPN = dpr(k): REM TARGET!
IF k > dpc THEN
CLS
PRINT "Status: Drill is over."
GOSUB 12600: GOSUB 60450: IF d$ = "Y" THEN 12900
END IF
IF k > dpc THEN GOTO 26532: REM get control character from bottom
of screen
GOTO 12750: REM provide random drill pair number
12730 REM generate dpn (drill pair number) ascending 1 to dpc
DPN = DPN + 1
IF DPN > dpc THEN CLS : PRINT "Status: Drill is over.": GOSUB
12600: GOSUB 60450: IF d$ = "Y" THEN 12900
IF DPN > dpc THEN GOTO 26532: REM get control character from
bottom of screen
GOTO 12750: REM provide ascending drill pair number
12740 REM generate dpn (drill pair number) descending dpc to 1
DPN = DPN - 1
IF DPN < 1 THEN CLS : PRINT "Status: Drill is over.": GOSUB
12600: GOSUB 60450: IF d$ = "Y" THEN 12900
IF DPN < 1 THEN GOTO 26532: REM get control character from bottom
of screen
GOTO 12750: REM provide descending drill pair number
12750 REM receive dpn, drill pair number
PRINT DPN
IF cne$ = "ALL" THEN GOTO 12770
IF (cne$ = "MISSED") AND (dps$(DPN) = "M") THEN GOTO 12770
IF cnf$ = "R" THEN GOTO 12726: REM get next random drill pair, try
it
GOTO 12710: REM get next "A" or "D" drill pair, try it
12770 REM TARGET! At this point the drill pair is included in this pass
REM ,now determine which side goes first
IF CND$ = "LEFT" THEN STM$ = dpl$(DPN): rsp$ = dpr$(DPN): GOTO
12780
IF CND$ = "RIGHT" THEN STM$ = dpr$(DPN): rsp$ = dpl$(DPN): GOTO
12780
CLS : PRINT "Error regarding which side of the drill pair comes
first.": GOSUB 60010: GOTO 905
12780 REM TARGET now have stm$ and rsp$
REM PRINT STM$: PRINT RSP$: STOP
CLS
LOCATE 1: PRINT "Status: Drill in Progress, Study File named ";
jn$; "."
PRINT "Working on screen number "; a; ", named "; nma$(a); ",
drill pair number "; DPN; "."
p = 1: REM initialize drill pair counter, p
l$ = "* * * * * DRILL * * * * *": GOSUB 43600: LOCATE 7:
PRINT l$
LOCATE 10
PRINT " Stimulus is . . . "; STM$
TMA = TIMER: REM get start time
LOCATE 12, 1
LINE INPUT " ENTER your response . . . "; rsa$
TMB = TIMER: REM after
IF ((TMB - TMA) > VAL(CNB$) AND (CNA$ = "on")) THEN BEEP: LOCATE
13, 1: PRINT "TOO MUCH TIME!";
LOCATE 14
PRINT " Correct response is . . . "; rsp$
ln$ = rsp$: GOSUB 60400: rsp$ = lna$: REM compress rsp$
ln$ = rsa$: GOSUB 60400: rsa$ = lna$: REM compress rsa$, correct
response
rsp$ = UCASE$(rsp$): rsa$ = UCASE$(rsa$): REM compare all caps
IF rsp$ = rsa$ THEN LOCATE 16: PRINT " RIGHT!": dps$(DPN) =
"C"
IF rsp$ <> rsa$ THEN LOCATE 16: PRINT " WRONG!": dps$(DPN) =
"M"
PAT = PAT + 1: REM increment drill pairs attempted
IF dps$(DPN) = "C" THEN PAC = PAC + 1: REM increment pairs
attempted correct
sco = PAC / PAT: sco = sco * 100: sco$ = STR$(INT(sco)): IF sco -
INT(sco) > .5 THEN sco = INT(sco) + 1: sco$ = STR$(sco)
p = p + 1: REM increment pair counter
IF p > dpc THEN CLS : PRINT "Status: Drill is over. You scored
correct"
IF p > dpc THEN PRINT " on"; NC: REM need to compute score
GOSUB 55300: IF d$ = "M" THEN 905
IF d$ = "S" THEN 6000
IF d$ = "D" THEN 12930
IF d$ = "C" THEN 12300: REM drill screen controls
IF cnf$ = "R" THEN GOTO 12726: REM next random drill pair
GOTO 12710: REM next "A" or "D" drill pair
GOTO 905
12900 REM Routine For Intro To Drill Screen
sfn$ = jn$
PAT = 0: REM pairs attempted, total
PAC = 0: REM pairs attempted, correct
aa = a: REM screen last studied
IF a <> lastdrillscreen THEN dpc = 0
IF lastfilename$ <> sfn$ THEN dpc = 0
CLS
GOTO 12930
CLS : PRINT "Status: You have arrived at a Drill Screen. Please
make your"
PRINT " selection from the Drill Screen Menu, coming up
next.":
GOSUB 55250
IF d$ = "M" THEN 905
IF d$ = "S" THEN 6000
12930 REM Drill Screen Menu
CLS
PRINT : PRINT : PRINT : PRINT
l$ = "Drill Screen Menu": GOSUB 43610: PRINT l$: PRINT
PRINT TAB(15); "1. Display The Drill Screen You Are Now On"
PRINT TAB(15); "2. Display Or Change Drill Screen Controls"
PRINT TAB(15); "3. Begin The Drill"
PRINT TAB(15); "4. Skip This Drill And Go On To Next Screen"
PRINT : PRINT
PRINT TAB(15); "m. Go To Main Menu"
PRINT TAB(15); "s. Go To Study Menu"
LOCATE 23, 1, 1: PRINT " (Select by letter
or number) ";
12981 d$ = INKEY$: d$ = UCASE$(d$)
IF d$ = "" THEN GOTO 12981
LOCATE 1, 1, 0
IF d$ = "1" THEN GOTO 60470
IF d$ = "2" THEN 12300
IF d$ = "3" AND dpc > 0 THEN 12700: REM already loaded drill pairs
IF d$ = "3" THEN 12020
IF d$ = "4" THEN a = a + 1: GOTO 26520
IF d$ = "S" THEN 6000
IF d$ = "M" THEN 905
GOTO 12930: REM Drill Screen Menu
13000 REM Quiz screens GETS HERE ONLY FROM 26526
REM Initialize
tempa = a: REM set up to load lines into qfl$(200)
aa = a: REM aa is screen last studied, stored in pa$(10) for auth
l$ = "": la$ = "": REM l$ is working storage for a line
REM la$ is w/s for a line squeezed
ERASE qfl$
qlc = 0: REM initialize quiz line counter
QC = 0: REM initialize question counter
QAT = 0: qac = 0: REM questions attempted, questions correct
CLS
REM Load Quiz Screen(s) into qfl$(200)
m = 0: REM m is counter for lines within qfl$
sfn$ = jn$: REM sfn$ is file last studied, saved in pa$(11) for
auth
REM jn$ is study file presently in the computer
13105 FOR i = sln(tempa) TO eln(tempa): REM TARGET from 13125+ only
m = m + 1: qfl$(m) = studyfile(i): REM load lines into qfl$(m)
NEXT i: REM qfl$(200) same as the random file for the lines
involved
REM Now all the lines from the current screen have been copied
REM into qfl$(200), the quiz file line array
REM Now see if last line of the current screen had Q-LINK
character
la$ = "": l$ = qfl$(m)
FOR j = 1 TO LEN(l$)
IF MID$(l$, j, 1) <> " " THEN la$ = la$ + MID$(l$, j, 1)
NEXT j: REM la$ now equals l$, but squeezed
l$ = la$
REM If last line in the current screen was a Q-LINK, then go back
and
REM get the next screen, too
IF l$ = "<*Q-link*>" THEN
tempa = tempa + 1: REM increment number of current screen
GOTO 13105: REM go get contents of next screen, which should be
REM a quiz screen, linked to previous one
END IF
REM <*Q-link*> must be on last line of its screen (squeezed or
not)
13200 REM Present Questions, One By One
CLS
REM Beginning of question is Q: Beginning of correct answer is A:
REM PRINT " (Screen or screens
ending at number ";A;")": PRINT
13205 qlc = qlc + 1: REM increment line counter
FOR j = 1 TO 15: IF MID$(qfl$(qlc), j, 2) = "Q:" THEN GOTO 13300
NEXT j
FOR j = 1 TO 15: IF MID$(qfl$(qlc), j, 2) = "A:" THEN GOTO 13400
NEXT j
13220 REM TARGET! sw(4) is on, means ok to print the line
REM 3-18-94 Trying to suppress Q:
IF SW(4) = 1 THEN
tstl$ = qfl$(qlc)
IF LEFT$(tstl$, 2) = "Q:" THEN
tstl$ = RIGHT$(tstl$, (LEN(tstl$) - 2))
tstl$ = tstl$ + " "
END IF
PRINT tstl$
END IF
REM PRINT qfl$(qlc) - from earlier, without tstl$
IF qlc = m THEN GOTO 13600: REM all lines are executed
GOTO 13205: REM do next line of question
13300 REM have encountered a question . Turn on switch
SW(4) = 1: REM switch is on
GOTO 13220
13400 REM TARGET! "A" Has Been Encountered
SW(4) = 0: REM turn switch off
GOTO 13500: REM A: has been encountered
13500 REM TARGET! go here after a question is presented and A:
encountered
PRINT
LINE INPUT "ENTER your answer . . . "; ans$
ln$ = ans$
GOSUB 60400
ans$ = lna$
GOSUB 13540: REM answer is compressed
REM ans$ = UCASE$(ans$): cans$ = UCASE$(cans$)
IF cans$ = "?" THEN
rsl$ = "No correct answer. Matter of choice."
GOTO 13512: REM untimately to bottom of quiz screen routine
END IF
IF UCASE$(ans$) = UCASE$(cans$) THEN
rsl$ = "Your answer is RIGHT!"
qac = qac + 1: REM increment correct counter
END IF
IF UCASE$(ans$) <> UCASE$(cans$) THEN
rsl$ = "Sorry. Your answer is wrong."
END IF
QAT = QAT + 1: REM increment question counter
sco = qac / QAT: sco = sco * 100: sco$ = STR$(INT(sco)): IF sco -
INT(sco) > .5 THEN sco = INT(sco) + 1: sco$ = STR$(sco): IF can$ = "?"
THEN GOTO 13512
LOCATE 19, 1: PRINT rsl$; : REM result string
LOCATE 20, 1: PRINT "Correct answer is . . . "; a$;
LOCATE 21, 1: PRINT "Cumulative score is "; qac; " correct out of
"; QAT; ", or "; sco$; " percent.";
13512 GOSUB 13700: REM bottom of quiz screen routine TARGET
IF d$ = "M" THEN 905
IF d$ = "S" THEN 6000
REM Go back and get another question
GOTO 13200: REM get another question
13540 REM sub to create cans$ (correct answer) from qfl$(qlc)
cans$ = qfl$(qlc): REM move correct answer line into can$
13542 l = LEN(cans$): IF LEFT$(cans$, 1) = " " THEN cans$ =
RIGHT$(cans$, l - 1): GOTO 13542: REM eliminatespaces before the "A:"
l = LEN(cans$): cans$ = RIGHT$(cans$, l - 2): REM eliminates "A:"
13545 l = LEN(cans$): IF LEFT$(cans$, 1) = " " THEN cans$ =
RIGHT$(cans$, l - 1): GOTO 13545: REM eliminates left spaces in the
correct answer
13546 l = LEN(cans$): IF RIGHT$(cans$, 10) = " " THEN cans$ =
LEFT$(cans$, l - 10): GOTO 13546
13547 l = LEN(cans$): IF RIGHT$(cans$, 1) = " " THEN cans$ =
LEFT$(cans$, l - 1): GOTO 13547
a$ = cans$: ln$ = cans$: GOSUB 60400: cans$ = lna$: REM compress
cans$
RETURN: REM to 13502 should have can$ compressed
13600 CLS : GOTO 13900: REM TARGET!
13700 REM Footer for quiz screens SUBROUTINE from 13512
clrcd "B"
LOCATE 23, 1, 1: PRINT " Hit m (main menu) or s (study menu) or
any other key to continue . . .";
13720 d$ = INKEY$: d$ = UCASE$(d$): IF d$ = "" THEN 13720
clrcd "A"
LOCATE 1, 1, 0
RETURN: REM TO 13512
13900 REM After Q screen work is done, continue on according to branch
instructions
a = tempa: REM restore a to its current value now that q-links are
done
aa = a: REM likewise
GOTO 26532: REM obtain & execute branch instructions
GOSUB 60010
GOTO 6000
16000 REM interpret branch character beginning with goto
REM comes from 26579 receives M$, sends a$ to 26511
ca$ = LEFT$(m$, 4): l = LEN(m$): cb$ = RIGHT$(m$, (l - 4)): REM
STOP
a$ = cb$: a = 0
GOTO 26511: REM need to set a=0 or else keeps prior value
16100 REM interpret branch character beginning with if
REM comes from 26580 receives m$, sends a$ to 26511 if usable
REM Else, goto 26577 to get next char.
REM the m$ has already been squeezed, no spaces remaining
ca$ = LEFT$(m$, 2): REM ca$= if (previously determined)
IF UCASE$(MID$(m$, 3, 6)) = UCASE$("answer") THEN
cb$ = "answer"
GOTO 16125
END IF
IF UCASE$(MID$(m$, 3, 5)) = UCASE$("score") THEN
cb$ = "score"
GOTO 16135
END IF
CLS : GOTO 55200: REM improper control character: rem should not
get here
16125 IF UCASE$(MID$(m$, 9, 5)) = UCASE$("isnot") THEN
cc$ = "isnot"
l = LEN(m$)
m$ = RIGHT$(m$, (l - 13))
GOTO 16150
END IF
IF UCASE$(MID$(m$, 9, 2)) = UCASE$("is") THEN
cc$ = "is"
l = LEN(m$)
m$ = RIGHT$(m$, (l - 10))
GOTO 16150
END IF
GOTO 55200: REM bad control character
16135 IF UCASE$(MID$(m$, 8, 13)) = UCASE$("isgreaterthan") THEN
cc$ = "isgreaterthan"
l = LEN(m$)
m$ = RIGHT$(m$, (l - 20))
GOTO 16150
END IF
IF UCASE$(MID$(m$, 8, 10)) = UCASE$("islessthan") THEN
cc$ = "islessthan"
l = LEN(m$)
m$ = RIGHT$(m$, (l - 17))
GOTO 16150
END IF
GOTO 55200: REM Should not get here
16150 REM TARGET for 16125 & 16130 & others
l = LEN(m$): REM after the ca$, cb$,cc$ already removed
FOR i = 1 TO l
IF UCASE$(MID$(m$, i, 4)) = UCASE$("then") THEN
cd$ = LEFT$(m$, (i - 1))
ce$ = "then": REM get right side of test condition
END IF
NEXT i
FOR i = 1 TO l
IF UCASE$(MID$(m$, i, 4)) = UCASE$("goto") THEN
cf$ = "goto"
GOTO 16200
END IF
IF UCASE$(MID$(m$, i, 4)) = UCASE$("quit") THEN
cf$ = "quit"
GOTO 16200
END IF
IF UCASE$(MID$(m$, i, 4)) = UCASE$("exit") THEN
cf$ = "exit"
GOTO 16200
END IF
IF UCASE$(MID$(m$, i, 4)) = UCASE$("load") THEN
cf$ = "load"
GOTO 16200
END IF
REM HERE CAN GO OTHER ACTIONS IN LATER VERSION, LIKE TURNING ON
VCR'S
IF UCASE$(MID$(m$, i, 10)) = UCASE$("doscommand") THEN
cf$ = "doscommand"
GOTO 16200
END IF
NEXT i
GOTO 55200: REM improper control character
16200 REM TARGET Here goes action after test conditions in brnch cntrl
offset = LEN(cd$) + LEN(ce$) + LEN(cf$): REM right
cg$ = RIGHT$(m$, (l - offset))
REM PRINT CA$; " "; CB$; " "; CC$; " "; CD$; " "; CE$; " "; CF$; "
"; CG$: REM STOP
REM STOP: REM now we have all the values broken apart
IF cc$ = "is" THEN 16250
IF cc$ = "isnot" THEN 16260
IF cc$ = "islessthan" THEN 16270
IF cc$ = "isgreaterthan" THEN 16280
GOTO 55200: REM improper control character
16250 IF UCASE$(ans$) = UCASE$(cd$) AND cf$ = "quit" THEN GOTO 905
IF UCASE$(ans$) = UCASE$(cd$) AND cf$ = "exit" THEN GOTO
exitroutine
IF UCASE$(ans$) = UCASE$(cd$) AND cf$ = "doscommand" THEN
doscommand$ = cg$: CLS : GOTO 16500: REM execute shell
END IF
IF UCASE$(ans$) = UCASE$(cd$) AND cf$ = "load" THEN jn$ = cg$: CLS
: GOTO 3130: REM load
IF UCASE$(ans$) = UCASE$(cd$) THEN a$ = cg$: a = 0: GOTO 26511:
ELSE 26577
16260 IF UCASE$(ans$) <> UCASE$(cd$) AND cf$ = "quit" THEN GOTO 905
IF UCASE$(ans$) <> UCASE$(cd$) AND cf$ = "exit" THEN GOTO
exitroutine
IF UCASE$(ans$) <> UCASE$(cd$) AND cf$ = "doscommand" THEN
doscommand$ = cg$: CLS : GOTO 16500: REM shell
END IF
IF UCASE$(ans$) <> UCASE$(cd$) AND cf$ = "load" THEN jn$ = cg$:
CLS : GOTO 3130: REM load
IF UCASE$(ans$) <> UCASE$(cd$) THEN a$ = cg$: a = 0: GOTO 26511:
ELSE 26577
16270 IF VAL(sco$) < VAL(cd$) AND cf$ = "quit" THEN GOTO 905
IF VAL(sco$) < VAL(cd$) AND cf$ = "exit" THEN GOTO exitroutine
IF VAL(sco$) < VAL(cd$) AND cf$ = "doscommand" THEN
doscommand$ = cg$: CLS : GOTO 16500: REM shell
END IF
IF VAL(sco$) < VAL(cd$) AND cf$ = "load" THEN jn$ = cg$: CLS :
GOTO 3130: REM load
IF VAL(sco$) < VAL(cd$) THEN a$ = cg$: a = 0: GOTO 26511: ELSE
26577
16280 IF VAL(sco$) > VAL(cd$) AND cf$ = "quit" THEN GOTO 905
IF VAL(sco$) > VAL(cd$) AND cf$ = "exit" THEN GOTO exitroutine
IF VAL(sco$) > VAL(cd$) AND cf$ = "doscommand" THEN
doscommand$ = cg$: CLS : GOTO 16500: REM shell
END IF
IF VAL(sco$) > VAL(cd$) AND cf$ = "load" THEN jn$ = cg$: CLS :
GOTO 3130: REM
IF VAL(sco$) > VAL(cd$) THEN a$ = cg$: a = 0: GOTO 26511: ELSE
26577
GOTO 55200: REM improper control character
16300 REM interprets unconditional branch character beginning with load
REM conditional is executed at
REM receives m$, the branch control character
ca$ = LEFT$(m$, 4): REM =load
l = LEN(m$)
cb$ = RIGHT$(m$, l - 4): REM name of file to be loaded
swc = 1: REM switch for loading new file
jn$ = cb$: GOTO 3130: REM load the specified new file
16340 REM returning from new file being loaded
a = 1: GOTO 26520: REM start studying at screen 1
16400 REM TARGET! interprets unconditional branch character
REM beginning with doscommand
REM similar to 16300+
REM receives m$, the branch control character which is bch$(k)
REM from 26582. Also has mnat$, the unsqueezed version
stripflag$ = "": REM check for errors
CALL strip(mnat$, stripflag$, doscommand$)
IF stripflag$ = "error" THEN GOTO striperror
shellflag = 1: REM for errhandle
SHELL doscommand$
shellflag = 0
LOCATE 1, 1, 1, 0, 7
a = a + 1: REM increment screen number
GOSUB 60010
GOTO 26520: REM start studying at screen a, which is the screen
REM following the one from which doscommand was issued
GOTO 6000: REM when all else fails
16500 REM Target! Execute conditional shell commands
REM uses mnat$, then strips off left part, leaving the dos command
stripflag$ = ""
CALL strip(mnat$, stripflag$, doscommand$)
IF stripflag$ = "error" THEN GOTO striperror
shellflag = 1
SHELL doscommand$
shellflag = 0
REM COLOR 14, 0
LOCATE 1, 1, 1, 0, 7
a = a + 1
GOSUB 60010
clrcd "a": REM 3-23-94
GOTO 26520: REM start studying at screen a, the next screen
GOTO 6000
23000 REM receives l$ from 3000 block. NOTE: goes through every line!
REM demark text, categorize
REM identify first control character in each line
FOR j = 1 TO 1
REM screen identification control character
IF MID$(l$, j, 2) = "<<" THEN GOSUB 33200
REM branch control character
IF MID$(l$, j, 2) = "<*" THEN Lst(i) = 1
NEXT j
RETURN: REM to 3000 block
REM Instructions For Drill
CLS
l$ = "Instructions For Drill Screens": GOSUB 43610: PRINT l$:
PRINT
PRINT
GOSUB 60010: REM hit any key
GOTO 12930: REM to drill screen menu
26100 REM Display an index of screen
CLS
REM L$="1. STUDY!": GOSUB 43610: PRINT L$: PRINT
REM L$="a. Display A Numerical Listing Of Screens": GOSUB 43610:
PRINT L$: PRINT
setilimits:
ilolim = 1
ihilim = 15
printilimits:
CLS
l$ = "Numerical Listing Of Screens In Study File " + f$: GOSUB
43610
PRINT l$
LOCATE 4, 1, 0
FOR i = ilolim TO ihilim
i$ = STR$(i)
26110 IF LEN(i$) < 3 THEN i$ = " " + i$: GOTO 26110
PRINT i$; ". "; nma$(i)
NEXT i
IF i < q THEN LOCATE 20, 5: PRINT "(more)"
LOCATE 22, 1, 0: PRINT SPACE$(80); : LOCATE 22, 1
PRINT " Hit or to move forward or backward through the
list, or "
LOCATE 23, 1, 1: PRINT SPACE$(80); : LOCATE 23, 1
l$ = " Hit m (Main Menu) or any other key for Study Menu . . . "
LOCATE 23, 1, 1: PRINT l$;
26112 d$ = INKEY$: REM NOTE do not use ucase$(d$) here
IF d$ = "" THEN GOTO 26112
IF LEN(d$) = 2 AND ASC(RIGHT$(d$, 1)) = 81 THEN
IF ihilim < q THEN
ilolim = ilolim + 15
ihilim = ihilim + 15
GOTO printilimits
END IF
GOTO printilimits
END IF
IF LEN(d$) = 2 AND ASC(RIGHT$(d$, 1)) = 73 THEN
IF ilolim > 15 THEN
ilolim = ilolim - 15
ihilim = ihilim - 15
GOTO printilimits
END IF
GOTO printilimits
END IF
d$ = UCASE$(d$)
IF d$ = "M" THEN 905
IF d$ = "S" THEN 6000
GOTO 6000
26200 REM Display a particular screen
CLS
l$ = "1. STUDY!": GOSUB 43610: PRINT l$: PRINT
PRINT TAB(15); "b. Display A Particular Screen"
LOCATE 22: LINE INPUT "ENTER the name or number of the screen you
want: "; a$: LOCATE 22: PRINT SPACE$(80): a = 0: l$ = a$: GOSUB 55100:
REM squeeze
FOR j = 1 TO q: IF UCASE$(nm$(j)) = UCASE$(l$) THEN a = j: GOTO
26220: REM match number to name
NEXT j
IF VAL(a$) < 1 OR VAL(a$) > c THEN LOCATE 6: PRINT "Status: No
screen "; a$; " is in the computer." ELSE GOTO 26220
LOCATE 22: PRINT SPACE$(80): LOCATE 22, 1, 1: PRINT "Do you want
to try again (y/n) ? ";
26215 d$ = INKEY$: d$ = UCASE$(d$): IF d$ = "" THEN 26215
LOCATE 1, 1, 0
IF d$ <> "Y" THEN GOTO 6000
IF d$ = "Y" THEN 26200
26220 REM valid screen. Also, target for 26400+
IF a = 0 THEN a = VAL(a$)
CALL browse(d$, a, q, sln(), eln())
IF d$ = "M" THEN 905
IF d$ = "S" THEN 6000
GOTO 6000
26300 REM Browse through the screens sequentially
CLS
a = 1: REM set screen number to 1
CALL browse(d$, a, q, sln(), eln())
IF d$ = "M" THEN GOTO 905
IF d$ = "S" THEN GOTO 6000
GOTO 6000
26400 REM Start studying at the beginning of the study file
CLS
a$ = "1": a = 1: GOTO 26520
GOSUB 48520
GOTO 6000
26500 REM Start studying at a particular screen
CLS
l$ = "1. STUDY!": GOSUB 43610: PRINT l$: PRINT
PRINT TAB(15); "2. Start STUDYing At A Particular Screen"
LOCATE 22: LINE INPUT "ENTER the name or number of the screen you
want: "; a$: LOCATE 22: PRINT SPACE$(80): a = 0
l$ = a$: aa$ = a$: GOSUB 55100: a$ = l$: REM squeeze
26511 REM MAJOR TARGET! for a$ coming from routines 16000-20999
aa$ = a$: REM ???
invokedscreenswitch$ = "": REM turn it off again
FOR j = 1 TO q
IF UCASE$(nm$(j)) = UCASE$(a$) THEN
a = j
GOTO 26520: REM match number to name
END IF
NEXT j
IF VAL(a$) < 1 OR VAL(a$) > q THEN
LOCATE 6: PRINT "Status: No screen "; aa$; " is in the
computer."
ELSE GOTO 26520
END IF
LOCATE 22: PRINT SPACE$(80)
LOCATE 22, 1, 1: PRINT "Do you want to try again (y/n) ? ";
26515 d$ = INKEY$: d$ = UCASE$(d$): IF d$ = "" THEN 26515
LOCATE 1, 1, 0
IF d$ <> "Y" THEN GOTO 6000
IF d$ = "Y" THEN 26500
26520 REM valid screen name. Also, target for 26400+ and 26600+ and
16350-
IF a = 0 THEN a = VAL(a$)
IF a > c THEN
clrcd "a"
CLS
PRINT "No screen number "; a; " is in the computer. Please
fix"
PRINT "Study File, then try again."
GOSUB 60010: REM hit any key
CLEAR : GOTO start
END IF: REM c is total number of screens
clrcd "a": CLS
IF tp$(a) = "R" THEN GOTO 11000: REM read screens
IF tp$(a) = "D" THEN GOTO 12000: REM drill screens
IF tp$(a) = "Q" THEN GOTO 13000: REM quiz screens
CLS : PRINT "Status: Screen named "; nma$(a); " has an improper
screen definition control"
PRINT "character. Please fix, then try again.": GOSUB 60010
CLEAR : GOTO start
GOSUB 55250: IF d$ = "M" THEN 905
IF d$ = "S" THEN 905
26532 REM Target! Now we are getting the branch strings from the bottom
of the last page
studied.*******************************************************
FOR k = 1 TO 9: bch$(k) = "": NEXT: REM clear out array
FOR k = 1 TO 9: bchnat$(k) = "": NEXT
GOSUB 36000: REM all 36000-36999 relate to acquiring control chars
CLS
FOR k = 1 TO d: REM copy unsqueezed to bchnat$()
bchnat$(k) = bch$(k)
NEXT k
FOR k = 1 TO d: REM eliminates spaces in bch$ ()
ch$ = bch$(k)
l$ = ""
FOR i = 1 TO LEN(ch$)
IF MID$(ch$, i, 1) <> " " THEN l$ = l$ + MID$(ch$, i, 1)
NEXT i
bch$(k) = l$
NEXT k
REM Interpret Branch Characters
REM we now have all the branch control characters ready to process
REM Now we need to create routines to interpret br cont chars and
take
REM appropriate action
REM read the cont chars, come back with a name or a number for
next screen to study, in the form of a$
k = 0: REM set counter
26577 k = k + 1: IF k > d THEN GOTO 26595: REM increment
******TARGET******
IF UCASE$(LEFT$(bch$(k), 4)) = UCASE$("goto") THEN
m$ = bch$(k)
GOTO 16000
END IF
IF UCASE$(LEFT$(bch$(k), 2)) = UCASE$("if") THEN
m$ = bch$(k): mnat$ = bchnat$(k)
GOTO 16100
END IF
IF UCASE$(LEFT$(bch$(k), 4)) = UCASE$("load") THEN
m$ = bch$(k)
GOTO 16300
END IF
IF UCASE$(LEFT$(bch$(k), 4)) = UCASE$("quit") THEN GOTO 905
IF UCASE$(LEFT$(bch$(k), 4)) = UCASE$("exit") THEN GOTO
exitroutine
IF UCASE$(LEFT$(bch$(k), 10)) = UCASE$("doscommand") THEN
m$ = bch$(k): mnat$ = bchnat$(k)
GOTO 16400: REM interpret
END IF
GOTO 26577
26595 REM have gone through all types of control characters
CLS : PRINT "Status: Found no usable branch control character in
screen ": PRINT "named "; nma$(a); "."
PRINT "Please fix, then try again.": GOSUB 60010: CLEAR : GOTO
start
GOSUB 48520: IF d$ = "M" THEN 905
GOTO 6000
26600 REM Resume studying at screen last studied
sfn$ = UCASE$(sfn$): jn$ = UCASE$(jn$)
CLS : PRINT : PRINT : PRINT
LOCATE 1, 1, 0
clrcd "A"
IF sfn$ = "" THEN
PRINT "If you have never used this program before, then welcome
to STUDY HALL."
PRINT "There is no record of a prior study location."
GOSUB 48520
GOTO 6000
END IF
IF sfn$ <> jn$ THEN
PRINT "Most recently, you were at screen number "; aa; " in Study
File named "; sfn$; "."
PRINT
PRINT "However, the Study File you have now is "; jn$; "."
GOSUB 48520
IF d$ = "M" THEN 905
GOTO 6000
END IF
26650
a = aa: GOTO 26520: REM impart value of screen last studied to a
GOSUB 55250
IF d$ = "M" THEN 905
IF d$ = "S" THEN 6000
GOTO 6000
26700 REM Display screen last studied
sfn$ = UCASE$(sfn$): jn$ = UCASE$(jn$)
CLS : PRINT : PRINT : PRINT
LOCATE 1, 1, 0
clrcd "A"
IF sfn$ = "" THEN
PRINT "If you have never used this program before, then welcome to
STUDY HALL."
PRINT "There is no record of a prior study location."
GOSUB 48520
GOTO 6000
END IF
IF sfn$ <> jn$ THEN
PRINT "Most recently, you were at screen number "; aa; " in Study
File named "; sfn$; "."
PRINT
PRINT "However, the Study File you have now is "; jn$; "."
GOSUB 48520
IF d$ = "M" THEN 905
GOTO 6000
END IF
PRINT
26750
a = aa: REM impart value of screen last studied to a
GOTO 26220
GOTO 6000
26800 REM Shell to DOS from study menu
COLOR 7, 0, 0
CLS
PRINT "Type EXIT to return to STUDY HALL."
shellflag = 1
SHELL
shellflag = 0
REM COLOR 14, 0
LOCATE 1, 1, 1, 0, 7
clrcd "A"
GOTO 6000
33200 REM demark, categorize. Comes only from 23000 block
REM also obtain its type
w$ = "": REM blank out word string
k = j + 1
33220 k = k + 1: REM increment k to get to next letter in word
IF k > 80 THEN
PRINT "No >> in line "; i; ". Please fix, then try again."
GOSUB 60010
CLEAR
GOTO start
END IF
IF MID$(l$, k, 2) <> ">>" THEN m$ = MID$(l$, k, 1): w$ = w$ + m$:
GOTO 33220
REM word is now complete
l = LEN(w$): tp$ = MID$(w$, l, 1)
REM Squeeze out space on right end
33302 IF tp$ = " " THEN l = l - 1: tp$ = MID$(w$, l, 1): GOTO 33302
REM c is initialized to 1 in 3000-
nm$(c) = w$: nma$(c) = w$: REM name of screen, stored in array
LOCATE 9
PRINT "Status: Working on screen named . . . "; SPACE$(30)
LOCATE 9: PRINT "Status: Working on screen named . . . "; nm$(c);
"."
tp$(c) = tp$: REM type of sceen, like d, q, s
sln(c) = i: REM start line, from 3000-
IF c > 1 THEN eln(c - 1) = (sln(c) - 1): REM eln(c) is ending line
c = c + 1: REM increment screen counter
RETURN: REM to 23000+
36000 REM reads control characters into bch$ array, max 9
REM comes only from 26532
d = 0: REM counter for number of branch control characters, max 9
REM *** branching to next screen
FOR i = sln(a) TO eln(a): REM a is number of current screen
fl$ = studyfile(i)
IF fl$ <> "" THEN l$ = fl$: GOSUB 36030
NEXT i
RETURN: REM to 26535
36030 REM Target of 36022. Uses L$ from 36010
FOR j = 1 TO 1
IF MID$(l$, j, 2) = "<*" THEN GOSUB 36100: REM identify branch
instruction
NEXT j
RETURN: REM to 36022
36100 REM Target of 36050, when have identified a branch instruction
w$ = "": REM blank out word string
k = j + 1: REM k is position within l$ where <* first spotted
36120 k = k + 1: REM increment k to get to next letter in word
IF k > 80 THEN
PRINT "No *> in line "; i; ". Please fix, then try again."
GOSUB 60010
CLEAR
GOTO start
END IF
IF MID$(l$, k, 2) <> "*>" THEN m$ = MID$(l$, k, 1): w$ = w$ + m$:
GOTO 36120
d = d + 1
IF d > 9 THEN
CLS
PRINT "Status: Too many branch control characters in screen "; nma$(a);
"."
PRINT "Please fix, then try again."
GOSUB 60010
CLEAR
GOTO start
END IF
bch$(d) = w$: REM load the branch control characters into array
RETURN: REM (To 36050) We have now loaded one branch instruction
into array
REM all 36000-36999 relate to obtaining branch control chars
42000 REM main menu & selection
clrcd "A"
CLS
REM IF SW(5) =1 THEN GOSUB 60010
CLS : LOCATE 1, 1, 0: PRINT : PRINT
l$ = "Main Menu": GOSUB 43600
PRINT l$
PRINT
PRINT : PRINT : PRINT
PRINT TAB(21); " 1. STUDY!"
PRINT
PRINT TAB(21); " a. Introduction To STUDY HALL"
PRINT TAB(21); " b. Instructions"
PRINT TAB(21); " c. Load A Study File Into STUDY HALL"
PRINT TAB(21); " d. Shell To DOS"
PRINT TAB(21); " e. Change Colors On Screen"
PRINT
PRINT TAB(21); " x. Exit"
clrcd "B"
LOCATE 23, 1, 1: PRINT " (Select by letter
or number) ";
42135 d$ = INKEY$: d$ = UCASE$(d$)
IF d$ = "" THEN GOTO 42135
clrcd "A"
CLS : LOCATE 1, 1, 0
GOTO 910
43600 REM "center line on screen"
43610 REM receives l$, returns l$ centered
l = LEN(l$): m$ = ""
s = (80 - l) / 2: s = s - 1
FOR i = 1 TO s: m$ = m$ + " ": NEXT i
l$ = m$ + l$
RETURN
48100 REM print to screen
CLS : LOCATE 1, 1, 0
FOR i = 1 TO 22: PRINT s$(i): NEXT i
GOSUB 60010: REM Hit any key to continue . . .
RETURN
48520 REM hit m for Main Menu or any other key to continue
clrcd "B"
LOCATE 23, 1, 0: PRINT SPACE$(80);
l$ = " Hit m for Main Menu or any other key to continue
. . . "
LOCATE 23, 1, 1: PRINT l$;
48535 d$ = INKEY$: d$ = UCASE$(d$)
IF d$ = "" THEN GOTO 48535
clrcd "A"
LOCATE 1, 1, 0
LOCATE 23, 1, 0: PRINT SPACE$(80); : LOCATE 1, 1, 0: RETURN
REM waiting
LOCATE 22, 1, 0: PRINT SPACE$(80)
LOCATE 22, 1, 0: l$ = "(Waiting . . . )": GOSUB 43600: PRINT l$;
RETURN
49000 REM "authfl.bas",a 1/3/89, based on earlier
REM requires prior dimension of pa$(90) and prior creation
REM of auth.bms on disk
f$ = "auth.bms": REM name of file is f$, array is pa$, size is 20
OPEN "i", 1, f$: REM f$ is file name
openflag$ = "yes"
FOR i = 1 TO 86
INPUT #1, pa$(i)
NEXT i: CLOSE 1
openflag$ = "no"
RETURN
49090 REM save authorization file
f$ = "auth.bms": REM name of file is f$, array is pa$(90)
OPEN "o", 1, f$: REM f$ is file name
openflag$ = "yes"
FOR i = 1 TO 86
WRITE #1, pa$(i)
NEXT i: CLOSE 1
openflag$ = "no"
RETURN
55100 REM compress a line. receive l$, return l$ compressed (no spaces)
la$ = ""
FOR i = 1 TO LEN(l$)
IF MID$(l$, i, 1) <> " " THEN
IF MID$(l$, i, 1) <> CHR$(9) THEN
la$ = la$ + MID$(l$, i, 1)
END IF
END IF
NEXT i
l$ = la$
RETURN
55200 REM routine for improper branch control character
CLS : PRINT "Status: Improper branch control character, number ";
k; ", screen "; a; "."
PRINT "Please fix, then try again."
GOSUB 60010
CLEAR
GOTO start
55250 REM Hit m (Main Menu) or s (Study Menu) or any other key to
continue . . .
clrcd "B"
LOCATE 23, 1, 0: PRINT SPACE$(80); : LOCATE 23, 1
l$ = " Hit m (Main Menu) or s (Study Menu) or any other key to
continue . . . "
LOCATE 23, 1, 1: PRINT l$;
55270 d$ = INKEY$: d$ = UCASE$(d$)
IF d$ = "" THEN GOTO 55270
clrcd "A"
LOCATE 23, 1, 0: PRINT SPACE$(80); : LOCATE 1, 1, 0
RETURN
55300 REM Hit m (Main Menu) or s (Study Menu) or d (Drill Menu) or any
other . . .
LOCATE 23, 1: PRINT SPACE$(80);
clrcd "B"
l$ = " Hit m (Main Menu) or s (Study Menu) or d (Drill Menu) or
any other . . . "
LOCATE 23, 1, 1: PRINT l$;
55320 d$ = INKEY$: d$ = UCASE$(d$)
IF d$ = "" THEN GOTO 55320
LOCATE 23, 1, 0: PRINT SPACE$(80); : LOCATE 1, 1, 0
clrcd "A"
RETURN
60010 REM Hit any key to continue . . .
clrcd "b"
REM COLOR clr(plet, 8) REM secondary text, orig other
LOCATE 23, 2, 0: PRINT SPACE$(78); : LOCATE 23, 1, 0
l$ = "Hit any key to continue . . . "
LOCATE 23, 26, 1: PRINT l$;
60050 d$ = INKEY$
IF d$ = "" THEN 60050
LOCATE 23, 2, 0: PRINT SPACE$(78);
LOCATE 1, 1, 0
RETURN
striperror:
CLS
PRINT " There is an error in the branch control character"
PRINT "<*" + mnat$ + "*> on screen named " + nma$(a) + "."
PRINT "Please fix, then try again."
GOSUB 60010
CLEAR
GOTO start
'The following data defines the color schemes available via the main
menu.
'Seven palettes with 12 items each palette.
' #1 #2 #3 #4 #5 #6 #7 #8 #9 #10 #11 #12
' fora baka brdr bart bar bxa bxb forb blok blt #11 #12
DATA 0, 7, 15, 15, 0, 0, 15, 15, 0, 15, 0, 0: REM
monochrome
DATA 15, 1, 1, 0, 7, 15, 0, 15, 7, 0, 7, 4: REM white on
blue
DATA 15, 2, 2, 0, 7, 15, 0, 15, 7, 0, 7, 4: REM white on
green
DATA 14, 6, 0, 14, 0, 14, 14, 15, 0, 15, 0, 0: REM black on
brown
DATA 15, 4, 2, 15, 2, 15, 15, 14, 2, 15, 0, 0: REM Holiday
DATA 15, 4, 1, 15, 1, 15, 15, 14, 1, 15, 0, 0: REM Patriot
DATA 0, 4, 2, 2, 0, 0, 2, 14, 0, 14, 0, 0: REM African
DATA 14, 4, 6, 14, 0, 14, 14, 0, 6, 0, 0, 0: REM Oriental
DATA 1, 3, 9, 15, 1, 1, 15, 0, 1, 15, 0, 0: REM Cool
DATA 0, 6, 4, 14, 4, 14, 14, 14, 0, 14, 0, 0: REM Autumn
' fora baka brdr bart bar bxa bxb forb blok blt #11 #12
REM SCREEN Mode 0 Syntax: COLOR [foreground][,[background][,border]]
REM þ foreground is the text color (range = 0-31, with 16-31 blinking
REM þ background is the screen color (range = 0-7)
REM þ border is the color surrounding the screen (range = 0-15)
REM 0 = black 4 = red 8 = grey 12 = light
red
REM 1 = blue 5 = magenta 9 = light blue 13 = light
magenta
REM 2 = green 6 = brown 10 = light green 14 = yellow
REM 3 = cyan 7 = white 11 = light cyan 15 = bright
white
errhandle:
REM error handling
CLS
IF openflag$ = "yes" THEN CLOSE 1
PRINT "An error has occured."
PRINT "The error code is "; ERR; ", in BASIC."
IF ERR = 5 THEN
PRINT "Illegal Function Call"
IF shellflag = 1 THEN
PRINT "Probably your system could not locate command.com file when
needed"
PRINT "for shell to DOS. Please put command.com on current directory, "
PRINT "then try again."
END IF
END IF
IF ERR = 7 THEN PRINT "Out Of Memory"
IF ERR = 9 THEN PRINT "Subscript Out Of Range"
IF ERR = 14 THEN PRINT "Out Of String Space"
IF ERR = 24 THEN PRINT "Device Timeout"
IF ERR = 25 THEN PRINT "Device fault"
IF ERR = 27 THEN PRINT "Out of Paper"
IF ERR = 53 THEN
PRINT "File Not Found"
IF UCASE$(f$) = "AUTH.BMS" THEN
PRINT "NOTE: AUTH.BMS must be on current drive/directory."
END IF
IF UCASE$(f$) <> "AUTH.BMS" THEN
PRINT f$ + " could not be found. Try again."
END IF
END IF
IF ERR = 57 THEN
PRINT "Device Input/Output Error"
PRINT "Probably had trouble reading or writing to disk."
PRINT "Please check disk and/or drive, then try again."
END IF
IF ERR = 61 THEN PRINT "Disk Full"
IF ERR = 62 THEN PRINT "Input Past End Of File"
IF ERR = 64 THEN
PRINT "Bad File Name"
PRINT "Must use legal MS/DOS file name. Try again."
END IF
IF ERR = 68 THEN PRINT "Device Unavailable"
IF ERR = 70 THEN PRINT "Disk Write Protected/Permission Denied"
IF ERR = 71 THEN PRINT "Disk Not Ready"
IF ERR = 72 THEN PRINT "Disk Media Error"
IF ERR = 75 THEN PRINT "Path/File Access Error"
IF ERR = 76 THEN PRINT "Path Not Found"
GOSUB 60010: REM hit any key
IF menuflag$ = "yes" THEN RESUME 905
IF menuflag$ <> "yes" THEN RESUME start
RESUME start
60400 REM compress line; receive ln$ uncompressed; return lna$
compressed
lna$ = "": REM set lna$ (compressed line) to ""
FOR j = 1 TO LEN(ln$): IF MID$(ln$, j, 1) <> " " THEN lna$ = lna$
+ MID$(ln$, j, 1)
NEXT j: REM lna$ now equals ln$, but squeezed
RETURN
60450 REM sub for "do you want to drill again" from 12727, 12737, 12745
LOCATE 23, 1, 1: PRINT "Want to drill again (y/n)? ";
60458 d$ = INKEY$: d$ = UCASE$(d$)
IF d$ = "" THEN GOTO 60458
LOCATE 1, 1, 0
RETURN: REM to 12727, 12737, 12745
60470 REM routine to display current drill screen
a = aa
IF a = 0 THEN a = VAL(a$)
CLS
FOR i = sln(a) TO eln(a)
l$ = studyfile(i)
PRINT l$
NEXT i
GOSUB 55250
IF d$ = "M" THEN 905
IF d$ = "S" THEN 6000
GOTO 12930: REM drill screen menu
invokedfile:
invokedfile$ = "": REM initialize
l$ = COMMAND$
GOSUB 55100: REM squeeze
IF LEFT$(l$, 1) = "/" THEN
invokedfile$ = RIGHT$(l$, (LEN(l$) - 1))
END IF
GOSUB invokedscreen
RETURN
invokedscreen:
l$ = invokedfile$
FOR i = 1 TO LEN(l$)
IF MID$(l$, i, 1) = "/" THEN
invokedscreen$ = RIGHT$(l$, (LEN(l$) - i))
invokedfile$ = LEFT$(l$, (i - 1))
invokedscreenswitch$ = "yes"
a = 0
aa$ = invokedscreen$
a$ = invokedscreen$
END IF
NEXT i
RETURN
loadscreentoo:
REM only from 3130+
l$ = jn$: REM name of file to be loaded, may contain "/screename"
FOR i = 1 TO LEN(l$)
IF MID$(l$, i, 1) = "/" THEN
invokedscreen$ = RIGHT$(l$, (LEN(l$) - i))
jn$ = LEFT$(l$, (i - 1))
invokedscreenswitch$ = "yes"
a = 0
aa$ = invokedscreen$
a$ = invokedscreen$
END IF
NEXT i
RETURN
exitroutine:
pa$(10) = STR$(aa): REM number of screen last studied
pa$(11) = jn$: REM name of study file in computer
IF fullexit$ = "yes" THEN
GOSUB 49090: REM save auth file, close
END IF
REM use locate to return cursor to normal size
LOCATE 1, 1, 1, 6, 7
COLOR 7, 0, 0: REM return to normal
CLS
SYSTEM
DEFSNG I-L
SUB border
REM Basic Star border, using secondary text color, orig bckgrnd, brdr
REM Not intrusive on the rest of the screen. Should be last item on
screen.
REM DEFINT A-Z
REM PRINT "palette is "; plet
REM PRINT clr(plet, 1)
REM PRINT clr(plet, 2)
clrcd "b"
REM COLOR clr(plet, 8) (over existing background & border)
Col1 = 1: Col2 = 80: Row1 = 1: Row2 = 25
BoxWidth = Col2 - Col1 + 1
LOCATE Row1, Col1
PRINT "Ú";
FOR ii% = 1 TO 39: PRINT " *"; : NEXT ii%
PRINT "¿";
FOR a% = Row1 + 1 TO Row2 - 1
LOCATE a%, Col1
PRINT "*"; SPACE$(BoxWidth - 2); "*";
NEXT a%
LOCATE Row2, Col1
PRINT "À";
FOR ii% = 1 TO 39: PRINT "* "; : NEXT ii%
REM STRING$(BoxWidth - 2, "*");
PRINT "Ù";
END SUB
SUB box (Row1, Col1, Row2, Col2)
BoxWidth = Col2 - Col1 + 1
LOCATE Row1, Col1
PRINT "Ú"; STRING$(BoxWidth - 2, "Ä"); "¿";
FOR a = Row1 + 1 TO Row2 - 1
LOCATE a, Col1
PRINT "³"; SPACE$(BoxWidth - 2); "³";
NEXT a
LOCATE Row2, Col1
PRINT "À"; STRING$(BoxWidth - 2, "Ä"); "Ù";
END SUB
SUB browse (d$, a, q, sln(), eln())
REM receives a, screen counter
REM returns d$ which is either m or s
DEFINT I-K
SHARED studyfile() AS STRING * 80
CLS
26315 REM print screen
FOR i = sln(a) TO eln(a)
fl$ = studyfile(i)
PRINT fl$
NEXT i
LOCATE 1, 60
clrcd "B"
PRINT " Screen "; a; " "
LOCATE 22, 1, 0: PRINT SPACE$(80); : LOCATE 22, 1
clrcd "B"
PRINT " Hit or to move forward or backward through the
screens, or"
LOCATE 23, 1, 1: PRINT SPACE$(80); : LOCATE 23, 1
l$ = " Hit m (Main Menu) or any other key for Study Menu . . . "
LOCATE 23, 1, 1: PRINT l$;
26316 d$ = INKEY$
IF d$ = "" THEN GOTO 26316
clrcd "A"
IF LEN(d$) = 2 THEN
IF ASC(RIGHT$(d$, 1)) = 81 THEN
a = a + 1
IF a > q THEN a = 1
CLS
GOTO 26315
END IF
IF ASC(RIGHT$(d$, 1)) = 73 THEN
a = a - 1
IF a < 1 THEN a = q
CLS
GOTO 26315
END IF
END IF
d$ = UCASE$(d$)
END SUB
DEFSNG I-K
SUB centerline (l$)
REM "center line on screen"
REM receives l$, returns l$ centered
l = LEN(l$): m$ = ""
s = (80 - l) / 2: s = s - 1
FOR ii = 1 TO s: m$ = m$ + " ": NEXT ii
l$ = m$ + l$
END SUB
SUB clrcd (c$)
REM 1-14-94 wem
REM Receives code for various color combinations used with the plet
REM color control system. Changes screen colors accordingly.
c$ = UCASE$(c$)
REM STANDARD SETTING FOR TEXT ON SCREEN*****************************
IF c$ = "A" THEN
COLOR clr(plet, 1), clr(plet, 2), clr(plet, 3): REM fora, baka, brdr
END IF
REM STANDARD SETTING FOR SECONDARY TEXT****************************8
IF c$ = "B" THEN
COLOR clr(plet, 8): REM forb secondary text
END IF
REM STANDARD SETTING FOR COLOR BAR *********************************
IF c$ = "C" THEN
COLOR clr(plet, 4), clr(plet, 5): REM bart, bar
END IF
REM STANDARD SETTING FOR OUTLINE BOX *******************************
IF c$ = "D" THEN
COLOR clr(plet, 6), clr(plet, 2): REM bxa, baka
END IF
REM CAN ADD TEXT INSIDE, TEXT SAME AS BOX OUTLINE
REM Can use clrcd "a" or "d" for text within outline box.
REM STANDARD SETTING FOR FILLED BOX: filler like bar line
IF c$ = "E" THEN
COLOR clr(plet, 7), clr(plet, 5): REM bxb, bar
END IF
REM CAN ADD TEXT INSIDE: Text same as box outline - No change in color
needed
REM STANDARD SETTING FOR COLOR BLOCK: filler like box outline
IF c$ = "F" THEN
COLOR clr(plet, 9), clr(plet, 9): REM blok
END IF
REM ADD TEXT INSIDE COLOR BLOCK
IF c$ = "G" THEN
COLOR clr(plet, 10): REM forb, "foreground b"
END IF
END SUB
SUB clrmenu (cplet)
DIM menutxt$(10)
DIM menitrow%(10)
DIM menitcol%(80)
DIM menitlen%(80)
DEFINT I-K
clrcd "a"
REM COLOR clr(plet, 1), clr(plet, 2), clr(plet, 4) ??? 4?
CLS
LOCATE 1, 1, 0
cplet = plet
clrstart: REM TARGET!
plet = cplet
COLOR clr(plet, 8), clr(plet, 2), clr(plet, 3)
CLS
dblbox 1, 1, 25, 80
LOCATE 8, 1, 0
l$ = "Color Menu": CALL centerline(l$): CALL trimnprint(l$, 6)
COLOR clr(plet, 1), clr(plet, 2), clr(plet, 3): REM fora, baka, brdr
menutxt$(1) = "1. Monochrome"
menutxt$(2) = "2. White On Blue"
menutxt$(3) = "3. White On Green"
menutxt$(4) = "4. Yellow On Brown"
menutxt$(5) = "5. Holiday"
menutxt$(6) = "6. Patriot"
menutxt$(7) = "7. African"
menutxt$(8) = "8. Oriental"
menutxt$(9) = "9. Cool Blues"
menutxt$(10) = "a. Autumn Leaves"
menitrow%(1) = 8
menitrow%(2) = 9
menitrow%(3) = 10
menitrow%(4) = 11
menitrow%(5) = 12
menitrow%(6) = 14
menitrow%(7) = 15
menitrow%(8) = 16
menitrow%(9) = 17
menitrow%(10) = 18
FOR i = 1 TO 10: menitcol%(i) = 24: NEXT
REM FOR i = 5 TO 9: menitcol%(i) = 24: NEXT
FOR i = 1 TO 10: menitlen%(i) = LEN(menutxt$(i)): NEXT
FOR i = 1 TO 10
LOCATE menitrow%(i), menitcol%(i)
PRINT menutxt$(i);
NEXT i
c43003: REM target
i = INT(cplet)
plet = cplet
clrcd "c"
LOCATE menitrow%(i), menitcol%(i)
PRINT menutxt$(i);
COLOR clr(plet, 8), clr(plet, 2), clr(plet, 3)
LOCATE 22, 2, 0: PRINT SPACE$(78); : LOCATE 22, 2, 1
l$ = "(Use arrow keys to move light bar, then ENTER your
selection.)"
CALL centerline(l$)
CALL trimnprint(l$, 22)
l$ = "(Or else, press the number or letter of your selection.)"
CALL centerline(l$)
CALL trimnprint(l$, 23)
c43010: REM Target! Start of inkey$ routine
d$ = INKEY$
IF d$ = "" THEN GOTO c43010
SELECT CASE d$
CASE "1": GOTO clrdecmade
CASE "2": GOTO clrdecmade
CASE "3": GOTO clrdecmade
CASE "4": GOTO clrdecmade
CASE "5": GOTO clrdecmade
CASE "6": GOTO clrdecmade
CASE "7": GOTO clrdecmade
CASE "8": GOTO clrdecmade
CASE "9": GOTO clrdecmade
CASE "a": d$ = UCASE$(d$): GOTO clrdecmade
CASE "A": GOTO clrdecmade
CASE CHR$(0) + "H"
GOSUB c43012: REM up arrow
cplet = i
GOTO clrstart
CASE CHR$(0) + "P"
GOSUB c43020: REM down arrow
cplet = i
GOTO clrstart
REM CASE CHR$(0) + "K": rem GOSUB cMenuLeft
REM CASE CHR$(0) + "M": GOSUB cMenuRight
CASE CHR$(13): REM pressed ENTER
d$ = LEFT$(menutxt$(i), 1)
d$ = UCASE$(d$)
clrdecmade: REM decision made TARGET!
LOCATE 1, 1, 0
IF d$ = "A" THEN d$ = "10"
cplet = VAL(d$)
clrcd "a": REM reset screen colors
GOTO clend
STOP
CASE CHR$(27): GOTO clend
END SELECT
GOTO c43010: REM Back to inkey$ routine
c43012: REM up arrow
GOSUB crestoremenitem
i = i - 1
IF i < 1 THEN i = 10
GOSUB cnewmenitem
RETURN
c43020: REM down arrow
GOSUB crestoremenitem
i = i + 1
IF i > 10 THEN i = 1
GOSUB cnewmenitem
RETURN
crestoremenitem:
REM COLOR clr(plet, 1), clr(plet, 4), clr(plet, 1)
COLOR clr(plet, 1), clr(plet, 2), clr(plet, 3): REM fora, baka, brdr
LOCATE 1, 1, 0
LOCATE menitrow%(i), menitcol%(i)
PRINT menutxt$(i);
RETURN
cnewmenitem:
COLOR clr(plet, 4), clr(plet, 5): REM bart, bar
LOCATE 1, 1, 0
REM COLOR clr(plet, 7), clr(plet, 12)
LOCATE menitrow%(i), menitcol%(i)
PRINT menutxt$(i);
RETURN
STOP
clend:
END SUB
DEFSNG I-K
SUB colortest
REM 1-14-94 wem
REM This sub tests and illustrates the use of the plet colorcode system.
REM Used in conjunction with the clrcd (colorcode) sub
REM GOTO clrtst2
CLS
COLOR 7, 1, 1
CLS
PRINT
PRINT "This is the way it was from before."
ctop:
LOCATE 22, 1
COLOR clr(plet, 8): REM forb secondary text
INPUT "Which palette do you want"; plet
IF plet = 99 THEN EXIT SUB
REM STANDARD SETTING FOR TEXT ON SCREEN*****************************
clrcd "a"
REM COLOR clr(plet, 1), clr(plet, 2), clr(plet, 3): REM fora, baka, brdr
CLS
PRINT "Current pallette is"; plet;
PRINT "and this is the primary text color.";
REM STANDARD SETTING FOR SECONDARY TEXT****************************8
clrcd "b"
REM COLOR clr(plet, 8): REM forb secondary text
PRINT "This is the secondary text color"
PRINT
REM STANDARD SETTING FOR COLOR BAR *********************************
clrcd "c"
REM COLOR clr(plet, 4), clr(plet, 5): REM bart, bar
PRINT
PRINT "This is color bar"
REM STANDARD SETTING FOR OUTLINE BOX *******************************
clrcd "d"
REM COLOR clr(plet, 6), clr(plet, 2): REM bxa, baka
REM NOTE: Can also always use clrcd "a" (original setting) to do outline
REM boxes. Also can use primary and text (clrcd "a")
REM for text within outline boxes.
box 15, 20, 20, 30
REM ADD TEXT INSIDE, TEXT SAME AS BOX OUTLINE
LOCATE 16, 21: PRINT "cat";
REM STANDARD SETTING FOR FILLED BOX: filler like bar line
clrcd "e"
REM COLOR clr(plet, 7), clr(plet, 5): REM bxb, bar
box 15, 40, 20, 50
REM ADD TEXT INSIDE: Text same as box outline - No change in color
needed
LOCATE 16, 41: PRINT "cat";
REM STANDARD SETTING FOR COLOR BLOCK: filler like box outline *******
clrcd "f"
REM COLOR clr(plet, 9), clr(plet, 9): REM blok
box 15, 60, 20, 70
REM ADD TEXT INSIDE COLOR BLOCK ************************************
clrcd "g"
REM COLOR clr(plet, 10): REM forb, "foreground b"
LOCATE 16, 61: PRINT "cat";
REM Now add text in original mode
clrcd "a"
REM COLOR clr(plet, 1), clr(plet, 2), clr(plet, 3): REM fora, baka, brdr
LOCATE 21, 20
PRINT "Outline Box Filled Box Color Block";
PRINT
GOTO ctop
clrtst2:
clrtsta:
END SUB
SUB dblbox (Row1, Col1, Row2, Col2)
Row1% = INT(Row1): Col1% = INT(Col1): Col2% = INT(Col2)
BoxWidth% = Col2 - Col1 + 1
LOCATE Row1, Col1
PRINT "É"; STRING$(BoxWidth% - 2, "Í"); "»"; : REM asc 201, 205, 187
FOR a% = Row1 + 1 TO Row2 - 1
LOCATE a%, Col1
PRINT "º"; SPACE$(BoxWidth% - 2); "º"; : REM asc 186
NEXT a%
LOCATE Row2, Col1
PRINT "È"; STRING$(BoxWidth% - 2, "Í"); "¼"; : REM asc 200, 205, 188
END SUB
SUB loadcolors
' Read colors in and set up assembly routines
REM WIDTH , 25
REM VIEW PRINT
FOR i = 1 TO 10
FOR j = 1 TO 12
READ clr(i, j)
NEXT j
NEXT i
END SUB
SUB strip (mnat$, stripflag$, doscommand$)
DEFINT L, P
REM Purpose is to isolate the actual dos command string in my
"doscommand"
REM control character
candidate$ = ""
p = 0
t1:
p = p + 1
IF p > LEN(mnat$) THEN stripflag$ = "error": EXIT SUB
IF MID$(mnat$, p, 1) = " " THEN GOTO t1
candidate$ = candidate$ + MID$(mnat$, p, 1)
IF LEN(candidate$) < 10 THEN GOTO t1
IF LEN(candidate$) > 10 THEN candidate$ = RIGHT$(candidate$, 10)
IF UCASE$(candidate$) = "DOSCOMMAND" THEN
doscommand$ = RIGHT$(mnat$, LEN(mnat$) - p)
GOTO t2
END IF
GOTO t1
t2: REM Next eliminate any leading/trailing spaces from doscommand$
l = LEN(doscommand$)
p = 0
DO UNTIL LEFT$(doscommand$, 1) <> " "
l = LEN(doscommand$)
doscommand$ = RIGHT$(doscommand$, (l - 1))
LOOP
DO UNTIL RIGHT$(doscommand$, 1) <> " "
l = LEN(doscommand$)
doscommand$ = LEFT$(doscommand$, (l - 1))
LOOP
END SUB
DEFSNG L, P
SUB sub13
REM Hit Any Key To Continue
COLOR clr(plet, 8), clr(plet, 2), clr(plet, 3): REM secondary text, orig
other
REM 60010 REM Hit any key to continue . . .
LOCATE 23, 1, 0: PRINT SPACE$(80); : LOCATE 23, 1, 0
l$ = "Hit any key to continue . . . "
LOCATE 23, 26, 1: PRINT l$;
d$ = ""
DO WHILE d$ = ""
d$ = INKEY$
LOOP
d$ = UCASE$(d$)
LOCATE 23, 1, 0: PRINT SPACE$(80); : LOCATE 1, 1, 0
END SUB
SUB trimnprint (l$, printrow%)
REM Purpose is to allow lines of any length to be printed without
REM interfering with a one-character border.
IF LEN(l$) = 80 THEN
l$ = RIGHT$(l$, 79): REM trim off one char from left
l$ = LEFT$(l$, 78): REM trim off one char from right
GOTO prntrimdline
END IF
IF LEN(l$) = 79 THEN
l$ = LEFT$(l$, 78): REM trim off one char from right
GOTO prntrimdline
END IF
prntrimdline: REM line is now 78 characters long or less
LOCATE printrow%, 2
PRINT l$;
END SUB
SUB yesnobox (ynla$, ynlb$, ynlc$)
ynbtop:
INPUT "What palette do you want"; plet
clrcd "a"
REM COLOR clr(plet, 1), clr(plet, 2), clr(plet, 3)
LOCATE 1, 1, 0
CLS
LOCATE 3, 5
PRINT "Now is the time for the cat!"
CALL dblbox(1, 1, 25, 80)
LOCATE 10, 10
PRINT "Now is the time for the cat!"
COLOR clr(plet, 7), clr(plet, 5): REM bxb, bar
LOCATE 1, 1, 0
box 15, 20, 20, 60
LOCATE 16, 22: PRINT ynla$;
LOCATE 17, 22: PRINT ynlb$;
LOCATE 18, 22: PRINT ynlc$;
LOCATE 25, 80, 1
LINE INPUT a$
GOTO ynbtop
STOP
END SUB
End source code . . .
Blessings to you. May God help us all.
Rev. Bill McGinnis, Director - LoveAllPeople.org
All of our original content on all of our pages is in the Public Domain. Webmasters: you may link to all of our pages by any means you choose, including "framing."
Index of LoveAllPeople.org: - ETHICS & HUMAN RELATIONS - POLITICS & PUBLIC AFFAIRS - CHRISTIAN - AUTOMOTIVE - LAW & LEGAL SERVICES - HEALTH & FITNESS - PUBLISHING & CONSULTING - AFFILIATES & FEATURED PRODUCTS - SITE MAP - CONTACT LINK
Search all pages in The LoveAllPeople.org Network,
using the search box below . . .For list of suggested searches, click => HERE!
See what we do => On The Web and Newsgroups-1 and Newsgroups-2. To support us, please click => HERE!.
See our
Huge
selection of products
"Therefore all things whatsoever ye would that men should do to
you, do ye even so to them: for this is the law and the
prophets."
- Jesus, as quoted in Matthew 7:12(KJV)
LoveAllPeople.org
maintains hundreds of web pages and files, in the Public
Interest, funded by sales commissions paid to us by
Our Affiliates and by
direct
donations. We also have written and posted hundreds of
messages to the Usenet newsgroups and elsewhere.
We produce and distribute a wide range
of content, all intended to benefit many people. We try to bring
as much
helpful information to as many people as possible, free of charge. All
our pages and messages are "free to copy, free to use." And you
may
link
to our pages
any way you choose, including framing. Also, you may link
directly to any file residing on
our servers.
All of our original content is
Public Domain, so you may
cut/paste/clip/modify/decompile/republish/use it, any
way you want. Our desire is to disseminate our work, not to monopolize
or restrict it. Enjoy it! Blessings to you!
You are invited to visit and search The LoveAllPeople.org Archives, containing items from 1996 to the present, including hundreds of original web pages and posted messages in the Public Domain. Fast, efficient downloads of our pages are available from our publisher at KING JAMES PUBLISHING (TM).
BLESSINGS TO YOU! May you thrive and prosper in everything you do.
Rev. Bill McGinnis, Director
LoveAllPeople.org
bmcgin@patriot.net
"Start Each Day The Positive Way," at Internet Daily Chapel - Christian daily worship service and practical guide.
http://www.internetchurchofchrist.org/idc.html