1 COMMON A, AL, B, BASEONLY, C, C$, C1, CAT$, CC, CKT$, D, D$, DD, DIA, DIMN$, DMS, E, EO, EX$, F, F$, FD, FF, FQ, FRQ, G$, GO$, I, I$, L, LATLONG, LD, LL, LN, LS, LW, LX, MAX, MENU, MIN, MX, N, NN, NT, OV, P, PI, PROG$, Q, QQ, QU, R, RA, RC, T, T$, U, U$, UH, UL$, V$, VC, W, WHIP, WIRD, WW, X, X$, X1, XS, Z$, ZP, ZS
5 'OMMON EX$
10 '\hamcalc\prog\HAMDEX - 18 FEB 94 rev. 21 NOV 2009
20 EX$="\hamcalc\prog\hamdex"
30 
40 CLS:KEY OFF
50 COLOR 15,4,0:LOCATE 13,15
60 T=TIMER
70 PRINT " LOADING AND SORTING A LARGE FILE . . . PLEASE WAIT "
80 IF TIMER<T+5.000000E-01 THEN 80
90 ON ERROR GOTO 490
100 COLOR 7,0,0
110 DIM A$(900,4),F$(256,4)
120 UL$=STRING$(80,205)
130 '
140 '.....load file
150 OPEN "I",1,"\hamcalc\index\hamdex.fil"
160 N=0
170 IF EOF(1)THEN 210
180 N=N+1:FOR Y=1 TO 4
190 INPUT # 1,A$(N,Y):NEXT Y
200 GOTO 170
210 CLOSE
220 GOSUB 240:GOTO 380
230 '
240 '....sort
250 SN=N
260 SM=SN
270 SM=INT(SM/2):IF SM=0 THEN 360
280 SK=SN-SM:SJ=1
290 SI=SJ
300 SL=SI+SM
310 IF A$(SI,1)+A$(SI,2)<=A$(SL,1)+A$(SL,2)THEN 340
320 FOR Z=1 TO 4:SWAP A$(SI,Z),A$(SL,Z):NEXT Z
330 SI=SI-SM:IF SI>0 THEN 300
340 SJ=SJ+1:IF SJ>SK THEN 270
350 GOTO 290
360 RETURN
370 '
380 '.....start
390 CLS
400 COLOR 14,2:PRINT STRING$(80,32);
410 LOCATE CSRLIN-1,23:PRINT "A L P H A B E T I C A L   I N D E X"
420 COLOR 1,0:PRINT STRING$(80,223);
430 COLOR 7,0
440 LOCATE 15,36
450 GOSUB 2690  'preface
460 GOSUB 2440  'start a page
470 GOTO 1120
480 '
490 BEEP:CLS
500 PRINT "Error";ERR;;"in line";ERL:END
510 '
520 '.....Index menu
530 CLS:PRINT:COLOR 15:BEEP
540 PRINT " EDITING SHOULD NOT BE ATTEMPTED BY THE USER!";:COLOR 7
550 PRINT
560 PRINT "   . . . . . . . press any key . . . . . . . "
570 Z$=INKEY$:IF Z$=""THEN 570 ELSE 580
580 IF Z$<>""THEN CHAIN EX$
590 ' to edit, CLS then goto 590
600 PRINT MN$
610 PRINT UL$;
620 PRINT "Press letter in ( ) to:"
630 PRINT UL$;
640 PRINT "  (a) ADD a listing to the Index"
650 PRINT "  (b) LOOK UP an Index listing"
660 PRINT "  (c) DISPLAY/PRINT Index"
670 PRINT "  (d) Return to Index Menu"
680 Z$=INKEY$
690 IF Z$="a"THEN CLS:GOTO 1060
700 IF Z$="b"THEN CLS:GOTO 1380
710 IF Z$="c"THEN CLS:GOTO 1120
720 IF Z$="d"THEN CLS:CHAIN EX$
730 GOTO 680
740 '
750 '.....save data
760 CLS
770 OPEN "O",1,"\hamcalc\index\hamdex.fil"
780 FOR Z=1 TO N
790 WRITE #1,A$(Z,1),A$(Z,2),A$(Z,3),A$(Z,4)
800 NEXT Z
810 CLOSE
820 CLS:GOTO 380
830 '
840 '.....convert to upper case
850 FOR U=1 TO LEN(I$):V=ASC(MID$(I$,U,1)):IF V=44 THEN RETURN
860 IF V>96 AND V<123 THEN MID$(I$,U,1)=CHR$(V-32)
870 NEXT U:RETURN
880 '
890 '.....inputs
900 LINE INPUT "ENTER Word or Heading..............? ";I$:GOSUB 840
910 RETURN
920 '
930 LINE INPUT "ENTER Subheading...................? ";I$
940 IF I$=""THEN 960
950 I$=", "+I$
960 RETURN
970 '
980 LINE INPUT "ENTER Supplementary note, if any...? ";I$
990 IF I$=""THEN 1010
1000 I$=", "+I$
1010 RETURN
1020 '
1030 LINE INPUT "ENTER Program Filename............ ? ";I$:GOSUB 840
1040 RETURN
1050 '
1060 '.....new listing
1070 N=N+1
1080 PRINT "NEW LISTING";:PRINT
1090 FOR Z=1 TO 4:ON Z GOSUB 900,930,980,1030:A$(N,Z)=I$
1100 NEXT Z:CLS:Z=N:GOTO 1910
1110 '
1120 '.....screen display
1130 CLS
1140 IF Z<>0 THEN A=Z+1 ELSE A=1
1150 LN=0:C=0   'line number,counter
1160   FOR Z=A TO N
1170 LN=LN+1:C=C+1
1180   IF Z=1 THEN 1190
1190 Z$=CHR$(C+96)
1200 IF Z<1 THEN Z=1
1210 F$(C,1)=A$(Z,4)
1220 PRINT " <";Z$;;">  ";
1230 COLOR 12,0:PRINT A$(Z,1);
1240 COLOR 7,0:PRINT A$(Z,2);A$(Z,3);
1250 IF LN<24 THEN PRINT "";:GOTO 1280
1260 GOSUB 2150     'command line
1270 CLS:LN=0:C=0   'clear screen
1280   NEXT Z
1290 GOSUB 2150     'command line
1300 GOTO 1120
1310 '
1320 '.....return to menu
1330 BEEP:PRINT:PRINT ;"There is nothing starting with ";I$;;" on file......"
1340 PRINT:PRINT ;"Press SPACE BAR to return to Menu";
1350 Z$=INKEY$:IF Z$=" "THEN CLS:GOTO 620
1360 GOTO 1350
1370 '
1380 '.....search
1390 INPUT "ENTER first 1 or 2 letters of word";I$:GOSUB 840
1400 L=LEN(I$):F=0
1410 FOR Z=1 TO N
1420  IF LEFT$(A$(Z,1),L)<>I$ THEN 1450
1430  F=F+1:F$(F,1)=A$(Z,1)+A$(Z,2)+A$(Z,3):F$(F,2)=STR$(Z):F$(F,3)=A$(Z,4)
1440 F$(F,4)=STR$(Z)
1450 NEXT Z
1460 IF F=0 THEN 1320
1470 CLS':IF F<=22 THEN 1170
1480 IF F=1 THEN Z=VAL(F$(F,2)):GOTO 1660
1490 ROW=0     'screen row number
1500 FOR Z=1 TO F
1510 ROW=ROW+1
1520  IF ROW<25 THEN 1570
1530  COLOR 0,7
1540  LOCATE 25,20:PRINT "......press any key for more......";
1550  COLOR 7,0
1560  IF INKEY$=""THEN 1560 ELSE ROW=0:CLS
1570 IF Z<10 THEN PRINT " ";
1580 PRINT Z;;"   ";F$(Z,1);
1590 IF ROW<24 THEN PRINT ""
1600 NEXT Z
1610 COLOR 0,7
1620 INPUT " ENTER item no. to select listing ";J
1630 COLOR 7,0
1640 Z=VAL(F$(J,4))
1650 CLS
1660 PRINT "You have just looked up ";:COLOR 0,7
1670 PRINT " ";:FOR Q=1 TO 3:PRINT A$(Z,Q);:NEXT Q:PRINT " "
1680 COLOR 7,0
1690 PRINT UL$;
1700 PRINT "Press number in ( ) to:"
1710 PRINT UL$;
1720 PRINT "(1) RUN program pertaining to this listing"
1730 PRINT "(2) EDIT Listing"
1740 PRINT "(3) DELETE Listing"
1750 PRINT "(4) Return to menu"
1760 Z$=INKEY$
1770 IF Z$="1"THEN CLS:X$=A$(Z,4):CHAIN X$
1780 IF Z$="2"THEN CLS:GOTO 1920
1790 IF Z$="3"THEN 2040
1800 IF Z$="4"THEN CLS:GOTO 620
1810 GOTO 1760
1820 '
1830 PRINT UL$;
1840 PRINT "Line 1: Main Heading..........";A$(Z,1)
1850 PRINT "Line 2: Sub-Heading...........";A$(Z,2)
1860 PRINT "Line 3: Supplementary note....";A$(Z,3)
1870 PRINT "Line 4: Program filename......";A$(Z,4)
1880 PRINT UL$;
1890 RETURN
1900 '
1910 '.....edit listing
1920 FOR Q=1 TO 3:PRINT A$(Z,Q);:NEXT Q:PRINT ""
1930 GOSUB 1830:PRINT "Press number in ( ) for next step:"
1940 PRINT UL$;
1950 FOR Y=1 TO 4:PRINT "(";Y;;")  Change Line";Y:NEXT Y
1960 PRINT "( 5 )  O.K. as is";:PRINT
1970 Z$=INKEY$:Q=VAL(Z$):IF Q<1 OR Q>5 THEN 2030
1980 IF Z$="1"THEN GOSUB 900:A$(Z,1)=I$:CLS:GOTO 1910
1990 IF Z$="2"THEN GOSUB 930:A$(Z,2)=I$:CLS:GOTO 1910
2000 IF Z$="3"THEN GOSUB 980:A$(Z,3)=I$:CLS:GOTO 1910
2010 IF Z$="4"THEN GOSUB 1030:A$(Z,4)=I$:CLS:GOTO 1910
2020 IF Z$="5"THEN CLS:GOSUB 240:GOTO 750                      'sort and save
2030 GOTO 1970
2040 '
2050 '.....delete listing
2060 PRINT:PRINT ;"Are you sure you want this listing deleted ?  (y/n)";
2070 Z$=INKEY$
2080 IF Z$="n"THEN CLS:GOTO 1700
2090 IF Z$="y"THEN 2110
2100 GOTO 2070
2110 FOR X=Z TO N:LOCATE 1,40:PRINT N-X:FOR Y=1 TO 4
2120 A$(X,Y)=A$(X+1,Y):NEXT Y:NEXT X:N=N-1
2130 GOSUB 240:GOTO 750     'sort & save
2140 '
2150 '.....command line 25
2160 LOCATE 25,1:COLOR 15,1
2170 PRINT "ENTER < >  or press³1-NEXT PAGE ³2-PREVIOUS PAGE ³3-ANOTHER ";
2180 PRINT "PAGE ³4-EXIT ³5-EDIT";
2190 COLOR 7,0
2200   Z$=INKEY$:IF Z$="" THEN 2200
2210 IF Z$="0"THEN 520
2220 IF (Z$="1") AND Z>=N THEN Z=0:GOTO 2340
2230 IF Z$="1" THEN 2340
2240 IF Z$="2" THEN Z=Z-48:GOTO 2340
2250 IF Z$="3" THEN CLS:GOTO 2440
2260 IF Z$="4" THEN GOSUB 240:GOTO 750
2270 IF Z$="5" THEN CLS:GOTO 590
2280 R=ASC(Z$)-96
2290 IF R+96<97 OR R>C THEN BEEP:GOTO 2150
2300 R$=F$(R,1)
2310 IF R$=M$ THEN ERASE A$,F$:GOTO 10
2320 CLS:CHAIN R$
2330   GOTO 2200
2340 RETURN
2350 '
2360 LOCATE 2,10:COLOR 14,6:BEEP
2370 PRINT " Options shown below are accessible only from an index page."
2400 COLOR 7,0
2420 COLOR 7:GOTO 2540
2430 '
2440 '.....find
2450 LOCATE 4,12:COLOR 14,4
2460 PRINT " PRESS A LETTER AT WHICH YOU WANT AN INDEX PAGE TO BEGIN "
2470 PRINT
2480 LOCATE ,37:PRINT " - or - "
2490 PRINT
2500 LOCATE ,25:PRINT " Press 0 to return to main menu "
2510 COLOR 7,0
2520 PRINT
2530 PRINT UL$;
2540 I$=INKEY$:IF I$=""THEN 2540
2550 IF I$="0"THEN CLS:EX$="\HAMCALC\MENU\HCAL":CHAIN EX$
2560 IF ASC(I$)>=97 AND ASC(I$)<=122 THEN I$=CHR$(ASC(I$)-32):GOTO 2580
2570 IF ASC(I$)>=49 AND ASC(I$)<=53 OR ASC(I$)>53 THEN 2360
2580 CLS
2590 FOR Y=1 TO N
2600 IF LEFT$(A$(Y,1),1)=I$ THEN Z=Y-1:RETURN
2610 NEXT Y
2620 CLS:LOCATE 20,18
2630 PRINT "There is nothing in the Index starting with ";
2640 COLOR 0,7:PRINT " ";I$;;" ";:COLOR 7,0:PRINT"."
2650 LOCATE 22,18:PRINT "Press any key.........."
2660 IF INKEY$=""THEN 2660
2670 CLEAR:CLS:GOTO 10
2680 '
2690 '.....preface
2700 S=7:T=9
2710 PRINT TAB(S+1);
2720 PRINT "Each page has a prompt line to select one of the following options:"
2730 PRINT TAB(S);
2740 PRINT STRING$(68,196)
2750 PRINT TAB(T+7);;"Prompt                         Option"
2760 PRINT TAB(S);
2770 PRINT STRING$(68,196)
2780 T=12
2790 PRINT TAB(T);
2800 PRINT "< > RUN PROGRAM       Press any letter in < > to RUN a PROGRAM"
2810 PRINT TAB(T);
2820 PRINT "  1-NEXT PAGE         Press 1 to display NEXT index page"
2830 PRINT TAB(T);
2840 PRINT "  2-PRECEDING PAGE    Press 2 to display PRECEDING index page"
2850 PRINT TAB(T);
2860 PRINT "  3-ANOTHER PAGE      Press 3 to display ANOTHER index page"
2870 PRINT TAB(T);
2880 PRINT "  4-EXIT              Press 4 to EXIT";
2890 PRINT TAB(T);
2900 PRINT "  5-listings          Press 5 to add a or edit a listing"
2910 '
2920 RETURN
2930 LOCATE 9
2940 PRINT " Options 1 to 4 below are accessible only from and index page."
2950 PRINT " To select an index page or return to menu, follow instructions ";
2960 PRINT "above.";
2970 GOTO 2540
2980 END
