'----------------------------------------------------- '- - '- Cardfile.bas - '- cf/s/e/x/o and n if squish is used - '- Version 0.8f 10/10/85 - '- Copyright (c) 1983,1984,1985 - '- Don W. Watkins - '- All right reserved - '----------------------------------------------------- sub setup DIM DAYS_dollar(100)as string DIM DAY(100) as long dim DAYS_IN_MONTH(31)as long dim COLUM(14)as long dim LIN(14)as long dim X(100) as long dim HD_dollar(100)as string dim HB_dollar(100)as string end sub sub date_calc 120 MONTH$ = MID$(DATE$,1,2) 130 DAY$ = MID$(DATE$,4,2) 140 YEAR$ = MID$(DATE$,7,4) 150 DEF FNZEL(M,D,Y) = (D+M+M+INT((M+1)*.6)+Y+Y\4-Y\100+Y\400+1) MOD 7 160 DEF FNDAY_dollar(D)=MID$("SunMonTueWedThuFriSat",D*3+1,3) 170 DEF FNMON_dollar(M)=MID$("JanFebMarAprMayJunJulAugSepOctNovDec",(M-1)*3+1,3) 180 MONTH = VAL(MONTH$) 190 DAY = 1 200 YEAR = VAL(YEAR$) end sub 210 ' 220 ' 230 ' 240 ' 250 ' 260 ' 270 ' 280 ' 290 ' 300 ' 310 ' 320 ' 330 ' 340 'COLOR 1,0 350 ' 360 ' 370 ' 380 ' 390 ' 400 ' 410 ' 420 ' 430 ' 440 ' 450 ' 460 ' 470 ' 480 ' 490 ' 500 ' 510 ' 520 ' 530 IF MONTH > 2 THEN GOTO 560 'nothing special for Mar - Dec 540 DAY_OF_WEEK=FNZEL(MONTH+12,DAY,YEAR-1) 'jan&feb 550 GOTO 570 560 day_of_week = FNZEL(MONTH,DAY,YEAR) 570 IF MONTH = 1 THEN MONTH$ = "January" : DAYS_IN_MONTH = 31 580 IF MONTH = 2 THEN MONTH$ = "February": DAYS_IN_MONTH = 29 590 IF MONTH = 3 THEN MONTH$ = "March" : DAYS_IN_MONTH = 31 600 IF MONTH = 4 THEN MONTH$ = "April" : DAYS_IN_MONTH = 30 605 IF MONTH = 5 THEN MONTH$ = "May" : DAYS_IN_MONTH = 31 610 IF MONTH = 6 THEN MONTH$ = "June " : DAYS_IN_MONTH = 30 620 IF MONTH = 7 THEN MONTH$ = "July " : DAYS_IN_MONTH = 31 630 IF MONTH = 8 THEN MONTH$ = "August" : DAYS_IN_MONTH = 31 640 IF MONTH = 9 THEN MONTH$ = "September" : DAYS_IN_MONTH = 30 650 IF MONTH = 10 THEN MONTH$ = "October" : DAYS_IN_MONTH = 31 660 IF MONTH = 11 THEN MONTH$ = "November" : DAYS_IN_MONTH = 30 670 IF MONTH = 12 THEN MONTH$ = "December" : DAYS_IN_MONTH = 31 680 IF day_of_week = 0 THEN diaplay_column = 52 'monday 681 IF day_of_week = 1 THEN diaplay_column = 56 682 IF day_of_week = 2 THEN diaplay_column = 60 683 IF day_of_week = 3 THEN diaplay_column = 64 684 IF day_of_week = 4 THEN diaplay_column = 68 686 IF day_of_week = 5 THEN diaplay_column = 72 687 IF day_of_week = 7 THEN diaplay_column = 48 'sunday 688 ROW = 6 690 FOR LOOP = 1 TO DAYS.IN.MONTH 700 IF LOOP > 1 THEN diaplay_column = diaplay_column + 4 710 IF DAY = DAYS.IN.MONTH(LOOP) THEN COLOR 7,0 'ELSE COLOR 4,0 720 IF diaplay_column >78 THEN diaplay_column = 52 : ROW = ROW + 1 730 LOCATE ROW,diaplay_column:PRINT LOOP 740 NEXT 750 LOCATE 1,6:COLOR 4,0:PRINT "Time",TIME$:LOCATE 1,29:COLOR 7,0:PRINT "Main Menu" 760 LOCATE 2,4:COLOR 7,0:PRINT STRING$(39,205) 770 LOCATE 4,10:COLOR 3,0:PRINT "Cardfile - Version 0.8f" 780 LOCATE 2,60:PRINT MONTH$ 790 LOCATE 1,48:PRINT CHR$(201):LOCATE 1,49:PRINT STRING$(31,205):LOCATE 1,80:PRINT CHR$(187) 800 LOCATE 2,48:PRINT CHR$(186):LOCATE 2,80:PRINT CHR$(186) 810 LOCATE 3,48:PRINT CHR$(204):LOCATE 3,49:PRINT STRING$(31,205):LOCATE 3,80:PRINT CHR$(185) 820 LOCATE 4,50:COLOR 2,0:PRINT " Su Mo Tu We Th Fr Sa":COLOR 1,0 830 LOCATE 4,48:PRINT CHR$(186):LOCATE 4,80:PRINT CHR$(186) 840 LOCATE 5,48:PRINT CHR$(204):LOCATE 5,49:PRINT STRING$(31,205):LOCATE 5,80:PRINT CHR$(185) 850 LOCATE 6,48:PRINT CHR$(186):LOCATE 6,80:PRINT CHR$(186) 860 LOCATE 7,48:PRINT CHR$(186):LOCATE 7,80:PRINT CHR$(186) 870 LOCATE 8,48:PRINT CHR$(186):LOCATE 8,80:PRINT CHR$(186) 880 LOCATE 9,48:PRINT CHR$(186):LOCATE 9,80:PRINT CHR$(186) 890 LOCATE 10,48:PRINT CHR$(186):LOCATE 10,80:PRINT CHR$(186) 900 LOCATE 11,48:PRINT CHR$(186):LOCATE 11,80:PRINT CHR$(186) 910 LOCATE 12,48:PRINT CHR$(200):LOCATE 12,49:PRINT STRING$(31,205):LOCATE 12,80:PRINT CHR$(188): 915 ' 920 '------------------------------------------------------------ 930 '- Set up and ask for file - 940 '------------------------------------------------------------ 950 KEY OFF:FOR X=1 TO 10:KEY X,"":NEXT:WIDTH "LPT1:",255:LOCATE ,,0,2,10 960 DEFINT A-Z:B$=SPACE$(80):B1$=SPACE$(40):ZZ=0:DF$="N" 970 DIM M$(20),KWORD$(42),NT$(42),KP(42),DL(100),JP$(127) 980 DATA 01,02,03,04,05,06,07,08,09,10,11,12,13,14,15,16,17,18,19,20,21 990 DATA 22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42 1000 RESTORE 980 1010 FOR KEYWX = 0 TO 41:READ NT$(KEYWX):NEXT 1020 GOSUB 2940 1030 ON ERROR GOTO 3040 1040 LOCATE 17,25:PRINT "> Enter filename: ";:FILE.LENGTH=8:GOSUB 4500:IF IN$ = "" THEN CLS:SYSTEM 1050 P=INSTR(IN$,".") 1060 IF P>0 THEN E$="Please try again without the file extension":GOSUB 2950:GOTO 1040 1070 FS$=IN$ 1080 OPEN"I",1,FS$+".KEY":ON ERROR GOTO 4490 1090 FOR X=1 TO 42:INPUT#1,KWORD$(X),KP(X):NEXT 1100 INPUT #1,KI,KD:CLOSE 1 1110 OPEN"R",2,FS$+".IND",256 1120 FOR X=1 TO 127:FIELD#2,(X-1)*2 AS DU$,2 AS JP$(X):NEXT 1130 FIELD#2,254 AS DU$,2 AS JX$ 1140 OPEN"R",3,FS$+".DAT",256 1150 FOR X=1 TO 3:FIELD#3,(X-1)*82 AS DU$,80 AS HD_dollar(X),2AS HB_dollar(X):NEXT 1160 FIELD#3,246 AS DU$,2 AS HF$,2 AS HN$ 1170 '--------------------------------------------------- 1180 ' Main menu - 1190 '--------------------------------------------------- 1200 COLOR 7,1:CLS:F$="N" 1210 GOSUB 3010:COLOR 7,1:LOCATE 24,1:PRINT "Maintenance Menu: " TAB(26)"- Keywords" TAB(42)"- Data" TAB(55)"- End program";:COLOR 0,7:LOCATE 24,24:PRINT "K";:LOCATE 24,40:PRINT "D";:LOCATE 24,53:PRINT "E";:COLOR 7,1 1220 GOSUB 3110 1230 IF IN$="K" OR IN$="k" THEN 1250 ELSE IF IN$="D" OR IN$="d" THEN 1670 ELSE IF IN$="E" OR IN$="e" THEN 2430 1240 GOTO 1220 1250 '--------------------------------------------------- 1260 ' Index section - 1270 '--------------------------------------------------- 1280 CLS 1290 GOSUB 3010:GOSUB 3130 1300 LOCATE 24,1:PRINT "Keyword Maintenance: - Add - Delete - Return to menu";:COLOR 0,7:LOCATE 24,26:PRINT "A";:LOCATE 24,37:PRINT "D";:LOCATE 24,51:PRINT "R";:COLOR 7,1 1310 GOSUB 3110:IF IN$="R" OR IN$="r" THEN 1170 1320 IF IN$="D" OR IN$="d" THEN 1530 1330 GOSUB 3030 1340 IF IN$<>"A" AND IN$<>"a" THEN 1300 1350 '--------------------------------------------------- 1351 ' Add keyword routine - 1352 '--------------------------------------------------- 1360 LOCATE 24,1:PRINT "ð Add ð Enter keyword: ";:FILE.LENGTH=12:GOSUB 4500:GOSUB 3030:IF IN$="" THEN 1300 1370 IF LEN(IN$)<2 THEN E$="Keywords must be more than one character long":GOSUB 2950:GOTO 1360 1380 IF LEN(IN$)=2 THEN IF IN$>"00" AND IN$<"43" THEN E$="Sorry, keyword of 01 to 42 not allowed":GOSUB 2950:GOTO 1360 1390 FOR X=1 TO 42 1400 IF KWORD$(X)=IN$ THEN E$="Duplicate keyword":GOSUB 2950:GOTO 1360 1410 NEXT 1420 FOR X=1 TO 42:IF KP(X)=0 THEN 1440 ELSE NEXT 1430 E$="Keyword list full":GOSUB 2950:GOTO 1300 1440 KWORD$(X)=IN$:SK$="Y" 1450 IF X>28 THEN DX=X-25:DY=54 ELSE IF X>14 THEN DX=X-11:DY=30 ELSE DX=X+3:DY=6 1460 LOCATE DX,DY:PRINT KWORD$(X);:LOCATE 24,1:PRINT "Initializing index record";:GOSUB 3170:KP(X)=XI:GOSUB 3970:GOSUB 3980 1470 GOSUB 3030 1480 LOCATE 24,1:PRINT "Reindexing with new keyword"; 1490 XD=1:search_value$=KWORD$(X):C=0 1500 GOSUB 3220 1510 IF RK$="Y" THEN GOSUB 3280:C=C+1:LOCATE 24,75:PRINT C;:XD=XD+1:GOTO 1500 1520 GOSUB 3030:GOTO 1300 1530 '--------------------------------------------------- 1540 '- Delete section - 1550 '--------------------------------------------------- 1560 GOSUB 3030 1570 LOCATE 24,1:PRINT "ð Delete ð Enter keyword #: ";:FILE.LENGTH=-2:GOSUB 4500:GOSUB 3030:IF IN$="" THEN 1300 1580 N=VAL(IN$):IF N<1 OR N>42 THEN E$="Number must be from 1 to 42":GOSUB 2950:GOTO 1570 1590 IF KP(N)=0 THEN E$="Keyword number not in use":GOSUB 2950:GOTO 1570 1600 XI=KP(N):LOCATE 24,1:PRINT "Deleting keyword from screens"; 1610 GOSUB 3940:IS=CVI(JX$):IX=KI:GOSUB 3970:GOSUB 3980 1620 KI=XI:SK$="Y" 1630 IF IS>0 THEN XI=IS:GOTO 1610 1640 KP(N)=0:KWORD$(N)="":IF N>28 THEN DX=N-25:DY=54 ELSE IF N>14 THEN DX=N-11:DY=30 ELSE DX=N+3:DY=6 1650 LOCATE DX,DY:PRINT SPC(12); 1660 GOSUB 3030:GOTO 1300 1670 '--------------------------------------------------- 1680 '- Data Section - 1690 '--------------------------------------------------- 1700 CLS:GOSUB 3010:F$="N" 1710 LOCATE 24,1:PRINT "File Maint: dd dit elete rint ext ind eturn";:COLOR 0,7:LOCATE 24,16:PRINT "A";:LOCATE 24,22:PRINT "E";:LOCATE 24,29:PRINT "D";:LOCATE 24,38:PRINT "P"; 1720 LOCATE 24,46:PRINT "N";:LOCATE 24,53:PRINT "F";:LOCATE 24,60:PRINT "R";:COLOR 7,0 1730 GOSUB 3110:PP=INSTR("AaEeDdPpNnFfRr",IN$):GOSUB 3030 1740 ON PP GOTO 1760,1760,1850,1850,1980,1980,2060,2060,2380,2380,2130,2130,2420,2420 1750 GOTO 1710 1760 '--------------------------------------------------- 1770 '- Add section - 1780 '--------------------------------------------------- 1790 IF DF$="Y" THEN GOSUB 4170 1800 CLS:GOSUB 3010:F$="N":LOCATE 24,1:PRINT "ð Add ð";:GOSUB 3020 1810 GOSUB 2940:GOSUB 2480:GOSUB 3030 1820 FOR X=1 TO 20:IF M$(X)<>B$ THEN 1830 ELSE NEXT :GOTO 1670 1830 GOSUB 3680:FR=XD:GF=FR:GOSUB 3480:GOSUB 3780 1840 F$="Y":GOTO 1710 1850 '--------------------------------------------------- 1860 '- Edit Section - 1870 '--------------------------------------------------- 1880 IF DF$="Y" THEN GOSUB 4170 1890 IF F$<>"Y" THEN E$="Edit what? -- Do [F]ind first":GOSUB 2950:GOTO 1710 1900 LOCATE 24,1:PRINT "ð Edit ð";:GOSUB 3020 1910 GOSUB 2480:GOSUB 3030 1920 FOR X=1 TO 20:IF M$(X)<>B$ THEN 1950 ELSE NEXT 1930 IF XD<>GF THEN XD=GF:GOSUB 3990 1940 GOSUB 3740:GOSUB 4020:GOTO 1670 1950 IF XD<>GF THEN XD=GF:GOSUB 3990 1960 GOSUB 3480:GOSUB 3780 1970 GOTO 1710 1980 '--------------------------------------------------- 1990 '- Delete Section - 2000 '--------------------------------------------------- 2010 IF F$<>"Y" THEN E$="Delete what? -- Please [F]ind first":GOSUB 2950:GOTO 1710 2020 LOCATE 24,1:PRINT "ð Delete ð Confirm delete (Y or N) ";:GOSUB 3110:IF IN$="N" OR IN$="n" THEN 1670 2030 IF IN$<>"Y" AND IN$<>"y" THEN 2020 2040 IF XD<>FR THEN XD=FR:GOSUB 3990 2050 GOSUB 3030:GOSUB 3740:GOSUB 4020:F$="D":CLS:GOSUB 3010:GOTO 1710 2060 '--------------------------------------------------- 2070 '- Print section - 2080 '--------------------------------------------------- 2090 IF F$<>"Y" THEN E$="Print what? -- Do [F]ind first":GOSUB 2950:GOTO 1710 2100 LOCATE 24,1:PRINT "ð Print ð Press 'P' to print or 'C' to cancel";:GOSUB 3110:IF IN$="C" OR IN$="c" THEN 1710 ELSE IF IN$<>"P" AND IN$<>"p" THEN 2100 2110 FOR X=1 TO 20:LPRINT M$(X):NEXT 2120 GOSUB 3030:GOTO 1710 2130 '--------------------------------------------------- 2140 '- Find section - 2150 '--------------------------------------------------- 2160 CLS:GOSUB 3010:GOSUB 3130 2170 XD=1:XE=0:LOCATE 24,1:PRINT "ð Find ð Enter number of keyword or word to search for: ";:FILE.LENGTH=15:GOSUB 4510:IF IN$="" OR IN$=STRING$(LEN(IN$)," ") THEN 1670 ELSE GOSUB 3030 2180 IN=VAL(IN$) 2190 IF LEN(IN$)<3 AND IN<43 AND IN>0 AND KP(IN)<>0 THEN 2270 2200 '--------------------------------------------------- 2210 '- Find string - 2220 '--------------------------------------------------- 2230 search_value$=IN$:F$="N" 2240 LOCATE 24,1:PRINT "Search on word = ";search_value$; 2250 GOSUB 3220:GOSUB 3030:IF RK$="E" THEN E$="End of file. Hit 'ESC' key to continue":GOSUB 2950:IF F$="N" THEN 2170 ELSE GOTO 1710 2260 XE=XD:XD=GF:GOSUB 3990:GOSUB 4070:GOTO 1710 2270 '--------------------------------------------------- 2280 '- Find key - 2290 '--------------------------------------------------- 2300 search_value$="":XI=KP(IN):GOSUB 3940:GOSUB 3960:LP=0:F$="N" 2310 IF LP=127 THEN 2360 2320 FOR LX=LP+1 TO 127 2330 IP=CVI(JP$(LX)):IF IP=0 THEN 2360 2340 XD=IP:GOSUB 3990:IF GF<>0 THEN GOSUB 4070:LP=LX:GOTO 1710 2350 NEXT LX 2360 IF IX>0 THEN XI=IX:GOSUB 3940:GOSUB 3960:LP=0:GOTO 2320 2370 E$="No more matches. Hit 'ESC' key to continue":GOSUB 2950:IF F$="N" THEN 2170 ELSE 1710 2380 'Next 2390 IF F$<>"Y" AND F$<>"D" THEN E$="Next what? -- Do ind first":GOSUB 2950:GOTO 1710 2400 IF search_value$="" THEN 2310 ELSE XD=XE+1:GOTO 2240 2410 'Return 2420 GOTO 1170 2430 'End 2440 IF DF$="Y" THEN GOSUB 4170 2450 CLS 2460 IF SK$="Y" THEN GOSUB 3890 2470 CLOSE : SYSTEM 2480 '--------------------------------------------------- 2490 '- Full screen editor (thanks Vern!) - 2500 '--------------------------------------------------- 2510 LOCATE 3,1,1 2520 WORD.COL.LOC%=1:WORD.ROW.LOC%=1 2530 WORD$=INKEY$:IF WORD$="" THEN 2530 2540 IF WORD$>= CHR$(32) AND WORD$<= CHR$(126) THEN 2730 ELSE IF LEN(WORD$) = 2 THEN 2590 2550 IF WORD$=CHR$(8) THEN IF WORD.COL.LOC%>1 THEN WORD.COL.LOC%=WORD.COL.LOC%-1:PRINT CHR$(29)+CHR$(0)+CHR$(29);:GOTO 2530 ELSE IF WORD.ROW.LOC%>0 THEN WORD.ROW.LOC%=WORD.ROW.LOC%-1:LOCATE WORD.ROW.LOC%+2,80:WORD.COL.LOC%=80:GOTO 2530 2560 IF WORD$=CHR$(9) THEN LOCATE WORD.ROW.LOC%+2,80:WORD.COL.LOC%=80:GOTO 2530 2570 IF WORD$=CHR$(13) THEN IF WORD.ROW.LOC%<20 THEN WORD.ROW.LOC%=WORD.ROW.LOC%+1:LOCATE WORD.ROW.LOC%+2,1:WORD.COL.LOC%=1:GOTO 2530 2580 GOTO 2530 2590 WORD$=RIGHT$(WORD$,1) 2600 IF WORD$=CHR$(75) THEN IF WORD.COL.LOC%>1 THEN WORD.COL.LOC%=WORD.COL.LOC%-1:PRINT CHR$(29);:GOTO 2530 ELSE IF WORD.ROW.LOC%>1 THEN WORD.ROW.LOC%=WORD.ROW.LOC%-1:LOCATE WORD.ROW.LOC%+2,80:WORD.COL.LOC%=80:GOTO 2530 2610 IF WORD$=CHR$(15) THEN LOCATE WORD.ROW.LOC%+2,1:WORD.COL.LOC%=1:GOTO 2530 2620 IF WORD$=CHR$(77) THEN IF WORD.COL.LOC%<80 THEN PRINT CHR$(28);:WORD.COL.LOC%=WORD.COL.LOC%+1:GOTO 2530 ELSE IF WORD.ROW.LOC%<20 THEN WORD.ROW.LOC%=WORD.ROW.LOC%+1:LOCATE WORD.ROW.LOC%+2,1:WORD.COL.LOC%=1:GOTO 2530 2630 IF WORD$=CHR$(72) THEN IF WORD.ROW.LOC%>1 THEN WORD.ROW.LOC%=WORD.ROW.LOC%-1:LOCATE WORD.ROW.LOC%+2,WORD.COL.LOC%:GOTO 2530 2640 IF WORD$=CHR$(80) THEN IF WORD.ROW.LOC%<20 THEN WORD.ROW.LOC%=WORD.ROW.LOC%+1:LOCATE WORD.ROW.LOC%+2,WORD.COL.LOC%:GOTO 2530 2650 IF WORD$=CHR$(73) OR WORD$=CHR$(71) THEN 2510 2660 IF WORD$=CHR$(81) THEN LOCATE 22,1:WORD.ROW.LOC%=20:WORD.COL.LOC%=1:GOTO 2530 2670 IF WORD$=CHR$(82) and WORD.COL.LOC%<80 THEN LOCATE,,0:W1$=" "+MID$(M$(WORD.ROW.LOC%),WORD.COL.LOC%,80-WORD.COL.LOC%):MID$(M$(WORD.ROW.LOC%),WORD.COL.LOC%,LEN(W1$))=W1$:PRINT W1$;:PRINT STRING$(LEN(W1$),29);:LOCATE,,1:GOTO 2530 2680 IF WORD$=CHR$(83) and WORD.COL.LOC%<80 THEN LOCATE,,0:W1$=+MID$(M$(WORD.ROW.LOC%),WORD.COL.LOC%+1,81-WORD.COL.LOC%)+" ":MID$(M$(WORD.ROW.LOC%),WORD.COL.LOC%,LEN(W1$))=W1$:PRINT W1$;:PRINT STRING$(LEN(W1$),29);:LOCATE,,1:GOTO 2530 2690 IF WORD$=CHR$(59) OR WORD$=CHR$(61) THEN GOSUB 2770:GOTO 2530 2700 IF WORD$=CHR$(60) THEN GOSUB 2850:GOTO 2530 2710 IF WORD$=CHR$(62) THEN 2760 2720 GOTO 2530 2730 PRINT WORD$;:MID$(M$(WORD.ROW.LOC%),WORD.COL.LOC%,1)=WORD$:WORD.COL.LOC%=WORD.COL.LOC%+1: IF WORD.COL.LOC% = > 76 AND WORD$ = CHR$(32) THEN PRINT CHR$(29):WORD.ROW.LOC%=WORD.ROW.LOC%+1:WORD.COL.LOC%=1:LOCATE WORD.ROW.LOC%+2,1 2740 'IF WORD.COL.LOC%>75 THEN GOSUB 2751:IF WORD.ROW.LOC%<20 THEN WORD.ROW.LOC%=WORD.ROW.LOC%+1:WORD.COL.LOC%=1:LOCATE WORD.ROW.LOC%+2,1 ELSE WORD.COL.LOC%=80:PRINT CHR$(29); 2750 GOTO 2530 2751 'A.NEW.LINE$ = SPACE$(76): PRINT A.NEW.LINE$:RETURN 2760 LOCATE ,,0:RETURN 2770 '-------------------------------------------------- 2771 '- Open routine - 2772 '-------------------------------------------------- 2780 LOCATE,,0 2790 IF WORD.ROW.LOC%=20 THEN 2830 2800 FOR W% = 20 TO WORD.ROW.LOC%+1 STEP -1 2810 M$(W%)=M$(W%-1):LOCATE W%+2,1:PRINT M$(W%); 2820 NEXT 2830 IF WORD$=CHR$(59) THEN M$(WORD.ROW.LOC%)=SPACE$(80) 2840 LOCATE WORD.ROW.LOC%+2,1:PRINT M$(WORD.ROW.LOC%);:PRINT STRING$(81-WORD.COL.LOC%,29);:LOCATE,,1:RETURN 2850 '------------------------------------------------ 2851 ' Close routine - 2852 '------------------------------------------------ 2860 LOCATE,,0 2870 IF WORD.ROW.LOC%=20 THEN 2910 2880 FOR W% = WORD.ROW.LOC% TO 19 2890 M$(W%)=M$(W%+1):LOCATE W%+2,1:PRINT M$(W%); 2900 NEXT 2910 M$(20)=SPACE$(80):LOCATE 22,1:PRINT M$(20); 2920 LOCATE WORD.ROW.LOC%+2,WORD.COL.LOC%,1:RETURN 2930 '-------------------------------------------------- 2931 ' End of full screen routine - 2932 '-------------------------------------------------- 2940 FOR X=1 TO 20 :M$(X)=B$:NEXT :RETURN 2950 '--------------------------------------------------- 2960 ' Some setup stuff and error traps - 2970 '--------------------------------------------------- 2980 BEEP 2990 COLOR 31:LOCATE 25,40-(LEN(E$)/2),0:PRINT E$; 3000 EKEY$=INKEY$:IF EKEY$<>CHR$(27) THEN 3000 ELSE COLOR 7:LOCATE 25,1:PRINT SPC(79);:LOCATE ,,1:RETURN 3010 PRINT FS$ " " STRING$(29-LEN(FS$),chr$(205)) " ";:COLOR 7,1:PRINT " C a r d f i l e ";:COLOR 7,1:PRINT " " STRING$(20,Chr$(205)) " " DATE$;:LOCATE 23,1:PRINT STRING$(80,223);:COLOR 7,1:RETURN 3020 LOCATE 24,22:PRINT "- Insert - Delete - Repeat - End";:COLOR O,7:LOCATE 24,19:PRINT "F1";:LOCATE 24,32:PRINT "F2";:LOCATE 24,46:PRINT "F3";:LOCATE 24,61:PRINT "F4";:COLOR 7,1:RETURN 3030 LOCATE 24,1:PRINT SPC(79);:RETURN 3040 LOCATE 19,25:PRINT "> File not found. Create? (Y or N) ";:FILE.LENGTH=1:GOSUB 4500:IF IN$="" THEN 3040 3050 IF IN$<>"N" AND IN$<>"n" AND IN$<>"Y" AND IN$<>"y" THEN 3040 3060 LOCATE 19,25:PRINT B1$;:IF IN$= "N" OR IN$ ="n" THEN RESUME 1040 3070 D=0 3080 OPEN "O",1,FS$+".KEY":GOSUB 3910 3090 OPEN "R",2,FS$+".IND":OPEN "R",3,FS$+".DAT" 3100 CLOSE:ON ERROR GOTO 4490:RESUME 1110 3110 LOCATE 24,75:PRINT "==> ";:FILE.LENGTH=1:GOSUB 4500:IF IN$="" THEN 3110 3120 COLOR 7,1:LOCATE 24,75:PRINT SPC(5);:RETURN 3130 '------------------------------------------- 3131 '- Paint function keys - 3132 '------------------------------------------- 3140 D=0:DX=4:DY=2:FOR KEYWX = 0 TO 41:LOCATE DX,DY+D:PRINT NT$(KEYWX)+")" " " KWORD$(KEYWX + 1);:DX=DX+1 3150 IF DX>17 THEN DX=4:D=D+24 3160 NEXT :RETURN 3170 '------------------------------------------- 3171 '- Get next available index - 3172 '------------------------------------------- 3180 IF KI=0 THEN XI=(LOF(2)/256)+1:GOTO 3200 3190 XI=KI:GOSUB 3950:KI=CVI(JX$):SK$="Y" 3200 FOR Z=1 TO 127:LSET JP$(Z)=MKI$(ZZ):NEXT :IX=0 3210 RETURN 3220 '------------------------------------------- 3221 '- Add search string - 3222 '------------------------------------------- 3230 IF XD>LOF(3)/256 THEN RK$="E":GOTO 3270 3240 GOSUB 4000 3241 'get record for test, convert to all uppers (upc) 3250 FOR Z=1 TO 4:if HD_dollar(Z) <> "" then call upc(HD_dollar(Z)):P=INSTR(HD_dollar(Z),search_value$):IF P>0 THEN RK$="Y":GOTO 3270 ELSE NEXT 3260 XD=XD+1:GOTO 3230 3270 RETURN 3280 '------------------------------------------- 3281 '- Add to index - 3282 '------------------------------------------- 3290 IF KP(X)=XI THEN 3320 3300 XI=KP(X) 3310 GOSUB 3940:GOSUB 3960 3320 FOR Z=1 TO 127 3330 IP=CVI(JP$(Z)) 3340 IF IP=GF THEN 3470 3350 IF IP=0 THEN 3370 3360 NEXT Z 3370 IF IX>0 THEN XI=IX:GOTO 3310 3380 IF KP(X)=XI THEN 3410 3390 XI=KP(X) 3400 GOSUB 3940:GOSUB 3960 3410 FOR Z=1 TO 127 3420 IP=CVI(JP$(Z)) 3430 IF IP=0 THEN LSET JP$(Z)=MKI$(GF):GOSUB 3970:GOSUB 3980:GOTO 3470 3440 NEXT Z 3450 IF IX>0 THEN XI=IX:GOTO 3400 3460 GOSUB 3170:GOTO 3400 3470 RETURN 3480 '------------------------------------------- 3481 ' add/rewrite page - 3482 '------------------------------------------- 3490 LOCATE 24,1:PRINT "Adding/rewriting page"; 3500 Y=1:Z=0 3510 FOR X=1 TO 20 3520 IF X+Z+1=21 THEN 3550 3530 IF M$(X+Z+1)<>B$ THEN 3550 3540 Z=Z+1:GOTO 3520 3550 GOSUB 3610:X=X+Z:Z=0 3560 NEXT X 3570 X1=GN:GN=0:GOSUB 4010 3580 IF X1=0 THEN 3600 3590 XD=X1:GOSUB 3990:GOSUB 3740 3600 GOSUB 3030:RETURN 3610 '------------------------------------------- 3611 '- Load index buffer - 3612 '------------------------------------------- 3620 IF Y<>4 THEN 3670 3630 IF GN>0 THEN GOSUB 4010:XD=GN:GOSUB 3990:GOSUB 3710:GOTO 3660 3640 IF KD>0 THEN GN=KD ELSE GN=(LOF(3)/256)+1:IF GN=XD THEN GN=GN+1 3650 GOSUB 4010:GOSUB 3680 3660 Y=1 3670 LSET HD_dollar(Y)=M$(X):LSET HB_dollar(Y)=MKI$(Z):Y=Y+1:RETURN 3680 '------------------------------------------- 3681 '- Get next record - 3682 '------------------------------------------- 3690 IF KD>0 THEN XD=KD:GOSUB 3990:KD=GN:SK$="Y" ELSE XD=(LOF(3)/256)+1 3700 GOSUB 3710:GF=FR:GN=0:RETURN 3710 '------------------------------------------- 3711 ' Initialize - 3712 '------------------------------------------- 3720 FOR X7=1 TO 3:LSET HD_dollar(X7)=B1$:LSET HB_dollar(X7)=MKI$(ZZ):NEXT 3730 RETURN 3740 '------------------------------------------- 3741 ' Delete entire page - 3742 '------------------------------------------- 3750 X1=GN:GN=KD:KD=XD:GOSUB 3710:GF=0:GOSUB 4010:SK$="Y" 3760 IF X1>0 THEN XD=X1:GOSUB 3990:GOTO 3750 3770 RETURN 3780 '------------------------------------------- 3781 ' Index page - 3782 '------------------------------------------- 3790 LOCATE 24,1:PRINT "Indexing file"; 3800 FOR X = 1 TO 42 3810 IF KP(X)=0 THEN 3870 3820 FOR Y = 1 TO 20 3830 IF M$(Y)=B$ THEN 3860 3840 P=INSTR(M$(Y),KWORD$(X)) 3850 IF P>0 THEN GOSUB 3280:GOTO 3870 3860 NEXT Y 3870 NEXT X 3880 GOSUB 3030:RETURN 3890 '------------------------------------------- 3891 ' Write keys to file - 3892 '------------------------------------------- 3900 OPEN "O",1,FS$+".KEY" 3910 FOR Z=1 TO 42:WRITE#1,KWORD$(Z),KP(Z):NEXT 3920 WRITE#1,KI,KD 3930 CLOSE 1:RETURN 3940 '------------------------------------------- 3941 ' Index I/O - 3942 '------------------------------------------- 3950 GET 2,XI:RETURN 3960 IX=CVI(JX$):RETURN 3970 LSET JX$=MKI$(IX):RETURN 3980 PUT 2,XI:RETURN 3990 '------------------------------------------- 3991 '- Data I/O - 3992 '------------------------------------------- 4000 GET 3,XD:GF=CVI(HF$):GN=CVI(HN$):RETURN 4010 LSET HF$=MKI$(GF):LSET HN$=MKI$(GN):PUT 3,XD:RETURN 4020 'Add del list 4030 FOR Z=1 TO 100 4040 '------------------------------------------- 4041 '- Add/delete from list - 4042 '------------------------------------------- 4050 NEXT 4060 DF$="Y":RETURN 4070 '------------------------------------------- 4071 ' Paint page - 4072 '------------------------------------------- 4080 FR=GF:CLS:GOSUB 3010:GOSUB 2940 4090 LY=1 4100 FOR LZ=1 TO 3 4110 IF LY>20 THEN 4160 4120 LOCATE LY+2,1:PRINT HD_dollar(LZ);:M$(LY)=HD_dollar(LZ) 4130 LY=LY+CVI(HB_dollar(LZ))+1 4140 NEXT 4150 IF GN>0 THEN XD=GN:GOSUB 3990:GOTO 4100 4160 F$="Y":RETURN 4170 '------------------------------------------- 4171 ' Index/Delete Maint. - 4172 '------------------------------------------- 4180 GOSUB 3030:LOCATE 24,1:PRINT "Performing index file maintenance"; 4190 FOR L=1 TO 42 4200 IF KP(L)=0 THEN 4320 4210 XI=KP(L) 4220 GOSUB 3940:GOSUB 3960 4230 FOR M=1 TO 127 4240 IP=CVI(JP$(M)) 4250 IF IP=0 THEN 4300 4260 FOR N=1 TO 100 4270 IF DL(N)=0 THEN 4290 4280 IF IP=DL(N) THEN LSET JP$(M)=MKI$(ZZ):A$="Y" ELSE NEXT N 4290 NEXT M 4300 IF A$="Y" THEN GOSUB 4390:A$="N" 4310 IF IX>0 THEN XI=IX:GOTO 4220 4320 NEXT L 4330 DF$="N" 4340 FOR L=1 TO 100 4350 IF DL(L)=0 THEN 4380 4360 DL(L)=0 4370 NEXT 4380 RETURN 4390 '----------------------------------------------------------- 4391 ' Shrink it down to size - 4392 '----------------------------------------------------------- 4400 FOR M1=1 TO 126 4410 IP=CVI(JP$(M1)) 4420 IF IP>0 THEN 4470 4430 FOR N1=M1+1 TO 127 4440 IQ=CVI(JP$(N1)) 4450 IF IQ>0 THEN LSET JP$(M1)=MKI$(IQ):LSET JP$(N1)=MKI$(ZZ):GOTO 4470 4460 NEXT N1:GOTO 4480 4470 NEXT M1 4480 GOSUB 3980:RETURN 4490 RESUME 4500 '--------------------------------------------------------------- 4510 '- Common input routine - 4520 '--------------------------------------------------------------- 4530 IN$ = STRING$(ABS(FILE.LENGTH)," "):WD%=0:WS%=0:WORD.LENGTH%=0:RC%=0:WORD$=" " 4540 PRINT STRING$(ABS(FILE.LENGTH),".");:LOCATE ,POS(0)-ABS(FILE.LENGTH) 4550 LOCATE ,,1:WORD$ = INKEY$:IF WORD$ = "" THEN 4550 ELSE IF LEN(WORD$) = 2 THEN 4620 4560 IF ABS(FILE.LENGTH) = WORD.LENGTH% THEN 4590 ELSE IF FILE.LENGTH>0 AND WORD$>=" " AND WORD$<=CHR$(126) THEN 4690 ELSE IF FILE.LENGTH<0 AND WORD$>"/" AND WORD$<":" THEN 4690 4570 IF WORD$="." AND WD%=0 THEN WD%=1:GOTO 4690 4580 IF (WORD$="-" OR WORD$="+") AND WS%=0 AND WORD.LENGTH%=0 THEN WS%=1:GOTO 4690 4590 IF WORD$ = CHR$(8) AND WORD.LENGTH%>0 THEN GOSUB 4700:MID$(IN$,WORD.LENGTH%,1)=" ":WORD.LENGTH%=WORD.LENGTH%-1:PRINT CHR$(29)+CHR$(46)+CHR$(29);:GOTO 4550 4600 IF WORD$ = CHR$(27) THEN LOCATE ,POS(0)-WORD.LENGTH%:GOTO 4530 4610 IF WORD$ = CHR$(13) THEN GOTO 4680 ELSE GOTO 4550 4620 WORD$ = RIGHT$(WORD$,1) 4630 IF WORD$ = CHR$(75) AND WORD.LENGTH%>0 THEN GOSUB 4700:MID$(IN$,WORD.LENGTH%,1)=" ":WORD.LENGTH%=WORD.LENGTH%-1:PRINT CHR$(29);:PRINT ".";:PRINT CHR$(29);:GOTO 4550 4640 IF WORD$ >= CHR$(59) AND WORD$ <= CHR$(68) AND WORD.LENGTH%=0 THEN RC% = ASC(WORD$)-58:GOTO 4680 4650 IF WORD$=CHR$(72) AND WORD.LENGTH%=0 THEN RC%=11:GOTO 4680 4660 IF WORD$=CHR$(80) AND WORD.LENGTH%=0 THEN RC%=12:GOTO 4680 4670 GOTO 4550 4680 PRINT STRING$(ABS(FILE.LENGTH)-WORD.LENGTH%," ");:IN$ = LEFT$(IN$,WORD.LENGTH%):LOCATE ,,0:call upc(in$):RETURN 4690 PRINT WORD$;:WORD.LENGTH%=WORD.LENGTH%+1:MID$(IN$,WORD.LENGTH)=WORD$:IF ABS(FILE.LENGTH) = 1 THEN 4710 ELSE GOTO 4550 4700 IF MID$(IN$,WORD.LENGTH%,1)="." THEN WD%=0 ELSE IF (MID$(IN$,WORD.LENGTH%,1)="+" OR MID$(IN$,WORD.LENGTH%,1)="-") THEN WS%=0 4710 LOCATE ,,0:RETURN 4720 ' -- End of input routine --