home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / lambda / soundpot / p / refind2.lbr / LITCIT.BZS / LITCIT.BAS
Encoding:
BASIC Source File  |  1993-10-25  |  4.6 KB  |  123 lines
  1. 10 REM This program written by John Porter
  2. 20 REM copyright (c) 1984 by John Porter
  3. 30 REM NOT TO BE SOLD
  4. 40 REM  3/13/84 
  5. 50 VERSION= 2
  6. 60 DIM ISTR$(30),AUTH$(200),DATE$(200) 
  7. 70 DEFINT I-N
  8. 80 REM DEFINE CLEAR SCREEN CHARACTER
  9. 90 CLS$=CHR$(26)
  10. 100 REM DEFINE BELL CHARACTER
  11. 110 BELL$=CHR$(7)
  12. 120 REM DEFINE DELIMITER USED TO SEPARATE COMMENTS FROM THE REFERENCES
  13. 130 NCHAR$="|"
  14. 135 IF ASC(NCHAR$)<128 THEN ICHAR$= CHR$(ASC(NCHAR$)+128) ELSE ICHAR$=CHR$(ASC(NCHAR$)-128)
  15. 140 REM SET SUBROUTINE TO CAPTURE ERROR CODES FOR INPUT FILES
  16. 150 ON ERROR GOTO 3000
  17. 160 PRINT CLS$:PRINT:PRINT "LITCIT - VERSION ";VERSION:PRINT
  18. 170  PRINT  "This  program locates references based on  the  first author and date"
  19. 180 PRINT " References should have single vertical spacing and"
  20. 190 PRINT " be separated from one another by double spacing."
  21. 200 PRINT 
  22. 210 PRINT "References will be written to another file in the same format."
  23. 220 PRINT "  and comments will be stripped off when they follow a: ";NCHAR$:PRINT 
  24. 230 PRINT:PRINT "You will be able to use multiple input files on different"
  25. 240 PRINT "   disks (or, if you want, the same disk). BUT YOU CAN NOT "
  26. 250 PRINT "   CHANGE THE DISK THE OUTPUT FILE IS ON!!!!!"
  27. 260 IFILE=1
  28. 270 PRINT:PRINT:PRINT "PUT IN THE DISKS YOU WANT TO READ FROM OR WRITE TO"
  29. 280 INPUT " AND HIT A CARRIAGE RETURN";A$
  30. 290 RESET
  31. 300 PRINT:PRINT
  32. 310 INPUT "What is the file name for INPUT";F1$
  33. 320 DUM$=F1$
  34. 330 GOSUB 1000
  35. 340 F1$=DUM$
  36. 350 INPUT "What is the file name for OUTPUT";F2$
  37. 360 DUM$=F2$
  38. 370 GOSUB 1000
  39. 380 F2$=DUM$
  40. 390 OPEN "I",#1,F1$
  41. 400 OPEN "O",#2,F2$
  42. 410 REM go read in authors and dates
  43. 420 PRINT 
  44. 430 PRINT "Input the first author's last name and the year"
  45. 440 PRINT "     for references to be listed"
  46. 450 PRINT
  47. 460 PRINT  "Separate them by a comma"
  48. 470 PRINT "When done, put in just a comma"
  49. 480 PRINT
  50. 490 NKEY=1
  51. 500 INPUT "Author,date (just , to end)";AUTH$(NKEY),DATE$(NKEY)
  52. 510 IF AUTH$(NKEY)="" THEN 560
  53. 520 IF LEN(DATE$(NKEY))<4 THEN DATE$(NKEY)="19"+ DATE$(NKEY)
  54. 530 IF LEN(DATE$(NKEY))<>4 THEN PRINT "BAD DATE - REDO":GOTO 500
  55. 540 NKEY=NKEY+1
  56. 550 GOTO 500
  57. 560 PRINT CLS$
  58. 570 NKEY=NKEY-1
  59. 580 REM this section reads in the references
  60. 590 REM the raw references are stored in array istr$
  61. 600 WHILE NOT EOF(1)
  62. 610 NB=1
  63. 620 NREF=NREF+1
  64. 630 LINE INPUT #1, ISTR$(NB)
  65. 640 IF ISTR$(NB)="" OR ISTR$(NB)=SPACE$(LEN(ISTR$(NB))) THEN 670
  66. 650 NB=NB+1
  67. 660 GOTO 630
  68. 670 GOSUB 2000
  69. 680 PRINT CLS$:PRINT:PRINT :PRINT
  70. 690 PRINT ,"REFS CHECKED = ";NREF,"NUMBER OF MATCHES = ";NFOU
  71. 700 IF MC < 1 THEN GOTO 850
  72. 710 NFOU=NFOU+1
  73. 720 PRINT CLS$:PRINT:PRINT :PRINT
  74. 730 PRINT ,"REFS CHECKED = ";NREF,"NUMBER OF MATCHES = ";NFOU
  75. 740 PRINT:PRINT:PRINT 
  76. 750 FOR I1=1 TO NB
  77. 760 I2=INSTR(ISTR$(I1),NCHAR$)
  78. 770 IF I2=0 THEN I2=INSTR(ISTR$(I1),ICHAR$)
  79. 775 IF I2=0 THEN 820
  80. 780 PRINT #2, LEFT$(ISTR$(I1),I2-1)
  81. 790 PRINT LEFT$(ISTR$(I1),(I2-1))
  82. 800 IF I2>1 THEN PRINT #2
  83. 810 GOTO 600
  84. 820 IF LEN(ISTR$(I1))=255 THEN PRINT #2,ISTR$(I1); :ELSE PRINT #2, ISTR$(I1)
  85. 830 IF LEN(ISTR$(I1))=255 THEN PRINT ISTR$(I1); :ELSE PRINT ISTR$(I1)
  86. 840 NEXT I1
  87. 850 WEND
  88. 860 CLOSE #1
  89. 870 FOR I= 1 TO 10:PRINT BELL$:NEXT I : PRINT CLS$
  90. 880 IFILE=IFILE+1
  91. 890 PRINT:PRINT:PRINT "Place the disk with input file #";IFILE;" in a disk drive"
  92. 900 PRINT" DO NOT remove the disk containing the output file!!!!!"
  93. 910 PRINT: PRINT
  94. 920 PRINT:INPUT "What is the new INPUT file name (Hit 'RETURN' to end)";F1$   
  95. 930 DUM$=F1$: GOSUB 1000: F1$=DUM$
  96. 940 IF F1$ = "" THEN CLOSE:PRINT BELL$,BELL$:PRINT "FINISHED":PRINT:PRINT NREF;"References checked",NFOU;"put on output file: ";F2$:PRINT:PRINT:SYSTEM:END
  97. 950 OPEN "I",#1,F1$
  98. 960 GOTO 600
  99. 970 END
  100. 1000 REM this subroutine converts strings to upper case. It also eliminates
  101. 1005 REM    spaces and resets the high order bit to 0
  102. 1010 REM input the string to be cleaned as DUM$
  103. 1020 DUM1$=""
  104. 1030 FOR I1=1 TO LEN(DUM$)
  105. 1040 I2=ASC(MID$(DUM$,I1,1))
  106. 1050 IF I2>90 THEN IF I2>127 THEN I2=I2-128:GOTO 1050:ELSE I2=I2-32: GOTO 1050
  107. 1060 DUM1$=DUM1$ + CHR$(I2)
  108. 1070 NEXT I1
  109. 1080 DUM$=DUM1$
  110. 1090 RETURN
  111. 2000 REM this section checks for matches with keys
  112. 2010 MC=0
  113. 2020 FOR I2=1 TO NKEY
  114. 2030 IF AUTH$(I2)=LEFT$(ISTR$(1),LEN(AUTH$(I2))) THEN IF INSTR(ISTR$(1),DATE$(I2))<>0 THEN:MC=MC+1:GOTO 2050
  115. 2040 NEXT I2
  116. 2050 RETURN
  117. 3000 REM ERROR TRAPPING ROUTINE
  118. 3010 IF ERR=53 AND ERL=950 THEN PRINT "INPUT FILE NOT FOUND - TRY AGAIN":PRINT:RESUME 890
  119. 3015 IF ERR=62 THEN CLOSE #1:PRINT"IMPROPER END TO FILE - LAST REF MAY HAVE BEEN MISSED":RESUME 880
  120. 3020 REM RE-ENABLE ERROR TRAPPING FOR OTHER FATAL ERRORS
  121. 3030 ON ERROR GOTO 0
  122. E - LAST REF MAY HAVE BEEN MISSED":RESUME 880
  123. 3020 REM RE-ENABLE ERROR TRAPPING FOR OTHER F