home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / lambda / soundpot / p / refind2.lbr / REFIND.BZS / REFIND.BAS
Encoding:
BASIC Source File  |  1993-10-25  |  6.0 KB  |  157 lines
  1. 10 REM This program written by John Porter
  2. 20 REM Dept. Environmental Sciences, Univ. of Virginia
  3. 30 REM Charlottesville, VA 22903
  4. 40 REM copyright (c) 1984 by John Porter
  5. 50 REM NOT TO BE SOLD
  6. 60 REM  3/13/84 
  7. 70 CLEAR,46999!
  8. 80 VERSI$ =" 9"
  9. 90 DIM ISTR$(30),CSTR$(30),KEY$(30,5,15),NKEY(15)
  10. 100 DEFINT I-N
  11. 110 DEF USR1=47000!
  12. 120 REM DEFINE CLEAR SCREEN CHARACTER
  13. 130 CLS$=CHR$(26)
  14. 140 REM DEFINE BELL CHARACTER (SET TO "" IF YOU DON'T WANT THE BELL)
  15. 150 BELL$=CHR$(7)
  16. 160 REM DEFINE ERROR TRAPPING ROUTINE FOR INPUT FILE ERRORS
  17. 170 ON ERROR GOTO 4000
  18. 180 PRINT CLS$:PRINT:PRINT "REFFIND - VERSION ";VERSI$:PRINT
  19. 190 PRINT "This program locates key strings within references."
  20. 200 PRINT " References should have single vertical spacing and"
  21. 210 PRINT " be separated from one another by double spacing."
  22. 220 PRINT 
  23. 230 PRINT "References that contain the appropriate key strings will"
  24. 240 PRINT " be written to another file in the same format."
  25. 250 PRINT:PRINT "You will be able to use multiple input files on different"
  26. 260 PRINT "   disks (or, if you want, the same disk). BUT YOU CAN NOT "
  27. 270 PRINT "   CHANGE THE DISK THE OUTPUT FILE IS ON!!!!!"
  28. 280 IFILE=1
  29. 290 PRINT:PRINT:PRINT "PUT IN THE DISKS YOU WANT TO READ FROM OR WRITE TO"
  30. 300 INPUT " AND HIT A CARRIAGE RETURN";A$
  31. 310 RESET
  32. 320 PRINT:PRINT
  33. 330 REM THIS READS IN THE MACHINE LANGUAGE SUBROUTINE USR1
  34. 340 FOR I=0 TO 70
  35. 350 READ J
  36. 360 POKE I+47000!,J
  37. 370 NEXT I
  38. 380 INPUT "What is the file name for INPUT";F1$
  39. 390 DUM$=F1$
  40. 400 GOSUB 2000
  41. 410 F1$=DUM$
  42. 420 INPUT "What is the file name for OUTPUT";F2$
  43. 430 DUM$=F2$
  44. 440 GOSUB 2000
  45. 450 F2$=DUM$
  46. 460 OPEN "I",#1,F1$
  47. 470 OPEN "O",#2,F2$
  48. 480 REM *************** go read in key strings
  49. 490 NSET=1
  50. 500 NKEY(NSET)=1
  51. 510 PRINT 
  52. 520 PRINT "Input KEY STRINGS"
  53. 530 PRINT  "Up to 5 keys may be input on a single line, separated by commas."
  54. 540 PRINT "When more than one key string is input per line, ALL of the "
  55. 550 PRINT "key strings in the line MUST OCCUR in a reference for it to be"
  56. 560 PRINT "included. "
  57. 570 OLDK$=K$
  58. 580 PRINT
  59. 590 PRINT "Input key string (Input 2 empty key strings to start search) "
  60. 600 LINE INPUT K$
  61. 610 ICOM=0
  62. 620 IKEY=1
  63. 630 IF K$="" THEN 670
  64. 640 NCOM=ICOM: ICOM=INSTR(ICOM+1,K$,","):IF IKEY>5 THEN PRINT"EXTRA KEY(S) IGNORED":GOTO 570
  65. 650 IF ICOM><0 THEN KEY$(NSET,IKEY,NKEY(NSET))=MID$(K$,NCOM+1,(ICOM-NCOM-1)):IKEY=IKEY+1:GOTO 640
  66. 660 KEY$(NSET,IKEY,NKEY(NSET))=MID$(K$,NCOM+1):NKEY(NSET)=NKEY(NSET)+1:PRINT:PRINT " OR":GOTO 570
  67. 670 IF OLDK$<>""THEN NKEY(NSET)=NKEY(NSET)-1:NSET=NSET+1:NKEY(NSET)=1:PRINT:PRINT "***** AND *****":GOTO 570
  68. 680 NSET=NSET-1
  69. 690 PRINT #2, "-SET","  KEY"
  70. 700 FOR I1=1 TO NSET
  71. 710 FOR I2=1 TO NKEY(I1)
  72. 720 FOR I3=1 TO 5
  73. 730 DUM$=KEY$(I1,I3,I2)
  74. 740 GOSUB 2000
  75. 750 KEY$(I1,I3,I2)=DUM$
  76. 760 NEXT I3
  77. 770 PRINT #2,I1,KEY$(I1,1,I2);",";KEY$(I1,2,I2);",";KEY$(I1,3,I2);",";KEY$(I1,4,I2);",";KEY$(I1,5,I2)
  78. 780 NEXT I2
  79. 790 NEXT I1
  80. 800 PRINT #2,""
  81. 810 PRINT CLS$
  82. 820 REM this section reads in the references
  83. 830 REM the raw references are stored in array istr$
  84. 840 REM compressed, upper case refs are stored in cstr$
  85. 850 REM overlapping words are stored in ostr$
  86. 860 WHILE NOT EOF(1)
  87. 870 NB=1
  88. 880 NREF=NREF+1
  89. 890 ISTR$(1)=""
  90. 900 OSTR$=""
  91. 910 LINE INPUT #1, ISTR$(NB)
  92. 920  DUM$=ISTR$(NB):GOSUB 2000:CSTR$(NB)=DUM$
  93. 930 IF CSTR$(NB)<>"" THEN NB=NB+1:GOTO 910
  94. 940 FOR I1=1 TO NB
  95. 950 IF LEN(ISTR$(I1))=255 THEN OSTR$=OSTR$+RIGHT$(ISTR$(I1),12)+LEFT$(ISTR$(I1+1),12)
  96. 960 NEXT I1
  97. 970 DUM$=OSTR$:GOSUB 2000: OSTR$=DUM$
  98. 980 GOSUB 3000
  99. 990 PRINT CLS$:PRINT:PRINT :PRINT
  100. 1000 PRINT ,"REFS CHECKED = ";NREF,"NUMBER OF MATCHES = ";NFOU
  101. 1010 IF MC<NSET THEN 1080
  102. 1020 NFOU=NFOU+1
  103. 1030 PRINT CLS$:PRINT:PRINT :PRINT
  104. 1040 PRINT ,"REFS CHECKED = ";NREF,"NUMBER OF MATCHES = ";NFOU
  105. 1050 FOR I1=1 TO NB
  106. 1060 IF LEN(ISTR$(I1))=255 THEN PRINT #2,ISTR$(I1); :ELSE PRINT #2, ISTR$(I1)
  107. 1070 NEXT I1
  108. 1080 WEND
  109. 1090 CLOSE #1
  110. 1100 FOR I= 1 TO 10:PRINT BELL$:NEXT I : PRINT CLS$
  111. 1110 IFILE=IFILE+1
  112. 1120 PRINT:PRINT:PRINT "Place the disk with input file #";IFILE;" in a disk drive"
  113. 1130 PRINT" DO NOT remove the disk containing the output file!!!!!"
  114. 1140 PRINT: PRINT
  115. 1150 PRINT:INPUT "What is the new INPUT file name (Hit 'RETURN' to end)";F1$   
  116. 1160 DUM$=F1$: GOSUB 2000: F1$=DUM$
  117. 1170 IF F1$ = "" THEN CLOSE:PRINT BELL$,BELL$:PRINT "FINISHED":PRINT:PRINT NREF;"References checked",NFOU;"put on output file: ";F2$:PRINT:PRINT:SYSTEM:END
  118. 1180 OPEN "I",#1,F1$
  119. 1190 GOTO 860
  120. 2000 REM this subroutine converts strings to upper case and eliminates
  121. 2010 REM control characters, punct.  and spaces  and resets high order bits
  122. 2020 REM input the string to be cleaned as DUM$
  123. 2030 DUM$=USR1(DUM$)+""
  124. 2040 RETURN
  125. 3000 REM this subroutine checks for matches with keys. MC keeps count 
  126. 3010 REM    of the sets with at least one match  
  127. 3020 MC=0
  128. 3030 FOR I1=1 TO NSET
  129. 3040 FOR I2=1 TO NKEY(I1)
  130. 3050 FOR I4=1 TO 5
  131. 3060 IF KEY$(I1,I4,I2)="" THEN GOTO 3120
  132. 3070 FOR I3=1 TO NB
  133. 3080 IF INSTR(CSTR$(I3),KEY$(I1,I4,I2))<>0 THEN GOTO 3110
  134. 3090 NEXT I3
  135. 3100 IF INSTR(OSTR$,KEY$(I1,I4,I2))=0 THEN GOTO 3130
  136. 3110 NEXT I4
  137. 3120 MC=MC+1: GOTO 3150
  138. 3130 NEXT I2
  139. 3140 RETURN
  140. 3150 NEXT I1
  141. 3160 RETURN
  142. 4000 REM ERROR TRAPPING ROUTINE
  143. 4010 IF ERR=53 AND ERL=1180 THEN PRINT "INPUT FILE NOT FOUND - TRY AGAIN":PRINT:RESUME 1120
  144. 4020 IF ERR=62 THEN CLOSE #1:PRINT "IMPROPER FILE END - LAST REFERENCE MAY BE IGNORED":RESUME 1110
  145. 4030 REM RE-ENABLE ERROR TRAPPING FOR OTHER FATAL ERRORS
  146. 4040 ON ERROR GOTO 0
  147. 5000 REM THIS IS THE DATA FOR THE ASSEMBLY LANGUAGE SUBROUTINE
  148. 5010 DATA &HEB,&H46,&H0E,&H00,&HE5,&H23,&H5E,&H23,&H56,&HEB,&H11
  149. 5020 DATA &HDF,&HB7,&H78,&HA7,&HCA,&HD0,&HB7,&H7E,&HE6,&H7F,&HFE
  150. 5030 DATA &H5B,&HDA,&HB7,&HB7,&HD6,&H20,&HC3,&HAD,&HB7,&HFE,&H2D
  151. 5040 DATA &HDA,&HCB,&HB7,&HFE,&H41,&HD2,&HC6,&HB7,&HFE,&H3B,&HD2
  152. 5050 DATA &HCB,&HB7,&HEB,&H77,&H23,&H0C,&HEB,&H05,&H23,&HC3,&HA5
  153. 5060 DATA &HB7,&HE1,&HE5,&H71,&H11,&HDF,&HB7,&H23,&H73,&H23,&H72
  154. 5070 DATA &H3E,&H03,&HE1,&HEB,&HC9
  155. HEB,&H05,&H23,&HC3,&HA5
  156. 5060 DATA &HB7,&HE1,&HE5,&H71,&H11,&HDF,&HB7,&H23,&H73,&H23,&H72
  157. 5070 DATA &H3E,&H0