home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / autofile.zip / AUTOFILE.BAS next >
BASIC Source File  |  1986-04-25  |  16KB  |  365 lines
  1. 1 '*************************************
  2. 2 '*  A U T O F I L E  -  T D KOLOUCH  *
  3. 3 '*                                   *
  4. 4 '*  CUSTOM DATA SERVICES, INC.       *
  5. 5 '*  PO BOX 13                        *
  6. 6 '*  CROMWELL, CT  06416              *
  7. 7 '*  TEL# 203-635-1589                *
  8. 8 '*************************************
  9. 9 GOTO 100
  10. 10 '
  11. 11 ' *** Input routine ***
  12. 12 '
  13. 13 IN$ = STRING$(ABS(FL)," "):WD%=0:WS%=0:WL%=0:RC%=0:W$=" "
  14. 14 PRINT STRING$(ABS(FL),".");:LOCATE ,POS(0)-ABS(FL)
  15. 15 LOCATE ,,1:W$ = INKEY$:IF W$ = "" THEN 15 ELSE IF LEN(W$) = 2 THEN 22
  16. 16 IF ABS(FL) = WL% THEN 19 ELSE IF FL>0 AND W$>=" " AND W$<=CHR$(126) THEN 29 ELSE IF FL<0 AND W$>"/" AND W$<":" THEN 29
  17. 17 IF W$="." AND WD%=0 THEN WD%=1:GOTO 29
  18. 18 IF (W$="-" OR W$="+") AND WS%=0 AND WL%=0 THEN WS%=1:GOTO 29
  19. 19 IF W$ = CHR$(8) AND WL%>0 THEN GOSUB 30:MID$(IN$,WL%,1)=" ":WL%=WL%-1:PRINT CHR$(29);:PRINT ".";:PRINT CHR$(29);:GOTO 15
  20. 20 IF W$ = CHR$(27) THEN LOCATE ,POS(0)-WL%:GOTO 13
  21. 21 IF W$ = CHR$(13) THEN GOTO 28 ELSE GOTO 15
  22. 22 W$ = RIGHT$(W$,1)
  23. 23 IF W$ = CHR$(75) AND WL%>0 THEN GOSUB 30:MID$(IN$,WL%,1)=" ":WL%=WL%-1:PRINT CHR$(29);:PRINT ".";:PRINT CHR$(29);:GOTO 15
  24. 24 IF W$ >= CHR$(59) AND W$ <= CHR$(68) AND WL%=0 THEN RC% = ASC(W$)-58:GOTO 28
  25. 25 IF W$=CHR$(72) AND WL%=0 THEN RC%=11:GOTO 28
  26. 26 IF W$=CHR$(80) AND WL%=0 THEN RC%=12:GOTO 28
  27. 27 GOTO 15
  28. 28 PRINT STRING$(ABS(FL)-WL%," ");:IN$ = LEFT$(IN$,WL%):LOCATE ,,0:RETURN
  29. 29 PRINT W$;:WL%=WL%+1:MID$(IN$,WL%,1)=W$:IF ABS(FL) = 1 THEN 31 ELSE GOTO 15
  30. 30 IF MID$(IN$,WL%,1)="." THEN WD%=0 ELSE IF (MID$(IN$,WL%,1)="+" OR MID$(IN$,WL%,1)="-") THEN WS%=0
  31. 31 LOCATE ,,0:RETURN
  32. 35 '  ** End of input routine  **
  33. 100 KEY OFF:FOR X=1 TO 10:KEY X,"":NEXT:WIDTH "LPT1:",255:LOCATE ,,0,2,10
  34. 105 DEFINT A-Z:B$=SPACE$(80):B1$=SPACE$(40):ZZ=0:DF$="N"
  35. 110 DIM M$(20),KW$(42),NT$(42),KP(42),DL(100),JP$(127)
  36. 130 DATA 01,02,03,04,05,06,07,08,09,10,11,12,13,14,15,16,17,18,19,20,21
  37. 131 DATA 22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42
  38. 140 FOR X = 1 TO 42:READ NT$(X):NEXT
  39. 300 CLS:COLOR 15,0:LOCATE 4,25:PRINT STRING$(31,"*"):PRINT TAB(25)"*" TAB(55)"*":PRINT TAB(25)"*" TAB(55)"*":PRINT TAB(25)"*" TAB(55)"*":PRINT TAB(25)"*" TAB(55)"*"
  40. 305 PRINT TAB(25)"*" TAB(55)"*":PRINT TAB(25)"*" TAB(55)"*":PRINT TAB(25)"*" TAB(55)"*"
  41. 306 PRINT TAB(25)"*" TAB(55)"*":PRINT TAB(25)"*" TAB(55)"*":PRINT TAB(25)STRING$(31,"*")
  42. 310 LOCATE 6,31:PRINT "Welcome to AUTOFILE":LOCATE 8,38:PRINT "from":LOCATE 10,28:PRINT "CUSTOM DATA SERVICES, INC":LOCATE 12,37:PRINT "Ver 1.0":COLOR 7,0
  43. 320 GOSUB 6000
  44. 500 ON ERROR GOTO 6100
  45. 510 LOCATE 17,25:PRINT "> Enter filespec: ";:FL=8:GOSUB 10:IF IN$ = "" THEN CLS:SYSTEM
  46. 520 P=INSTR(IN$,".")
  47. 530 IF P>0 THEN E$="INVALID -- NO EXTENSION ALLOWED":GOSUB 6010:GOTO 510
  48. 540 FS$=IN$
  49. 550 OPEN"I",1,FS$+".KEY":ON ERROR GOTO 9000
  50. 560 FOR X=1 TO 42:INPUT#1,KW$(X),KP(X):NEXT
  51. 570 INPUT #1,KI,KD:CLOSE 1
  52. 580 OPEN"R",2,FS$+".IND",256
  53. 590 FOR X=1 TO 127:FIELD#2,(X-1)*2ASDU$,2ASJP$(X):NEXT
  54. 600 FIELD#2,254ASDU$,2ASJX$
  55. 610 OPEN"R",3,FS$+".DAT",256
  56. 620 FOR X=1 TO 3:FIELD#3,(X-1)*82ASDU$,80ASHD$(X),2ASHB$(X):NEXT
  57. 630 FIELD#3,246ASDU$,2ASHF$,2ASHN$
  58. 1000 'Menu
  59. 1010 CLS:F$="N"
  60. 1020 GOSUB 6070: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,0
  61. 1030 GOSUB 6200
  62. 1040 IF IN$="K" OR IN$="k" THEN 2000 ELSE IF IN$="D" OR IN$="d" THEN 3000 ELSE IF IN$="E" OR IN$="e" THEN 4000
  63. 1050 GOTO 1030
  64. 2000 'Index
  65. 2010 CLS
  66. 2020 GOSUB 6070:GOSUB 6220
  67. 2030 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,0
  68. 2040 GOSUB 6200:IF IN$="R" OR IN$="r" THEN 1000
  69. 2050 IF IN$="D" OR IN$="d" THEN 2300
  70. 2055 GOSUB 6080
  71. 2060 IF IN$<>"A" AND IN$<>"a" THEN 2030
  72. 2070 'Add keys
  73. 2080 LOCATE 24,1:PRINT "- ADD -             Enter keyword: ";:FL=12:GOSUB 10:GOSUB 6080:IF IN$="" THEN 2030
  74. 2090 IF LEN(IN$)<2 THEN E$="KEYWORDS CANNOT BE ONE CHARACTER LONG":GOSUB 6010:GOTO 2080
  75. 2095 IF LEN(IN$)=2 THEN IF IN$>"00" AND IN$<"43" THEN E$="KEYWORD OF 01 TO 42 NOT ALLOWED":GOSUB 6010:GOTO 2080
  76. 2100 FOR X=1 TO 42
  77. 2110 IF KW$(X)=IN$ THEN E$="DUPLICATE KEYWORD":GOSUB 6010:GOTO 2080
  78. 2120 NEXT
  79. 2122 FOR X=1 TO 42:IF KP(X)=0 THEN 2130 ELSE NEXT
  80. 2125 E$="KEYWORD FILE FULL":GOSUB 6010:GOTO 2030
  81. 2130 KW$(X)=IN$:SK$="Y"
  82. 2140 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
  83. 2150 LOCATE DX,DY:PRINT KW$(X);:LOCATE 24,1:PRINT "Initializing index record";:GOSUB 6300:KP(X)=XI:GOSUB 7150:GOSUB 7160
  84. 2155 GOSUB 6080
  85. 2160 LOCATE 24,1:PRINT "Reindexing with new keyword";
  86. 2170 XD=1:SV$=KW$(X):C=0
  87. 2180 GOSUB 6350
  88. 2190 IF RK$="Y" THEN GOSUB 6400:C=C+1:LOCATE 24,75:PRINT C;:XD=XD+1:GOTO 2180
  89. 2200 GOSUB 6080:GOTO 2030
  90. 2300 'Del keys
  91. 2310 GOSUB 6080
  92. 2320 LOCATE 24,1:PRINT "- DELETE -          Enter keyword #: ";:FL=-2:GOSUB 10:GOSUB 6080:IF IN$="" THEN 2030
  93. 2340 N=VAL(IN$):IF N<1 OR N>42 THEN E$="NUMBER MUST BE FROM 1 TO 42":GOSUB 6010:GOTO 2320
  94. 2350 IF KP(N)=0 THEN E$="KEYWORD NUMBER NOT IN USE":GOSUB 6010:GOTO 2320
  95. 2360 XI=KP(N):LOCATE 24,1:PRINT "Deleting keyword chain";
  96. 2370 GOSUB 7100:IS=CVI(JX$):IX=KI:GOSUB 7150:GOSUB 7160
  97. 2380 KI=XI:SK$="Y"
  98. 2390 IF IS>0 THEN XI=IS:GOTO 2370
  99. 2400 KP(N)=0:KW$(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
  100. 2410 LOCATE DX,DY:PRINT SPC(12);
  101. 2420 GOSUB 6080:GOTO 2030
  102. 3000 'Data
  103. 3010 CLS:GOSUB 6070:F$="N"
  104. 3020 LOCATE 24,1:PRINT "DATA 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";
  105. 3025 LOCATE 24,46:PRINT "N";:LOCATE 24,53:PRINT "F";:LOCATE 24,60:PRINT "R";:COLOR 7,0
  106. 3030 GOSUB 6200:PP=INSTR("AaEeDdPpNnFfRr",IN$):GOSUB 6080
  107. 3040 ON PP GOTO 3060,3060,3200,3200,3300,3300,3400,3400,3700,3700,3500,3500,3760,3760
  108. 3050 GOTO 3020
  109. 3060 'Add
  110. 3065 IF DF$="Y" THEN GOSUB 8200
  111. 3070 CLS:GOSUB 6070:F$="N":LOCATE 24,1:PRINT "- ADD -";:GOSUB 6075
  112. 3080 GOSUB 6000:GOSUB 5000:GOSUB 6080
  113. 3090 FOR X=1 TO 20:IF M$(X)<>B$ THEN 3100 ELSE NEXT :GOTO 3000
  114. 3100 GOSUB 6780:FR=XD:GF=FR:GOSUB 6600:GOSUB 6880
  115. 3110 F$="Y":GOTO 3020
  116. 3200 'Edit
  117. 3205 IF DF$="Y" THEN GOSUB 8200
  118. 3210 IF F$<>"Y" THEN E$="EDIT WHAT?  --  DO <F>IND FIRST":GOSUB 6010:GOTO 3020
  119. 3220 LOCATE 24,1:PRINT "- EDIT -";:GOSUB 6075
  120. 3230 GOSUB 5000:GOSUB 6080
  121. 3240 FOR X=1 TO 20:IF M$(X)<>B$ THEN 3255 ELSE NEXT
  122. 3245 IF XD<>GF THEN XD=GF:GOSUB 7200
  123. 3250 GOSUB 6840:GOSUB 8000:GOTO 3000
  124. 3255 IF XD<>GF THEN XD=GF:GOSUB 7200
  125. 3260 GOSUB 6600:GOSUB 6880
  126. 3270 GOTO 3020
  127. 3300 'Del
  128. 3310 IF F$<>"Y" THEN E$="DELETE WHAT?  --  DO <F>IND FIRST":GOSUB 6010:GOTO 3020
  129. 3320 LOCATE 24,1:PRINT "- DELETE -            Confirm delete (Y or N) ";:GOSUB 6200:IF IN$="N" OR IN$="n" THEN 3000
  130. 3330 IF IN$<>"Y" AND IN$<>"y" THEN 3320
  131. 3335 IF XD<>FR THEN XD=FR:GOSUB 7200
  132. 3340 GOSUB 6080:GOSUB 6840:GOSUB 8000:F$="D":CLS:GOSUB 6070:GOTO 3020
  133. 3400 'Print
  134. 3410 IF F$<>"Y" THEN E$="PRINT WHAT?  --  DO <F>IND FIRST":GOSUB 6010:GOTO 3020
  135. 3420 LOCATE 24,1:PRINT "- PRINT -         Press 'P' to print or 'C' to cancel";:GOSUB 6200:IF IN$="C" OR IN$="c" THEN 3020 ELSE IF IN$<>"P" AND IN$<>"p" THEN 3420
  136. 3430 FOR X=1 TO 20:LPRINT M$(X):NEXT
  137. 3440 GOSUB 6080:GOTO 3020
  138. 3500 'Find
  139. 3510 CLS:GOSUB 6070:GOSUB 6220
  140. 3520 XD=1:XE=0:LOCATE 24,1:PRINT "- FIND -     Enter number of keyword or string to search for: ";:FL=15:GOSUB 10:IF IN$="" OR IN$=STRING$(LEN(IN$)," ") THEN 3000 ELSE GOSUB 6080
  141. 3530 IN=VAL(IN$)
  142. 3540 IF LEN(IN$)<3 AND IN<43 AND IN>0 AND KP(IN)<>0 THEN 3600
  143. 3545 'Find string
  144. 3550 SV$=IN$:F$="N"
  145. 3560 LOCATE 24,1:PRINT "Search on string = ";SV$;
  146. 3570 GOSUB 6350:GOSUB 6080:IF RK$="E" THEN E$="END OF FILE":GOSUB 6010:IF F$="N" THEN 3520 ELSE GOTO 3020
  147. 3590 XE=XD:XD=GF:GOSUB 7200:GOSUB 8050:GOTO 3020
  148. 3600 'Find key
  149. 3610 SV$="":XI=KP(IN):GOSUB 7100:GOSUB 7130:LP=0:F$="N"
  150. 3620 IF LP=127 THEN 3670
  151. 3630 FOR LX=LP+1 TO 127
  152. 3640 IP=CVI(JP$(LX)):IF IP=0 THEN 3670
  153. 3650 XD=IP:GOSUB 7200:IF GF<>0 THEN GOSUB 8050:LP=LX:GOTO 3020
  154. 3660 NEXT LX
  155. 3670 IF IX>0 THEN XI=IX:GOSUB 7100:GOSUB 7130:LP=0:GOTO 3630
  156. 3675 E$="END OF INDEX":GOSUB 6010:IF F$="N" THEN 3520 ELSE 3020
  157. 3700 'Next
  158. 3710 IF F$<>"Y" AND F$<>"D" THEN E$="NEXT WHAT?  --  DO <F>IND FIRST":GOSUB 6010:GOTO 3020
  159. 3720 IF SV$="" THEN 3620 ELSE XD=XE+1:GOTO 3560
  160. 3750 'Return
  161. 3760 GOTO 1000
  162. 4000 'End
  163. 4005 IF DF$="Y" THEN GOSUB 8200
  164. 4010 CLS
  165. 4020 IF SK$="Y" THEN GOSUB 7000
  166. 4030 CLOSE : SYSTEM
  167. 5000 ' ** Full screen editor **
  168. 5010 LOCATE 3,1,1
  169. 5020 WC%=1:WR%=1
  170. 5030 W$=INKEY$:IF W$="" THEN 5030
  171. 5040 IF W$>= CHR$(32) AND W$<= CHR$(126) THEN 5230 ELSE IF LEN(W$) = 2 THEN 5090
  172. 5050 IF W$=CHR$(8) THEN IF WC%>1 THEN WC%=WC%-1:PRINT CHR$(29);:GOTO 5030 ELSE IF WR%>0 THEN WR%=WR%-1:LOCATE WR%+2,80:WC%=80:GOTO 5030
  173. 5060 IF W$=CHR$(9) THEN LOCATE WR%+2,80:WC%=80:GOTO 5030
  174. 5070 IF W$=CHR$(13) THEN IF WR%<20 THEN WR%=WR%+1:LOCATE WR%+2,1:WC%=1:GOTO 5030
  175. 5080 GOTO 5030
  176. 5090 W$=RIGHT$(W$,1)
  177. 5100 IF W$=CHR$(75) THEN IF WC%>1 THEN WC%=WC%-1:PRINT CHR$(29);:GOTO 5030 ELSE IF WR%>1 THEN WR%=WR%-1:LOCATE WR%+2,80:WC%=80:GOTO 5030
  178. 5110 IF W$=CHR$(15) THEN LOCATE WR%+2,1:WC%=1:GOTO 5030
  179. 5120 IF W$=CHR$(77) THEN IF WC%<80 THEN PRINT CHR$(28);:WC%=WC%+1:GOTO 5030 ELSE IF WR%<20 THEN WR%=WR%+1:LOCATE WR%+2,1:WC%=1:GOTO 5030
  180. 5130 IF W$=CHR$(72) THEN IF WR%>1 THEN WR%=WR%-1:LOCATE WR%+2,WC%:GOTO 5030
  181. 5140 IF W$=CHR$(80) THEN IF WR%<20 THEN WR%=WR%+1:LOCATE WR%+2,WC%:GOTO 5030
  182. 5150 IF W$=CHR$(73) OR W$=CHR$(71) THEN 5010
  183. 5160 IF W$=CHR$(81) THEN LOCATE 22,1:WR%=20:WC%=1:GOTO 5030
  184. 5170 IF W$=CHR$(82) THEN IF WC%<80 THEN LOCATE,,0:W1$=" "+MID$(M$(WR%),WC%,80-WC%):MID$(M$(WR%),WC%,LEN(W1$))=W1$:PRINT W1$;:PRINT STRING$(LEN(W1$),29);:LOCATE,,1:GOTO 5030
  185. 5180 IF W$=CHR$(83) THEN IF WC%<80 THEN LOCATE,,0:W1$=+MID$(M$(WR%),WC%+1,81-WC%)+" ":MID$(M$(WR%),WC%,LEN(W1$))=W1$:PRINT W1$;:PRINT STRING$(LEN(W1$),29);:LOCATE,,1:GOTO 5030
  186. 5190 IF W$=CHR$(59) OR W$=CHR$(61) THEN GOSUB 5270:GOTO 5030
  187. 5200 IF W$=CHR$(60) THEN GOSUB 5350:GOTO 5030
  188. 5210 IF W$=CHR$(62) THEN 5260
  189. 5220 GOTO 5030
  190. 5230 PRINT W$;:MID$(M$(WR%),WC%,1)=W$:WC%=WC%+1
  191. 5240 IF WC%>80 THEN IF WR%<20 THEN WR%=WR%+1:WC%=1:LOCATE WR%+2,1 ELSE WC%=80:PRINT CHR$(29);
  192. 5250 GOTO 5030
  193. 5260 LOCATE ,,0:RETURN
  194. 5270 'OPEN/RPT RTN
  195. 5280 LOCATE,,0
  196. 5290 IF WR%=20 THEN 5330
  197. 5300 FOR W% = 20 TO WR%+1 STEP -1
  198. 5310 M$(W%)=M$(W%-1):LOCATE W%+2,1:PRINT M$(W%);
  199. 5320 NEXT
  200. 5330 IF W$=CHR$(59) THEN M$(WR%)=SPACE$(80)
  201. 5340 LOCATE WR%+2,1:PRINT M$(WR%);:PRINT STRING$(81-WC%,29);:LOCATE,,1:RETURN
  202. 5350 'CLOSE RTN
  203. 5360 LOCATE,,0
  204. 5370 IF WR%=20 THEN 5410
  205. 5380 FOR W% = WR% TO 19
  206. 5390 M$(W%)=M$(W%+1):LOCATE W%+2,1:PRINT M$(W%);
  207. 5400 NEXT
  208. 5410 M$(20)=SPACE$(80):LOCATE 22,1:PRINT M$(20);
  209. 5420 LOCATE WR%+2,WC%,1:RETURN
  210. 5430 ' ** End of full screen routine **
  211. 6000 FOR X=1 TO 20 :M$(X)=B$:NEXT :RETURN
  212. 6010 'Error
  213. 6015 BEEP
  214. 6020 COLOR 31:LOCATE 25,40-(LEN(E$)/2),0:PRINT E$;
  215. 6030 EKEY$=INKEY$:IF EKEY$<>CHR$(27) THEN 6030 ELSE COLOR 7:LOCATE 25,1:PRINT SPC(79);:LOCATE ,,1:RETURN
  216. 6070 PRINT FS$ " " STRING$(29-LEN(FS$),"-") " ";:COLOR 0,7:PRINT " A U T O F I L E ";:COLOR 7,0:PRINT " " STRING$(20,"-") " " DATE$;:LOCATE 23,1:PRINT STRING$(80,223);:RETURN
  217. 6075 LOCATE 24,22:PRINT "- Open       - Close       - 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,0:RETURN
  218. 6080 LOCATE 24,1:PRINT SPC(79);:RETURN
  219. 6100 LOCATE 19,25:PRINT "> File not found. Create? (Y or N) ";:FL=1:GOSUB 10:IF IN$="" THEN 6100
  220. 6110 IF IN$<>"N" AND IN$<>"n" AND IN$<>"Y" AND IN$<>"y" THEN 6100
  221. 6120 LOCATE 19,25:PRINT B1$;:IF IN$= "N" OR IN$ ="n" THEN RESUME 510
  222. 6160 D=0
  223. 6170 OPEN "O",1,FS$+".KEY":GOSUB 7020
  224. 6180 OPEN "R",2,FS$+".IND":OPEN "R",3,FS$+".DAT"
  225. 6190 CLOSE:ON ERROR GOTO 9000:RESUME 580
  226. 6200 LOCATE 24,75:PRINT "==> ";:FL=1:GOSUB 10:IF IN$="" THEN 6200
  227. 6210 LOCATE 24,75:PRINT SPC(5);:RETURN
  228. 6220 'Paint keys
  229. 6230 D=0:DX=4:DY=2:FOR X = 1 TO 42:LOCATE DX,DY+D:PRINT NT$(X)+")" " " KW$(X);:DX=DX+1
  230. 6240 IF DX>17 THEN DX=4:D=D+24
  231. 6250 NEXT :RETURN
  232. 6300 'Next avail indx
  233. 6310 IF KI=0 THEN XI=(LOF(2)/256)+1:GOTO 6330
  234. 6320 XI=KI:GOSUB 7110:KI=CVI(JX$):SK$="Y"
  235. 6330 FOR Z=1 TO 127:LSET JP$(Z)=MKI$(ZZ):NEXT :IX=0
  236. 6340 RETURN
  237. 6350 'String search
  238. 6360 IF XD>LOF(3)/256 THEN RK$="E":GOTO 6395
  239. 6370 GOSUB 7210
  240. 6380 FOR Z=1 TO 4:P=INSTR(HD$(Z),SV$):IF P>0 THEN RK$="Y":GOTO 6395 ELSE NEXT
  241. 6390 XD=XD+1:GOTO 6360
  242. 6395 RETURN
  243. 6400 'Add to indx
  244. 6410 IF KP(X)=XI THEN 6440
  245. 6420 XI=KP(X)
  246. 6430 GOSUB 7100:GOSUB 7130
  247. 6440 FOR Z=1 TO 127
  248. 6445 IP=CVI(JP$(Z))
  249. 6450 IF IP=GF THEN 6560
  250. 6455 IF IP=0 THEN 6470
  251. 6460 NEXT Z
  252. 6470 IF IX>0 THEN XI=IX:GOTO 6430
  253. 6480 IF KP(X)=XI THEN 6510
  254. 6490 XI=KP(X)
  255. 6500 GOSUB 7100:GOSUB 7130
  256. 6510 FOR Z=1 TO 127
  257. 6515 IP=CVI(JP$(Z))
  258. 6520 IF IP=0 THEN LSET JP$(Z)=MKI$(GF):GOSUB 7150:GOSUB 7160:GOTO 6560
  259. 6530 NEXT Z
  260. 6540 IF IX>0 THEN XI=IX:GOTO 6500
  261. 6550 GOSUB 6300:GOTO 6500
  262. 6560 RETURN
  263. 6600 'Add/rew
  264. 6610 LOCATE 24,1:PRINT "Adding/rewriting page";
  265. 6620 Y=1:Z=0
  266. 6630 FOR X=1 TO 20
  267. 6640 IF X+Z+1=21 THEN 6670
  268. 6650 IF M$(X+Z+1)<>B$ THEN 6670
  269. 6660 Z=Z+1:GOTO 6640
  270. 6670 GOSUB 6730:X=X+Z:Z=0
  271. 6680 NEXT X
  272. 6690 X1=GN:GN=0:GOSUB 7220
  273. 6700 IF X1=0 THEN 6720
  274. 6710 XD=X1:GOSUB 7200:GOSUB 6840
  275. 6720 GOSUB 6080:RETURN
  276. 6730 'Load buf
  277. 6740 IF Y<>4 THEN 6770
  278. 6760 IF GN>0 THEN GOSUB 7220:XD=GN:GOSUB 7200:GOSUB 6810:GOTO 6765
  279. 6762 IF KD>0 THEN GN=KD ELSE GN=(LOF(3)/256)+1:IF GN=XD THEN GN=GN+1
  280. 6764 GOSUB 7220:GOSUB 6780
  281. 6765 Y=1
  282. 6770 LSET HD$(Y)=M$(X):LSET HB$(Y)=MKI$(Z):Y=Y+1:RETURN
  283. 6780 'Get next
  284. 6790 IF KD>0 THEN XD=KD:GOSUB 7200:KD=GN:SK$="Y" ELSE XD=(LOF(3)/256)+1
  285. 6800 GOSUB 6810:GF=FR:GN=0:RETURN
  286. 6810 'Init
  287. 6820 FOR X7=1 TO 3:LSET HD$(X7)=B1$:LSET HB$(X7)=MKI$(ZZ):NEXT
  288. 6830 RETURN
  289. 6840 'Del page
  290. 6850 X1=GN:GN=KD:KD=XD:GOSUB 6810:GF=0:GOSUB 7220:SK$="Y"
  291. 6860 IF X1>0 THEN XD=X1:GOSUB 7200:GOTO 6850
  292. 6870 RETURN
  293. 6880 'Indx page
  294. 6885 LOCATE 24,1:PRINT "Indexing file";
  295. 6890 FOR X = 1 TO 42
  296. 6900 IF KP(X)=0 THEN 6930
  297. 6905 FOR Y = 1 TO 20
  298. 6910 IF M$(Y)=B$ THEN 6925
  299. 6915 P=INSTR(M$(Y),KW$(X))
  300. 6920 IF P>0 THEN GOSUB 6400:GOTO 6930
  301. 6925 NEXT Y
  302. 6930 NEXT X
  303. 6935 GOSUB 6080:RETURN
  304. 7000 'Write keys
  305. 7010 OPEN "O",1,FS$+".KEY"
  306. 7020 FOR Z=1 TO 42:WRITE#1,KW$(Z),KP(Z):NEXT
  307. 7030 WRITE#1,KI,KD
  308. 7040 CLOSE 1:RETURN
  309. 7100 'Indx I/O
  310. 7110 GET 2,XI:RETURN
  311. 7130 IX=CVI(JX$):RETURN
  312. 7150 LSET JX$=MKI$(IX):RETURN
  313. 7160 PUT 2,XI:RETURN
  314. 7200 'Data I/O
  315. 7210 GET 3,XD:GF=CVI(HF$):GN=CVI(HN$):RETURN
  316. 7220 LSET HF$=MKI$(GF):LSET HN$=MKI$(GN):PUT 3,XD:RETURN
  317. 8000 'Add del list
  318. 8010 FOR Z=1 TO 100
  319. 8020 IF DL(Z)=0 THEN DL(Z)=FR:GOTO 8040
  320. 8030 NEXT
  321. 8040 DF$="Y":RETURN
  322. 8050 'Paint page
  323. 8060 FR=GF:CLS:GOSUB 6070:GOSUB 6000
  324. 8070 LY=1
  325. 8080 FOR LZ=1 TO 3
  326. 8085 IF LY>20 THEN 8130
  327. 8090 LOCATE LY+2,1:PRINT HD$(LZ);:M$(LY)=HD$(LZ)
  328. 8100 LY=LY+CVI(HB$(LZ))+1
  329. 8110 NEXT
  330. 8120 IF GN>0 THEN XD=GN:GOSUB 7200:GOTO 8080
  331. 8130 F$="Y":RETURN
  332. 8200 'Indx del maint
  333. 8205 GOSUB 6080:LOCATE 24,1:PRINT "Performing index file maintenance";
  334. 8210 FOR L=1 TO 42
  335. 8220 IF KP(L)=0 THEN 8340
  336. 8230 XI=KP(L)
  337. 8240 GOSUB 7100:GOSUB 7130
  338. 8250 FOR M=1 TO 127
  339. 8260 IP=CVI(JP$(M))
  340. 8270 IF IP=0 THEN 8320
  341. 8280 FOR N=1 TO 100
  342. 8290 IF DL(N)=0 THEN 8310
  343. 8300 IF IP=DL(N) THEN LSET JP$(M)=MKI$(ZZ):A$="Y" ELSE NEXT N
  344. 8310 NEXT M
  345. 8320 IF A$="Y" THEN GOSUB 8400:A$="N"
  346. 8330 IF IX>0 THEN XI=IX:GOTO 8240
  347. 8340 NEXT L
  348. 8350 DF$="N"
  349. 8360 FOR L=1 TO 100
  350. 8365 IF DL(L)=0 THEN 8390
  351. 8370 DL(L)=0
  352. 8380 NEXT
  353. 8390 RETURN
  354. 8400 'Shrink
  355. 8410 FOR M1=1 TO 126
  356. 8420 IP=CVI(JP$(M1))
  357. 8430 IF IP>0 THEN 8480
  358. 8440 FOR N1=M1+1 TO 127
  359. 8450 IQ=CVI(JP$(N1))
  360. 8460 IF IQ>0 THEN LSET JP$(M1)=MKI$(IQ):LSET JP$(N1)=MKI$(ZZ):GOTO 8480
  361. 8470 NEXT N1:GOTO 8490
  362. 8480 NEXT M1
  363. 8490 GOSUB 7160:RETURN
  364. 9000 RESUME
  365.