100 REM 140 REM FILENAME: SETUP 180 REM 220 REM 260 REM IDENTIFICATION OF ITEM CHARACTERISTICS ZONES 300 REM 340 REM ZONE ID# X Y DEFAULT 380 REM BANK 1 19-23 1 420 REM ANSWERS 2 8-16 2 BLANK TEST: NO BLANK ALLOWED IN INTERIOR 460 REM OF ANSWER STRING 500 REM CATEGORY 3 27-31 2 BLANK TEST: NO COLUMN BLANK 540 REM SUBITEMS 4 42 2 BLANK SET AUTOMATICALLY TO # OF ANSWERS 580 REM OPTIONS 5 52 2 5 620 REM DIFFICULTY6 11 4 5 660 REM BEHAVIOR 7 23 4 1 700 REM ENHANC. 8 38 4 BLANK 740 REM KEYWRDS 9 9-12 6 BLANK\ 780 REM 10 14-17 6 BLANK \ 820 REM 11 19-22 6 BLANK \TEST: FOR EACH ZONE, EITHER 860 REM SP.CHR. 12 36-37 6 BLANK / ALL COLUMNS BLANK OR NO 900 REM 13 39-40 6 BLANK / COLUMNS BLANK 940 REM 14 42-43 6 BLANK/ 980 REM TXT.REF. 15 69-75 2 BLANK 1020 REM RES.REF. 16 69-75 4 BLANK 1060 REM SOURCE 17 66-69 6 1100 DIM DSK$(15), PK$(150), QK$(150), ALFRG(2, 9, 17), CZONE(3, 17), NRG(17), NUMZ(26) 1140 DIM CHAR$(17) 1180 DATA 19,23,1,8,16,2,27,31,2,42,42,2,52,52,2,11,11,4,23,23,4,38,38,4 1220 DATA 9,12,6,14,17,6,19,22,6,36,37,6,39,40,6,42,43,6 1260 DATA 69,75,2,69,75,4,66,69,6 1300 REM 1340 REM INITIALIZE PROGRAM CONSTANTS 1380 REM '************************************* ' 'Module to read the file PROTOCOL 'File PROTOCOL contains path information and printer protocol information ' '************************************* 306 ON ERROR GOTO 310 OPEN "I", #1, "PROTOCOL" 308 FOR N = 1 TO 11 INPUT #1, A$ INDX = VAL(LEFT$(A$, 2)) DSK$(INDX) = RIGHT$(A$, LEN(A$) - 3) NEXT N LINE INPUT #1, A$ IFORM% = VAL(RIGHT$(A$, LEN(A$) - 3)) IFORM% = IFORM% * 2 LINE INPUT #1, A$ CR$ = CHR$(VAL(RIGHT$(A$, LEN(A$) - 3))) LINE INPUT #1, A$ LF$ = CHR$(VAL(RIGHT$(A$, LEN(A$) - 3))) LINE INPUT #1, A$ FOR M = 6 TO LEN(A$) IF ASC(MID$(A$, M, 1)) = 44 THEN 314 NEXT M GOTO 313 314 NC = VAL(MID$(A$, 5, M - 5)) IIS = M + 1 HLF$ = "" FOR N = 1 TO NC IF N = NC THEN 315 FOR M = IIS TO LEN(A$) IF ASC(MID$(A$, M, 1)) = 44 THEN 316 NEXT M FOR M = IIS TO LEN(A$) IF ASC(MID$(A$, M, 1)) = 44 THEN 316 NEXT M GOTO 313 316 HLF$ = HLF$ + CHR$(VAL(MID$(A$, IIS, M - IIS))) IIS = M + 1 NEXT N 315 HLF$ = HLF$ + CHR$(VAL(RIGHT$(A$, LEN(A$) - IIS + 1))) LINE INPUT #1, A$ FF$ = CHR$(VAL(RIGHT$(A$, LEN(A$) - 3))) CLOSE GOTO 1420 310 RESUME 313 313 CLOSE CHAIN "START" '************************************** ' 'End PROTOCOL module ' '************************************** 1420 RESTORE: YEM = 8: XEM = 10: BL = 11: EL = 23: MAXL = 125 1430 COLOR 7, 0 1460 FOR N = 1 TO 17 1500 FOR M = 1 TO 3 1540 READ CZONE(M, N) 1580 NEXT M 1620 NEXT N 1660 DATA 16 1700 DATA "A",2,8,65,69,88,88,32,32,4,4,8,8,27,27,19,19,6,6 1740 DATA "C",3,8,48,57,32,32,4,4,8,8,27,27,19,19,6,6,1,1 1780 DATA "S",4,6,49,57,27,27,6,6,1,1,8,8,32,32 1820 DATA "O",5,4,50,53,27,27,6,6,1,1 1860 DATA "D",6,6,51,51,53,53,55,55,27,27,6,6,1,1 1900 DATA "B",7,5,49,49,50,50,27,27,6,6,1,1 1940 DATA "E",8,6,48,57,32,32,8,8,27,27,6,6,1,1 1980 DATA "K",9,8,48,57,32,32,4,4,8,8,27,27,19,19,6,6,1,1 2020 DATA "L",10,8,48,57,32,32,4,4,8,8,27,27,19,19,6,6,1,1 2060 DATA "M",11,8,48,57,32,32,4,4,8,8,27,27,19,19,6,6,1,1 2100 DATA "X",12,8,48,57,32,32,4,4,8,8,27,27,19,19,6,6,1,1 2140 DATA "Y",13,8,48,57,32,32,4,4,8,8,27,27,19,19,6,6,1,1 2180 DATA "Z",14,8,48,57,32,32,4,4,8,8,27,27,19,19,6,6,1,1 2220 DATA "R",15,6,32,126,4,4,19,19,6,6,1,1,27,27 2260 DATA "T",16,6,32,126,4,4,19,19,6,6,1,1,27,27 2300 DATA "U",17,7,32,126,4,4,19,19,6,6,1,1,27,27,8,8 2340 REM 2380 REM INITIALIZATION OF CHARACTERISTICS ARRAY 2420 REM 2460 REM 2500 REM EDFLG% IS THE FLAG FOR BRANCHING TO ADD, DELETE OR EDIT AN ITEM 2540 REM ADD=1, DELETE=2, EDIT=3 2620 READ N 2660 FOR M = 1 TO N 2700 READ Z$ 2740 READ NUMZ(ASC(Z$) - 64) 2780 READ NRG(NUMZ(ASC(Z$) - 64)) 2820 FOR J = 1 TO NRG(NUMZ(ASC(Z$) - 64)) 2860 FOR I = 1 TO 2 2900 READ ALFRG(I, J, NUMZ(ASC(Z$) - 64)) 2940 NEXT I 2980 NEXT J 3020 NEXT M 3021 CHAR$(1) = " " 3030 IF EDFLG% = 0 THEN 4340 ELSE 5200 4340 CLS 4380 PRINT "1 ADD AN ITEM" 4420 PRINT 4460 PRINT "2 DELETE AN ITEM" 4500 PRINT 4540 PRINT "3 EDIT AN ITEM" 4580 PRINT 4585 PRINT "ESC to escape back to program control" 4590 PRINT 4591 PRINT "Type 1,2,3 or ESC: "; 4592 C$ = INKEY$ 4594 IF LEN(C$) = 0 THEN 4592 4596 IF ASC(C$) = 27 THEN 4597 ELSE 4598 4597 CLOSE : CHAIN "MICROSOC" 4598 IF C$ <> "1" AND C$ <> "2" AND C$ <> "3" THEN 4592 4600 EDFLG% = VAL(C$) 4660 IF EDFLG% <> 1 AND EDFLG% <> 2 AND EDFLG% <> 3 THEN 4340 4700 GOTO 5200 4702 CLS 4703 PRINT "Type 7-digit item number that is to be edited." 4704 INPUT "(CR) if you want to return to previous screen. "; JEY$ 4705 IF JEY$ <> "" THEN 4707 4706 CLOSE : EDFLG% = 0: GOTO 3021 4707 GOSUB 50660 4708 IF IFETCH% = 0 THEN 5300 4710 PRINT "Item "; JEY$; " not found. Type again." 4712 GOTO 4704 4740 CLS 4780 PRINT "Type 7-digit item number that is to be deleted." 4781 INPUT "(CR) to return to previous screen. "; JEY$ 4782 IF JEY$ <> "" THEN 4820 4783 CLOSE : EDFLG% = 0 4790 GOTO 3021 4820 GOSUB 50660 4860 IF IFETCH% = 0 THEN 5300 4900 PRINT "ITEM "; JEY$; " NOT FOUND. TYPE AGAIN" 4940 GOTO 4780 5200 COLOR 7, 0 5205 CLS : IF CHAR$(1) = " " THEN 5210 ELSE 5247 5210 INPUT "TYPE FILENAME OF BANK. "; CHAR$(1) IF LEN(CHAR$(1)) = 5 THEN 5215 PRINT "ITEM BANK MUST HAVE NAME OF FIVE CHARACTERS." PRINT "Type any key except ESC to try again. Type ESC to" PRINT "exit program so that name of bank can be changed." 5212 B$ = INKEY$ IF LEN(B$) = 0 THEN 5212 IF ASC(B$) = 27 THEN 5214 CHAR$(1) = " " GOTO 5200 5214 CLOSE END 5215 ON ERROR GOTO 5220 CLOSE #11: OPEN "I", #11, DSK$(11) + CHAR$(1) GOTO 5224 5220 PRINT "CANNOT FIND FILE "; CHAR$(1); " TYPE ANY KEY TO RESUME." 5222 B$ = INKEY$ IF LEN(B$) = 0 THEN 5222 CHAR$(1) = " " RESUME 5200 5224 CLOSE #11 5225 OPEN "R", #11, DSK$(11) + CHAR$(1), 80 5226 FIELD #11, 80 AS PKTXT$ 5227 GET #11, 1 5228 CLS 5229 PRINT "TITLE LINE OF THIS FILE READS" 5230 PRINT 5231 PRINT 5232 FOR N = 1 TO LEN(PKTXT$) 5233 IF MID$(PKTXT$, LEN(PKTXT$) - N + 1, 1) <> " " THEN 5236 5234 NEXT N 5235 N = 1 5236 BT$ = LEFT$(PKTXT$, LEN(PKTXT$) - N + 1) 5237 COLOR 0, 7 5238 PRINT BT$ 5239 COLOR 7, 0 5240 PRINT 5241 PRINT 5242 PRINT "IS THIS O.K. "; 5243 INPUT ANS$ 5244 IF LEFT$(ANS$, 1) = "y" OR LEFT$(ANS$, 1) = "Y" THEN 5247 5245 CLOSE #11 5246 CLS : GOTO 5210 5247 CLOSE #11: OPEN "R", #11, DSK$(11) + CHAR$(1), 80: FIELD #11, 80 AS PKTXT$: GET #11, 2 5248 CEREC = VAL(MID$(PKTXT$, 1, 10)) 5249 CNREC = VAL(MID$(PKTXT$, 11, 10)) 5250 IBREC = VAL(MID$(PKTXT$, 21, 10)) 5251 IEREC = VAL(MID$(PKTXT$, 31, 10)) 5260 ON EDFLG% GOTO 7260, 4740, 4702 5300 GET #11, R3 5340 CREC = R3 5380 CHAR$(2) = MID$(PKTXT$, 9, 9) 5420 CHAR$(3) = LEFT$(PKTXT$, 5) 5460 CHAR$(4) = MID$(PKTXT$, 18, 1) 5500 CHAR$(5) = MID$(PKTXT$, 19, 1) 5540 CHAR$(6) = MID$(PKTXT$, 29, 1) 5580 CHAR$(7) = MID$(PKTXT$, 30, 1) 5620 CHAR$(8) = MID$(PKTXT$, 32, 1) 5660 FOR N = 9 TO 11 5700 CHAR$(N) = MID$(PKTXT$, 34 + (N - 9) * 4, 4) 5740 CHAR$(N + 3) = MID$(PKTXT$, 46 + (N - 9) * 2, 2) 5780 NEXT N 5820 CHAR$(15) = MID$(PKTXT$, 62, 7) 5860 CHAR$(16) = MID$(PKTXT$, 69, 7) 5900 CHAR$(17) = MID$(PKTXT$, 76, 4) 5940 R4 = VAL(MID$(PKTXT$, 20, 9)) 5980 IREC1 = R4 6020 GET #11, R4 6060 QKTXT$ = RIGHT$(PKTXT$, LEN(PKTXT$) - 8) 6100 L = 1 6140 PK$(L) = "" 6180 FOR N = 1 TO LEN(QKTXT$) 6220 IF ASC(MID$(QKTXT$, N, 1)) = 3 THEN 6500 6260 PK$(L) = PK$(L) + MID$(QKTXT$, N, 1) 6300 NEXT N 6340 R4 = R4 + 1 6380 GET #11, R4 6420 QKTXT$ = PKTXT$ 6460 GOTO 6180 6500 IF LEN(PK$(L)) <= 70 THEN 6510 6505 PK$(L) = LEFT$(PK$(L), 70) 6510 PK$(L) = RIGHT$(PK$(L), LEN(PK$(L)) - 2) + STRING$(70 - LEN(PK$(L)), 32) + "[" + MID$(PK$(L), 2, 1) + "][" + LEFT$(PK$(L), 1) 6540 IF MID$(PK$(L), 73, 1) <> " " THEN 6660 6580 PK$(L) = PK$(L) + " ]" + RIGHT$(STR$(L), 3) 6620 GOTO 6700 6660 PK$(L) = PK$(L) + "99]" + RIGHT$(STR$(L), 3) 6700 QKTXT$ = RIGHT$(QKTXT$, LEN(QKTXT$) - N) 6705 IF LEN(PK$(L)) < 80 THEN PK$(L) = PK$(L) + STRING$(80 - LEN(PK$(L)), 32) 6740 IF LEN(QKTXT$) <> 0 THEN 6900 6780 R4 = R4 + 1 6820 GET #11, R4 6860 QKTXT$ = PKTXT$ 6900 IF ASC(LEFT$(QKTXT$, 1)) = 3 THEN 7060 6940 L = L + 1 6980 PK$(L) = "" 7020 GOTO 6180 7060 IREC2 = R4 7100 L = L + 1 7140 FOR N = L TO MAXL 7180 PK$(N) = STRING$(68, 32) + "[ ][ ]" + RIGHT$(STR$(N), 3) 7185 IF LEN(PK$(N)) < 80 THEN PK$(N) = PK$(N) + STRING$(80 - LEN(PK$(N)), 32) 7220 NEXT N 7260 GOSUB 7500 7300 ON EDFLG% GOTO 7340, 51540, 7302 7302 LOCATE 3, 1, 1, 6, 7 7304 COLOR 0, 7 7306 PRINT "You are editing item no. "; 7308 COLOR 24, 1 7310 PRINT JEY$; 7312 COLOR 0, 7 7314 LOCATE BL, 1, 1, 6, 7 7340 GOTO 12300 7380 REM 7420 REM BEGIN SCREEN INITIATION 7460 REM 7500 ON EDFLG% GOTO 7540, 8100, 8100 7540 CHAR$(2) = "X " 7580 CHAR$(3) = "10000" 7620 CHAR$(4) = "1" 7660 CHAR$(5) = "5" 7700 CHAR$(6) = "5" 7740 CHAR$(7) = "1" 7780 CHAR$(8) = " " 7820 FOR N = 9 TO 11 7860 CHAR$(N) = " " 7900 CHAR$(N + 3) = " " 7940 NEXT N 7980 CHAR$(15) = " " 8020 CHAR$(16) = " " 8060 CHAR$(17) = " " 8100 CLS 8140 LOCATE 1, 1, 1, 6, 7 8180 PRINT "TEST ITEM BANK NO."; 8220 COLOR 0, 7 8260 PRINT CHAR$(1) 8300 COLOR 7, 0 8340 LOCATE 2, 1, 1, 6, 7 8380 PRINT "Answers"; 8420 COLOR 0, 7 8460 PRINT CHAR$(2); 8500 COLOR 7, 0 8540 PRINT " Category"; 8580 COLOR 0, 7 8620 PRINT CHAR$(3); 8660 COLOR 7, 0 8700 PRINT " Subitems"; 8740 COLOR 0, 7 8780 PRINT CHAR$(4); 8820 COLOR 7, 0 8860 PRINT " Options"; 8900 COLOR 0, 7 8940 PRINT CHAR$(5); 9020 COLOR 7, 0 9060 PRINT " Txt. ref."; 9100 COLOR 0, 7 9140 PRINT CHAR$(15); 9180 COLOR 7, 0 9220 PRINT 9260 PRINT 9300 PRINT "Difficulty"; 9340 COLOR 0, 7 9380 PRINT CHAR$(6); 9460 COLOR 7, 0 9500 PRINT " Behavior"; 9540 COLOR 0, 7 9580 PRINT CHAR$(7); 9660 COLOR 7, 0 9700 PRINT " Enhancement"; 9740 COLOR 0, 7 9780 PRINT CHAR$(8); 9820 COLOR 7, 0 9860 PRINT 9900 PRINT 9940 PRINT "Keywords"; 9980 FOR N = 1 TO 3 10020 COLOR 0, 7 10060 PRINT CHAR$(8 + N); 10100 COLOR 7, 0 10140 PRINT " "; 10180 NEXT N 10220 PRINT " sp. char."; 10260 FOR N = 1 TO 3 10300 COLOR 0, 7 10340 PRINT CHAR$(11 + N); 10380 COLOR 7, 0 10420 PRINT " "; 10460 NEXT N 10500 LOCATE 4, 60, 1, 6, 7 10540 PRINT "Res. ref."; 10580 COLOR 0, 7 10620 PRINT CHAR$(16); 10660 COLOR 7, 0 10700 LOCATE 6, 60, 1, 6, 7 10740 PRINT "soUrce"; 10780 COLOR 0, 7 10820 PRINT CHAR$(17); 10860 COLOR 7, 0 10900 LOCATE 10, 1, 1, 6, 7 10940 PRINT "*******************************************************************************"; 10980 X = 57 11020 FOR Y = 1 TO 9 11060 LOCATE Y, X, 1, 6, 7 11100 PRINT "|"; 11140 NEXT Y 11180 LOCATE 7, 9, 1, 6, 7 11220 PRINT "K L M X Y Z"; 11260 REM 11300 REM VARIABLE INITIATION SECTION 11340 REM 11380 EFLAG = 0 11420 X = 1 11460 Y = BL 11500 ON EDFLG% GOTO 11540, 11740, 11740 11540 FOR N = 1 TO MAXL 11580 PK$(N) = STRING$(68, 32) + "[ ][ ]" + RIGHT$(STR$(N), 3) 11620 QK$(N) = "" 11660 IF LEN(PK$(N)) < 80 THEN PK$(N) = PK$(N) + STRING$(80 - LEN(PK$(N)), 32) 11700 NEXT N 11740 LOCATE BL, 1, 1, 6, 7 11780 FOR N = BL TO EL 11820 PRINT PK$(N - BL + 1); 11860 NEXT N 11900 LOCATE Y, X, 1, 6, 7 11940 ITEML = 1 11980 SUBL = 1 12020 SUBIT = 1 12060 Y = 11 12100 X = 1 12140 RETURN 12180 REM 12220 REM END OF STRING INITIATION SUBROUTINE 12260 REM 12300 B$ = INKEY$ 12340 IF LEN(B$) <> 0 THEN 12380 ELSE 12300 12380 IF EFLAG = 1 THEN GOSUB 22020 ON LEN(B$) GOTO 12420, 12610 12420 IF ASC(B$) > 31 THEN GOSUB 15060 12460 TRIAL = ASC(B$) 12500 IF TRIAL > 27 AND TRIAL < 32 OR TRIAL = 0 THEN 12300 12540 ON TRIAL GOSUB 12600, 12600, 12600, 19340, 16300, 12600, 14500, 18900, 12600, 12600, 34340, 12600, 17940, 13220, 25580, 12600, 12740, 12600, 18900, 12600, 12600, 12600, 12600, 17060, 13940, 12600, 50531 12580 GOTO 12300 REM REM THE FOLLOWING STATEMENT IS A DUMMY SUBROUTINE FOR THE PRECEDING REM "ON TRIAL GOSUB" STATEMENT REM IT SERVES ONLY TO MAKE ALL "GOSUB" POINTS CONSISTENT. REM 12600 RETURN 12610 IF ASC(MID$(B$, 1, 1)) <> 0 THEN 12300 TRIAL = ASC(MID$(B$, 2, 1)) IF TRIAL < 71 OR TRIAL > 83 THEN 12300 ON TRIAL - 70 GOSUB 12616, 16300, 12618, 12618, 18900, 12618, 19340, 12618, 12617, 17060, 12618, 12618, 14500 GOTO 12300 12616 X = 1 LOCATE Y, X, 1, 6, 7 RETURN 12617 X = 68 LOCATE Y, X, 1, 6, 7 12618 RETURN 12620 REM 12660 REM OTHER CURSOR CONTROL 12700 REM 12740 A$ = INKEY$ 12780 IF LEN(A$) = 0 THEN 12740 12820 IF A$ = "S" OR A$ = "s" THEN 12940 12860 IF A$ = "D" OR A$ = "d" THEN 13060 12900 RETURN 12940 X = 1 12980 LOCATE Y, X, 1, 6, 7 13020 RETURN 13060 X = 68 13100 LOCATE Y, X, 1, 6, 7 13140 RETURN 13180 REM INSERT LINE 13220 IF X <= 68 THEN 13300 13260 X = 1 13300 IF LEFT$(PK$(MAXL), 68) = STRING$(68, " ") THEN 13380 13340 RETURN 13380 FOR N = MAXL - 1 TO ITEML + 1 STEP -1 13420 PK$(N + 1) = LEFT$(PK$(N), 76) + RIGHT$(PK$(N + 1), 4) 13460 NEXT N 13500 PK$(ITEML + 1) = MID$(PK$(ITEML), X, 69 - X) + STRING$(X - 1, " ") + MID$(PK$(ITEML), 69, 8) + RIGHT$(PK$(ITEML + 1), 4) 13540 PK$(ITEML) = LEFT$(PK$(ITEML), X - 1) + STRING$(69 - X, " ") + "[ ][ ]" + RIGHT$(PK$(ITEML), 4) 13580 LOCATE Y, 1, 1, 6, 7 13620 FOR N = Y TO EL 13660 PRINT PK$(ITEML + N - Y); 13700 NEXT N 13740 LOCATE Y, X, 1, 6, 7 13780 RETURN 13820 REM 13860 REM DELETE LINE 13900 REM 13940 FOR N = ITEML TO MAXL - 1 13980 PK$(N) = LEFT$(PK$(N + 1), 76) + RIGHT$(PK$(N), 4) 14020 NEXT N 14060 PK$(MAXL) = STRING$(68, " ") + "[ ][ ]" + RIGHT$(PK$(MAXL), 4) 14100 X = 1 14140 LOCATE Y, X, 1, 6, 7 14180 FOR N = Y TO EL 14220 PRINT PK$(ITEML + N - Y); 14260 NEXT N 14300 LOCATE Y, X, 1, 6, 7 14340 RETURN 14380 REM 14420 REM SUBROUTINE DELETE CHARACTER 14460 REM 14500 IF X = 70 OR X = 73 THEN 14700 14540 PK$(ITEML) = LEFT$(PK$(ITEML), X - 1) + MID$(PK$(ITEML), X + 1, 68 - X) + " " + RIGHT$(PK$(ITEML), 12) 14580 PRINT RIGHT$(PK$(ITEML), 81 - X); 14620 LOCATE Y, X, 1, 6, 7 14660 RETURN 14700 PRINT " "; 14740 IF X <> 73 THEN 14860 14780 PRINT " "; 14820 PK$(ITEML) = LEFT$(PK$(ITEML), X) + " " + RIGHT$(PK$(ITEML), 80 - X - 3) 14860 LOCATE Y, X, 1, 6, 7 14900 RETURN 14940 REM 14980 REM SUBROUTINE PUT CHARACTER 15020 REM 15060 IF X >= 70 THEN 15380 15100 PRINT B$; 15140 PK$(ITEML) = LEFT$(PK$(ITEML), X - 1) + B$ + RIGHT$(PK$(ITEML), 80 - X) 15180 X = X + 1 15220 IF X <= 68 THEN RETURN 15260 LOCATE Y, 68, 1, 6, 7 15300 X = 68 15340 RETURN 15380 IF X = 70 THEN 15460 ELSE 15700 15420 RETURN 15460 IF ASC(B$) >= 51 AND ASC(B$) <= 53 OR ASC(B$) = 57 OR ASC(B$) = 32 THEN 15500 ELSE RETURN 15500 PRINT B$; 15540 PK$(ITEML) = LEFT$(PK$(ITEML), X - 1) + B$ + RIGHT$(PK$(ITEML), 80 - X) 15580 X = X + 3 15620 LOCATE Y, X, 1, 6, 7 15660 RETURN 15700 IF ASC(B$) >= 48 AND ASC(B$) <= 57 OR ASC(B$) = 32 THEN 15740 ELSE RETURN 15740 PRINT B$; 15780 LOCATE Y, 74, 1, 6, 7 15820 IF ASC(B$) = 32 THEN 15980 15860 PRINT "99"; 15900 LOCATE Y, X, 1, 6, 7 15940 GOTO 16060 15980 PRINT " "; 16020 LOCATE Y, X, 1, 6, 7 16060 PK$(ITEML) = LEFT$(PK$(ITEML), X - 1) + B$ + CHR$(SCREEN(Y, X + 1)) + CHR$(SCREEN(Y, X + 2)) + RIGHT$(PK$(ITEML), 80 - X - 2) 16100 LOCATE Y, X, 1, 6, 7 16140 RETURN 16180 REM 16220 REM SUBROUTINE UPCURSOR 16260 REM 16300 IF ITEML = 1 THEN RETURN 16340 IF Y = BL THEN 16540 16380 Y = Y - 1 16420 ITEML = ITEML - 1 16460 LOCATE Y, X, 1, 6, 7 16500 RETURN 16540 X = 1 16580 LOCATE Y, X, 1, 6, 7 16620 ITEML = ITEML - 1 16660 FOR N = BL TO EL 16700 PRINT PK$(ITEML); 16740 ITEML = ITEML + 1 16780 NEXT N 16820 LOCATE Y, X, 1, 6, 7 16860 ITEML = ITEML - 13 16900 RETURN 16940 REM 16980 REM SUBROUTINE DOWNCURSOR 17020 REM 17060 IF ITEML >= MAXL THEN GOSUB 20020 17100 IF EFLAG = 1 THEN ITEML = ITEML - 1 17140 IF Y = EL THEN 17340 17180 Y = Y + 1 17220 LOCATE Y, X, 1, 6, 7 17260 ITEML = ITEML + 1 17300 RETURN 17340 LOCATE BL, 1, 1, 6, 7 17380 Y = Y - 12 17420 ITEML = ITEML - 12 17460 FOR N = BL TO EL 17500 ITEML = ITEML + 1 17540 PRINT PK$(ITEML); 17580 Y = Y + 1 17620 NEXT N 17660 Y = EL 17700 X = 1 17740 LOCATE Y, X, 1, 6, 7 17780 RETURN 17820 REM 17860 REM SUBROUTINE CARRIAGE RETURN 17900 REM 17940 IF ITEML < MAXL THEN 18060 17980 GOSUB 20020 18020 RETURN 18060 IF Y = EL THEN 18300 18100 Y = Y + 1 18140 X = 1 18180 ITEML = ITEML + 1 18220 LOCATE Y, X, 1, 6, 7 18260 RETURN 18300 LOCATE BL, 1, 1, 6, 7 18340 Y = Y - 12 18380 ITEML = ITEML - 12 18420 FOR N = BL TO EL 18460 ITEML = ITEML + 1 18500 PRINT PK$(ITEML); 18540 Y = Y + 1 18580 NEXT N 18620 Y = EL 18660 X = 1 18700 LOCATE Y, X, 1, 6, 7 18740 RETURN 18780 REM 18820 REM SUBROUTINE LEFT CURSOR 18860 REM 18900 IF X = 1 THEN RETURN 18940 IF X = 70 OR X = 73 THEN 19100 18980 X = X - 1 19020 LOCATE Y, X, 1, 6, 7 19060 RETURN 19100 IF X = 70 THEN X = X - 2 19140 IF X = 73 THEN X = X - 3 19180 GOTO 19020 19220 REM 19260 REM SUBROUTINE RIGHT CURSOR 19300 REM 19340 IF X = 68 OR X = 70 THEN 19540 19380 IF X = 73 THEN RETURN 12300 19420 X = X + 1 19460 LOCATE Y, X, 1, 6, 7 19500 RETURN 19540 IF X = 70 THEN X = X + 3 19580 IF X = 68 THEN X = X + 2 19620 LOCATE Y, X, 1, 6, 7 19660 RETURN 19700 REM 19740 REM SUBROUTINE LINE CODES 19780 REM 19820 REM 19860 REM MESSAGE YOU HAVE USED ALL LINES POSSIBLE FOR THIS ITEM 19900 REM 19940 REM FIRST OF ALL, GET DRAGNET 19980 REM 20020 GOSUB 22820 20060 COLOR 0, 7 20100 LOCATE YEM, XEM, 1, 6, 7 20140 PRINT "YOU CANNOT GO BEYOND THE LAST LINE OF YOUR ITEM"; 20180 COLOR 7, 0 20220 LOCATE Y, X, 1, 6, 7 20260 EFLAG = 1 20300 RETURN 20340 REM 20380 REM MESSAGE ITEM IS BEING PLACED IN BANK 20420 REM 20460 REM FIRST OF ALL, GET CLOSE ENCOUNTERS 20500 REM 20540 GOSUB 23820 20580 COLOR 0, 7 20620 LOCATE YEM, XEM, 1, 6, 7 20660 PRINT "ITEM IS BEING PLACED IN BANK"; 20700 COLOR 7, 0 20740 LOCATE Y, X, 1, 6, 7 20780 EFLAG = 1 20820 RETURN 20860 REM 20900 REM MESSAGE: ONLY A,B,C,D,E,K,O,P,R,S,T ALLOWED HERE 20940 REM 20980 REM GET BEETHOVEN'S 5TH 21020 REM 21060 GOSUB 24940 21100 COLOR 0, 7 21140 LOCATE YEM, XEM, 1, 6, 7 21180 PRINT "ONLY A,B,C,D,E,K,L,M,O,R,S,T,X,Y,Z ALLOWED HERE"; 21220 COLOR 7, 0 21260 LOCATE Y, X, 1, 6, 7 21300 EFLAG = 1 21340 GOSUB 27420 21380 RETURN 21420 REM 21460 REM NIGHT ON BALD MOUNTAIN 21500 REM 21540 SPEED = 2 + 4 * RND(1) 21580 FREQ = 440 + 440 * RND(1) 21620 FOR NN = 1 TO 3 21660 SOUND FREQ, SPEED - .1 21700 SOUND 20000, .1 21740 NEXT NN 21780 SOUND FREQ * 2 ^ (-1 / 12), SPEED 21820 SOUND FREQ * 2 ^ (-3 / 12), SPEED * 4 21860 RETURN 21900 REM 21940 REM ERASE ERROR MESSAGE 21980 REM 22020 COLOR 7, 0 22060 FOR NN = YEM TO YEM + 1 22100 LOCATE NN, XEM, 1, 6, 7 22140 PRINT " "; 22180 NEXT NN 22220 EFLAG = 0 22260 LOCATE Y, X, 1, 6, 7 22300 RETURN 22340 REM HERNANDO'S HIDEAWAY 22380 SPEED = 2 + 4 * RND(1) 22420 FREQ = 220 + 220 * RND(1) 22460 SOUND FREQ, SPEED * 3 22500 SOUND FREQ * 2 ^ (1 / 12), SPEED 22540 SOUND FREQ, SPEED * 3 22580 SOUND FREQ * 2 ^ (1 / 12), SPEED 22620 SOUND FREQ, SPEED 22660 SOUND FREQ * 2 ^ (1 / 3), SPEED: SOUND FREQ * 2 ^ (7 / 12), SPEED: RETURN 22700 REM 22740 REM DRAGNET 22780 REM 22820 SPEED = 1 + 1 * RND(1) 22860 FREQ = 220 + 220 * RND(1) 22900 SOUND FREQ, 3 * SPEED 22940 SOUND FREQ * 2 ^ (2 / 12), SPEED 22980 SOUND FREQ * 2 ^ (3 / 12), SPEED * 2 23020 SOUND FREQ, 2 * SPEED 23060 SOUND 20000, 8 * SPEED 23100 SOUND FREQ, 3 * SPEED 23140 SOUND FREQ * 2 ^ (2 / 12), SPEED 23180 SOUND FREQ * 2 ^ (3 / 12), SPEED * 2 23220 SOUND FREQ, 2 * SPEED 23260 SOUND FREQ * 2 ^ (6 / 12), SPEED * 8 23300 RETURN 23340 REM 23380 REM BACH'S TOCCATA & FUGUE IN G MINOR 23420 REM 23460 SPEED = 8 + 8 * RND(1) 23500 FREQ = 440 + 440 * RND(1) 23540 SOUND FREQ, SPEED 23580 SOUND FREQ * 2 ^ (-1 / 12), SPEED 23620 SOUND FREQ * 2 ^ (-2 / 3), SPEED * 2 23660 RETURN 23700 REM 23740 REM CLOSE ENCOUNTERS 23780 REM 23820 SPEED = 4 + 4 * RND(1) 23860 FREQ = 440 + 440 * RND(1) 23900 SOUND FREQ * 2 ^ (2 / 12), SPEED 23940 SOUND FREQ * 2 ^ (4 / 12), SPEED 23980 SOUND FREQ, SPEED 24020 SOUND FREQ / 2, SPEED 24060 SOUND FREQ * 2 ^ (-5 / 12), SPEED * 4 24100 SPEED = SPEED / 2 24140 RETURN 24180 REM 24220 REM FUNERAL MARCH OF THE MARIONETTES 24260 REM 24300 SPEED = 2 + 3 * RND(1) 24340 FREQ = 440 + 440 * RND(1) 24380 SOUND FREQ, SPEED * 2 * .9 24420 SOUND 20000, SPEED * 2 * .1 24460 SOUND FREQ, SPEED * .9 24500 SOUND 20000, SPEED * .1 24540 SOUND FREQ, SPEED 24580 SOUND FREQ * 2 ^ (-1 / 12), SPEED 24620 SOUND FREQ * 2 ^ (-3 / 12), SPEED 24660 SOUND FREQ * 2 ^ (-1 / 12), SPEED * 2 24700 SOUND FREQ, SPEED 24740 SOUND FREQ * 2 ^ (2 / 12), SPEED * 3 24780 RETURN 24820 REM 24860 REM BEETHOVEN'S FIFTH 24900 REM 24940 SPEED = 2 + 2 * RND(1) 24980 REEK = 220 + 220 * RND(1) 25020 FOR W = 0 TO 1 25060 FREQ = REEK * 2 ^ ((4 - W * 2) / 12) 25100 FOR Z = 1 TO 3 25140 SOUND FREQ, SPEED 25180 SOUND 20000, .1 25220 NEXT Z 25260 IF W = 1 THEN 25380 25300 SOUND FREQ * 2 ^ (-4 / 12), SPEED * 9 25340 NEXT W 25380 SOUND FREQ * 2 ^ (-3 / 12), SPEED * 9 25420 RETURN 25460 REM 25500 REM CHARACTERISTIC CONTROL SECTION 25540 REM 25580 COLOR 0, 7 25620 A$ = INKEY$ 25660 IF LEN(A$) = 0 THEN 25620 25700 IF ASC(A$) < 97 OR ASC(A$) > 122 THEN 25820 25740 TRIAL = ASC(A$) - 96 25780 GOTO 25900 25820 IF ASC(A$) < 65 OR ASC(A$) > 90 THEN GOSUB 21060 25860 TRIAL = ASC(A$) - 64 25900 ON TRIAL GOTO 26020, 26020, 26020, 26020, 26020, 25940, 26020, 25940, 25940, 25940, 26020, 26020, 26020, 25940, 26020, 25940, 25940, 26020, 26020, 26020, 26020, 25940, 25940, 26020, 26020, 26020 25940 GOSUB 21060 25980 RETURN 26020 ZONE = NUMZ(TRIAL) 26060 REM 26100 REM CHARACTERISTICS ENTRY 26140 REM 26180 IX = X 26220 IY = Y 26260 X = CZONE(1, ZONE) 26300 Y = CZONE(3, ZONE) 26340 LOCATE Y, X, 1, 6, 7 26380 A$ = INKEY$ 26420 IF LEN(A$) = 0 THEN 26380 26460 ON EFLAG GOSUB 22020, 32020 26500 TRIAL = ASC(A$) 26540 FOR N = 1 TO NRG(ZONE) 26580 IF TRIAL >= ALFRG(1, N, ZONE) AND TRIAL <= ALFRG(2, N, ZONE) THEN 26700 26620 NEXT N 26660 GOTO 26380 26700 IF TRIAL >= 32 AND TRIAL <= 127 THEN TRIAL = 32 26740 ON TRIAL GOSUB 29580, 26820, 26820, 27980, 26820, 29100, 26820, 28260, 26820, 26820, 26820, 26820, 26820, 26820, 26820, 26820, 26820, 26820, 28740, 26820, 26820, 26820, 26820, 26820, 26820, 26820, 26900, 26820, 26820, 26820, 26820, 27580 26780 GOTO 26380 26820 STOP 26860 REM 26900 REM RETURN TO TEXT SECTION 26940 REM 26980 GOSUB 30180 27020 IF EFLAG <> 0 THEN RETURN 27060 COLOR 7, 0 27100 X = IX 27140 Y = IY 27180 LOCATE Y, X, 1, 6, 7 27220 RETURN 12300 27260 REM RIGHT CURSOR SECTION 27300 REM 27340 REM SUBROUTINE PRINT DIAGNOSTICS 27380 REM 27420 LOCATE 23, 1, 1, 6, 7 27460 PRINT VAR$; " "; VAR; 27500 LOCATE Y, X, 1, 6, 7 27540 RETURN 27580 REM 27620 REM ALPHABETIC OR NUMERIC CHARACTERISTIC INPUT SUBROUTINE 27660 REM 27700 PRINT A$; 27740 X = X + 1 27780 IF X > CZONE(2, ZONE) THEN 27860 27820 RETURN 27860 X = X - 1 27900 LOCATE Y, X, 1, 6, 7 27940 RETURN 27980 REM 28020 REM RIGHT CURSOR MOVEMENT FOR CHARACTERISTICS 28060 REM 28100 IF X = CZONE(2, ZONE) THEN RETURN 28140 X = X + 1 28180 LOCATE Y, X, 1, 6, 7 28220 RETURN 28260 REM 28300 REM DELETE CHARACTERISTICS ROUTINE 28340 REM 28380 IF X = CZONE(1, ZONE) THEN 28620 28420 X = X - 1 28460 LOCATE Y, X, 1, 6, 7 28500 PRINT " "; 28540 LOCATE Y, X, 1, 6, 7 28580 RETURN 28620 PRINT " "; 28660 LOCATE Y, X, 1, 6, 7 28700 RETURN 28740 REM 28780 REM LEFT CURSOR ROUTINE 28820 REM 28860 IF X = CZONE(1, ZONE) THEN RETURN 28900 X = X - 1 28940 VAR$ = STR$(X) + " " + STR$(XZ1) 29020 LOCATE Y, X, 1, 6, 7 29060 RETURN 29100 REM 29140 REM JUMP TO NEXT ZONE ROUTINE 29180 REM 29220 GOSUB 30180 29260 IF EFLAG <> 0 THEN RETURN 29300 IF ZONE = 17 THEN RETURN 29340 ZONE = ZONE + 1 29380 IF ZONE = 4 THEN ZONE = ZONE + 1 29420 X = CZONE(1, ZONE) 29460 Y = CZONE(3, ZONE) 29500 LOCATE Y, X, 1, 6, 7 29540 RETURN 29580 REM 29620 REM JUMP TO PREVIOUS ZONE ROUTINE 29660 REM 29700 GOSUB 30180 29740 IF EFLAG <> 0 THEN RETURN 29780 IF ZONE = 2 THEN RETURN 29820 ZONE = ZONE - 1 29860 IF ZONE = 4 THEN ZONE = ZONE - 1 29900 X = CZONE(1, ZONE) 29940 Y = CZONE(3, ZONE) 29980 LOCATE Y, X, 1, 6, 7 30020 RETURN 30060 REM 30100 REM MAKE CHAR$ ARRAY EQUAL TO WHAT IS CURRENTLY IN THAT ZONE 30140 REM 30180 EFLAG = 0 30220 DUM$ = "" 30260 FOR M = CZONE(1, ZONE) TO CZONE(2, ZONE) 30300 DUM$ = DUM$ + CHR$(SCREEN(CZONE(3, ZONE), M)) 30340 NEXT M 30380 CHAR$(ZONE) = DUM$ 30420 REM 30460 REM GO TO ERROR DETECTION ROUTINES 30500 REM 30540 ON ZONE GOTO 30580, 30620, 32500, 30580, 30580, 30580, 30580, 30580, 33340, 33340, 33340, 33340, 33340, 33340, 30580, 30580, 30580 30580 RETURN 30620 FOR N = 1 TO LEN(CHAR$(ZONE)) 30660 IF ASC(MID$(CHAR$(ZONE), LEN(CHAR$(ZONE)) - N + 1, 1)) <> 32 THEN 31100 30700 NEXT N 30740 REM GET BACH'S TOCCATA IN D MINOR 30780 GOSUB 23460 30820 LOCATE YEM, XEM, 1, 6, 7 30860 PRINT "AT LEAST ONE ANSWER(LEFT JUSTIFIED) IS"; 30900 LOCATE YEM + 1, XEM, 1, 6, 7 30940 PRINT "REQUIRED IN THIS ZONE"; 30980 EFLAG = 2 31020 LOCATE Y, X, 1, 6, 7 31060 RETURN 31100 IF N = LEN(CHAR$(ZONE)) THEN 31260 31140 FOR M = N TO LEN(CHAR$(ZONE)) 31180 IF ASC(MID$(CHAR$(ZONE), LEN(CHAR$(ZONE)) - M + 1, 1)) = 32 THEN 31580 31220 NEXT M 31260 CHAR$(4) = RIGHT$(STR$(LEN(CHAR$(ZONE)) - N + 1), 1) 31300 LOCATE 2, 42, 1, 6, 7 31340 PRINT CHAR$(4); 31380 LOCATE Y, X, 1, 6, 7 31420 RETURN 31460 REM 31500 REM FIRST OF ALL GET BACH'S TOCCATA IN D MINOR 31540 REM 31580 GOSUB 23460 31620 LOCATE YEM, XEM, 1, 6, 7 31660 PRINT "YOU HAVE A BLANK IN THE INTERIOR OF THE ANSWER"; 31700 LOCATE YEM + 1, XEM, 1, 6, 7 31740 PRINT "STRING. THAT IS NOT ALLOWED."; 31780 EFLAG = 2 31820 LOCATE Y, X, 1, 6, 7 31860 RETURN 31900 REM 31940 REM 2ND ERASE ERROR MESSAGES ROUTINE (IF ONE IS COMING FROM REVERSED COLOR AREA) 31980 REM 32020 COLOR 7, 0 32060 FOR N = YEM TO YEM + 1 32100 LOCATE N, XEM, 1, 6, 7 32140 PRINT " "; 32180 NEXT N 32220 EFLAG = 0 32260 COLOR 0, 7 32300 LOCATE Y, X, 1, 6, 7 32340 RETURN 32380 REM 32420 REM ERROR DETECTION FOR ZONE 3 (CATEGORY) 32460 REM 32500 FOR N = 1 TO LEN(CHAR$(ZONE)) 32540 IF ASC(MID$(CHAR$(ZONE), LEN(CHAR$(ZONE)) - N + 1, 1)) <> 32 THEN 32620 32580 GOTO 32900 32620 NEXT N 32660 RETURN 32700 REM 32740 REM ERROR MESSAGE 32780 REM 32820 REM GET HERNANDO'S HIDEAWAY 32860 REM 32900 GOSUB 22380 32940 LOCATE YEM, XEM, 1, 6, 7 32980 PRINT "THERE IS A BLANK IN YOUR CATEGORY FIELD." 33020 LOCATE YEM + 1, XEM, 1, 6, 7 33060 PRINT "THAT IS NOT ALLOWED." 33100 EFLAG = 2 33140 LOCATE Y, X, 1, 6, 7 33180 RETURN 33220 REM 33260 REM ERROR DETECTION FOR ZONES 9,10,11,12,13,14 (KWDS & SP. CHR.) 33300 REM 33340 DFLAG = 0 33380 CFLAG = 0 33420 IF LEFT$(CHAR$(ZONE), 1) <> " " THEN DFLAG = 1 33460 FOR N = 1 TO LEN(CHAR$(ZONE)) 33500 IF MID$(CHAR$(ZONE), N, 1) <> " " THEN CFLAG = 1 33540 IF CFLAG <> DFLAG THEN 33900 33580 CFLAG = 0 33620 NEXT N 33660 RETURN 33700 REM 33740 REM ERROR MESSAGE, ZONE 9,10,11,12,13 OR 14 HAS ILLEGAL COMBINATION 33780 REM 33820 REM GET FUNERAL MARCH OF THE MARIONETTES 33860 REM 33900 GOSUB 24300 33940 LOCATE YEM, XEM, 1, 6, 7 33980 PRINT "ZONE MUST BE ALL BLANKS OR ALL INTEGERS" 34020 EFLAG = 2 34060 LOCATE Y, X, 1, 6, 7 34100 RETURN 34180 REM 34220 REM SECTION TO DETERMINE IF END-OF-SUBITEM AND END-OF-ITEM 34260 REM INDICATORS ARE IN PLACE AND ARE IN SEQUENCE 34300 REM 34340 ISUB = VAL(CHAR$(4)) 34380 ICOMP = 0 34420 LSTL = 0 34460 BRF = 0 34500 BRR = 0 34540 FOR N = 1 TO MAXL 34580 IF MID$(PK$(N), 73, 1) = " " THEN 35140 34620 IF ISUB > 1 THEN 34780 34660 MCOMP = VAL(MID$(PK$(N), 73, 1)) 34700 IF MCOMP <> 9 THEN 36940 34740 GOTO 38582 34780 IF MID$(PK$(N), 73, 1) = " " THEN 35140 34820 MCOMP = VAL(MID$(PK$(N), 73, 1)) 34860 IF MCOMP = ICOMP AND MCOMP = 9 THEN 38582 34900 IF MCOMP <> ICOMP AND ICOMP < ISUB THEN 37420 34940 IF MCOMP <> ICOMP THEN 35060 34980 ICOMP = ICOMP + 1 35020 GOTO 35140 35060 IF MCOMP <> 9 THEN 37420 35100 GOTO 38582 35140 NEXT N 35180 REM 35220 REM 35260 REM FIRST OF ALL, GET NIGHT ON BALD MOUNTAIN 35300 REM 35340 GOSUB 21540 35380 COLOR 0, 7 35420 LOCATE YEM, XEM, 1, 6, 7 35460 PRINT "THERE IS NO END MARKER [999] FOR THIS ITEM" 35500 EFLAG = 1 35540 GOSUB 35660 35580 GOTO 12300 35620 REM SUBROUTINE FOR REWRITING ITEM TO LAST LINE 35660 FOR N = MAXL TO 1 STEP -1 35700 IF LEFT$(PK$(N), 68) <> " " THEN 35820 35740 NEXT N 35780 N = 1 35820 NLN = N 35860 ITEML = NLN 35900 COLOR 7, 0 35940 LOCATE BL, 1, 1, 6, 7 35980 IF NLN > EL - BL + 1 THEN 36460 36020 FOR N = BL TO EL 36060 PRINT PK$(N - BL + 1); 36100 NEXT N 36140 IF NLN <> 1 THEN 36300 36180 Y = BL 36220 X = 1 36260 GOTO 36380 36300 Y = BL + NLN - 1 36340 X = 73 36380 LOCATE Y, X, 1, 6, 7 36420 RETURN 36460 FOR N = BL TO EL 36500 PRINT PK$(NLN - EL + N); 36540 NEXT N 36580 Y = EL 36620 X = 73 36660 LOCATE Y, X, 1, 6, 7 36700 RETURN 36740 REM 36780 REM ERROR MESSAGE: SINGLE ITEM CAN END ONLY WITH [999] 36820 REM 36860 REM FIRST OF ALL, GET NIGHT ON BALD MOUNTAIN 36900 REM 36940 GOSUB 21540 36980 COLOR 0, 7 37020 LOCATE YEM, XEM, 1, 6, 7 37060 PRINT "ONLY 999 ALLOWED FOR SINGLE QUESTION ITEM" 37100 EFLAG = 1 37140 GOSUB 35660 37180 GOTO 12300 37220 REM 37260 REM ERROR MESSAGE: INCOMPLETE SEQUENCE OF END SUB-ITEM MARKERS FOUND 37300 REM 37340 REM FIRST OF ALL, GET NIGHT ON BALD MOUNTAIN 37380 REM 37420 GOSUB 21540 37460 COLOR 0, 7 37500 LOCATE YEM, XEM, 1, 6, 7 37540 PRINT "BAD SEQUENCE OF END SUB-ITEM MARKER FOUND" 37580 EFLAG = 1 37620 REM 37660 REM THIS SECTION RECREATES SCREEN SHOWING WHERE BAD SEQUENCE OCCURS 37700 REM 37740 COLOR 7, 0 37780 LOCATE BL, 1, 1, 6, 7 37820 IF N > EL - BL + 1 THEN 38180 37900 FOR M = 1 TO EL - BL + 1 37940 PRINT PK$(M); 37980 NEXT M 38020 Y = N + BL - 1: X = 73 38060 LOCATE Y, X, 1, 6, 7 38100 ITEML = N 38140 GOTO 12300 38180 FOR M = N - EL + BL - 1 TO N 38220 PRINT PK$(M) 38260 NEXT M 38340 Y = N + BL - 1 38380 LOCATE Y, X, 1, 6, 7 38420 ITEML = N 38460 GOTO 12300 38500 REM 38540 REM GO TO SECTION THAT MAKES ROOM FOR NEW ITEM 38580 REM 38582 NLN = N 38583 ON EDFLG% GOTO 39460, 38630, 38584 38584 IF LEFT$(JEY$, 5) <> CHAR$(3) THEN 38630 38590 MREC = CREC 38592 ITID$ = JEY$ 38594 GOSUB 52780 38596 GOTO 38820 38600 REM 38601 REM NEED TO BLANK OUT CHARACTERISTICS LINE 38602 REM AND TO FIND PLACE FOR TEXT OF ITEM 38603 REM 38630 GOSUB 52780 38660 GOTO 39460 38700 REM 38740 REM THIS SECTION PACKS THE ITEM INTO ARRAY QK$ 38780 REM 38820 PLN = 1 38860 QK$(1) = ITID$ + CHR$(3) 38900 FOR N = 1 TO NLN 38940 FOR M = 68 TO 1 STEP -1 38980 IF MID$(PK$(N), M, 1) <> " " THEN 39060 39020 NEXT M 39060 QK$(PLN) = QK$(PLN) + MID$(PK$(N), 73, 1) + MID$(PK$(N), 70, 1) + LEFT$(PK$(N), M) + CHR$(3) 39100 IF LEN(QK$(PLN)) <= 80 THEN 39220 39140 PLN = PLN + 1 39180 QK$(PLN) = RIGHT$(QK$(PLN - 1), LEN(QK$(PLN - 1)) - 80) 39190 QK$(PLN - 1) = LEFT$(QK$(PLN - 1), 80) 39220 NEXT N 39260 QK$(PLN) = QK$(PLN) + CHR$(3) 39265 IF LEN(QK$(PLN)) <= 80 THEN 39380 39270 PLN = PLN + 1 39275 QK$(PLN) = RIGHT$(QK$(PLN - 1), LEN(QK$(PLN - 1)) - 80) 39280 QK$(PLN - 1) = LEFT$(QK$(PLN - 1), 80) 39285 GOTO 39265 39295 REM 39380 GOTO 45540 39420 REM 39460 ON ERROR GOTO 39540 39500 GOTO 39820 39540 STOP 39580 REM SECTION TO FIND 1ST OCCURRENCE OF CATEGORY TO BE ADDED 39620 REM 39660 REM FREC=FIRST RECORD, LREC=LAST RECORD 39700 REM BRR=BLANK RECORD REVERSE 39740 REM BRF=BLANK RECORD FORWARD 39780 REM 39820 IF CNREC = 0 THEN 40100 39860 REM 39900 GET #11, CEREC 39940 IF CHAR$(3) + "01" > LEFT$(PKTXT$, 7) THEN 40100 39980 GET #11, 3 40020 IF CHAR$(3) + "01" < LEFT$(PKTXT$, 7) THEN 40340 40060 GOTO 40740 40080 REM 40081 REM NEW CATEGORY+"01" IS GREATER THAN LAST ITEM ID CURRENTLY IN BANK 40082 REM 40100 ITID$ = CHAR$(3) + "01" 40140 IF CEREC < IBREC - 1 THEN 40180 40142 REM 40144 REM THERE IS NO ROOM BETWEEN CEREC AND IBREC. THUS, THIS SECTION 40145 REM PREPARES TO SEARCH FOR A SPACE BEHIND THE LOCATION WHERE THE 40146 REM CHARACTERISTICS LINE IS TO BE ADDED. 40147 REM 40148 BRF = -1 40150 MREC = CEREC 40152 GOSUB 46940 40154 GOTO 43620 40160 REM 40161 REM THERE IS SPACE AFTER LAST CATEGORY IN BANK. CEREC IS INCREMENTED, 40162 REM MREC IS SET EQUAL TO THE NEW CEREC AND PROGRAM TRANSFERS DIRECTLY 40163 REM TO SECTION WHICH PACKS ITEM, ENCODES CHARACTERISTIC LINE AND LOADS 40164 REM THEM BOTH. 40165 REM 40180 CEREC = CEREC + 1 40220 MREC = CEREC 40300 GOTO 38820 40320 REM 40321 REM NEW CATEGORY+"01" IS LESS THAN FIRST ITEM ID CURRENTLY IN BANK 40322 REM 40340 ITID$ = CHAR$(3) + "01" 40350 REM 40351 REM NO ROOM BEHIND BECAUSE NEWC+"01" " " THEN 41140 41020 MREC = MREC - 1 41060 GOTO 40860 41100 REM 41101 REM TEST FOR NEWC+"01" >= LEFT$(PKTXT$,7) 41102 REM 41140 COMP$ = LEFT$(PKTXT$, 7) 41180 IF CHAR$(3) + "01" >= COMP$ THEN 41300 41200 REM 41201 REM THE NEW CATEGORY +"01" IS LESS THAN THE 7-DIGIT ID BEING CHECKED. 41202 REM 41220 LREC = MREC 41260 GOTO 40820 41300 IF CHAR$(3) + "01" = COMP$ THEN 42060 41305 IF MREC = FREC THEN 41420 41320 REM 41321 REM THE NEW CATEGORY +"01" IS GREATER THAN THE 7-DIGIT ID BEING CHECKED. 41322 REM 41340 FREC = MREC 41380 GOTO 40820 41400 REM 41401 REM THE NEW CATEGORY + "01" IS GREATER THAN THE 7-DIGIT ID BEING CHECKED 41402 REM MREC=FREC EITHER THROUGH HALVING AND TRUCATION OR BACKING UP. 41403 REM HOWEVER, IT MAY ALSO BE GREATER THAN OR EQUAL TO ANY RECORD ABOVE IT 41404 REM UP TO THE KEY IN LREC-1. It may be equal to the key in LREC. 41405 REM 41406 REM THE NEXT SECTION INCREMENTS MREC FROM FREC TO AND INCLUDING LREC, 41407 REM SKIPPING SPACES AND CHECKING IF NEWC>=LEFT$(PKTXT$,7) 41408 REM 41420 SAVREC = MREC 41425 FOR MREC = FREC TO LREC 41430 GET #11, MREC 41435 IF LEFT$(PKTXT$, 1) = " " THEN 41460 41440 IF CHAR$(3) + "01" = LEFT$(PKTXT$, 7) THEN 42060 41445 IF CHAR$(3) + "01" > LEFT$(PKTXT$, 7) THEN 41455 41450 GOTO 41520 41455 SAVREC = MREC 41460 NEXT MREC 41465 PRINT "There seems to be a sequence error in your bank." 41470 PRINT "Program will now print out values in neighborhood where " 41471 PRINT "error occurred." 41472 PRINT 41475 LPRINT "Record numbers followed by contents of record:" 41480 FOR MREC = FREC TO LREC 41485 GET #11, MREC 41490 LPRINT MREC; PKTXT$ 41495 NEXT MREC 41500 CLOSE 41505 STOP 41510 REM 41515 REM 41520 MREC = SAVREC 41525 GET #11, MREC 41530 ITID$ = CHAR$(3) + "01" 41535 GOSUB 46940 41540 GOTO 43620 41740 GOSUB 46940 41780 GOTO 43620 42040 REM 42041 REM THE 7-DIGIT ID IS IDENTICAL TO THE NEW CATEGORY + "01" 42042 REM THIS SECTION MOVES FORWARD ALONG CHARACTERISTICS SECTION, 42043 REM CHECKING EACH 7-DIGIT ID FOR SEQUENTIAL INCREASE OVER THE 42044 REM LAST. IF A SEQUENTIAL GAP IS FOUND, THE NEW CATEGORY HAS THE 42045 REM APPROPRIATE SEQUENCE NUMBER ADDED TO IT AND THE PROGRAM TRANSFERS TO 42046 REM THE ITEM LOADING SECTION. 42047 REM 42060 KEYOLD = VAL(LEFT$(PKTXT$, 7)) 42065 RECOLD = MREC 42070 IF MREC = CEREC THEN 42505 42075 MREC = MREC + 1 42080 GET #11, MREC 42085 IF LEFT$(PKTXT$, 1) = " " THEN 42075 42090 IF VAL(LEFT$(PKTXT$, 7)) - KEYOLD <= 1 THEN 42060 42095 MREC = RECOLD 42100 GET #11, MREC 42105 ISEQ = VAL(MID$(PKTXT$, 6, 2)) + 1 42110 IF ISEQ > 9 THEN 42125 42115 ITID$ = CHAR$(3) + "0" + RIGHT$(STR$(ISEQ), 1) 42120 GOTO 42130 42125 ITID$ = CHAR$(3) + RIGHT$(STR$(ISEQ), 2) 42130 GOSUB 46940 42135 GOTO 43620 42500 REM 42501 REM mrec=cerec 42502 REM 42505 IF VAL(MID$(PKTXT$, 6, 2)) = 99 THEN 43340 42510 ISEQ = VAL(MID$(PKTXT$, 6, 2)) + 1 42515 IF ISEQ > 9 THEN 42530 42520 ITID$ = CHAR$(3) + "0" + RIGHT$(STR$(ISEQ), 1) 42525 GOTO 42535 42530 ITID$ = CHAR$(3) + RIGHT$(STR$(ISEQ), 2) 42535 CEREC = CEREC + 1 42540 MREC = CEREC 42545 GOTO 38820 43340 LOCATE YREC, XREM, 1, 6, 7 43380 COLOR 0, 7 43420 PRINT "THIS CATEGORY ALREADY HAS 99 ITEMS. PLEASE" 43460 PRINT "CHANGE CATEGORY AND CONTINUE" 43500 COLOR 7, 0 43540 LOCATE Y, X, 1, 6, 7 43580 GOTO 12300 43590 REM 43591 REM SECTION WHICH SHIFTS LINES FORWARD OR BACK TO MAKE BLANK SPACE. 43592 REM 43620 IF BRR < 0 AND BRF < 0 THEN 45260 43660 IF BRR = 0 OR BRF = 0 THEN GOSUB 46940 43700 IF BRR < 0 THEN 44500 43740 IF BRF < 0 THEN 43980 43780 IF BRF - MREC < MREC - BRR THEN 44500 43860 REM 43900 REM SHIFT CATEGORY LINES BACK 43940 REM 43980 FOR N = BRR TO MREC - 1 44020 GET #11, N + 1 44060 PUT #11, N 44100 NEXT N 44140 DUM$ = STRING$(80, " ") 44180 LSET PKTXT$ = DUM$ 44220 PUT #11, MREC 44340 GOTO 38820 44459 REM 44460 REM SHIFT CATEGORY LINES FORWARD 44461 REM 44500 IF BRF = MREC + 1 THEN 44860 44540 FOR N = BRF - 1 TO MREC + 1 STEP -1 44580 GET #11, N 44620 PUT #11, N + 1 44660 NEXT N 44700 GOTO 44860 44860 MREC = MREC + 1 44880 IF BRF > CEREC THEN CEREC = CEREC + 1 44900 DUM$ = STRING$(80, " ") 44940 LSET PKTXT$ = DUM$ 44980 PUT #11, MREC 45140 GOTO 38820 45260 PRINT "YOUR FILE HAS NO MORE SPACE." 45300 PRINT "RUN CLEANUP BEFORE AGAIN TRYING TO EDIT THIS BANK." 45340 CLOSE 45380 STOP 45420 REM 45460 REM SETS CHARACTER LINE AND ADDS CHARACTER LINE AND ITEM TO BANK 45500 REM 45540 ON EDFLG% GOTO 45550, 45545, 45545 45545 IF IREC2 - IREC1 + 1 >= PLN THEN 45560 45550 IPOINT = IEREC + 1 45555 GOTO 45575 45560 IPOINT = IREC1 45575 CL$ = ITID$ + " " + CHAR$(2) + CHAR$(4) + CHAR$(5) + STR$(IPOINT) + STRING$(9 - LEN(STR$(IPOINT)), " ") + CHAR$(6) + CHAR$(7) + " " + CHAR$(8) + " " 45576 CL$ = CL$ + CHAR$(9) + CHAR$(10) + CHAR$(11) + CHAR$(12) + CHAR$(13) + CHAR$(14) + " " + CHAR$(15) + CHAR$(16) + CHAR$(17) 45580 LSET PKTXT$ = CL$ 45700 PUT #11, MREC 45740 FOR N = 1 TO PLN 45780 LSET PKTXT$ = QK$(N) 45820 PUT #11, IPOINT - 1 + N 45860 NEXT N 45863 IF EDFLG% = 1 THEN 45900 45864 IF IREC2 = IEREC THEN 46100 45865 IF IREC2 - IREC1 + 1 >= PLN THEN 46100 45870 IF IBREC <> IREC1 THEN 45900 45875 GET #11, IBREC 45880 IF PKTXT$ <> STRING$(80, 32) THEN 45900 45885 IBREC = IBREC + 1 45890 GOTO 45875 45900 IEREC = IEREC + PLN 45910 IF EDFLG% = 1 THEN 45940 ELSE 46100 45940 CNREC = CNREC + 1 45980 REM 46020 REM THIS SECTION SETS UP RECORD 2: CEREC,CNREC,IBREC,IEREC 46060 REM 46100 DUM$ = STR$(CEREC) + STRING$(10 - LEN(STR$(CEREC)), 32) + STR$(CNREC) + STRING$(10 - LEN(STR$(CNREC)), 32) + STR$(IBREC) + STRING$(10 - LEN(STR$(IBREC)), 32) + STR$(IEREC) + STRING$(10 - LEN(STR$(IEREC)), 32) 46140 LSET PKTXT$ = DUM$ 46180 PUT #11, 2 46220 COLOR 0, 7 46260 LOCATE YEM, XEM, 1, 6, 7 46262 ON EDFLG% GOTO 46300, 46300, 46264 46264 PRINT "Item "; ITID$; " edited successfully" 46266 GOTO 46340 46300 PRINT "Item "; ITID$; " added successfully" 46340 PRINT "COMMANDS: (E)rase and continue, (Q)uit"; : COLOR 7, 0 46360 COLOR 0, 7 46380 Z$ = INKEY$ 46420 IF LEN(Z$) = 0 THEN 46380 46440 IF ASC(Z$) = 27 THEN 46590 46460 IF LEFT$(Z$, 1) = "e" OR LEFT$(Z$, 1) = "E" THEN GOTO 3030 46500 IF LEFT$(Z$, 1) <> "q" AND LEFT$(Z$, 1) <> "Q" THEN 46380 46590 COLOR 7, 0: EDFLG% = 0: GOTO 3021 46620 REM 46660 REM PUT LIST OF POSSIBLE COMMANDS HERE 46700 REM 46740 GOSUB 7500 46780 GOTO 12300 46820 REM 46860 REM SUBROUTINE TO FIND NEAREST BLANK RECORD 46900 REM 46940 IF BRR <> 0 THEN 47260 46980 FOR N = MREC TO 3 STEP -1 47020 GET #11, N 47060 IF LEFT$(PKTXT$, 10) = " " THEN 47220 47100 NEXT N 47140 BRR = -1 47180 GOTO 47260 47220 BRR = N 47260 IF BRF <> 0 THEN 47620 47300 FOR N = MREC TO IBREC - 1 47340 GET #11, N 47380 IF LEFT$(PKTXT$, 10) = " " THEN 47540 47420 NEXT N 47460 BRF = -1 47500 GOTO 47620 47540 BRF = N 47620 RETURN 47660 REM 47700 REM SUBROUTINE TO PRINTOUT INFORMATION BEFORE ADDING IT TO BANK 47740 REM 47780 LPRINT "LAST ITEM CHARACTERISTIC RECORD: "; CEREC 47820 LPRINT "FIRST TEXT RECORD: "; IBREC 47860 LPRINT "LAST TEXT RECORD: "; IEREC 47900 LPRINT "TOTAL NUMBER OF WHOLE ITEMS: "; CNREC 47940 LPRINT "FREC,LREC= "; FREC; " "; LREC 47980 LPRINT 48020 LPRINT 48060 LPRINT "HERE IS THE ITEM THAT IS TO BE ADDED" 48100 LPRINT 48140 FOR N = 1 TO NLN 48180 LPRINT PK$(N) 48220 NEXT N 48260 LPRINT 48300 LPRINT 48340 LPRINT "HERE IS THE NEIGHBORHOOD AROUND THE POINT OF LOADING" 48380 LPRINT "F,M,L REPRESENT VALUES OF RECORDS FREC,MREC AND LREC" 48420 LPRINT 48460 D$ = PKTXT$ 48500 DUM1 = 1 48540 DUM2 = CEREC 48580 IF MREC > 2 THEN DUM1 = MREC - 2 48620 IF MREC < CEREC - 2 THEN DUM2 = MREC + 2 48660 FOR N = DUM1 TO DUM2 48700 GET #11, N 48740 S$ = " " 48780 IF N = FREC THEN S$ = "F" 48820 IF N = MREC THEN S$ = "M" 48860 IF N = LREC THEN S$ = "L" 48900 IF N = FREC AND N = MREC THEN S$ = "FM" 48940 IF N = MREC AND N = LREC THEN S$ = "ML" 48980 LPRINT N; S$; PKTXT$ 49020 NEXT N 49060 LPRINT 49100 LPRINT "HERE IS THE LINE TO BE ADDED" 49140 LPRINT 49180 LPRINT CL$ 49220 LPRINT 49260 LSET PKTXT$ = D$ 49300 LPRINT "EXAMINE ALL PARAMETERS BEFORE CONTINUING" 49340 LPRINT 49380 LPRINT "DO YOU WISH TO CONTINUE?" 49420 LPRINT CHR$(12) 49460 Z$ = INKEY$ 49500 IF LEN(Z$) = 0 THEN 49460 49540 IF Z$ = "y" OR Z$ = "Y" THEN RETURN 49580 RETURN 12300 49620 REM 49660 REM PRINTOUT OF INFORMATION AFTER ADDING ITEM 49700 REM 49740 LPRINT "HERE IS NEW RECORD 2" 49780 GET #11, 2 49820 LPRINT PKTXT$ 49860 LPRINT 49900 LPRINT "HERE IS NEW ITEM AS IT APPEARS IN BANK" 49940 LPRINT "POINTER:" 49980 GET #11, MREC 50020 LPRINT PKTXT$ 50060 FOR N = IEREC - NLN TO IEREC 50100 GET #11, N 50140 LPRINT N; PKTXT$ 50180 NEXT N 50220 LPRINT "EXAMINE ALL PARAMETERS BEFORE CONTINUING" 50260 LPRINT "DO YOU WISH TO CONTINUE?" 50300 LPRINT CHR$(12) 50340 Z$ = INKEY$ 50380 IF LEN(Z$) = 0 THEN 50340 50420 IF Z$ = "y" OR Z$ = "Y" THEN RETURN 50421 GOTO 50340 50501 REM 50502 REM SUBROUTINE FOR PRINTING NEIGHBORHOOD AROUND MREC 50503 REM 50504 I = MREC 50505 IF MREC > 5 THEN 50510 50507 I = 8 50510 FOR ZZ = I - 5 TO I + 5 50512 GET #11, ZZ 50514 LPRINT ZZ; PKTXT$ 50516 NEXT ZZ 50518 LPRINT "RECORD 2 = " 50520 GET #11, 2 50522 LPRINT PKTXT$ 50524 RETURN 50531 EDFLG% = 0: GOTO 3030 50540 REM 50580 REM BEGIN BINARY SEARCH FOR INDIVIDUAL ITEM 50620 REM 50660 IFETCH% = 0 50700 R1 = 3 50740 R2 = CEREC 50780 R3 = INT((R1 + R2) / 2) 50820 IF R3 = R1 THEN 51340 50860 GET #11, R3 50900 IF PKTXT$ <> STRING$(80, 32) THEN 51020 50940 R3 = R3 - 1 50980 GOTO 50820 51020 L$ = LEFT$(PKTXT$, 7) 51060 IF JEY$ >= L$ THEN 51180 51100 R2 = R3 51140 GOTO 50780 51180 IF JEY$ = L$ THEN 51500 51220 R1 = R3 51260 GOTO 50780 51300 REM PROGRAM MARKER (23) 51340 GET #11, R3 51380 J$ = LEFT$(PKTXT$, 7) 51420 IF J$ <> JEY$ THEN 51422 ELSE RETURN 51422 R3 = R3 + 1 51424 IF R3 > R2 THEN 51460 ELSE 51426 51426 GET #11, R3 51428 J$ = LEFT$(PKTXT$, 7) 51430 IF J$ <> JEY$ THEN 51422 ELSE RETURN 51460 IFETCH% = 1 51500 RETURN 51540 COLOR 0, 7 51580 LOCATE YEM, XEM, 1, 6, 7 51620 PRINT "THIS IS ITEM "; 51660 COLOR 24, 1 51700 PRINT JEY$ 51740 COLOR 0, 7 51780 PRINT "DO YOU WISH TO DELETE IT? "; 51820 COLOR 16, 7 51860 PRINT "Y OR N "; 51900 COLOR 0, 7 51940 PRINT "ONLY. "; 51980 COLOR 7, 0 52020 C$ = INKEY$ 52060 IF LEN(C$) = 0 THEN 52020 52100 IF C$ = "Y" OR C$ = "y" THEN 52300 52140 IF C$ = "N" OR C$ = "n" THEN 52220 52180 GOTO 52020 52220 COLOR 7, 0 52260 GOTO 4740 52300 GOSUB 52780 52340 CLS 52380 PRINT "ITEM "; JEY$; " DELETED" 52420 PRINT 52460 PRINT 52500 PRINT "To continue, type any key except ESC" 52502 PRINT "To back up to previous level,type ESC" 52540 C$ = INKEY$ 52580 IF LEN(C$) = 0 THEN 52540 52590 IF ASC(C$) = 27 THEN 52600 52595 GOTO 3030 52600 EDFLG% = 0: GOTO 3021 52620 GOTO 4740 52660 REM 52700 REM DELETE ITEM FROM BANK 52740 REM 52780 LSET PKTXT$ = STRING$(80, 32) 52820 PUT #11, CREC 52860 FOR N = IREC1 TO IREC2 52900 PUT #11, N 52940 NEXT N 52942 IF EDFLG% = 3 THEN RETURN 52943 IF CREC <> 3 THEN 52980 52944 FOR N = 4 TO CEREC 52946 GET #11, N 52948 IF LEFT$(PKTXT$, 7) = " " THEN 52960 52950 PUT #11, 3 52952 LSET PKTXT$ = STRING$(80, 32) 52954 PUT #11, N 52956 GOTO 52966 52960 NEXT N 52962 REM IT SHOULD BE IMPOSSIBLE TO GET TO THIS STATEMENT 52964 STOP 52966 IF N = CEREC THEN CEREC = 3 52968 GOTO 53140 52980 IF CEREC = CREC THEN 53020 ELSE 53140 53020 CEREC = CEREC - 1 53060 GET #11, CEREC 53100 IF PKTXT$ = STRING$(80, 32) THEN 53020 53140 CNREC = CNREC - 1 53180 IF IBREC = IREC1 THEN 53260 53220 IF IEREC = IREC2 THEN 53340 ELSE 53380 53260 IBREC = IREC2 + 1 53265 GET #11, IBREC 53270 IF PKTXT$ <> STRING$(80, 32) THEN 53380 53275 IBREC = IBREC + 1 53280 GOTO 53265 53340 IEREC = IREC1 - 1 53341 GOTO 53345 53343 IEREC = IEREC - 1 53345 GET #11, IEREC 53350 IF PKTXT$ = STRING$(80, 32) THEN 53343 53380 DUM$ = STR$(CEREC) + STRING$(10 - LEN(STR$(CEREC)), 32) + STR$(CNREC) + STRING$(10 - LEN(STR$(CNREC)), 32) + STR$(IBREC) + STRING$(10 - LEN(STR$(IBREC)), 32) + STR$(IEREC) + STRING$(10 - LEN(STR$(IEREC)), 32) 53420 LSET PKTXT$ = DUM$ 53460 PUT #11, 2 53500 RETURN 53540 END

Disclaimer: The views and opinions expressed on unofficial pages of California State University, Dominguez Hills faculty, staff or students are strictly those of the page authors. The content of these pages has not been reviewed or approved by California State University, Dominguez Hills.