home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol163 / vocbld.bas < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  4.9 KB  |  183 lines
  1.     REM------FILE VOCBLD.BAS
  2.  
  3.     REM BUILD/ENLARGE KEYWORD VOCABULARY
  4.  
  5.     COMMON KEYWD$(1),LIBNAME$,RLEN%,TRUE%,AUTH.LEN%,TITL.LEN%
  6.     COMMON MAXBIB%,MAXDESC%,MAXDEF%,MAXKEYS%,MAXCON%,CONCEPT$(1)
  7.     COMMON ISS.LEN%,CLEAR$,ERR%,JOUR.LEN%,KWD.LEN%,CMD$(1)
  8.     COMMON LFT%(1),RGHT%(1),CON.KEY%(2),CON.RATE(2),QUERY$,L%
  9.  
  10.     DIM DKEY%(MAXKEYS%),V%(MAXKEYS%),MOVE%(MAXKEYS%)
  11.     DIM L.STK%(8),R.STK%(8)
  12.  
  13.     REM CONVERT TWO ASCII HEX TO INTEGER
  14.     DEF FN.TWO.INT%(DUM$)
  15.     TEN%=ASC(MID$(DUM$,1,1))
  16.     IF TEN%>64 THEN TEN%=TEN%-55 ELSE TEN%=TEN%-48
  17.     ONE%=ASC(MID$(DUM$,2,1))
  18.     IF ONE%>64 THEN ONE%=ONE%-55 ELSE ONE%=ONE%-48
  19.     FN.TWO.INT%=16*TEN% + ONE%
  20.     RETURN
  21.     FEND
  22.  
  23.     REM CONVERT INTEGER TO TWO ASCII HEX
  24.     DEF FN.INT.TWO$(DUM%)
  25.     HI%=DUM%/16 : LO%=DUM%-16*HI%
  26.     IF HI%<10 THEN HI%=HI%+48 ELSE HI%=HI%+55
  27.     IF LO%<10 THEN LO%=LO%+48 ELSE LO%=LO%+55
  28.     FN.INT.TWO$=CHR$(HI%) + CHR$(LO%)
  29.     RETURN
  30.     FEND
  31.  
  32. 4E1     REM BUILD/ENLARGE/CHANGE VOCABULARY FILE
  33.     PRINT CLEAR$
  34.     PRINT TAB (12);"-----KEYWORD VOCABULARY BUILD/MODIFY-----"
  35.     PRINT
  36.     BLANK$="                                             "
  37.     ZEES$="zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz"
  38.     FOR I%=1 TO MAXKEYS% :  MOVE%(I%)=0 : V%(I%)=I% : NEXT I%
  39.     DEL%=0
  40.  
  41.     REM IF NO FILE THEN BUILD ONE
  42.     IF END #1 THEN 4.1E1
  43.     OPEN LIBNAME$+".VOC" AS 1
  44.     IF SIZE(LIBNAME$+".VOC")=0 THEN DELETE 1 : GOTO 4.1E1
  45.  
  46.     REM OTHERWISE READ THE FILE
  47.     IF END #1 THEN 4.2E1
  48.     VOC.LEN%=1
  49.     WHILE TRUE%
  50.       READ #1; LINE KEYWD$(VOC.LEN%)
  51.       VOC.LEN%=VOC.LEN%+1
  52.       WEND
  53.  
  54. 4.2E1   CLOSE 1
  55.     VOC.LEN%=VOC.LEN%-1:NEW%=0:OLD.NUM%=VOC.LEN%
  56.     B%=RENAME(LIBNAME$+".VBK",LIBNAME$+".VOC")
  57.     CREATE LIBNAME$+".VTM" AS 1
  58.  
  59.     INPUT "DO YOU WISH TO ADD OR DELETE (A/D)? ";LINE ANS$
  60.     ANS$=UCASE$(LEFT$(ANS$,1))
  61.     IF ANS$="A" THEN 4.5E1
  62.  
  63.     REM DELETE KEYWORDS
  64.     WHILE TRUE%
  65.       INPUT "ENTER KEYWORD NUMBER: ";LINE TEMP$
  66.       IF LEN(TEMP$)=0 THEN 4.4E1
  67.       J%=VAL(TEMP$) : DEL%=DEL%+1 : DKEY%(DEL%)=J%
  68.       KEYWD$(J%)=LEFT$(ZEES$,KWD.LEN%)
  69.       WEND
  70.  
  71. 4.5E1   REM GET A NEW KEYWORD
  72.     WHILE TRUE%
  73.       IF VOC.LEN%>=MAXKEYS% THEN PRINT "KEYWORD VOCABULARY FULL" : \
  74.            GOTO 4.4E1
  75.  
  76. 4.55E1  PRINT "ENTER KEYWORD #" ; VOC.LEN%+1;" : ";
  77.     INPUT "";LINE TEMP$
  78.       IF LEN(TEMP$)=0 THEN 4.4E1
  79.       TEMP$=UCASE$(TEMP$):I%=0
  80.       WHILE I%<LEN(TEMP$) : I%=I%+1
  81.         IF MID$(TEMP$,I%,1)=" " THEN \
  82.           PRINT "KEYWORDS MAY NOT CONTAIN BLANKS---RE-ENTER": \
  83.           GOTO 4.55E1
  84.           WEND
  85.       VOC.LEN%=VOC.LEN%+1 : KEYWD$(VOC.LEN%)=LEFT$(TEMP$+BLANK$,KWD.LEN%)
  86.       WEND
  87.  
  88. 4.1E1   REM BUILD FROM SCRATCH
  89.     CREATE LIBNAME$+".VOC" AS 1
  90.     VOC.LEN%=0:NEW%=-1:GOTO 4.5E1
  91.  
  92. 4.4E1   REM QUICKSORT ARRAY OF KEYWORDS, KEEPING TRACK OF MOVES
  93.     PRINT "SORTING . . . ."
  94.     S%=1 : L.STK%(1)=1 : R.STK%(1)=VOC.LEN%
  95.  
  96. 4.41E1  L%=L.STK%(S%) : R%=R.STK%(S%) : S%=S%-1
  97.  
  98. 4.422E1 I%=L% : J%=R% : X$=KEYWD$(INT%((L%+R%)/2))
  99.  
  100. 4.43E1  WHILE KEYWD$(I%)<X$ : I%=I%+1 : WEND
  101.         WHILE X$<KEYWD$(J%) : J%=J%-1 : WEND
  102.         IF I%<=J% THEN W$=KEYWD$(I%) : KEYWD$(I%)=KEYWD$(J%) : \
  103.              KEYWD$(J%)=W$ : TEMP%=V%(I%) : \
  104.              V%(I%)=V%(J%) : V%(J%)=TEMP% :I%=I%+1 : J%=J%-1
  105.         IF I%<=J% THEN 4.43E1
  106.       IF (J%-L%) >= (R%-I%) THEN 4.44E1
  107.       IF I%<R% THEN S%=S%+1 : L.STK%(S%)=I% : R.STK%(S%)=R%
  108.       R%=J%
  109.       GOTO 4.45E1
  110.  
  111. 4.44E1  IF L%<J% THEN S%=S%+1 : L.STK%(S%)=L% : R.STK%(S%)=J%
  112.       L%=I%
  113.  
  114. 4.45E1  IF L%<R% THEN 4.422E1
  115.     IF S%<>0 THEN 4.41E1
  116.  
  117.     REM RE-SHUFFLE MOVE VECTOR
  118.     IF NEW% THEN 4.42E1
  119.       FOR I%=1 TO VOC.LEN%
  120.         IF V%(I%)<=OLD.NUM% THEN MOVE%(V%(I%))=I%-V%(I%)
  121.         NEXT I%
  122.  
  123.     IF DEL%<=0 THEN 4.42E1
  124.     FOR I%=1 TO DEL%:MOVE%(DKEY%(I%))=999:NEXT I%
  125.     VOC.LEN%=VOC.LEN%-DEL%
  126.  
  127. 4.42E1  REM WRITE KEYWD$  ARRAY TO DISK
  128.     IF END #1 THEN 4.6E1
  129.     FOR I%=1 TO VOC.LEN%
  130.       PRINT USING "&"; #1; KEYWD$(I%)
  131.       NEXT I%
  132.     CLOSE 1
  133.     PRINT VOC.LEN%; " KEYWORDS WRITTEN TO VOCABULARY"
  134.  
  135.     IF NOT NEW% THEN \
  136.       B%=RENAME (LIBNAME$+".VOC",LIBNAME$+".VTM") : \
  137.          OPEN LIBNAME$+".VBK" AS 1 : DELETE 1 : GOSUB 5E1
  138.     CHAIN "VOCLST"
  139.  
  140. 4.6E1   PRINT "FILE WRITE ERROR"
  141.     IF NEW% THEN DELETE 1 ELSE CLOSE 1 : \
  142.          B%=RENAME (LIBNAME$+".VOC", LIBNAME$+".VBK") : \
  143.          OPEN LIBNAME$+".VTM" AS 1 : DELETE 1
  144.     INPUT "PRESS RETURN TO GO BACK TO MENU "; LINE ANS$
  145.  
  146. 4.9E1   CHAIN "BIBLIO"
  147.  
  148. 5E1     REM ALTER KEYWORD NUMBERS IN BIBLIO FILE FOR NEW ORDERING
  149.     REM IF THERE IS NO BIBLIO FILE WE ARE DONE
  150.     IF END #2 THEN 5.5E1
  151.     OPEN LIBNAME$+".BIB" RECL RLEN% AS 2
  152.     IF SIZE(LIBNAME$+".BIB")=0 THEN DELETE 2 : RETURN
  153.  
  154.     REM OTHERWISE WE READ AND MODIFY
  155.     PRINT "MODIFYING KEYWORD DESCTIPTIORS IN BIBLIO...."
  156.     IF END #2 THEN 5.4E1
  157.     RNUM%=2
  158.     READ #2,1;LINE TEMP$
  159.     DESC.BEG%=AUTH.LEN%+TITL.LEN%+JOUR.LEN%+ISS.LEN%+1
  160.  
  161.     WHILE TRUE%
  162.       READ #2,RNUM%;LINE TEMP$
  163.       I%=DESC.BEG% : L1%=LEN(TEMP$)
  164.       WHILE TRUE%
  165.         DUM$=MID$(TEMP$,I%,3)
  166.         IF DUM$="FFF" THEN 5.3E1
  167.         K%=FN.TWO.INT%(DUM$)
  168.         IF MOVE%(K%)=999 THEN DUM2$="" ELSE K%=K%+MOVE%(K%) : \
  169.            DUM2$=FN.INT.TWO$(K%) + RIGHT$(DUM$,1)
  170.         TEMP1$=LEFT$(TEMP$,I%-1)+DUM2$+RIGHT$(TEMP$,L1%-I%-2)
  171.         TEMP$=LEFT$(TEMP1$+"   ",L1%)
  172.         IF LEN(DUM2$)>0 THEN I%=I%+3
  173.         WEND
  174.  
  175. 5.3E1   PRINT USING "&"; #2,RNUM%; TEMP$
  176.     RNUM%=RNUM%+1
  177.       WEND
  178.  
  179. 5.4E1   CLOSE 2
  180.  
  181. 5.5E1   RETURN
  182.  
  183.